From http://www.jwz.org/xscreensaver/xscreensaver-5.23.tar.gz
[xscreensaver] / OSX / update-thumbnail.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 # Converts and installs a thumbnail image inside a .saver bundle.
13 #
14 # Created:  26-Jul-2012.
15
16 require 5;
17 #use diagnostics;       # Fails on some MacOS 10.5 systems
18 use strict;
19
20 my $progname = $0; $progname =~ s@.*/@@g;
21 my $version = q{ $Revision: 1.3 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
22
23 my $verbose = 1;
24
25 $ENV{PATH} = "/opt/local/bin:$ENV{PATH}";   # MacPorts, for ImageMagick
26
27
28 sub safe_system(@) {
29   my @cmd = @_;
30   system (@cmd);
31   my $exit_value  = $? >> 8;
32   my $signal_num  = $? & 127;
33   my $dumped_core = $? & 128;
34   error ("$cmd[0]: core dumped!") if ($dumped_core);
35   error ("$cmd[0]: signal $signal_num!") if ($signal_num);
36   error ("$cmd[0]: exited with $exit_value!") if ($exit_value);
37 }
38
39
40 # Returns true if the two files differ (by running "cmp")
41 #
42 sub cmp_files($$) {
43   my ($file1, $file2) = @_;
44
45   my @cmd = ("cmp", "-s", "$file1", "$file2");
46   print STDERR "$progname: executing \"" . join(" ", @cmd) . "\"\n"
47     if ($verbose > 3);
48
49   system (@cmd);
50   my $exit_value  = $? >> 8;
51   my $signal_num  = $? & 127;
52   my $dumped_core = $? & 128;
53
54   error ("$cmd[0]: core dumped!") if ($dumped_core);
55   error ("$cmd[0]: signal $signal_num!") if ($signal_num);
56   return $exit_value;
57 }
58
59
60 sub update($$) {
61   my ($src_dir, $app_dir) = @_;
62
63   # Apparently Apple wants Resources/{thumbnail.png to be 90x58,
64   # and Resources/thumbnail@2x.png to be 180x116.  Let's just 
65   # make the former, but make it be the latter's size.
66   #
67   my $size = '180x116';
68
69   error ("$app_dir does not exist") unless (-d $app_dir);
70   error ("$app_dir: no name")
71     unless ($app_dir =~ m@/([^/.]+).(saver|app)/?$@x);
72   my $app_name = $1;
73
74   $app_dir =~ s@/+$@@s;
75   $app_dir .= "/Contents/Resources";
76
77   error ("$app_dir does not exist") unless (-d $app_dir);
78   my $target = "$app_dir/thumbnail.png";
79
80   $src_dir .= "/" unless ($src_dir =~ m@/$@s);
81   my $src_dir2 = "${src_dir}retired/";
82
83   $app_name =~ s/rdbomb/rd-bomb/si;   # sigh
84
85   my $img  = $src_dir  . lc($app_name) . ".jpg";
86   my $img2 = $src_dir2 . lc($app_name) . ".jpg";
87   $img = $img2 if (! -f $img && -f $img2);
88   error ("$img does not exist") unless (-f $img);
89
90   my $tmp = sprintf ("%s/thumb-%08x.png",
91                      ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp"),
92                      rand(0xFFFFFFFF));
93   my @cmd = ("convert",
94              $img, 
95              "-resize", $size . "^",
96              "-gravity", "center",
97              "-extent", $size,
98              "-quality", "95",                  # saves 8%
99              "+dither", "-colors", "128",       # Saves an additional 61%
100              $tmp);
101
102   print STDERR "$progname: exec: " . join(' ', @cmd) . "\n" 
103     if ($verbose > 2);
104   safe_system (@cmd);
105
106   if (! -s $tmp) {
107     unlink $tmp;
108     error ("failed: " . join(" ", @cmd));
109   }
110
111   # This only saves 0.4% on top of the above.
112   #  @cmd = ("optipng", "-quiet", "-o7", $tmp);
113   #  print STDERR "$progname: exec: " . join(' ', @cmd) . "\n" 
114   #    if ($verbose > 2);
115   #  safe_system (@cmd);
116
117   if (! -s $tmp) {
118     unlink $tmp;
119     error ("failed: " . join(" ", @cmd));
120   }
121
122   if (! cmp_files ($tmp, $target)) {
123     unlink $tmp;
124     print STDERR "$progname: $target: unchanged\n" if ($verbose > 1);
125   } elsif (! rename ($tmp, $target)) {
126     unlink $tmp;
127     error ("mv $tmp $target: $!");
128   } else {
129     print STDERR "$progname: wrote $target\n" if ($verbose);
130   }
131 }
132
133
134 sub error($) {
135   my ($err) = @_;
136   print STDERR "$progname: $err\n";
137   exit 1;
138 }
139
140 sub usage() {
141   print STDERR "usage: $progname [--verbose] image-dir program.app ...\n";
142   exit 1;
143 }
144
145 sub main() {
146
147   my $src_dir;
148   my @files = ();
149   while ($_ = $ARGV[0]) {
150     shift @ARGV;
151     if    (m/^--?verbose$/s)  { $verbose++; }
152     elsif (m/^-v+$/)          { $verbose += length($_)-1; }
153     elsif (m/^--?q(uiet)?$/s) { $verbose = 0; }
154     elsif (m/^-/s)            { usage(); }
155     elsif (! $src_dir)        { $src_dir = $_; }
156     else                      { push @files, $_; }
157   }
158   usage() unless ($src_dir && $#files >= 0);
159   foreach (@files) {
160     update ($src_dir, $_);
161   }
162 }
163
164 main();
165 exit 0;