From http://www.jwz.org/xscreensaver/xscreensaver-5.35.tar.gz
[xscreensaver] / hacks / check-configs.pl
1 #!/usr/bin/perl -w
2 # Copyright © 2008-2016 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 # This parses the .c and .xml files and makes sure they are in sync: that
13 # options are spelled the same, and that all the numbers are in sync.
14 #
15 # It also converts the hacks/config/ XML files into the Android XML files.
16 #
17 # Created:  1-Aug-2008.
18
19 require 5;
20 use diagnostics;
21 use strict;
22
23 my $progname = $0; $progname =~ s@.*/@@g;
24 my ($version) = ('$Revision: 1.21 $' =~ m/\s(\d[.\d]+)\s/s);
25
26 my $verbose = 0;
27 my $debug_p = 0;
28
29
30 my $text_default_opts = '';
31 foreach (qw(text-mode text-literal text-file text-url text-program)) {
32   my $s = $_; $s =~ s/-(.)/\U$1/g; $s =~ s/url/URL/si;
33   $text_default_opts .= "{\"-$_\", \".$s\", XrmoptionSepArg, 0},\n";
34 }
35 my $image_default_opts = '';
36 foreach (qw(choose-random-images grab-desktop-images)) {
37   my $s = $_; $s =~ s/-(.)/\U$1/g;
38   $image_default_opts .= "{\"-$_\", \".$s\", XrmoptionSepArg, 0},\n";
39 }
40 my $xlockmore_default_opts = '';
41 foreach (qw(count cycles delay ncolors size font)) {
42   $xlockmore_default_opts .= "{\"-$_\", \".$_\", XrmoptionSepArg, 0},\n";
43 }
44 $xlockmore_default_opts .= 
45  "{\"-wireframe\", \".wireframe\", XrmoptionNoArg, \"true\"},\n" .
46  "{\"-3d\", \".use3d\", XrmoptionNoArg, \"true\"},\n" .
47  "{\"-no-3d\", \".use3d\", XrmoptionNoArg, \"false\"},\n";
48
49 my $thread_default_opts = 
50   "{\"-threads\",    \".useThreads\", XrmoptionNoArg, \"True\"},\n" .
51   "{\"-no-threads\", \".useThreads\", XrmoptionNoArg, \"False\"},\n";
52
53 my $analogtv_default_opts = '';
54 foreach (qw(color tint brightness contrast)) {
55   $analogtv_default_opts .= "{\"-tv-$_\", \".TV$_\", XrmoptionSepArg, 0},\n";
56 }
57
58 $analogtv_default_opts .= $thread_default_opts;
59
60
61
62 # Returns two tables:
63 # - A table of the default resource values.
64 # - A table of "-switch" => "resource: value", or "-switch" => "resource: %"
65 #
66 sub parse_src($) {
67   my ($saver) = @_;
68   my $file = lc($saver) . ".c";
69
70   # kludge...
71   $file = 'apple2-main.c' if ($file eq 'apple2.c');
72   $file = 'sproingiewrap.c' if ($file eq 'sproingies.c');
73   $file = 'b_lockglue.c' if ($file eq 'bubble3d.c');
74   $file = 'polyhedra-gl.c' if ($file eq 'polyhedra.c');
75   $file = 'companion.c' if ($file eq 'companioncube.c');
76   $file = 'rd-bomb.c' if ($file eq 'rdbomb.c');
77
78   my $ofile = $file;
79   $file = "glx/$ofile"          unless (-f $file);
80   $file = "../hacks/$ofile"     unless (-f $file);
81   $file = "../hacks/glx/$ofile" unless (-f $file);
82   my $body = '';
83   open (my $in, '<', $file) || error ("$ofile: $!");
84   while (<$in>) { $body .= $_; }
85   close $in;
86   $file =~ s@^.*/@@;
87
88   my $xlockmore_p = 0;
89   my $thread_p = ($body =~ m/THREAD_DEFAULTS/);
90   my $analogtv_p = ($body =~ m/ANALOGTV_DEFAULTS/);
91   my $text_p = ($body =~ m/"textclient\.h"/);
92   my $grab_p = ($body =~ m/load_image_async/);
93
94   $body =~ s@/\*.*?\*/@@gs;
95   $body =~ s@^#\s*(if|ifdef|ifndef|elif|else|endif).*$@@gm;
96   $body =~ s/(THREAD|ANALOGTV)_(DEFAULTS|OPTIONS)(_XLOCK)?//gs;
97   $body =~ s/__extension__//gs;
98
99   print STDERR "$progname: $file: defaults:\n" if ($verbose > 2);
100   my %res_to_val;
101   if ($body =~ m/_defaults\s*\[\]\s*=\s*{(.*?)}\s*;/s) {
102     foreach (split (/,\s*\n/, $1)) {
103       s/^\s*//s;
104       s/\s*$//s;
105       next if m/^0?$/s;
106       my ($key, $val) = m@^\"([^:\s]+)\s*:\s*(.*?)\s*\"$@;
107       print STDERR "$progname: $file: unparsable: $_\n" unless $key;
108       $key =~ s/^[.*]//s;
109       $res_to_val{$key} = $val;
110       print STDERR "$progname: $file:   $key = $val\n" if ($verbose > 2);
111     }
112   } elsif ($body =~ m/\#\s*define\s*DEFAULTS\s*\\?\s*(.*?)\n[\n#]/s) {
113     $xlockmore_p = 1;
114     my $str = $1;
115     $str =~ s/\"\s*\\\n\s*\"//gs;
116     $str =~ m/^\s*\"(.*?)\"\s*\\?\s*$/ || 
117       error ("$file: unparsable defaults: $str");
118     $str = $1;
119     $str =~ s/\s*\\n\s*/\n/gs;
120     foreach (split (/\n/, $str)) {
121       my ($key, $val) = m@^([^:\s]+)\s*:\s*(.*?)\s*$@;
122       print STDERR "$progname: $file: unparsable: $_\n" unless $key;
123       $key =~ s/^[.*]//s;
124       $val =~ s/"\s*"\s*$//s;
125       $res_to_val{$key} = $val;
126       print STDERR "$progname: $file:   $key = $val\n" if ($verbose > 2);
127     }
128
129     while ($body =~ s/^#\s*define\s+(DEF_([A-Z\d_]+))\s+\"([^\"]+)\"//m) {
130       my ($key1, $key2, $val) = ($1, lc($2), $3);
131       $key2 =~ s/_(.)/\U$1/gs;  # "foo_bar" -> "fooBar"
132       $key2 =~ s/Rpm/RPM/;      # kludge
133       $res_to_val{$key2} = $val;
134       print STDERR "$progname: $file:   $key1 ($key2) = $val\n" 
135         if ($verbose > 2);
136     }
137
138   } else {
139     error ("$file: no defaults");
140   }
141
142   $body =~ m/XSCREENSAVER_MODULE(_2)?\s*\(\s*\"([^\"]+)\"/ ||
143     error ("$file: no module name");
144   $res_to_val{progclass} = $2;
145   $res_to_val{doFPS} = 'false';
146   $res_to_val{textMode} = 'date';
147   $res_to_val{textLiteral} = '';
148   $res_to_val{textURL} =
149     'https://en.wikipedia.org/w/index.php?title=Special:NewPages&feed=rss';
150   $res_to_val{grabDesktopImages} = 'true';
151   $res_to_val{chooseRandomImages} = 'true';
152
153   print STDERR "$progname: $file:   progclass = $2\n" if ($verbose > 2);
154
155   print STDERR "$progname: $file: switches to resources:\n"
156     if ($verbose > 2);
157   my %switch_to_res;
158   $switch_to_res{'-fps'} = 'doFPS: true';
159   $switch_to_res{'-fg'}  = 'foreground: %';
160   $switch_to_res{'-bg'}  = 'background: %';
161   $switch_to_res{'-no-grab-desktop-images'}  = 'grabDesktopImages: false';
162   $switch_to_res{'-no-choose-random-images'}  = 'chooseRandomImages: false';
163
164   my ($ign, $opts) = ($body =~ m/(_options|\bopts)\s*\[\]\s*=\s*{(.*?)}\s*;/s);
165   if  ($xlockmore_p || $thread_p || $analogtv_p || $opts) {
166     $opts = '' unless $opts;
167     $opts .= ",\n$text_default_opts" if ($text_p);
168     $opts .= ",\n$image_default_opts" if ($grab_p);
169     $opts .= ",\n$xlockmore_default_opts" if ($xlockmore_p);
170     $opts .= ",\n$thread_default_opts" if ($thread_p);
171     $opts .= ",\n$analogtv_default_opts" if ($analogtv_p);
172
173     foreach (split (/,\s*\n/, $opts)) {
174       s/^\s*//s;
175       s/\s*$//s;
176       next if m/^$/s;
177       next if m/^\{\s*0\s*,/s;
178       my ($switch, $res, $type, $v0, $v1, $v2) =
179         m@^ \s* { \s * \"([^\"]+)\" \s* ,
180                   \s * \"([^\"]+)\" \s* ,
181                   \s * ([^\s]+)     \s* ,
182                   \s * (\"([^\"]*)\"|([a-zA-Z\d_]+)) \s* }@xi;
183       print STDERR "$progname: $file: unparsable: $_\n" unless $switch;
184       my $val = defined($v1) ? $v1 : $v2;
185       $val = '%' if ($type eq 'XrmoptionSepArg');
186       $res =~ s/^[.*]//s;
187       $res =~ s/^[a-z\d]+\.//si;
188       $switch =~ s/^\+/-no-/s;
189
190       $val = "$res: $val";
191       if (defined ($switch_to_res{$switch})) {
192         print STDERR "$progname: $file:   DUP! $switch = \"$val\"\n" 
193           if ($verbose > 2);
194       } else {
195         $switch_to_res{$switch} = $val;
196         print STDERR "$progname: $file:   $switch = \"$val\"\n" 
197           if ($verbose > 2);
198       }
199     }
200   } else {
201     error ("$file: no options");
202   }
203
204   return (\%res_to_val, \%switch_to_res);
205 }
206
207 # Returns a list of:
208 #    "resource = default value"
209 # or "resource != non-default value"
210 #
211 # Also a hash of the simplified XML contents.
212 #
213 sub parse_xml($$$) {
214   my ($saver, $switch_to_res, $src_opts) = @_;
215
216   my $saver_title = undef;
217   my $gl_p = 0;
218   my $file = "config/" . lc($saver) . ".xml";
219   my $ofile = $file;
220   $file = "../hacks/$ofile" unless (-f $file);
221   my $body = '';
222   open (my $in, '<', $file) || error ("$ofile: $!");
223   while (<$in>) { $body .= $_; }
224   close $in;
225   $file =~ s@^.*/@@;
226
227   my @result = ();
228
229   $body =~ s@<xscreensaver-text\s*/?>@
230     <select id="textMode">
231       <option id="date"  _label="Display the date and time"/>
232       <option id="text"  _label="Display static text"
233         arg-set="-text-mode literal"/>
234       <option id="url"   _label="Display the contents of a URL"
235         arg-set="-text-mode url"/>
236     </select>
237     <string id="textLiteral" _label="Text to display" arg="-text-literal %"/>
238     <string id="textURL" _label="URL to display" arg="-text-url %"/>
239     @gs;
240
241   $body =~ s@<xscreensaver-image\s*/?>@
242     <boolean id="grabDesktopImages" _label="Grab screenshots"
243        arg-unset="-no-grab-desktop-images"/>
244     <boolean id="chooseRandomImages" _label="Use photo library"
245        arg-unset="-no-choose-random-images"/>
246     @gs;
247
248   $body =~ s/<!--.*?-->/ /gsi;
249
250   $body =~ s@(<(_description)>.*?</\2>)@{ $_ = $1; s/\n/\002/gs; $_; }@gsexi;
251
252   $body =~ s/\s+/ /gs;
253   $body =~ s/</\001</gs;
254   $body =~ s/\001(<option)/$1/gs;
255
256   my $video = undef;
257
258   my @widgets = ();
259
260   print STDERR "$progname: $file: options:\n" if ($verbose > 2);
261   foreach (split (m/\001/, $body)) {
262     next if (m/^\s*$/s);
263     my ($type, $args) = m@^<([?/]?[-_a-z]+)\b\s*(.*)$@si;
264     error ("$progname: $file: unparsable: $_") unless $type;
265     next if ($type =~ m@^/@);
266
267     my $ctrl = { type => $type };
268
269     if ($type =~ m/^( [hv]group |
270                       \?xml |
271                       command |
272                       file |
273                       xscreensaver-image |
274                       xscreensaver-updater
275                     )/sx) {
276       $ctrl = undef;
277
278     } elsif ($type eq '_description') {
279       $args =~ s/\002/\n/gs;
280       $args =~ s@^>\s*@@s;
281       $args =~ s/^\n*|\s*$//gs;
282       $ctrl->{text} = $args;
283
284     } elsif ($type eq 'screensaver') {
285       ($saver_title) = ($args =~ m/\b_label\s*=\s*\"([^\"]+)\"/s);
286       ($gl_p) = ($args =~ m/\bgl="?yes/s);
287       my $s = $saver_title;
288       $s =~ s/\s+//gs;
289       my $val = "progclass = $s";
290       push @result, $val;
291       print STDERR "$progname: $file:   name:    $saver_title\n"
292         if ($verbose > 2);
293       $ctrl = undef;
294
295     } elsif ($type eq 'video') {
296       error ("$file: multiple videos") if $video;
297       ($video) = ($args =~ m/\bhref="(.*?)"/);
298       error ("$file: unparsable video") unless $video;
299       error ("$file: unparsable video URL")
300         unless ($video =~ m@^https?://www\.youtube\.com/watch\?v=[^?&]+$@s);
301       $ctrl = undef;
302
303     } elsif ($type eq 'select') {
304       $args =~ s/</\001</gs;
305       my @opts = split (/\001/, $args);
306       shift @opts;
307       my $unset_p = 0;
308       my $this_res = undef;
309       my @menu = ();
310       foreach (@opts) {
311         error ("$file: unparsable option: $_") unless (m/^<option\s/);
312
313         my %item;
314         my $opt = $_;
315         $opt =~ s@^<option\s+@@s;
316         $opt =~ s@[?/]>\s*$@@s;
317         while ($opt =~ s/^\s*([^\s]+)\s*=\s*"(.*?)"\s*(.*)/$3/s) {
318           my ($k, $v) = ($1, $2);
319           $item{$k} = $v;
320         }
321
322         error ("unparsable XML option line: $_ [$opt]") if ($opt);
323         push @menu, \%item;
324
325         my ($set) = $item{'arg-set'};
326         if ($set) {
327           my ($set2, $val) = ($set =~ m/^(.*?) (.*)$/s);
328           $set = $set2 if ($set2);
329           my ($res) = $switch_to_res->{$set};
330           error ("$file: no resource for select switch \"$set\"") unless $res;
331
332           my ($res2, $val2) = ($res =~ m/^(.*?): (.*)$/s);
333           error ("$file: unparsable select resource: $res") unless $res2;
334           $res = $res2;
335           $val = $val2 unless ($val2 eq '%');
336           $item{value} = $val;
337
338           error ("$file: mismatched resources: $res vs $this_res")
339             if (defined($this_res) && $this_res ne $res);
340           $this_res = $res;
341
342           $val = "$res != $val";
343           push @result, $val;
344           print STDERR "$progname: $file:   select:  $val\n" if ($verbose > 2);
345
346         } else {
347           error ("$file: multiple default options: $set") if ($unset_p);
348           $unset_p++;
349         }
350       }
351       $ctrl->{resource} = $this_res;
352       $ctrl->{default} = $src_opts->{$this_res};
353       $ctrl->{menu} = \@menu;
354
355     } else {
356
357       my $rest = $args;
358       $rest =~ s@[/?]*>\s*$@@s;
359       while ($rest =~ s/^\s*([^\s]+)\s*=\s*"(.*?)"\s*(.*)/$3/s) {
360         my ($k, $v) = ($1, $2);
361         $ctrl->{$k} = $v;
362       }
363       error ("unparsable XML line: $args [$rest]") if ($rest);
364
365       if ($type eq 'number') {
366         my ($arg) = $ctrl->{arg};
367         my ($val) = $ctrl->{default};
368         $val = '' unless defined($val);
369
370         my $switch = $arg;
371         $switch =~ s/\s+.*$//;
372         my ($res) = $switch_to_res->{$switch};
373         error ("$file: no resource for $type switch \"$arg\"") unless $res;
374
375         $res =~ s/: \%$//;
376         error ("$file: unparsable value: $res") if ($res =~ m/:/);
377         $ctrl->{resource} = $res;
378
379         $val = "$res = $val";
380         push @result, $val;
381         print STDERR "$progname: $file:   number:  $val\n" if ($verbose > 2);
382
383       } elsif ($type eq 'boolean') {
384         my ($set)   = $ctrl->{'arg-set'};
385         my ($unset) = $ctrl->{'arg-unset'};
386         my ($arg) = $set || $unset || error ("$file: unparsable: $args");
387         my ($res) = $switch_to_res->{$arg};
388           error ("$file: no resource for boolean switch \"$arg\"") unless $res;
389
390         my ($res2, $val) = ($res =~ m/^(.*?): (.*)$/s);
391         error ("$file: unparsable boolean resource: $res") unless $res2;
392         $res = $res2;
393
394         $ctrl->{resource} = $res;
395         $ctrl->{convert} = 'invert' if ($val =~ m/false/i);
396         $ctrl->{default} = ($ctrl->{convert} ? 'true' : 'false');
397
398 #       $val = ($set ? "$res != $val" : "$res = $val");
399         $val = "$res != $val";
400         push @result, $val;
401         print STDERR "$progname: $file:   boolean: $val\n" if ($verbose > 2);
402
403       } elsif ($type eq 'string') {
404         my ($arg) = $ctrl->{arg};
405
406         my $switch = $arg;
407         $switch =~ s/\s+.*$//;
408         my ($res) = $switch_to_res->{$switch};
409         error ("$file: no resource for $type switch \"$arg\"") unless $res;
410
411         $res =~ s/: \%$//;
412         error ("$file: unparsable value: $res") if ($res =~ m/:/);
413         $ctrl->{resource} = $res;
414         $ctrl->{default} = $src_opts->{$res};
415         my $val = "$res = %";
416         push @result, $val;
417         print STDERR "$progname: $file:   string:  $val\n" if ($verbose > 2);
418
419       } else {
420         error ("$file: unknown type \"$type\" for no arg");
421       }
422     }
423
424     push @widgets, $ctrl if $ctrl;
425   }
426
427 #  error ("$file: no video") unless $video;
428   print STDERR "\n$file: WARNING: no video\n\n" unless $video;
429
430   return ($saver_title, $gl_p, \@result, \@widgets);
431 }
432
433
434 sub check_config($) {
435   my ($saver) = @_;
436
437   # kludge
438   return 0 if ($saver =~ m/(-helper)$/);
439
440   my ($src_opts, $switchmap) = parse_src ($saver);
441   my ($saver_title, $gl_p, $xml_opts, $widgets) =
442     parse_xml ($saver, $switchmap, $src_opts);
443
444   my $failures = 0;
445   foreach my $claim (@$xml_opts) {
446     my ($res, $compare, $xval) = ($claim =~ m/^(.*) (=|!=) (.*)$/s);
447     error ("$saver: unparsable xml claim: $claim") unless $compare;
448
449     my $sval = $src_opts->{$res};
450     if ($res =~ m/^TV|^text-mode/) {
451       print STDERR "$progname: $saver: OK: skipping \"$res\"\n"
452         if ($verbose > 1);
453     } elsif (!defined($sval)) {
454       print STDERR "$progname: $saver: $res: not in source\n";
455     } elsif ($claim !~ m/ = %$/s &&
456              ($compare eq '!='
457               ? $sval eq $xval
458               : $sval ne $xval)) {
459       print STDERR "$progname: $saver: " .
460         "src has \"$res = $sval\", xml has \"$claim\"\n";
461       $failures++;
462     } elsif ($verbose > 1) {
463       print STDERR "$progname: $saver: OK: \"$res = $sval\" vs \"$claim\"\n";
464     }
465   }
466
467   # Now make sure the progclass in the source and XML also matches
468   # the XCode target name.
469   #
470   my $obd = "../OSX/build/Debug";
471   if (-d $obd) {
472     my $progclass = $src_opts->{progclass};
473     $progclass = 'DNAlogo' if ($progclass eq 'DNALogo');
474     my $f = (glob("$obd/$progclass.saver*"))[0];
475     if (!$f && $progclass ne 'Flurry') {
476       print STDERR "$progname: $progclass.saver does not exist\n";
477       $failures++;
478     }
479   }
480
481   print STDERR "$progname: $saver: OK\n"
482     if ($verbose == 1 && $failures == 0);
483
484   return $failures;
485 }
486
487
488 # Returns true if the two files differ (by running "cmp")
489 #
490 sub cmp_files($$) {
491   my ($file1, $file2) = @_;
492
493   my @cmd = ("cmp", "-s", "$file1", "$file2");
494   print STDERR "$progname: executing \"" . join(" ", @cmd) . "\"\n"
495     if ($verbose > 3);
496
497   system (@cmd);
498   my $exit_value  = $? >> 8;
499   my $signal_num  = $? & 127;
500   my $dumped_core = $? & 128;
501
502   error ("$cmd[0]: core dumped!") if ($dumped_core);
503   error ("$cmd[0]: signal $signal_num!") if ($signal_num);
504   return $exit_value;
505 }
506
507
508 sub diff_files($$) {
509   my ($file1, $file2) = @_;
510
511   my @cmd = ("diff", 
512              "-U1",
513 #            "-w",
514              "--unidirectional-new-file", "$file1", "$file2");
515   print STDERR "$progname: executing \"" . join(" ", @cmd) . "\"\n"
516     if ($verbose > 3);
517
518   system (@cmd);
519   my $exit_value  = $? >> 8;
520   my $signal_num  = $? & 127;
521   my $dumped_core = $? & 128;
522
523   error ("$cmd[0]: core dumped!") if ($dumped_core);
524   error ("$cmd[0]: signal $signal_num!") if ($signal_num);
525   return $exit_value;
526 }
527
528
529 # If the two files differ:
530 #   mv file2 file1
531 # else
532 #   rm file2
533 #
534 sub rename_or_delete($$;$) {
535   my ($file, $file_tmp, $suffix_msg) = @_;
536
537   my $changed_p = cmp_files ($file, $file_tmp);
538
539   if ($changed_p && $debug_p) {
540     print STDOUT "\n" . ('#' x 79) . "\n";
541     diff_files ("$file", "$file_tmp");
542     $changed_p = 0;
543   }
544
545   if ($changed_p) {
546
547     if (!rename ("$file_tmp", "$file")) {
548       unlink "$file_tmp";
549       error ("mv $file_tmp $file: $!");
550     }
551     print STDERR "$progname: wrote $file" .
552       ($suffix_msg ? " $suffix_msg" : "") . "\n";
553
554   } else {
555     unlink "$file_tmp" || error ("rm $file_tmp: $!\n");
556     print STDERR "$file unchanged" .
557                  ($suffix_msg ? " $suffix_msg" : "") . "\n"
558         if ($verbose);
559     print STDERR "$progname: rm $file_tmp\n" if ($verbose > 2);
560   }
561 }
562
563
564 # Write the given body to the file, but don't alter the file's
565 # date if the new content is the same as the existing content.
566 #
567 sub write_file_if_changed($$;$) {
568   my ($outfile, $body, $suffix_msg) = @_;
569
570   my $file_tmp = "$outfile.tmp";
571   open (my $out, '>', $file_tmp) || error ("$file_tmp: $!");
572   (print $out $body) || error ("$file_tmp: $!");
573   close $out || error ("$file_tmp: $!");
574   rename_or_delete ($outfile, $file_tmp, $suffix_msg);
575 }
576
577
578 # Read the template file and splice in the @KEYWORDS@ in the hash.
579 #
580 sub read_template($$) {
581   my ($file, $subs) = @_;
582   my $body = '';
583   open (my $in, '<', $file) || error ("$file: $!");
584   while (<$in>) { $body .= $_; }
585   close $in;
586
587   $body =~ s@/\*.*?\*/@@gs;  # omit comments
588   $body =~ s@//.*$@@gm;
589
590   foreach my $key (keys %$subs) {
591     my $val = $subs->{$key};
592     $body =~ s/@\Q$key\E@/$val/gs;
593   }
594
595   if ($body =~ m/(@[-_A-Z\d]+@)/s) {
596     error ("$file: unmatched: $1 [$body]");
597   }
598
599   $body =~ s/[ \t]+$//gm;
600   $body =~ s/(\n\n)\n+/$1/gs;
601   return $body;
602 }
603
604
605 # This is duplicated in OSX/update-info-plist.pl
606 #
607 sub munge_blurb($$$$) {
608   my ($filename, $name, $vers, $desc) = @_;
609
610   $desc =~ s/^([ \t]*\n)+//s;
611   $desc =~ s/\s*$//s;
612
613   # in case it's done already...
614   $desc =~ s@<!--.*?-->@@gs;
615   $desc =~ s/^.* version \d[^\n]*\n//s;
616   $desc =~ s/^From the XScreenSaver.*\n//m;
617   $desc =~ s@^https://www\.jwz\.org/xscreensaver.*\n@@m;
618   $desc =~
619        s/\nCopyright [^ \r\n\t]+ (\d{4})(-\d{4})? (.*)\.$/\nWritten $3; $1./s;
620   $desc =~ s/^\n+//s;
621
622   error ("$filename: description contains markup: $1")
623     if ($desc =~ m/([<>&][^<>&\s]*)/s);
624   error ("$filename: description contains ctl chars: $1")
625     if ($desc =~ m/([\000-\010\013-\037])/s);
626
627   error ("$filename: can't extract authors")
628     unless ($desc =~ m@^(.*)\nWritten by[ \t]+(.+)$@s);
629   $desc = $1;
630   my $authors = $2;
631   $desc =~ s/\s*$//s;
632
633   my $year = undef;
634   if ($authors =~ m@^(.*?)\s*[,;]\s+(\d\d\d\d)([-\s,;]+\d\d\d\d)*[.]?$@s) {
635     $authors = $1;
636     $year = $2;
637   }
638
639   error ("$filename: can't extract year") unless $year;
640   my $cyear = 1900 + ((localtime())[5]);
641   $year = "$cyear" unless $year;
642   if ($year && ! ($year =~ m/$cyear/)) {
643     $year = "$year-$cyear";
644   }
645
646   $authors =~ s/[.,;\s]+$//s;
647
648   # List me as a co-author on all of them, since I'm the one who
649   # did the OSX port, packaged it up, and built the executables.
650   #
651   my $curator = "Jamie Zawinski";
652   if (! ($authors =~ m/$curator/si)) {
653     if ($authors =~ m@^(.*?),? and (.*)$@s) {
654       $authors = "$1, $2, and $curator";
655     } else {
656       $authors .= " and $curator";
657     }
658   }
659
660   my $desc1 = ("$name, version $vers.\n\n" .            # savername.xml
661                $desc . "\n" .
662                "\n" . 
663                "From the XScreenSaver collection: " .
664                "https://www.jwz.org/xscreensaver/\n" .
665                "Copyright \302\251 $year by $authors.\n");
666
667   my $desc2 = ("$name $vers,\n" .                       # Info.plist
668                "\302\251 $year $authors.\n" .
669                #"From the XScreenSaver collection:\n" .
670                #"https://www.jwz.org/xscreensaver/\n" .
671                "\n" .
672                $desc .
673                "\n");
674
675   # unwrap lines, but only when it's obviously ok: leave blank lines,
676   # and don't unwrap if that would compress leading whitespace on a line.
677   #
678   $desc2 =~ s/^(From |https?:)/\n$1/gm;
679   1 while ($desc2 =~ s/([^\s])[ \t]*\n([^\s])/$1 $2/gs);
680   $desc2 =~ s/\n\n(From |https?:)/\n$1/gs;
681
682   return ($desc1, $desc2);
683 }
684
685
686 sub build_android(@) {
687   my (@savers) = @_;
688
689   my $package     = "org.jwz.xscreensaver";
690   my $project_dir = "project/xscreensaver";
691   my $xml_dir     = "$project_dir/res/xml";
692   my $values_dir  = "$project_dir/res/values";
693   my $java_dir    = "$project_dir/src/org/jwz/xscreensaver/gen";
694   my $gen_dir     = "gen";
695
696   my $xml_header = "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n";
697
698   my $manifest = '';
699   my $arrays   = '';
700   my $strings  = '';
701   my %write_files;
702   my %string_dups;
703
704   my $vers;
705   {
706     my $file = "../utils/version.h";
707     my $body = '';
708     open (my $in, '<', $file) || error ("$file: $!");
709     while (<$in>) { $body .= $_; }
710     close $in;
711     ($vers) = ($body =~ m@ (\d+\.\d+) @s);
712     error ("$file: no version number") unless $vers;
713   }
714
715
716   foreach my $saver (@savers) {
717     next if ($saver =~ m/(-helper)$/);
718     $saver = 'rdbomb' if ($saver eq 'rd-bomb');
719
720     my ($src_opts, $switchmap) = parse_src ($saver);
721     my ($saver_title, $gl_p, $xml_opts, $widgets) =
722       parse_xml ($saver, $switchmap, $src_opts);
723
724     my $daydream_class = "${saver_title}Daydream";
725     my $settings_class = "${saver_title}Settings";
726     foreach ($settings_class, $daydream_class) {
727       s/\s+//gs;
728       s/^([a-z])/\U$1/gs;  # upcase first letter
729     }
730
731     $saver_title =~ s/(.[a-z])([A-Z\d])/$1 $2/gs;       # Spaces in InterCaps
732     $saver_title =~ s/^(GL|RD)[- ]?(.)/$1 \U$2/gs;      # Space after "GL"
733     $saver_title =~ s/^Apple ?2$/Apple &#x5D;&#x5B;/gs; # "Apple ]["
734     $saver_title =~ s/(m)oe(bius)/$1&#xF6;$2/gsi;       # &ouml;
735     $saver_title =~ s/(moir)e/$1&#xE9;/gsi;             # &eacute;
736     $saver_title =~ s/^([a-z])/\U$1/s;                  # "M6502" for sorting
737
738     my $settings = '';
739
740     my $localize0 = sub($$) {
741       my ($key, $string) = @_;
742       $string =~ s@([\\\"\'])@\\$1@gs;          # backslashify
743       $string =~ s@\n@\\n@gs;                   # quote newlines
744       $key =~ s@[^a-z\d_]+@_@gsi;               # illegal characters
745
746       my $old = $string_dups{$key};
747       error ("dup string: $key: \"$old\" != \"$string\"")
748         if (defined($old) && $old ne $string);
749       $string_dups{$key} = $string;
750
751       my $fmt = ($string =~ m/%/ ? ' formatted="false"' : '');
752       $strings .= "<string name=\"${key}\"$fmt>$string</string>\n"
753         unless defined($old);
754       return "\@string/$key";
755     };
756
757     $localize0->('app_name', 'XScreenSaver');
758
759     $settings .= ("<Preference\n" .
760                   "  android:key=\"${saver}_reset\"\n" .
761                   "  android:title=\"" .
762                       $localize0->('reset_to_defaults', 'Reset to defaults') .
763                      "\"\n" .
764                   " />\n");
765
766     my $daydream_desc = '';
767     foreach my $widget (@$widgets) {
768       my $type  = $widget->{type};
769       my $rsrc  = $widget->{resource};
770       my $label = $widget->{_label};
771       my $def   = $widget->{default};
772       my $invert_p = (($widget->{convert} || '') eq 'invert');
773
774       my $key   = "${saver}_$rsrc" if $rsrc;
775
776       #### The menus don't actually have titles on X11 or Cocoa...
777       $label = $widget->{resource} unless $label;
778
779       my $localize = sub($;$) {
780         my ($string, $suf) = @_;
781         $suf = 'title' unless $suf;
782         return $localize0->("${saver}_${rsrc}_${suf}", $string);
783       };
784
785       if ($type eq 'slider' || $type eq 'spinbutton') {
786
787         my $low        = $widget->{low};
788         my $high       = $widget->{high};
789         my $float_p    = $low =~ m/[.]/;
790         my $low_label  = $widget->{'_low-label'};
791         my $high_label = $widget->{'_high-label'};
792
793         $low_label  = $low  unless defined($low_label);
794         $high_label = $high unless defined($high_label);
795
796         ($low, $high) = ($high, $low)
797           if (($widget->{convert} || '') eq 'invert');
798
799         $settings .=
800           ("<$package.SliderPreference\n" .
801            "  android:layout=\"\@layout/slider_preference\"\n" .
802            "  android:key=\"${key}\"\n" .
803            "  android:title=\"" . $localize->($label) . "\"\n" .
804            "  android:defaultValue=\"$def\"\n" .
805            "  low=\"$low\"\n" .
806            "  high=\"$high\"\n" .
807            "  lowLabel=\""  . $localize->($low_label,  'low_label')  . "\"\n" .
808            "  highLabel=\"" . $localize->($high_label, 'high_label') . "\"\n" .
809            "  integral=\"" .($float_p ? 'false' : 'true'). "\" />\n");
810
811       } elsif ($type eq 'boolean') {
812
813         my $def = ($invert_p ? 'true' : 'false');
814         $settings .=
815           ("<CheckBoxPreference\n" .
816            "  android:key=\"${key}\"\n" .
817            "  android:title=\"" . $localize->($label) . "\"\n" .
818            "  android:defaultValue=\"$def\" />\n");
819
820       } elsif ($type eq 'select') {
821
822         $label =~ s/^(.)/\U$1/s;  # upcase first letter of menu title
823         $label =~ s/[-_]/ /gs;
824         $label =~ s/([a-z])([A-Z])/$1 $2/gs;
825         $def = '' unless defined ($def);
826         $settings .=
827           ("<ListPreference\n" .
828            "  android:key=\"${key}\"\n" .
829            "  android:title=\"" . $localize->($label, 'menu') . "\"\n" .
830            "  android:entries=\"\@array/${key}_entries\"\n" .
831            "  android:defaultValue=\"$def\"\n" .
832            "  android:entryValues=\"\@array/${key}_values\" />\n");
833
834         my $a1 = '';
835         foreach my $item (@{$widget->{menu}}) {
836           my $val = $item->{value};
837           if (! defined($val)) {
838             $val = $src_opts->{$widget->{resource}};
839             error ("$saver: no default resource in option menu " .
840                    $item->{_label})
841               unless defined($val);
842           }
843           $val =~ s@([\\\"\'])@\\$1@gs;         # backslashify
844           $a1 .= "  <item>$val</item>\n";
845         }
846
847         my $a2 = '';
848         foreach my $item (@{$widget->{menu}}) {
849           my $val = $item->{value};
850           $val = $src_opts->{$widget->{resource}} unless defined($val);
851           $a2 .= ("  <item>" . $localize->($item->{_label}, $val) .
852                   "</item>\n");
853         }
854
855         my $fmt1 = ($a1 =~ m/%/ ? ' formatted="false"' : '');
856         my $fmt2 = ($a2 =~ m/%/ ? ' formatted="false"' : '');
857         $arrays .= ("<string-array name=\"${key}_values\"$fmt1>\n" .
858                     $a1 .
859                     "</string-array>\n" .
860                     "<string-array name=\"${key}_entries\"$fmt2>\n" .
861                     $a2 .
862                     "</string-array>\n");
863
864       } elsif ($type eq 'string') {
865
866         $def =~ s/&/&amp;/gs;
867         $settings .=
868           ("<EditTextPreference\n" .
869            "  android:key=\"${key}\"\n" .
870            "  android:title=\"" . $localize->($label) . "\"\n" .
871            "  android:defaultValue=\"$def\" />\n");
872
873       } elsif ($type eq 'file') {
874
875       } elsif ($type eq '_description') {
876
877         $type = 'description';
878         $rsrc = $type;
879         my $desc = $widget->{text};
880         (undef, $desc) = munge_blurb ($saver, $saver_title, $vers, $desc);
881
882         # Lose the Wikipedia URLs.
883         $desc =~ s@https?:.*?\b(wikipedia|mathworld)\b[^\s]+[ \t]*\n?@@gm;
884         $desc =~ s/(\n\n)\n+/$1/s;
885         $desc =~ s/\s*$/\n\n\n/s;
886
887         $daydream_desc = $desc;
888
889         my ($year) = ($daydream_desc =~ m/\b((19|20)\d\d)\b/s);
890         error ("$saver: no year") unless $year;
891         $daydream_desc =~ s/^.*?\n\n//gs;
892         $daydream_desc =~ s/\n.*$//gs;
893         $daydream_desc = "$year: $daydream_desc";
894         $daydream_desc =~ s/^(.{72}).+$/$1.../s;
895
896         $settings .=
897           ("<Preference\n" .
898            "  android:icon=\"\@drawable/thumbnail\"\n" .
899            "  android:key=\"${saver}_${type}\"\n" .
900 #           "  android:selectable=\"false\"\n" .
901            "  android:persistent=\"false\"\n" .
902            "  android:layout=\"\@layout/preference_blurb\"\n" .
903            "  android:summary=\"" . $localize->($desc) . "\">\n" .
904            "  <intent android:action=\"android.intent.action.VIEW\"\n" .
905            "    android:data=\"https://www.jwz.org/xscreensaver/\" />\n" .
906            "</Preference>\n");
907
908       } else {
909         error ("unhandled type: $type");
910       }
911     }
912
913     my $heading = "XScreenSaver: $saver_title";
914
915     $settings =~ s/^/  /gm;
916     $settings = ($xml_header .
917                  "<PreferenceScreen xmlns:android=\"" .
918                  "http://schemas.android.com/apk/res/android\"\n" .
919                  "  android:title=\"" .
920                  $localize0->("${saver}_settings_title", $heading) . "\">\n" .
921                  $settings .
922                  "</PreferenceScreen>\n");
923
924     my $saver_underscore = $saver;
925     $saver_underscore =~ s/-/_/g;
926     $write_files{"$xml_dir/${saver_underscore}_settings.xml"} = $settings;
927
928     $manifest .= ("<service android:label=\"" .
929                      $localize0->("${saver_underscore}_saver_title",
930                                   $saver_title) .
931                      "\"\n" .
932                   "  android:summary=\"" .
933                        $localize0->("${saver_underscore}_saver_desc",
934                                     $daydream_desc) . "\"\n" .
935                   "  android:name=\".gen.$daydream_class\"\n" .
936                   "  android:permission=\"android.permission" .
937                        ".BIND_DREAM_SERVICE\"\n" .
938                   "  android:exported=\"true\"\n" .
939                   "  android:icon=\"\@drawable/${saver_underscore}\">\n" .
940                   "  <intent-filter>\n" .
941                   "    <action android:name=\"android.service.dreams" .
942                         ".DreamService\" />\n" .
943                   "    <category android:name=\"android.intent.category" .
944                         ".DEFAULT\" />\n" .
945                   "  </intent-filter>\n" .
946                   "  <meta-data android:name=\"android.service.dream\"\n" .
947                   "    android:resource=\"\@xml/${saver}_dream\" />\n" .
948                   "</service>\n" .
949                   "<activity android:name=\"" .
950                     "$package.gen.$settings_class\" />\n"
951                  );
952
953     my $dream = ("<dream xmlns:android=\"" .
954                    "http://schemas.android.com/apk/res/android\"\n" .
955                  "  android:settingsActivity=\"" .
956                      "$package.gen.$settings_class\" />\n");
957     $write_files{"$xml_dir/${saver_underscore}_dream.xml"} = $dream;
958
959     $write_files{"$java_dir/$daydream_class.java"} =
960       read_template ("XScreenSaverDaydream.java.in",
961                      { CLASS => $daydream_class,
962                        API  => ($gl_p ? 'GL' : 'XLIB') });
963
964     $write_files{"$java_dir/$settings_class.java"} =
965       read_template ("XScreenSaverSettings.java.in",
966                      { CLASS => $settings_class });
967   }
968
969   $arrays =~ s/^/  /gm;
970   $arrays = ($xml_header .
971              "<resources xmlns:xliff=\"" .
972              "urn:oasis:names:tc:xliff:document:1.2\">\n" .
973              $arrays .
974              "</resources>\n");
975
976   $strings =~ s/^/  /gm;
977   $strings = ($xml_header .
978               "<resources>\n" .
979               $strings .
980               "</resources>\n");
981
982   $manifest .= "<activity android:name=\"$package.XScreenSaverSettings\" />\n";
983
984   $manifest .= ("<activity android:name=\"" .
985                 "org.jwz.xscreensaver.XScreenSaverActivity\"\n" .
986                 "  android:theme=\"\@android:style/Theme.Holo\"\n" .
987                 "  android:label=\"\@string/app_name\">\n" .
988                 "  <intent-filter>\n" .
989                 "    <action android:name=\"android.intent.action" .
990                 ".MAIN\" />\n" .
991                 "    <category android:name=\"android.intent.category" .
992                 ".LAUNCHER\" />\n" .
993                 "  </intent-filter>\n" .
994                 "  <intent-filter>\n" .
995                 "    <action android:name=\"android.intent.action" .
996                 ".VIEW\" />\n" .
997                 "    <category android:name=\"android.intent.category" .
998                 ".DEFAULT\" />\n" .
999                 "    <category android:name=\"android.intent.category" .
1000                 ".BROWSABLE\" />\n" .
1001                 "  </intent-filter>\n" .
1002                 "</activity>\n");
1003
1004   # Android wants this to be an int
1005   my $versb = $vers;
1006   $versb =~ s/^(\d+)\.(\d+).*$/{ $1 * 10000 + $2 * 100 }/sex;
1007   $versb++ if ($versb == 53500); # Herp derp
1008
1009   $manifest =~ s/^/   /gm;
1010   $manifest = ($xml_header .
1011                "<manifest xmlns:android=\"" .
1012                "http://schemas.android.com/apk/res/android\"\n" .
1013                "  package=\"$package\"\n" .
1014                "  android:versionCode=\"$versb\"\n" .
1015                "  android:versionName=\"$vers\">\n" .
1016
1017                "  <uses-sdk android:minSdkVersion=\"14\"" .
1018                " android:targetSdkVersion=\"19\" />\n" .
1019
1020                "  <uses-feature android:glEsVersion=\"0x00010001\"\n" .
1021                "    android:required=\"true\" />\n" .
1022
1023                "  <uses-permission android:name=\"" .
1024                    "android.permission.INTERNET\" />\n" .
1025                "  <uses-permission android:name=\"" .
1026                    "android.permission.READ_EXTERNAL_STORAGE\" />\n" .
1027
1028                "  <application android:icon=\"\@drawable/thumbnail\"\n" .
1029                "    android:label=\"\@string/app_name\"\n" .
1030                "    android:name=\".XScreenSaverApp\">\n" .
1031                $manifest .
1032                "  </application>\n" .
1033                "</manifest>\n");
1034
1035   $write_files{"$project_dir/AndroidManifest.xml"}     = $manifest;
1036   $write_files{"$values_dir/settings.xml"} = $arrays;
1037   $write_files{"$values_dir/strings.xml"}  = $strings;
1038
1039   my @s2 = ();
1040   foreach my $saver (sort @savers) {
1041     push @s2, $saver unless ($saver =~ m/(-helper)$/);
1042   }
1043   my @s3 = @s2;
1044
1045   foreach (@s2) { s/^(.*)$/${1}_xscreensaver_function_table/s; }
1046   foreach (@s3) { s/^(.*)$/{"$1", &${1}_xscreensaver_function_table}/s; }
1047
1048   my $fntable_h = ("extern struct xscreensaver_function_table\n" .
1049                    "  " . join(",\n  ", @s2) . ";\n" .
1050                    "\n" .
1051                    "static const struct function_table_entry" .
1052                    " function_table[] = {\n" .
1053                    "  " . join(",\n  ", @s3) . "\n" .
1054                    "};\n");
1055   $write_files{"$gen_dir/function-table.h"} = $fntable_h;
1056
1057
1058   $write_files{"$values_dir/attrs.xml"} =
1059     # This file doesn't actually have any substitutions in it, so it could
1060     # just be static, somewhere...
1061     # SliderPreference.java refers to this via "R.styleable.SliderPreference".
1062     ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" .
1063      "<resources>\n" .
1064      "  <declare-styleable name=\"SliderPreference\">\n" .
1065      "    <attr name=\"android:summary\" />\n" .
1066      "  </declare-styleable>\n" .
1067      "</resources>\n");
1068
1069
1070   foreach my $file (sort keys %write_files) {
1071     my ($dir) = ($file =~ m@^(.*)/[^/]*$@s);
1072     system ("mkdir", "-p", $dir) if (! -d $dir && !$debug_p);
1073     my $body = $write_files{$file};
1074     $body = "// Generated by $progname\n$body"
1075       if ($file =~ m/\.(java|[chm])$/s);
1076     write_file_if_changed ($file, $body);
1077   }
1078
1079   # Unlink any .xml files from a previous run that shouldn't be there:
1080   # if a hack is removed from $ANDROID_HACKS in android/Makefile but
1081   # the old XML files remain behind, the build blows up.
1082   #
1083   opendir (my $dirp, $xml_dir) || error ("$xml_dir: $!");
1084   my @files = readdir ($dirp);
1085   closedir $dirp;
1086   foreach my $f (sort @files) {
1087     next if ($f eq '.' || $f eq '..');
1088     $f = "$xml_dir/$f";
1089     next if (defined ($write_files{$f}));
1090     if ($f =~ m/_(settings|dream)\.xml$/s) {
1091       print STDERR "$progname: rm $f\n";
1092       unlink ($f) unless ($debug_p);
1093     } else {
1094       print STDERR "$progname: warning: unrecognised file: $f\n";
1095     }
1096   }
1097 }
1098
1099
1100 sub error($) {
1101   my ($err) = @_;
1102   print STDERR "$progname: $err\n";
1103   exit 1;
1104 }
1105
1106 sub usage() {
1107   print STDERR "usage: $progname [--verbose] [--debug]" .
1108     " [--build-android] files ...\n";
1109   exit 1;
1110 }
1111
1112 sub main() {
1113   my $android_p = 0;
1114   my @files = ();
1115   while ($#ARGV >= 0) {
1116     $_ = shift @ARGV;
1117     if (m/^--?verbose$/) { $verbose++; }
1118     elsif (m/^-v+$/) { $verbose += length($_)-1; }
1119     elsif (m/^--?debug$/s) { $debug_p++; }
1120     elsif (m/^--?build-android$/s) { $android_p++; }
1121     elsif (m/^-./) { usage; }
1122     else { push @files, $_; }
1123 #    else { usage; }
1124   }
1125
1126   usage unless ($#files >= 0);
1127   my $failures = 0;
1128   foreach my $file (@files) {
1129     $failures += check_config ($file);
1130   }
1131
1132   build_android (@files) if ($android_p);
1133
1134   exit ($failures);
1135 }
1136
1137 main();