2 # Copyright © 2008-2014 Jamie Zawinski <jwz@jwz.org>
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
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.
15 # Created: 1-Aug-2008.
21 my $progname = $0; $progname =~ s@.*/@@g;
22 my ($version) = ('$Revision: 1.12 $' =~ m/\s(\d[.\d]+)\s/s);
27 my $xlockmore_default_opts = '';
28 foreach (qw(count cycles delay ncolors size font)) {
29 $xlockmore_default_opts .= "{\"-$_\", \".$_\", XrmoptionSepArg, 0},\n";
31 $xlockmore_default_opts .=
32 "{\"-wireframe\", \".wireframe\", XrmoptionNoArg, \"true\"},\n" .
33 "{\"-3d\", \".use3d\", XrmoptionNoArg, \"true\"},\n" .
34 "{\"-no-3d\", \".use3d\", XrmoptionNoArg, \"false\"},\n";
36 my $thread_default_opts =
37 "{\"-threads\", \".useThreads\", XrmoptionNoArg, \"True\"},\n" .
38 "{\"-no-threads\", \".useThreads\", XrmoptionNoArg, \"False\"},\n";
40 my $analogtv_default_opts = '';
41 foreach (qw(color tint brightness contrast)) {
42 $analogtv_default_opts .= "{\"-tv-$_\", \".TV$_\", XrmoptionSepArg, 0},\n";
45 $analogtv_default_opts .= $thread_default_opts;
50 # - A table of the default resource values.
51 # - A table of "-switch" => "resource: value", or "-switch" => "resource: %"
55 my $file = lc($saver) . ".c";
58 $file = 'apple2-main.c' if ($file eq 'apple2.c');
59 $file = 'sproingiewrap.c' if ($file eq 'sproingies.c');
60 $file = 'b_lockglue.c' if ($file eq 'bubble3d.c');
61 $file = 'polyhedra-gl.c' if ($file eq 'polyhedra.c');
62 $file = 'companion.c' if ($file eq 'companioncube.c');
64 $file = "glx/$file" unless (-f $file);
66 open (my $in, '<', $file) || error ("$file: $!");
67 while (<$in>) { $body .= $_; }
72 my $thread_p = ($body =~ m/THREAD_DEFAULTS/);
73 my $analogtv_p = ($body =~ m/ANALOGTV_DEFAULTS/);
75 $body =~ s@/\*.*?\*/@@gs;
76 $body =~ s@^#\s*(if|ifdef|ifndef|elif|else|endif).*$@@gm;
77 $body =~ s/(THREAD|ANALOGTV)_(DEFAULTS|OPTIONS)(_XLOCK)?//gs;
79 print STDERR "$progname: $file: defaults:\n" if ($verbose > 2);
81 if ($body =~ m/_defaults\s*\[\]\s*=\s*{(.*?)}\s*;/s) {
82 foreach (split (/,\s*\n/, $1)) {
86 my ($key, $val) = m@^\"([^:\s]+)\s*:\s*(.*?)\s*\"$@;
87 print STDERR "$progname: $file: unparsable: $_\n" unless $key;
89 $res_to_val{$key} = $val;
90 print STDERR "$progname: $file: $key = $val\n" if ($verbose > 2);
92 } elsif ($body =~ m/\#\s*define\s*DEFAULTS\s*\\?\s*(.*?)\n[\n#]/s) {
95 $str =~ s/\"\s*\\\n\s*\"//gs;
96 $str =~ m/^\s*\"(.*?)\"\s*\\?\s*$/ ||
97 error ("$file: unparsable defaults: $str");
99 $str =~ s/\s*\\n\s*/\n/gs;
100 foreach (split (/\n/, $str)) {
101 my ($key, $val) = m@^([^:\s]+)\s*:\s*(.*?)\s*$@;
102 print STDERR "$progname: $file: unparsable: $_\n" unless $key;
104 $res_to_val{$key} = $val;
105 print STDERR "$progname: $file: $key = $val\n" if ($verbose > 2);
108 while ($body =~ s/^#\s*define\s+(DEF_([A-Z\d_]+))\s+\"([^\"]+)\"//m) {
109 my ($key1, $key2, $val) = ($1, lc($2), $3);
110 $key2 =~ s/_(.)/\U$1/gs; # "foo_bar" -> "fooBar"
111 $key2 =~ s/Rpm/RPM/; # kludge
112 $res_to_val{$key2} = $val;
113 print STDERR "$progname: $file: $key1 ($key2) = $val\n"
118 error ("$file: no defaults");
121 $body =~ m/XSCREENSAVER_MODULE(_2)?\s*\(\s*\"([^\"]+)\"/ ||
122 error ("$file: no module name");
123 $res_to_val{progclass} = $2;
124 $res_to_val{doFPS} = 'false';
125 print STDERR "$progname: $file: progclass = $2\n" if ($verbose > 2);
127 print STDERR "$progname: $file: switches to resources:\n"
130 $switch_to_res{-fps} = 'doFPS: true';
131 $switch_to_res{-fg} = 'foreground: %';
132 $switch_to_res{-bg} = 'background: %';
134 my ($ign, $opts) = ($body =~ m/(_options|\bopts)\s*\[\]\s*=\s*{(.*?)}\s*;/s);
135 if ($xlockmore_p || $thread_p || $analogtv_p || $opts) {
136 $opts = '' unless $opts;
137 $opts .= ",\n$xlockmore_default_opts" if ($xlockmore_p);
138 $opts .= ",\n$thread_default_opts" if ($thread_p);
139 $opts .= ",\n$analogtv_default_opts" if ($analogtv_p);
141 foreach (split (/,\s*\n/, $opts)) {
145 next if m/^{\s*0\s*,/s;
146 my ($switch, $res, $type, $v0, $v1, $v2) =
147 m@^ \s* { \s * \"([^\"]+)\" \s* ,
148 \s * \"([^\"]+)\" \s* ,
150 \s * (\"([^\"]*)\"|([a-zA-Z\d_]+)) \s* }@xi;
151 print STDERR "$progname: $file: unparsable: $_\n" unless $switch;
152 my $val = defined($v1) ? $v1 : $v2;
153 $val = '%' if ($type eq 'XrmoptionSepArg');
155 $res =~ s/^[a-z\d]+\.//si;
156 $switch =~ s/^\+/-no-/s;
159 if (defined ($switch_to_res{$switch})) {
160 print STDERR "$progname: $file: DUP! $switch = \"$val\"\n"
163 $switch_to_res{$switch} = $val;
164 print STDERR "$progname: $file: $switch = \"$val\"\n"
169 error ("$file: no options");
172 return (\%res_to_val, \%switch_to_res);
176 # "resource = default value"
177 # or "resource != non-default value"
180 my ($saver, $switch_to_res) = @_;
181 my $file = "config/" . lc($saver) . ".xml";
184 open (IN, "<$file") || error ("$file: $!");
185 while (<IN>) { $body .= $_; }
191 $body =~ s/<!--.*?-->/ /gsi;
194 $body =~ s/</\001</gs;
195 $body =~ s/\001(<option)/$1/gs;
199 print STDERR "$progname: $file: options:\n" if ($verbose > 2);
200 foreach (split (m/\001/, $body)) {
202 my ($type, $args) = m@^<([?/]?[-_a-z]+)\b\s*(.*)$@si;
203 error ("$progname: $file: unparsable: $_") unless $type;
204 next if ($type =~ m@^/@);
206 if ($type =~ m/^([hv]group|\?xml|command|string|file|_description|xscreensaver-(image|text|updater))/s) {
208 } elsif ($type eq 'screensaver') {
209 my ($name) = ($args =~ m/\b_label\s*=\s*\"([^\"]+)\"/);
210 my $val = "progclass = $name";
212 print STDERR "$progname: $file: name: $name\n" if ($verbose > 2);
214 } elsif ($type eq 'video') {
215 error ("$file: multiple videos") if $video;
216 ($video) = ($args =~ m/\bhref="(.*?)"/);
217 error ("$file: unparsable video") unless $video;
218 error ("$file: unparsable video URL")
219 unless ($video =~ m@^https?://www\.youtube\.com/watch\?v=[^?&]+$@s);
221 } elsif ($type eq 'number') {
222 my ($arg) = ($args =~ m/\barg\s*=\s*\"([^\"]+)\"/);
223 my ($val) = ($args =~ m/\bdefault\s*=\s*\"([^\"]+)\"/);
224 $val = '' unless defined($val);
227 $switch =~ s/\s+.*$//;
228 my ($res) = $switch_to_res->{$switch};
229 error ("$file: no resource for $type switch \"$arg\"") unless $res;
231 error ("$file: unparsable value: $res") if ($res =~ m/:/);
232 $val = "$res = $val";
234 print STDERR "$progname: $file: number: $val\n" if ($verbose > 2);
236 } elsif ($type eq 'boolean') {
237 my ($set) = ($args =~ m/\barg-set\s*=\s*\"([^\"]+)\"/);
238 my ($unset) = ($args =~ m/\barg-unset\s*=\s*\"([^\"]+)\"/);
239 my ($arg) = $set || $unset || error ("$file: unparsable: $args");
240 my ($res) = $switch_to_res->{$arg};
241 error ("$file: no resource for boolean switch \"$arg\"") unless $res;
242 my ($res2, $val) = ($res =~ m/^(.*?): (.*)$/s);
243 error ("$file: unparsable boolean resource: $res") unless $res2;
245 # $val = ($set ? "$res != $val" : "$res = $val");
246 $val = "$res != $val";
248 print STDERR "$progname: $file: boolean: $val\n" if ($verbose > 2);
250 } elsif ($type eq 'select') {
251 $args =~ s/</\001</gs;
252 my @opts = split (/\001/, $args);
255 my $this_res = undef;
257 error ("$file: unparsable: $_") unless (m/^<option\s/);
258 my ($set) = m/\barg-set\s*=\s*\"([^\"]+)\"/;
260 my ($set2, $val) = ($set =~ m/^(.*?) (.*)$/s);
261 $set = $set2 if ($set2);
262 my ($res) = $switch_to_res->{$set};
263 error ("$file: no resource for select switch \"$set\"") unless $res;
265 my ($res2, $val2) = ($res =~ m/^(.*?): (.*)$/s);
266 error ("$file: unparsable select resource: $res") unless $res2;
268 $val = $val2 unless ($val2 eq '%');
270 error ("$file: mismatched resources: $res vs $this_res")
271 if (defined($this_res) && $this_res ne $res);
274 $val = "$res != $val";
276 print STDERR "$progname: $file: select: $val\n" if ($verbose > 2);
279 error ("$file: multiple default options: $set") if ($unset_p);
285 error ("$file: unknown type \"$type\" for no arg");
289 # error ("$file: no video") unless $video;
290 print STDERR "\n$file: WARNING: no video\n\n" unless $video;
296 sub check_config($) {
300 return 0 if ($saver =~ m/(-helper)$/);
302 my ($src_opts, $switchmap) = parse_src ($saver);
303 my (@xml_opts) = parse_xml ($saver, $switchmap);
306 foreach my $claim (@xml_opts) {
307 my ($res, $compare, $xval) = ($claim =~ m/^(.*) (=|!=) (.*)$/s);
308 error ("$saver: unparsable xml claim: $_") unless $compare;
310 my $sval = $src_opts->{$res};
311 if ($res =~ m/^TV/) {
312 print STDERR "$progname: $saver: OK: skipping \"$res\"\n"
314 } elsif (!defined($sval)) {
315 print STDERR "$progname: $saver: $res: not in source\n";
316 } elsif ($compare eq '!='
319 print STDERR "$progname: $saver: " .
320 "src has \"$res = $sval\", xml has \"$claim\"\n";
322 } elsif ($verbose > 1) {
323 print STDERR "$progname: $saver: OK: \"$res = $sval\" vs \"$claim\"\n";
327 # Now make sure the progclass in the source and XML also matches
328 # the XCode target name.
330 my $obd = "../OSX/build/Debug";
332 my $progclass = $src_opts->{progclass};
333 my $f = (glob("$obd/$progclass.saver*"))[0];
334 if (!$f && $progclass ne 'Flurry') {
335 print STDERR "$progname: $progclass.saver does not exist\n";
340 print STDERR "$progname: $saver: OK\n"
341 if ($verbose == 1 && $failures == 0);
349 print STDERR "$progname: $err\n";
354 print STDERR "usage: $progname [--verbose] files ...\n";
360 while ($#ARGV >= 0) {
362 if (m/^--?verbose$/) { $verbose++; }
363 elsif (m/^-v+$/) { $verbose += length($_)-1; }
364 elsif (m/^-./) { usage; }
365 else { push @files, $_; }
369 usage unless ($#files >= 0);
371 foreach (@files) { $failures += check_config($_); }