git.hungrycats.org Git - xscreensaver/blob - 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
  25 my ($exec_dir, $progname) = ($0 =~ m@^(.*?)/([^/]+)$@);
  26
  27 my $version = q{ $Revision: 1.23 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
  28
  29 $ENV{PATH} = "/usr/local/bin:$ENV{PATH}";   # for seticon
  30
  31 my $thumbdir = $ENV{HOME} . '/www/xscreensaver/screenshots/';
  32
  33
  34
  35 my $verbose = 1;
  36
  37 sub read_info_plist($);
  38 sub read_info_plist($) {
  39   my ($app_dir) = @_;
  40   my $file  = "$app_dir/Contents/Info.plist";
  41   my $file2 = "$app_dir/Info.plist";
  42   $file =~ s@/+@/@g;
  43   my $in;
  44   if (open ($in, '<', $file)) {
  45   } elsif (open ($in, '<', $file2)) {
  46     $file = $file2;
  47   } else {
  48     error ("$file: $!");
  49   }
  50   local $/ = undef;  # read entire file
  51   my $body = <$in>;
  52   close $in;
  53
  54   if ($body =~ m/^bplist/s) {
  55     print STDERR "$progname: converting binary plist file: $file\n";
  56     system ("plutil", "-convert", "xml1", $file);
  57     return read_info_plist ($app_dir);
  58   }
  59
  60   return ($file, $body);
  61 }
  62
  63
  64 sub read_saver_xml($) {
  65   my ($app_dir) = @_;
  66   error ("$app_dir: no name")
  67     unless ($app_dir =~ m@/([^/.]+).(app|saver)/?$@x);
  68   my $name  = $1;
  69
  70   return () if ($name eq 'XScreenSaver');
  71   return () if ($name eq 'SaverTester');
  72
  73   my $file  = "$app_dir/Contents/Resources/" . lc($name) . ".xml";
  74   my $file2 = "$app_dir/" . lc($name) . ".xml";
  75   my $file3 = "$app_dir/Contents/PlugIns/$name.saver/Contents/Resources/" .
  76               lc($name) . ".xml";
  77   $file =~ s@/+@/@g;
  78   my $in;
  79   if (open ($in, '<', $file)) {
  80   } elsif (open ($in, '<', $file2)) { $file = $file2;
  81   } elsif (open ($in, '<', $file3)) { $file = $file3;
  82   } else {
  83     error ("$file: $!");
  84   }
  85   local $/ = undef;  # read entire file
  86   my $body = <$in>;
  87   close $in;
  88   return ($file, $body);
  89 }
  90
  91
  92 sub update_saver_xml($$) {
  93   my ($app_dir, $vers) = @_;
  94   my ($filename, $body) = read_saver_xml ($app_dir);
  95   my $obody = $body;
  96
  97   return () unless defined ($filename);
  98
  99   $body =~ m@<screensaver[^<>]*?[ \t]_label=\"([^\"]+)\"@m ||
 100     error ("$filename: no name label");
 101   my $name = $1;
 102
 103   $body =~ m@<_description>(.*?)</_description>@s ||
 104     error ("$filename: no description tag");
 105   my $desc = $1;
 106   $desc =~ s/^([ \t]*\n)+//s;
 107   $desc =~ s/\s*$//s;
 108
 109   # in case it's done already...
 110   $desc =~ s@<!--.*?-->@@gs;
 111   $desc =~ s/^.* version \d[^\n]*\n//s;
 112   $desc =~ s/^From the XScreenSaver.*\n//m;
 113   $desc =~ s@^http://www\.jwz\.org/xscreensaver.*\n@@m;
 114   $desc =~
 115        s/\nCopyright [^ \r\n\t]+ (\d{4})(-\d{4})? (.*)\.$/\nWritten $3; $1./s;
 116   $desc =~ s/^\n+//s;
 117
 118   error ("$filename: description contains bad characters")
 119     if ($desc =~ m/([^\t\n -~]|[<>])/);
 120
 121   error ("$filename: can't extract authors")
 122     unless ($desc =~ m@^(.*)\nWritten by[ \t]+(.+)$@s);
 123   $desc = $1;
 124   my $authors = $2;
 125   $desc =~ s/\s*$//s;
 126
 127   my $year = undef;
 128   if ($authors =~ m@^(.*?)\s*[,;]\s+(\d\d\d\d)([-\s,;]+\d\d\d\d)*[.]?$@s) {
 129     $authors = $1;
 130     $year = $2;
 131   }
 132
 133   error ("$filename: can't extract year") unless $year;
 134   my $cyear = 1900 + ((localtime())[5]);
 135   $year = "$cyear" unless $year;
 136   if ($year && ! ($year =~ m/$cyear/)) {
 137     $year = "$year-$cyear";
 138   }
 139
 140   $authors =~ s/[.,;\s]+$//s;
 141
 142   # List me as a co-author on all of them, since I'm the one who
 143   # did the OSX port, packaged it up, and built the executables.
 144   #
 145   my $curator = "Jamie Zawinski";
 146   if (! ($authors =~ m/$curator/si)) {
 147     if ($authors =~ m@^(.*?),? and (.*)$@s) {
 148       $authors = "$1, $2, and $curator";
 149     } else {
 150       $authors .= " and $curator";
 151     }
 152   }
 153
 154   my $desc1 = ("$name, version $vers.\n\n" .            # savername.xml
 155                $desc . "\n" .
 156                "\n" .
 157                "From the XScreenSaver collection: " .
 158                "http://www.jwz.org/xscreensaver/\n" .
 159                "Copyright \251 $year by $authors.\n");
 160
 161   my $desc2 = ("$name $vers,\n" .                       # Info.plist
 162                "\302\251 $year $authors.\n" .
 163                "From the XScreenSaver collection:\n" .
 164                "http://www.jwz.org/xscreensaver/\n" .
 165                "\n" .
 166                $desc .
 167                "\n");
 168
 169   # unwrap lines, but only when it's obviously ok: leave blank lines,
 170   # and don't unwrap if that would compress leading whitespace on a line.
 171   #
 172   $desc2 =~ s/^(From |http:)/\n$1/gm;
 173   1 while ($desc2 =~ s/([^\s])[ \t]*\n([^\s])/$1 $2/gs);
 174   $desc2 =~ s/\n\n(From |http:)/\n$1/gs;
 175
 176   $body =~ s@(<_description>)(.*?)(</_description>)@$1$desc1$3@s;
 177
 178   if ($obody eq $body) {
 179     print STDERR "$progname: $filename: unchanged\n" if ($verbose > 1);
 180   } else {
 181     my $file_tmp = "$filename.tmp";
 182     open (my $out, '>', $file_tmp) || error ("$file_tmp: $!");
 183     print $out $body || error ("$file_tmp: $!");
 184     close $out || error ("$file_tmp: $!");
 185
 186     if (!rename ("$file_tmp", "$filename")) {
 187       unlink "$file_tmp";
 188       error ("mv \"$file_tmp\" \"$filename\": $!");
 189     }
 190     print STDERR "$progname: wrote $filename\n" if ($verbose);
 191   }
 192
 193   return ($desc1, $desc2);
 194 }
 195
 196
 197
 198 sub set_plist_key($$$$) {
 199   my ($filename, $body, $key, $val) = @_;
 200
 201   if ($body =~ m@^(.*
 202                   \n\t<key>$key</key>
 203                   \n\t<string>)([^<>]*)(</string>
 204                   .*)$@xs) {
 205 #    print STDERR "$progname: $filename: $key was: $2\n" if ($verbose);
 206     $body = $1 . $val . $3;
 207   } else {
 208     error ("$filename: unparsable")
 209       unless ($body =~ m@^(.*)(\n</dict>\n</plist>\n)$@s);
 210     $body = ($1 .
 211              "\n\t<key>$key</key>" .
 212              "\n\t<string>$val</string>" .
 213              $2);
 214   }
 215
 216   return $body;
 217 }
 218
 219
 220 sub set_icon($) {
 221   my ($app_dir) = @_;
 222   $app_dir =~ s@/+$@@s;
 223
 224   # "seticon" is from osxutils, http://osxutils.sourceforge.net/
 225
 226   my $icon = ($app_dir =~ m/\.saver$/ ? 'XScreenSaver' : 'SaverRunner');
 227   $icon = "$app_dir/../../../$icon.icns";
 228   my @cmd = ("seticon", "-d", $icon, $app_dir);
 229   print STDERR "$progname: exec: " . join(' ', @cmd) . "\n"
 230     if ($verbose > 1);
 231   system (@cmd);
 232 }
 233
 234
 235 sub set_thumb($) {
 236   my ($app_dir) = @_;
 237
 238   return unless ($app_dir =~ m@\.saver/?$@s);
 239
 240   my @cmd = ("$exec_dir/update-thumbnail.pl", $thumbdir, $app_dir);
 241   push @cmd, "-" . ("v" x $verbose) if ($verbose);
 242   print STDERR "$progname: exec: " . join(' ', @cmd) . "\n"
 243     if ($verbose > 1);
 244   system (@cmd);
 245   my $exit  = $? >> 8;
 246   exit ($exit) if $exit;
 247 }
 248
 249
 250 sub update($) {
 251   my ($app_dir) = @_;
 252
 253   error ("$app_dir: no name")
 254     unless ($app_dir =~ m@/([^/.]+).(app|saver)/?$@x);
 255   my $app_name = $1;
 256
 257   my ($filename, $plist) = read_info_plist ($app_dir);
 258   my $oplist = $plist;
 259
 260   error ("$filename: no version number")
 261     unless ($plist =~ m@<key>CFBundleShortVersionString</key>\s*
 262                         <string>([^<>]+)</string>@sx);
 263   my $vers = $1;
 264   my ($ignore, $info_str) = update_saver_xml ($app_dir, $vers);
 265
 266   if (! defined($info_str)) {
 267     print STDERR "$progname: $filename: no XML file\n" if ($verbose > 1);
 268   } else {
 269
 270     $info_str =~ m@^([^\n]+)\n@s ||
 271       error ("$filename: unparsable copyright");
 272     my $copyright = "$1";
 273     $copyright =~ s/\b\d{4}-(\d{4})\b/$1/;
 274
 275     # Lose the Wikipedia URLs.
 276     $info_str =~ s@http:.*?\b(wikipedia|mathworld)\b[^\s]+[ \t]*\n?@@gm;
 277
 278     $info_str =~ s/(\n\n)\n+/$1/gs;
 279     $info_str =~ s/(^\s+|\s+$)//gs;
 280     $plist = set_plist_key ($filename, $plist,
 281                             "NSHumanReadableCopyright", $copyright);
 282     $plist = set_plist_key ($filename, $plist,
 283                             "CFBundleLongVersionString",$copyright);
 284     $plist = set_plist_key ($filename, $plist,
 285                             "CFBundleGetInfoString",    $info_str);
 286
 287     if ($oplist eq $plist) {
 288       print STDERR "$progname: $filename: unchanged\n" if ($verbose > 1);
 289     } else {
 290       my $file_tmp = "$filename.tmp";
 291       open (my $out, '>', $file_tmp) || error ("$file_tmp: $!");
 292       print $out $plist || error ("$file_tmp: $!");
 293       close $out || error ("$file_tmp: $!");
 294
 295       if (!rename ("$file_tmp", "$filename")) {
 296         unlink "$file_tmp";
 297         error ("mv \"$file_tmp\" \"$filename\": $!");
 298       }
 299       print STDERR "$progname: wrote $filename\n" if ($verbose);
 300     }
 301   }
 302
 303   set_icon ($app_dir);
 304   set_thumb ($app_dir);
 305 }
 306
 307
 308 sub error($) {
 309   my ($err) = @_;
 310   print STDERR "$progname: $err\n";
 311   exit 1;
 312 }
 313
 314 sub usage() {
 315   print STDERR "usage: $progname [--verbose] program.app ...\n";
 316   exit 1;
 317 }
 318
 319 sub main() {
 320
 321   my @files = ();
 322   while ($_ = $ARGV[0]) {
 323     shift @ARGV;
 324     if    (m/^--?verbose$/s)  { $verbose++; }
 325     elsif (m/^-v+$/)          { $verbose += length($_)-1; }
 326     elsif (m/^--?q(uiet)?$/s) { $verbose = 0; }
 327     elsif (m/^-/s)            { usage(); }
 328     else                      { push @files, $_; }
 329   }
 330   usage() unless ($#files >= 0);
 331   foreach (@files) {
 332     update ($_);
 333   }
 334 }
 335
 336 main();
 337 exit 0;