git.hungrycats.org Git - xscreensaver/blob - hacks/check-configs.pl

   1 #!/usr/bin/perl -w
   2 # Copyright © 2008-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 # 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.5 $ }; $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
 125   my ($ign, $opts) = ($body =~ m/(_options|\bopts)\s*\[\]\s*=\s*{(.*?)}\s*;/s);
 126   if  ($xlockmore_p || $analogtv_p || $opts) {
 127     $opts = '' unless $opts;
 128     $opts .= ",\n$xlockmore_default_opts" if ($xlockmore_p);
 129     $opts .= ",\n$analogtv_default_opts" if ($analogtv_p);
 130
 131     foreach (split (/,\s*\n/, $opts)) {
 132       s/^\s*//s;
 133       s/\s*$//s;
 134       next if m/^$/s;
 135       next if m/^{\s*0\s*,/s;
 136       my ($switch, $res, $type, $v0, $v1, $v2) =
 137         m@^ \s* { \s * \"([^\"]+)\" \s* ,
 138                   \s * \"([^\"]+)\" \s* ,
 139                   \s * ([^\s]+)     \s* ,
 140                   \s * (\"([^\"]*)\"|([a-zA-Z\d_]+)) \s* }@xi;
 141       print STDERR "$progname: $file: unparsable: $_\n" unless $switch;
 142       my $val = defined($v1) ? $v1 : $v2;
 143       $val = '%' if ($type eq 'XrmoptionSepArg');
 144       $res =~ s/^[.*]//s;
 145       $res =~ s/^[a-z\d]+\.//si;
 146       $switch =~ s/^\+/-no-/s;
 147
 148       $val = "$res: $val";
 149       if (defined ($switch_to_res{$switch})) {
 150         print STDERR "$progname: $file:   DUP! $switch = \"$val\"\n"
 151           if ($verbose > 2);
 152       } else {
 153         $switch_to_res{$switch} = $val;
 154         print STDERR "$progname: $file:   $switch = \"$val\"\n"
 155           if ($verbose > 2);
 156       }
 157     }
 158   } else {
 159     error ("$file: no options");
 160   }
 161
 162   return (\%res_to_val, \%switch_to_res);
 163 }
 164
 165 # Returns a list of:
 166 #    "resource = default value"
 167 # or "resource != non-default value"
 168 #
 169 sub parse_xml($$) {
 170   my ($saver, $switch_to_res) = @_;
 171   my $file = "config/" . lc($saver) . ".xml";
 172   my $body = '';
 173   local *IN;
 174   open (IN, "<$file") || error ("$file: $!");
 175   while (<IN>) { $body .= $_; }
 176   close IN;
 177   $file =~ s@^.*/@@;
 178
 179   my @result = ();
 180
 181   $body =~ s/<!--.*?-->/ /gsi;
 182
 183   $body =~ s/\s+/ /gs;
 184   $body =~ s/</\001</gs;
 185   $body =~ s/\001(<option)/$1/gs;
 186
 187   print STDERR "$progname: $file: options:\n" if ($verbose > 2);
 188   foreach (split (m/\001/, $body)) {
 189     next if (m/^\s*$/s);
 190     my ($type, $args) = m@^<([?/]?[-_a-z]+)\b\s*(.*)$@si;
 191     error ("$progname: $file: unparsable: $_") unless $type;
 192     next if ($type =~ m@^/@);
 193
 194     if ($type =~ m/^([hv]group|\?xml|command|string|file|_description|xscreensaver-(image|text))/s) {
 195
 196     } elsif ($type eq 'screensaver') {
 197       my ($name) = ($args =~ m/\b_label\s*=\s*\"([^\"]+)\"/);
 198       my $val = "progclass = $name";
 199       push @result, $val;
 200       print STDERR "$progname: $file:   name:    $name\n" if ($verbose > 2);
 201
 202     } elsif ($type eq 'number') {
 203       my ($arg) = ($args =~ m/\barg\s*=\s*\"([^\"]+)\"/);
 204       my ($val) = ($args =~ m/\bdefault\s*=\s*\"([^\"]+)\"/);
 205       $val = '' unless defined($val);
 206
 207       my $switch = $arg;
 208       $switch =~ s/\s+.*$//;
 209       my ($res) = $switch_to_res->{$switch};
 210       error ("$file: no resource for $type switch \"$arg\"") unless $res;
 211       $res =~ s/: \%$//;
 212       error ("$file: unparsable value: $res") if ($res =~ m/:/);
 213       $val = "$res = $val";
 214       push @result, $val;
 215       print STDERR "$progname: $file:   number:  $val\n" if ($verbose > 2);
 216
 217     } elsif ($type eq 'boolean') {
 218       my ($set)   = ($args =~ m/\barg-set\s*=\s*\"([^\"]+)\"/);
 219       my ($unset) = ($args =~ m/\barg-unset\s*=\s*\"([^\"]+)\"/);
 220       my ($arg) = $set || $unset || error ("$file: unparsable: $args");
 221       my ($res) = $switch_to_res->{$arg};
 222         error ("$file: no resource for boolean switch \"$arg\"") unless $res;
 223       my ($res2, $val) = ($res =~ m/^(.*?): (.*)$/s);
 224       error ("$file: unparsable boolean resource: $res") unless $res2;
 225       $res = $res2;
 226 #      $val = ($set ? "$res != $val" : "$res = $val");
 227       $val = "$res != $val";
 228       push @result, $val;
 229       print STDERR "$progname: $file:   boolean: $val\n" if ($verbose > 2);
 230
 231     } elsif ($type eq 'select') {
 232       $args =~ s/</\001</gs;
 233       my @opts = split (/\001/, $args);
 234       shift @opts;
 235       my $unset_p = 0;
 236       my $this_res = undef;
 237       foreach (@opts) {
 238         error ("$file: unparsable: $_") unless (m/^<option\s/);
 239         my ($set) = m/\barg-set\s*=\s*\"([^\"]+)\"/;
 240         if ($set) {
 241           my ($set2, $val) = ($set =~ m/^(.*?) (.*)$/s);
 242           $set = $set2 if ($set2);
 243           my ($res) = $switch_to_res->{$set};
 244           error ("$file: no resource for select switch \"$set\"") unless $res;
 245
 246           my ($res2, $val2) = ($res =~ m/^(.*?): (.*)$/s);
 247           error ("$file: unparsable select resource: $res") unless $res2;
 248           $res = $res2;
 249           $val = $val2 unless ($val2 eq '%');
 250
 251           error ("$file: mismatched resources: $res vs $this_res")
 252             if (defined($this_res) && $this_res ne $res);
 253           $this_res = $res;
 254
 255           $val = "$res != $val";
 256           push @result, $val;
 257           print STDERR "$progname: $file:   select:  $val\n" if ($verbose > 2);
 258
 259         } else {
 260           error ("$file: multiple default options: $set") if ($unset_p);
 261           $unset_p++;
 262         }
 263       }
 264
 265     } else {
 266       error ("$file: unknown type \"$type\" for no arg");
 267     }
 268   }
 269
 270   return @result;
 271 }
 272
 273
 274 sub check_config($) {
 275   my ($saver) = @_;
 276
 277   # kludge
 278   return 0 if ($saver =~ m/(-helper)$/);
 279
 280   my ($src_opts, $switchmap) = parse_src ($saver);
 281   my (@xml_opts) = parse_xml ($saver, $switchmap);
 282
 283   my $failures = 0;
 284   foreach my $claim (@xml_opts) {
 285     my ($res, $compare, $xval) = ($claim =~ m/^(.*) (=|!=) (.*)$/s);
 286     error ("$saver: unparsable xml claim: $_") unless $compare;
 287
 288     my $sval = $src_opts->{$res};
 289     if ($res =~ m/^TV/) {
 290       print STDERR "$progname: $saver: OK: skipping \"$res\"\n"
 291         if ($verbose > 1);
 292     } elsif (!defined($sval)) {
 293       print STDERR "$progname: $saver: $res: not in source\n";
 294     } elsif ($compare eq '!='
 295              ? $sval eq $xval
 296              : $sval ne $xval) {
 297       print STDERR "$progname: $saver: " .
 298         "src has \"$res = $sval\", xml has \"$claim\"\n";
 299       $failures++;
 300     } elsif ($verbose > 1) {
 301       print STDERR "$progname: $saver: OK: \"$res = $sval\" vs \"$claim\"\n";
 302     }
 303   }
 304
 305   # Now make sure the progclass in the source and XML also matches
 306   # the XCode target name.
 307   #
 308   my $obd = "../OSX/build/Debug";
 309   if (-d $obd) {
 310     my $progclass = $src_opts->{progclass};
 311     my $f = (glob("$obd/$progclass.saver*"))[0];
 312     if (!$f && $progclass ne 'Flurry') {
 313       print STDERR "$progname: $progclass.saver does not exist\n";
 314       $failures++;
 315     }
 316   }
 317
 318   print STDERR "$progname: $saver: OK\n"
 319     if ($verbose == 1 && $failures == 0);
 320
 321   return $failures;
 322 }
 323
 324
 325 sub error($) {
 326   my ($err) = @_;
 327   print STDERR "$progname: $err\n";
 328   exit 1;
 329 }
 330
 331 sub usage() {
 332   print STDERR "usage: $progname [--verbose] files ...\n";
 333   exit 1;
 334 }
 335
 336 sub main() {
 337   my @files = ();
 338   while ($#ARGV >= 0) {
 339     $_ = shift @ARGV;
 340     if (m/^--?verbose$/) { $verbose++; }
 341     elsif (m/^-v+$/) { $verbose += length($_)-1; }
 342     elsif (m/^-./) { usage; }
 343     else { push @files, $_; }
 344 #    else { usage; }
 345   }
 346
 347   usage unless ($#files >= 0);
 348   my $failures = 0;
 349   foreach (@files) { $failures += check_config($_); }
 350   exit ($failures);
 351 }
 352
 353 main();