git.hungrycats.org Git - xscreensaver/blob - OSX/update-info-plist.pl

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