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