94c8fd4fa2e5adfc89a51c06707dba166296d476
[xscreensaver] / hacks / check-configs.pl
1 #!/usr/bin/perl -w
2 # Copyright © 2008-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 # 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 # Created:  1-Aug-2008.
16
17 require 5;
18 use diagnostics;
19 use strict;
20
21 my $progname = $0; $progname =~ s@.*/@@g;
22 my $version = q{ $Revision: 1.7 $ }; $version =~ s/^[^\d]+([\d.]+).*/$1/;
23
24 my $verbose = 0;
25
26
27 my $xlockmore_default_opts = '';
28 foreach (qw(count cycles delay ncolors size font)) {
29   $xlockmore_default_opts .= "{\"-$_\", \".$_\", XrmoptionSepArg, 0},\n";
30 }
31 $xlockmore_default_opts .= 
32  "{\"-wireframe\", \".wireframe\", XrmoptionNoArg, \"true\"},\n" .
33  "{\"-3d\", \".use3d\", XrmoptionNoArg, \"true\"},\n";
34
35 my $analogtv_default_opts = '';
36 foreach (qw(color tint brightness contrast)) {
37   $analogtv_default_opts .= "{\"-tv-$_\", \".TV$_\", XrmoptionSepArg, 0},\n";
38 }
39
40
41
42 # Returns two tables:
43 # - A table of the default resource values.
44 # - A table of "-switch" => "resource: value", or "-switch" => "resource: %"
45 #
46 sub parse_src($) {
47   my ($saver) = @_;
48   my $file = lc($saver) . ".c";
49
50   # kludge...
51   $file = 'apple2-main.c' if ($file eq 'apple2.c');
52   $file = 'sproingiewrap.c' if ($file eq 'sproingies.c');
53   $file = 'b_lockglue.c' if ($file eq 'bubble3d.c');
54   $file = 'polyhedra-gl.c' if ($file eq 'polyhedra.c');
55   $file = 'companion.c' if ($file eq 'companioncube.c');
56
57   $file = "glx/$file" unless (-f $file);
58   my $body = '';
59   local *IN;
60   open (IN, "<$file") || error ("$file: $!");
61   while (<IN>) { $body .= $_; }
62   close IN;
63   $file =~ s@^.*/@@;
64
65   my $xlockmore_p = 0;
66   my $analogtv_p = ($body =~ m/ANALOGTV_DEFAULTS/);
67
68   $body =~ s@/\*.*?\*/@@gs;
69   $body =~ s@^#\s*(if|ifdef|ifndef|elif|else|endif).*$@@gm;
70   $body =~ s/ANALOGTV_(DEFAULTS|OPTIONS)//gs;
71
72   print STDERR "$progname: $file: defaults:\n" if ($verbose > 2);
73   my %res_to_val;
74   if ($body =~ m/_defaults\s*\[\]\s*=\s*{(.*?)}\s*;/s) {
75     foreach (split (/,\s*\n/, $1)) {
76       s/^\s*//s;
77       s/\s*$//s;
78       next if m/^0?$/s;
79       my ($key, $val) = m@^\"([^:\s]+)\s*:\s*(.*?)\s*\"$@;
80       print STDERR "$progname: $file: unparsable: $_\n" unless $key;
81       $key =~ s/^[.*]//s;
82       $res_to_val{$key} = $val;
83       print STDERR "$progname: $file:   $key = $val\n" if ($verbose > 2);
84     }
85   } elsif ($body =~ m/\#\s*define\s*DEFAULTS\s*\\?\s*(.*?)\n[\n#]/s) {
86     $xlockmore_p = 1;
87     my $str = $1;
88     $str =~ s/\"\s*\\\n\s*\"//gs;
89     $str =~ m/^\s*\"(.*?)\"\s*\\?\s*$/ || 
90       error ("$file: unparsable defaults: $str");
91     $str = $1;
92     $str =~ s/\s*\\n\s*/\n/gs;
93     foreach (split (/\n/, $str)) {
94       my ($key, $val) = m@^([^:\s]+)\s*:\s*(.*?)\s*$@;
95       print STDERR "$progname: $file: unparsable: $_\n" unless $key;
96       $key =~ s/^[.*]//s;
97       $res_to_val{$key} = $val;
98       print STDERR "$progname: $file:   $key = $val\n" if ($verbose > 2);
99     }
100
101     while ($body =~ s/^#\s*define\s+(DEF_([A-Z\d_]+))\s+\"([^\"]+)\"//m) {
102       my ($key1, $key2, $val) = ($1, lc($2), $3);
103       $key2 =~ s/_(.)/\U$1/gs;  # "foo_bar" -> "fooBar"
104       $key2 =~ s/Rpm/RPM/;      # kludge
105       $res_to_val{$key2} = $val;
106       print STDERR "$progname: $file:   $key1 ($key2) = $val\n" 
107         if ($verbose > 2);
108     }
109
110   } else {
111     error ("$file: no defaults");
112   }
113
114   $body =~ m/XSCREENSAVER_MODULE(_2)?\s*\(\s*\"([^\"]+)\"/ ||
115     error ("$file: no module name");
116   $res_to_val{progclass} = $2;
117   $res_to_val{doFPS} = 'false';
118   print STDERR "$progname: $file:   progclass = $2\n" if ($verbose > 2);
119
120   print STDERR "$progname: $file: switches to resources:\n"
121     if ($verbose > 2);
122   my %switch_to_res;
123   $switch_to_res{-fps} = 'doFPS: true';
124   $switch_to_res{-fg}  = 'foreground: %';
125   $switch_to_res{-bg}  = 'background: %';
126
127   my ($ign, $opts) = ($body =~ m/(_options|\bopts)\s*\[\]\s*=\s*{(.*?)}\s*;/s);
128   if  ($xlockmore_p || $analogtv_p || $opts) {
129     $opts = '' unless $opts;
130     $opts .= ",\n$xlockmore_default_opts" if ($xlockmore_p);
131     $opts .= ",\n$analogtv_default_opts" if ($analogtv_p);
132
133     foreach (split (/,\s*\n/, $opts)) {
134       s/^\s*//s;
135       s/\s*$//s;
136       next if m/^$/s;
137       next if m/^{\s*0\s*,/s;
138       my ($switch, $res, $type, $v0, $v1, $v2) =
139         m@^ \s* { \s * \"([^\"]+)\" \s* ,
140                   \s * \"([^\"]+)\" \s* ,
141                   \s * ([^\s]+)     \s* ,
142                   \s * (\"([^\"]*)\"|([a-zA-Z\d_]+)) \s* }@xi;
143       print STDERR "$progname: $file: unparsable: $_\n" unless $switch;
144       my $val = defined($v1) ? $v1 : $v2;
145       $val = '%' if ($type eq 'XrmoptionSepArg');
146       $res =~ s/^[.*]//s;
147       $res =~ s/^[a-z\d]+\.//si;
148       $switch =~ s/^\+/-no-/s;
149
150       $val = "$res: $val";
151       if (defined ($switch_to_res{$switch})) {
152         print STDERR "$progname: $file:   DUP! $switch = \"$val\"\n" 
153           if ($verbose > 2);
154       } else {
155         $switch_to_res{$switch} = $val;
156         print STDERR "$progname: $file:   $switch = \"$val\"\n" 
157           if ($verbose > 2);
158       }
159     }
160   } else {
161     error ("$file: no options");
162   }
163
164   return (\%res_to_val, \%switch_to_res);
165 }
166
167 # Returns a list of:
168 #    "resource = default value"
169 # or "resource != non-default value"
170 #
171 sub parse_xml($$) {
172   my ($saver, $switch_to_res) = @_;
173   my $file = "config/" . lc($saver) . ".xml";
174   my $body = '';
175   local *IN;
176   open (IN, "<$file") || error ("$file: $!");
177   while (<IN>) { $body .= $_; }
178   close IN;
179   $file =~ s@^.*/@@;
180
181   my @result = ();
182
183   $body =~ s/<!--.*?-->/ /gsi;
184
185   $body =~ s/\s+/ /gs;
186   $body =~ s/</\001</gs;
187   $body =~ s/\001(<option)/$1/gs;
188
189   print STDERR "$progname: $file: options:\n" if ($verbose > 2);
190   foreach (split (m/\001/, $body)) {
191     next if (m/^\s*$/s);
192     my ($type, $args) = m@^<([?/]?[-_a-z]+)\b\s*(.*)$@si;
193     error ("$progname: $file: unparsable: $_") unless $type;
194     next if ($type =~ m@^/@);
195
196     if ($type =~ m/^([hv]group|\?xml|command|string|file|_description|xscreensaver-(image|text|updater))/s) {
197
198     } elsif ($type eq 'screensaver') {
199       my ($name) = ($args =~ m/\b_label\s*=\s*\"([^\"]+)\"/);
200       my $val = "progclass = $name";
201       push @result, $val;
202       print STDERR "$progname: $file:   name:    $name\n" if ($verbose > 2);
203
204     } elsif ($type eq 'number') {
205       my ($arg) = ($args =~ m/\barg\s*=\s*\"([^\"]+)\"/);
206       my ($val) = ($args =~ m/\bdefault\s*=\s*\"([^\"]+)\"/);
207       $val = '' unless defined($val);
208
209       my $switch = $arg;
210       $switch =~ s/\s+.*$//;
211       my ($res) = $switch_to_res->{$switch};
212       error ("$file: no resource for $type switch \"$arg\"") unless $res;
213       $res =~ s/: \%$//;
214       error ("$file: unparsable value: $res") if ($res =~ m/:/);
215       $val = "$res = $val";
216       push @result, $val;
217       print STDERR "$progname: $file:   number:  $val\n" if ($verbose > 2);
218
219     } elsif ($type eq 'boolean') {
220       my ($set)   = ($args =~ m/\barg-set\s*=\s*\"([^\"]+)\"/);
221       my ($unset) = ($args =~ m/\barg-unset\s*=\s*\"([^\"]+)\"/);
222       my ($arg) = $set || $unset || error ("$file: unparsable: $args");
223       my ($res) = $switch_to_res->{$arg};
224         error ("$file: no resource for boolean switch \"$arg\"") unless $res;
225       my ($res2, $val) = ($res =~ m/^(.*?): (.*)$/s);
226       error ("$file: unparsable boolean resource: $res") unless $res2;
227       $res = $res2;
228 #      $val = ($set ? "$res != $val" : "$res = $val");
229       $val = "$res != $val";
230       push @result, $val;
231       print STDERR "$progname: $file:   boolean: $val\n" if ($verbose > 2);
232
233     } elsif ($type eq 'select') {
234       $args =~ s/</\001</gs;
235       my @opts = split (/\001/, $args);
236       shift @opts;
237       my $unset_p = 0;
238       my $this_res = undef;
239       foreach (@opts) {
240         error ("$file: unparsable: $_") unless (m/^<option\s/);
241         my ($set) = m/\barg-set\s*=\s*\"([^\"]+)\"/;
242         if ($set) {
243           my ($set2, $val) = ($set =~ m/^(.*?) (.*)$/s);
244           $set = $set2 if ($set2);
245           my ($res) = $switch_to_res->{$set};
246           error ("$file: no resource for select switch \"$set\"") unless $res;
247
248           my ($res2, $val2) = ($res =~ m/^(.*?): (.*)$/s);
249           error ("$file: unparsable select resource: $res") unless $res2;
250           $res = $res2;
251           $val = $val2 unless ($val2 eq '%');
252
253           error ("$file: mismatched resources: $res vs $this_res")
254             if (defined($this_res) && $this_res ne $res);
255           $this_res = $res;
256
257           $val = "$res != $val";
258           push @result, $val;
259           print STDERR "$progname: $file:   select:  $val\n" if ($verbose > 2);
260
261         } else {
262           error ("$file: multiple default options: $set") if ($unset_p);
263           $unset_p++;
264         }
265       }
266
267     } else {
268       error ("$file: unknown type \"$type\" for no arg");
269     }
270   }
271
272   return @result;
273 }
274
275
276 sub check_config($) {
277   my ($saver) = @_;
278
279   # kludge
280   return 0 if ($saver =~ m/(-helper)$/);
281
282   my ($src_opts, $switchmap) = parse_src ($saver);
283   my (@xml_opts) = parse_xml ($saver, $switchmap);
284
285   my $failures = 0;
286   foreach my $claim (@xml_opts) {
287     my ($res, $compare, $xval) = ($claim =~ m/^(.*) (=|!=) (.*)$/s);
288     error ("$saver: unparsable xml claim: $_") unless $compare;
289
290     my $sval = $src_opts->{$res};
291     if ($res =~ m/^TV/) {
292       print STDERR "$progname: $saver: OK: skipping \"$res\"\n"
293         if ($verbose > 1);
294     } elsif (!defined($sval)) {
295       print STDERR "$progname: $saver: $res: not in source\n";
296     } elsif ($compare eq '!='
297              ? $sval eq $xval
298              : $sval ne $xval) {
299       print STDERR "$progname: $saver: " .
300         "src has \"$res = $sval\", xml has \"$claim\"\n";
301       $failures++;
302     } elsif ($verbose > 1) {
303       print STDERR "$progname: $saver: OK: \"$res = $sval\" vs \"$claim\"\n";
304     }
305   }
306
307   # Now make sure the progclass in the source and XML also matches
308   # the XCode target name.
309   #
310   my $obd = "../OSX/build/Debug";
311   if (-d $obd) {
312     my $progclass = $src_opts->{progclass};
313     my $f = (glob("$obd/$progclass.saver*"))[0];
314     if (!$f && $progclass ne 'Flurry') {
315       print STDERR "$progname: $progclass.saver does not exist\n";
316       $failures++;
317     }
318   }
319
320   print STDERR "$progname: $saver: OK\n"
321     if ($verbose == 1 && $failures == 0);
322
323   return $failures;
324 }
325
326
327 sub error($) {
328   my ($err) = @_;
329   print STDERR "$progname: $err\n";
330   exit 1;
331 }
332
333 sub usage() {
334   print STDERR "usage: $progname [--verbose] files ...\n";
335   exit 1;
336 }
337
338 sub main() {
339   my @files = ();
340   while ($#ARGV >= 0) {
341     $_ = shift @ARGV;
342     if (m/^--?verbose$/) { $verbose++; }
343     elsif (m/^-v+$/) { $verbose += length($_)-1; }
344     elsif (m/^-./) { usage; }
345     else { push @files, $_; }
346 #    else { usage; }
347   }
348
349   usage unless ($#files >= 0);
350   my $failures = 0;
351   foreach (@files) { $failures += check_config($_); }
352   exit ($failures);
353 }
354
355 main();