git.hungrycats.org Git - xscreensaver/blob - hacks/munge-ad.pl

   1 #!/usr/bin/perl -w
   2 # Copyright © 2008 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 updates driver/XScreenSaver.ad.in with the current list of savers.
  13 #
  14 # Created:  3-Aug-2008.
  15
  16 require 5;
  17 use diagnostics;
  18 use strict;
  19
  20 my $progname = $0; $progname =~ s@.*/@@g;
  21 my $version = q{ $Revision: 1.4 $ }; $version =~ s/^[^\d]+([\d.]+).*/$1/;
  22
  23 my $verbose = 0;
  24
  25 # 1 means disabled: marked with "-" by default in the .ad file.
  26 # 2 means retired: not mentioned in .ad at all.
  27 #
  28 my %disable = (
  29    'abstractile'        => 1,
  30    'ant'                => 1,
  31    'antinspect'         => 1,
  32    'antmaze'            => 1,
  33    'antspotlight'       => 1,
  34    'braid'              => 1,
  35    'critical'           => 1,
  36    'crystal'            => 1,
  37    'demon'              => 1,
  38    'dnalogo'            => 1,
  39    'fadeplot'           => 1,
  40    'glblur'             => 1,
  41    'glforestfire'       => 1,
  42    'glplanet'           => 1,
  43    'glslideshow'        => 1,
  44    'hyperball'          => 1,
  45    'hypercube'          => 1,
  46    'jigglypuff'         => 1,
  47    'juggle'             => 1,
  48    'kaleidescope'       => 1,
  49    'laser'              => 1,
  50    'lcdscrub'           => 1,
  51    'lightning'          => 1,
  52    'lisa'               => 1,
  53    'lissie'             => 1,
  54    'lmorph'             => 1,
  55    'loop'               => 1,
  56    'nerverot'           => 1,
  57    'noseguy'            => 1,
  58    'polyominoes'        => 1,
  59    'providence'         => 1,
  60    'pyro'               => 1,
  61    'rdbomb'             => 2,  # alternate name
  62    'rocks'              => 1,
  63    'rotor'              => 1,
  64    'sballs'             => 1,
  65    'sierpinski'         => 1,
  66    'sphere'             => 1,
  67    'spiral'             => 1,
  68    'thornbird'          => 1,
  69    'vidwhacker'         => 1,
  70    'vines'              => 1,
  71    'webcollage'         => 1,
  72    'worm'               => 1,
  73    'xsublim'            => 2,
  74   );
  75
  76
  77 # Parse the RETIRED_EXES variable from the Makefiles to populate %disable.
  78 #
  79 sub parse_makefiles() {
  80   foreach my $mf ( "Makefile.in", "glx/Makefile.in" ) {
  81     my $body = '';
  82     local *IN;
  83     open (IN, "<$mf") || error ("$mf: $!");
  84     while (<IN>) { $body .= $_; }
  85     close IN;
  86
  87     $body =~ s/\\\n//gs;
  88     my ($var)  = ($body =~ m/^RETIRED_EXES\s*=\s*(.*)$/mi);
  89     my ($var2) = ($body =~ m/^RETIRED_GL_EXES\s*=\s*(.*)$/mi);
  90     error ("no RETIRED_EXES in $mf") unless $var;
  91     $var .= " $var2" if $var2;
  92     foreach my $hack (split (/\s+/, $var)) {
  93       $disable{$hack} = 2;
  94     }
  95   }
  96 }
  97
  98
  99 sub munge_ad($) {
 100   my ($file) = @_;
 101
 102   parse_makefiles();
 103
 104   my $body = '';
 105   local *IN;
 106   open (IN, "<$file") || error ("$file: $!");
 107   while (<IN>) { $body .= $_; }
 108   close IN;
 109   my $obody = $body;
 110
 111   my ($top, $mid, $bot) = ($body =~ m/^(.*?\n)(\*hacks\..*?\n)(\n.*)$/s);
 112
 113   my $mid2 = '';
 114
 115   my %hacks;
 116
 117   # Update the "*hacks.foo.name" section of the file based on the contents
 118   # of config/*.xml.
 119   #
 120   my $dir = $file;
 121   $dir =~ s@/[^/]*$@@s;
 122   my @counts = (0,0,0,0,0,0,0,0,0,0);
 123   foreach my $xml (sort (glob ("$dir/../hacks/config/*.xml"))) {
 124     my $b = '';
 125     open (IN, "<$xml") || error ("$xml: $!");
 126     while (<IN>) { $b .= $_; }
 127     close IN;
 128     my ($name) = ($b =~ m@<screensaver[^<>]*\b_label=\"([^<>\"]+)\">@s);
 129     error ("$xml: no name") unless $name;
 130
 131     my $name2 = lc($name);
 132     $name2 =~ s/^((x|gl)?[a-z])/\U$1/s;  # what prefs.c (make_hack_name) does
 133
 134     $xml =~ s@^.*/([^/]+)\.xml$@$1@s;
 135     if ($name ne $name2) {
 136       my $s = sprintf("*hacks.%s.name:", $xml);
 137       $mid2 .= sprintf ("%-28s%s\n", $s, $name);
 138       $counts[9]++;
 139     }
 140
 141     # Grab the year.
 142     my ($year) =
 143       ($b =~ m/<_description>.*Written by.*?;\s+(19[6-9]\d|20\d\d)\b/si);
 144     error ("no year in $xml.xml") unless $year;
 145     $hacks{$xml} = $year;
 146   }
 147
 148   # Splice in new names.
 149   $body = $top . $mid2 . $bot;
 150
 151
 152   # Replace the "programs" section.
 153   # Sort hacks by creation date, but put the OpenGL ones at the end.
 154   #
 155   my $segregate_p = 0;  # whether to put the GL hacks at the end.
 156   my $xhacks = '';
 157   my $ghacks = '';
 158   foreach my $hack (sort { $hacks{$a} == $hacks{$b}
 159                            ? $a cmp $b
 160                            : $hacks{$a} <=> $hacks{$b}}
 161                     (keys(%hacks))) {
 162     my $cmd = "$hack -root";
 163     my $ts = (length($cmd) / 8) * 8;
 164     while ($ts < 40) { $cmd .= "\t"; $ts += 8; }
 165
 166     my $dis = $disable{$hack} || 0;
 167
 168     my $glp;
 169     my $glep = ($hack eq 'extrusion');
 170     if (-f "$hack.c" || -f "$hack") { $glp = 0; }
 171     elsif (-f "glx/$hack.c") { $glp = 1; }
 172     elsif ($dis != 2) { error ("is $hack X or GL?"); }
 173
 174     $counts[($disable{$hack} || 0)]++;
 175     if ($glp) {
 176       $counts[6+($disable{$hack} || 0)]++;
 177     } else {
 178       $counts[3+($disable{$hack} || 0)]++;
 179     }
 180
 181     next if ($dis == 2);
 182
 183     $dis = ($dis ? '-' : '');
 184     my $vis = ($glp
 185                ? (($dis ? '' : $glep ? '@GLE_KLUDGE@' : '@GL_KLUDGE@') .
 186                   ' GL: ')
 187                : '');
 188     $cmd = "$dis$vis\t\t\t\t$cmd    \\n\\\n";
 189
 190     if ($glp) {
 191       ($segregate_p ? $ghacks : $xhacks) .= $cmd;
 192     } else {
 193       $xhacks .= $cmd;
 194     }
 195   }
 196
 197   # Splice in new programs list.
 198   #
 199   $mid2 = ($xhacks .
 200            ($segregate_p ? "\t\t\t\t\t\t\t\t\t      \\\n" : "") .
 201            $ghacks);
 202   $mid2 =~ s@\\$@@s;
 203   ($top, $mid, $bot) =
 204     ($body =~ m/^(.*?\n\*programs:\s+\\\n)(.*?\n)(\n.*)$/s);
 205   error ("unparsable") unless $mid;
 206   $body = $top . $mid2 . $bot;
 207
 208   print STDERR "$progname: " .
 209     "Total: $counts[0]+$counts[1]+$counts[2]; " .
 210       "X11: $counts[3]+$counts[4]+$counts[5]; " .
 211        "GL: $counts[6]+$counts[7]+$counts[8]; " .
 212     "Names: $counts[9]\n"
 213         if ($verbose);
 214
 215   # Write file if changed.
 216   #
 217   if ($body ne $obody) {
 218     local *OUT;
 219     open (OUT, ">$file") || error ("$file: $!");
 220     print OUT $body;
 221     close OUT;
 222     print STDERR "$progname: wrote $file\n";
 223   } elsif ($verbose) {
 224     print STDERR "$progname: $file unchanged\n";
 225   }
 226 }
 227
 228
 229 sub error($) {
 230   my ($err) = @_;
 231   print STDERR "$progname: $err\n";
 232   exit 1;
 233 }
 234
 235 sub usage() {
 236   print STDERR "usage: $progname [--verbose] ad-file\n";
 237   exit 1;
 238 }
 239
 240 sub main() {
 241   my $file;
 242   while ($#ARGV >= 0) {
 243     $_ = shift @ARGV;
 244     if (m/^--?verbose$/) { $verbose++; }
 245     elsif (m/^-v+$/) { $verbose += length($_)-1; }
 246     elsif (m/^-./) { usage; }
 247     elsif (!$file) { $file = $_; }
 248     else { usage; }
 249   }
 250
 251   usage unless ($file);
 252   munge_ad ($file);
 253 }
 254
 255 main();
 256 exit 0;