From http://www.jwz.org/xscreensaver/xscreensaver-5.30.tar.gz
[xscreensaver] / 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;