0d933cb7f6d69fa081a03f02dfc1f04bb2b759f9
[xscreensaver] / OSX / update-info-plist.pl
1 #!/usr/bin/perl -w
2 # Copyright © 2006-2013 Jamie Zawinski <jwz@jwz.org>
3 #
4 # Permission to use, copy, modify, distribute, and sell this software and its
5 # documentation for any purpose is hereby granted without fee, provided that
6 # the above copyright notice appear in all copies and that both that
7 # copyright notice and this permission notice appear in supporting
8 # documentation.  No representations are made about the suitability of this
9 # software for any purpose.  It is provided "as is" without express or 
10 # implied warranty.
11 #
12 # Updates the NAME.xml file of a .saver bundle to include the current year,
13 # version number, etc.  Also updates the Info.plist file to include the
14 # short documentation, authors, etc. in the Finder "Get Info" properties.
15 #
16 # This is invoked by a final "Shell Script" build action on each of the
17 # .saver targets in the XCode project.
18 #
19 # Created:  8-Mar-2006.
20
21 require 5;
22 #use diagnostics;       # Fails on some MacOS 10.5 systems
23 use strict;
24 use IPC::Open3;
25 use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
26 use IO::Compress::Gzip qw(gzip $GzipError);
27
28 my ($exec_dir, $progname) = ($0 =~ m@^(.*?)/([^/]+)$@);
29
30 my $version = q{ $Revision: 1.28 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
31
32 $ENV{PATH} = "/usr/local/bin:$ENV{PATH}";   # for seticon
33
34 my $thumbdir = $ENV{HOME} . '/www/xscreensaver/screenshots/';
35
36
37
38 my $verbose = 1;
39
40 sub convert_plist($$) {
41   my ($data, $to_binary_p) = @_;
42   my $is_binary_p = ($data =~ m/^bplist/s);
43   if ($data && (!$is_binary_p) != (!$to_binary_p)) {
44     print STDERR "$progname: converting plist\n" if ($verbose > 2);
45     my $which = ($to_binary_p ? 'binary1' : 'xml1');
46     my $cmd = "plutil -convert $which -s -o - -";
47     my $pid = open3 (my $in, my $out, undef, $cmd) || error ("pipe: $cmd: $!");
48     print $in $data;
49     close $in;
50     local $/ = undef;  # read entire file
51     $data = <$out>;
52     close $out;
53   }
54   return $data;
55 }
56
57
58 sub read_info_plist($) {
59   my ($app_dir) = @_;
60   my $file  = "$app_dir/Contents/Info.plist";
61   my $file2 = "$app_dir/Info.plist";
62   $file =~ s@/+@/@g;
63   my $in;
64   if (open ($in, '<', $file)) {
65   } elsif (open ($in, '<', $file2)) {
66     $file = $file2;
67   } else {
68     error ("$file: $!");
69   }
70   print STDERR "$progname: read $file\n" if ($verbose > 2);
71   local $/ = undef;  # read entire file
72   my $body = <$in>;
73   close $in;
74
75   $body = convert_plist ($body, 0);  # convert to xml plist
76   return ($file, $body);
77 }
78
79
80 sub read_saver_xml($) {
81   my ($app_dir) = @_;
82   error ("$app_dir: no name") 
83     unless ($app_dir =~ m@/([^/.]+).(app|saver)/?$@x);
84   my $name  = $1;
85
86   return () if ($name eq 'XScreenSaver');
87   return () if ($name eq 'SaverTester');
88   return () if ($name eq 'XScreenSaverUpdater');
89
90   my $file  = "$app_dir/Contents/Resources/" . lc($name) . ".xml";
91   my $file2 = "$app_dir/" . lc($name) . ".xml";
92   my $file3 = "$app_dir/Contents/PlugIns/$name.saver/Contents/Resources/" .
93               lc($name) . ".xml";
94   $file =~ s@/+@/@g;
95   my $in;
96   if (open ($in, '<', $file)) {
97   } elsif (open ($in, '<', $file2)) { $file = $file2;
98   } elsif (open ($in, '<', $file3)) { $file = $file3;
99   } else {
100     error ("$file: $!");
101   }
102   print STDERR "$progname: read $file\n" if ($verbose > 2);
103   local $/ = undef;  # read entire file
104   my $body = <$in>;
105   close $in;
106
107   # Uncompress the XML if it is compressed.
108   my $body2 = '';
109   gunzip (\$body, \$body2) || error ("$app_dir: xml gunzip: $GunzipError");
110   my $was_compressed_p = ($body ne $body2);
111   return ($file, $body2, $was_compressed_p);
112 }
113
114
115 sub update_saver_xml($$) {
116   my ($app_dir, $vers) = @_;
117   my ($filename, $body, $was_compressed_p) = read_saver_xml ($app_dir);
118   my $obody = $body;
119
120   return () unless defined ($filename);
121
122   $body =~ m@<screensaver[^<>]*?[ \t]_label=\"([^\"]+)\"@m ||
123     error ("$filename: no name label");
124   my $name = $1;
125
126   $body =~ m@<_description>(.*?)</_description>@s ||
127     error ("$filename: no description tag");
128   my $desc = $1;
129   $desc =~ s/^([ \t]*\n)+//s;
130   $desc =~ s/\s*$//s;
131
132   # in case it's done already...
133   $desc =~ s@<!--.*?-->@@gs;
134   $desc =~ s/^.* version \d[^\n]*\n//s;
135   $desc =~ s/^From the XScreenSaver.*\n//m;
136   $desc =~ s@^http://www\.jwz\.org/xscreensaver.*\n@@m;
137   $desc =~
138        s/\nCopyright [^ \r\n\t]+ (\d{4})(-\d{4})? (.*)\.$/\nWritten $3; $1./s;
139   $desc =~ s/^\n+//s;
140
141   error ("$filename: description contains bad characters")
142     if ($desc =~ m/([^\t\n -~]|[<>])/);
143
144   error ("$filename: can't extract authors")
145     unless ($desc =~ m@^(.*)\nWritten by[ \t]+(.+)$@s);
146   $desc = $1;
147   my $authors = $2;
148   $desc =~ s/\s*$//s;
149
150   my $year = undef;
151   if ($authors =~ m@^(.*?)\s*[,;]\s+(\d\d\d\d)([-\s,;]+\d\d\d\d)*[.]?$@s) {
152     $authors = $1;
153     $year = $2;
154   }
155
156   error ("$filename: can't extract year") unless $year;
157   my $cyear = 1900 + ((localtime())[5]);
158   $year = "$cyear" unless $year;
159   if ($year && ! ($year =~ m/$cyear/)) {
160     $year = "$year-$cyear";
161   }
162
163   $authors =~ s/[.,;\s]+$//s;
164
165   # List me as a co-author on all of them, since I'm the one who
166   # did the OSX port, packaged it up, and built the executables.
167   #
168   my $curator = "Jamie Zawinski";
169   if (! ($authors =~ m/$curator/si)) {
170     if ($authors =~ m@^(.*?),? and (.*)$@s) {
171       $authors = "$1, $2, and $curator";
172     } else {
173       $authors .= " and $curator";
174     }
175   }
176
177   my $desc1 = ("$name, version $vers.\n\n" .            # savername.xml
178                $desc . "\n" .
179                "\n" . 
180                "From the XScreenSaver collection: " .
181                "http://www.jwz.org/xscreensaver/\n" .
182                "Copyright \302\251 $year by $authors.\n");
183
184   my $desc2 = ("$name $vers,\n" .                       # Info.plist
185                "\302\251 $year $authors.\n" .
186                "From the XScreenSaver collection:\n" .
187                "http://www.jwz.org/xscreensaver/\n" .
188                "\n" .
189                $desc .
190                "\n");
191
192   # unwrap lines, but only when it's obviously ok: leave blank lines,
193   # and don't unwrap if that would compress leading whitespace on a line.
194   #
195   $desc2 =~ s/^(From |http:)/\n$1/gm;
196   1 while ($desc2 =~ s/([^\s])[ \t]*\n([^\s])/$1 $2/gs);
197   $desc2 =~ s/\n\n(From |http:)/\n$1/gs;
198
199   $body =~ s@(<_description>)(.*?)(</_description>)@$1$desc1$3@s;
200
201   # NSXMLParser doesn't seem to work properly on Latin1 XML documents,
202   # so we convert these to UTF8 when embedding them in the .saver bundle.
203   $body =~ s@encoding="ISO-8859-1"@encoding="UTF-8"@gsi;
204
205   if ($obody eq $body && $was_compressed_p) {
206     print STDERR "$progname: $filename: unchanged\n" if ($verbose > 1);
207   } else {
208
209     # Gzip the XML.
210     my $body2 = '';
211     gzip (\$body, \$body2) || error ("$app_dir: xml gzip: $GzipError");
212     $body = $body2;
213
214     my $file_tmp = "$filename.tmp";
215     open (my $out, '>:raw', $file_tmp) || error ("$file_tmp: $!");
216     print $out $body || error ("$file_tmp: $!");
217     close $out || error ("$file_tmp: $!");
218
219     if (!rename ("$file_tmp", "$filename")) {
220       unlink "$file_tmp";
221       error ("mv \"$file_tmp\" \"$filename\": $!");
222     }
223     print STDERR "$progname: wrote $filename\n" if ($verbose);
224   }
225
226   return ($desc1, $desc2);
227 }
228
229
230 sub compress_all_xml_files($) {
231   my ($dir) = @_;
232   opendir (my $dirp, $dir) || error ("$dir: $!");
233   my @files = readdir ($dirp);
234   closedir $dirp;
235   foreach my $f (sort @files) {
236     next unless ($f =~ m/\.xml$/si);
237     my $filename = "$dir/$f";
238     open (my $in, '<', $filename) || error ("$filename: $!");
239     print STDERR "$progname: read $filename\n" if ($verbose > 2);
240     local $/ = undef;  # read entire file
241     my $body = <$in>;
242     close $in;
243
244     if ($body =~ m/^<\?xml/s) {
245       my $body2 = '';
246       gzip (\$body, \$body2) || error ("$filename: xml gzip: $GzipError");
247       $body = $body2;
248       my $file_tmp = "$filename.tmp";
249       open (my $out, '>:raw', $file_tmp) || error ("$file_tmp: $!");
250       print $out $body || error ("$file_tmp: $!");
251       close $out || error ("$file_tmp: $!");
252
253       if (!rename ("$file_tmp", "$filename")) {
254         unlink "$file_tmp";
255         error ("mv \"$file_tmp\" \"$filename\": $!");
256       }
257       print STDERR "$progname: compressed $filename\n" if ($verbose);
258     } elsif ($verbose > 2) {
259       print STDERR "$filename: already compressed\n";
260     }
261   }
262 }
263
264
265 sub set_plist_key($$$$) {
266   my ($filename, $body, $key, $val) = @_;
267
268   if ($body =~ m@^(.*
269                   \n\t<key>$key</key>
270                   \n\t<string>)([^<>]*)(</string>
271                   .*)$@xs) {
272 #    print STDERR "$progname: $filename: $key was: $2\n" if ($verbose);
273     $body = $1 . $val . $3;
274   } else {
275     error ("$filename: unparsable")
276       unless ($body =~ m@^(.*)(\n</dict>\n</plist>\n)$@s);
277     $body = ($1 .
278              "\n\t<key>$key</key>" .
279              "\n\t<string>$val</string>" .
280              $2);
281   }
282
283   return $body;
284 }
285
286
287 sub set_icon($) {
288   my ($app_dir) = @_;
289   $app_dir =~ s@/+$@@s;
290
291   # "seticon" is from osxutils, http://osxutils.sourceforge.net/
292
293   my $icon = ($app_dir =~ m/\.saver$/ ? 'XScreenSaver' : 'SaverRunner');
294   $icon = "$app_dir/../../../$icon.icns";
295   my @cmd = ("seticon", "-d", $icon, $app_dir);
296   print STDERR "$progname: exec: " . join(' ', @cmd) . "\n"
297     if ($verbose > 1);
298   system (@cmd);
299 }
300
301
302 sub set_thumb($) {
303   my ($app_dir) = @_;
304
305   return unless ($app_dir =~ m@\.saver/?$@s);
306
307   my @cmd = ("$exec_dir/update-thumbnail.pl", $thumbdir, $app_dir);
308   push @cmd, "-" . ("v" x $verbose) if ($verbose);
309   print STDERR "$progname: exec: " . join(' ', @cmd) . "\n"
310     if ($verbose > 1);
311   system (@cmd);
312   my $exit  = $? >> 8;
313   exit ($exit) if $exit;
314 }
315
316
317 sub update($) {
318   my ($app_dir) = @_;
319
320   error ("$app_dir: no name") 
321     unless ($app_dir =~ m@/([^/.]+).(app|saver)/?$@x);
322   my $app_name = $1;
323
324   my ($filename, $plist) = read_info_plist ($app_dir);
325   my $oplist = $plist;
326
327   error ("$filename: no version number")
328     unless ($plist =~ m@<key>CFBundleShortVersionString</key>\s*
329                         <string>([^<>]+)</string>@sx);
330   my $vers = $1;
331   my ($ignore, $info_str) = update_saver_xml ($app_dir, $vers);
332
333   # No, don't do this -- the iOS version reads the XML file in a few
334   # different places, and most of those places don't understand gzip.
335
336   if ($app_name eq 'XScreenSaver') {
337     compress_all_xml_files ($app_dir);
338   } elsif (! defined($info_str)) {
339     print STDERR "$progname: $filename: no XML file\n" if ($verbose > 1);
340   } else {
341
342     $info_str =~ m@^([^\n]+)\n@s ||
343       error ("$filename: unparsable copyright");
344     my $copyright = "$1";
345     $copyright =~ s/\b\d{4}-(\d{4})\b/$1/;
346
347     # Lose the Wikipedia URLs.
348     $info_str =~ s@http:.*?\b(wikipedia|mathworld)\b[^\s]+[ \t]*\n?@@gm;
349
350     $info_str =~ s/(\n\n)\n+/$1/gs;
351     $info_str =~ s/(^\s+|\s+$)//gs;
352     $plist = set_plist_key ($filename, $plist, 
353                             "NSHumanReadableCopyright", $copyright);
354     $plist = set_plist_key ($filename, $plist,
355                             "CFBundleLongVersionString",$copyright);
356     $plist = set_plist_key ($filename, $plist,
357                             "CFBundleGetInfoString",    $info_str);
358
359     if ($oplist eq $plist) {
360       print STDERR "$progname: $filename: unchanged\n" if ($verbose > 1);
361     } else {
362       $plist = convert_plist ($plist, 1);  # convert to binary plist
363       my $file_tmp = "$filename.tmp";
364       open (my $out, '>:raw', $file_tmp) || error ("$file_tmp: $!");
365       print $out $plist || error ("$file_tmp: $!");
366       close $out || error ("$file_tmp: $!");
367
368       if (!rename ("$file_tmp", "$filename")) {
369         unlink "$file_tmp";
370         error ("mv \"$file_tmp\" \"$filename\": $!");
371       }
372       print STDERR "$progname: wrote $filename\n" if ($verbose);
373     }
374   }
375
376   set_icon ($app_dir);
377   set_thumb ($app_dir);
378 }
379
380
381 sub error($) {
382   my ($err) = @_;
383   print STDERR "$progname: $err\n";
384   exit 1;
385 }
386
387 sub usage() {
388   print STDERR "usage: $progname [--verbose] program.app ...\n";
389   exit 1;
390 }
391
392 sub main() {
393
394   my @files = ();
395   while ($_ = $ARGV[0]) {
396     shift @ARGV;
397     if    (m/^--?verbose$/s)  { $verbose++; }
398     elsif (m/^-v+$/)          { $verbose += length($_)-1; }
399     elsif (m/^--?q(uiet)?$/s) { $verbose = 0; }
400     elsif (m/^-/s)            { usage(); }
401     else                      { push @files, $_; }
402   }
403   usage() unless ($#files >= 0);
404   foreach (@files) {
405     update ($_);
406   }
407 }
408
409 main();
410 exit 0;