X-Git-Url: http://git.hungrycats.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=hacks%2Fmunge-ad.pl;h=7504d2ce6b39d8904707e92f74e958cb0ba3ec41;hb=d5186197bc394e10a4402f7f6d23fbb14103bc50;hp=d8b2bb9567fbc22de1e8e5f49a52b2fe5485b740;hpb=c1b9b55ad8d59dc05ef55e316aebf5863e7dfa56;p=xscreensaver diff --git a/hacks/munge-ad.pl b/hacks/munge-ad.pl index d8b2bb95..7504d2ce 100755 --- a/hacks/munge-ad.pl +++ b/hacks/munge-ad.pl @@ -1,5 +1,5 @@ #!/usr/bin/perl -w -# Copyright © 2008 Jamie Zawinski +# Copyright © 2008-2014 Jamie Zawinski # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that @@ -18,53 +18,75 @@ use diagnostics; use strict; my $progname = $0; $progname =~ s@.*/@@g; -my $version = q{ $Revision: 1.2 $ }; $version =~ s/^[^\d]+([\d.]+).*/$1/; +my ($version) = ('$Revision: 1.10 $' =~ m/\s(\d[.\d]+)\s/s); my $verbose = 0; -# These are marked as disabled by default in the .ad file. +# 1 means disabled: marked with "-" by default in the .ad file. +# 2 means retired: not mentioned in .ad at all (parsed from Makefile). # my %disable = ( - 'abstractile' => 1, - 'antinspect' => 1, - 'antmaze' => 1, - 'ant' => 1, - 'carousel' => 1, - 'critical' => 1, - 'demon' => 1, - 'dnalogo' => 1, - 'glblur' => 1, - 'glforestfire' => 1, - 'glslideshow' => 1, - 'hyperball' => 1, - 'juggle' => 1, - 'laser' => 1, - 'lcdscrub' => 1, - 'lightning' => 1, - 'lisa' => 1, - 'lissie' => 1, - 'lmorph' => 1, - 'loop' => 1, - 'rotor' => 1, - 'sballs' => 1, - 'sierpinski' => 1, - 'sphere' => 1, - 'spiral' => 1, - 'thornbird' => 1, - 'vidwhacker' => 1, - 'vines' => 1, - 'webcollage' => 1, - 'worm' => 1, + 'antinspect' => 1, + 'antmaze' => 1, + 'antspotlight' => 1, + 'braid' => 1, + 'crystal' => 1, + 'demon' => 1, + 'dnalogo' => 1, + 'fadeplot' => 1, + 'glblur' => 1, + 'glslideshow' => 1, + 'jigglypuff' => 1, + 'kaleidescope' => 1, + 'lcdscrub' => 1, + 'loop' => 1, + 'mismunch' => 2, + 'nerverot' => 1, + 'noseguy' => 1, + 'polyominoes' => 1, + 'providence' => 1, + 'pyro' => 1, + 'rdbomb' => 2, # alternate name + 'rocks' => 1, + 'sballs' => 1, + 'sierpinski' => 1, + 'thornbird' => 1, + 'vidwhacker' => 1, + 'webcollage' => 1, ); +# Parse the RETIRED_EXES variable from the Makefiles to populate %disable. +# Duplicated in ../OSX/build-fntable.pl. +# +sub parse_makefiles() { + foreach my $mf ( "Makefile.in", "glx/Makefile.in" ) { + open (my $in, '<', $mf) || error ("$mf: $!"); + local $/ = undef; # read entire file + my $body = <$in>; + close $in; + + $body =~ s/\\\n//gs; + my ($var) = ($body =~ m/^RETIRED_EXES\s*=\s*(.*)$/mi); + my ($var2) = ($body =~ m/^RETIRED_GL_EXES\s*=\s*(.*)$/mi); + error ("no RETIRED_EXES in $mf") unless $var; + $var .= " $var2" if $var2; + foreach my $hack (split (/\s+/, $var)) { + $disable{$hack} = 2; + } + } +} + + sub munge_ad($) { my ($file) = @_; - my $body = ''; - local *IN; - open (IN, "<$file") || error ("$file: $!"); - while () { $body .= $_; } - close IN; + + parse_makefiles(); + + open (my $in, '<', $file) || error ("$file: $!"); + local $/ = undef; # read entire file + my $body = <$in>; + close $in; my $obody = $body; my ($top, $mid, $bot) = ($body =~ m/^(.*?\n)(\*hacks\..*?\n)(\n.*)$/s); @@ -78,13 +100,13 @@ sub munge_ad($) { # my $dir = $file; $dir =~ s@/[^/]*$@@s; - my @counts = (0,0,0,0,0,0); + my @counts = (0,0,0,0,0,0,0,0,0,0); foreach my $xml (sort (glob ("$dir/../hacks/config/*.xml"))) { - my $b = ''; - open (IN, "<$xml") || error ("$xml: $!"); - while () { $b .= $_; } - close IN; - my ($name) = ($b =~ m@]*\b_label=\"([^<>\"]+)\">@s); + open (my $in, '<', $xml) || error ("$xml: $!"); + local $/ = undef; # read entire file + my $b = <$in>; + close $in; + my ($name) = ($b =~ m@]*\b_label=\"([^<>\"]+)\"@s); error ("$xml: no name") unless $name; my $name2 = lc($name); @@ -94,7 +116,7 @@ sub munge_ad($) { if ($name ne $name2) { my $s = sprintf("*hacks.%s.name:", $xml); $mid2 .= sprintf ("%-28s%s\n", $s, $name); - $counts[1]++; + $counts[9]++; } # Grab the year. @@ -102,7 +124,6 @@ sub munge_ad($) { ($b =~ m/<_description>.*Written by.*?;\s+(19[6-9]\d|20\d\d)\b/si); error ("no year in $xml.xml") unless $year; $hacks{$xml} = $year; - $counts[0]++; } # Splice in new names. @@ -122,15 +143,26 @@ sub munge_ad($) { my $cmd = "$hack -root"; my $ts = (length($cmd) / 8) * 8; while ($ts < 40) { $cmd .= "\t"; $ts += 8; } - next if ($hack eq 'ant' || $hack eq 'rdbomb'); + + my $dis = $disable{$hack} || 0; my $glp; my $glep = ($hack eq 'extrusion'); if (-f "$hack.c" || -f "$hack") { $glp = 0; } elsif (-f "glx/$hack.c") { $glp = 1; } - else { error ("is $hack X or GL?"); } + elsif ($hack eq 'companioncube') { $glp = 1; } # kludge + elsif ($dis != 2) { error ("is $hack X or GL?"); } + + $counts[($disable{$hack} || 0)]++; + if ($glp) { + $counts[6+($disable{$hack} || 0)]++; + } else { + $counts[3+($disable{$hack} || 0)]++; + } + + next if ($dis == 2); - my $dis = ($disable{$hack} ? '-' : ''); + $dis = ($dis ? '-' : ''); my $vis = ($glp ? (($dis ? '' : $glep ? '@GLE_KLUDGE@' : '@GL_KLUDGE@') . ' GL: ') @@ -139,10 +171,8 @@ sub munge_ad($) { if ($glp) { ($segregate_p ? $ghacks : $xhacks) .= $cmd; - $counts[4+defined($disable{$hack})]++; } else { $xhacks .= $cmd; - $counts[2+defined($disable{$hack})]++; } } @@ -157,18 +187,19 @@ sub munge_ad($) { error ("unparsable") unless $mid; $body = $top . $mid2 . $bot; - print STDERR "$progname: Total: $counts[0]; " . - "X11: $counts[2]+$counts[3]; GL: $counts[4]+$counts[5]; " . - "Names: $counts[1]\n" + print STDERR "$progname: " . + "Total: $counts[0]+$counts[1]+$counts[2]; " . + "X11: $counts[3]+$counts[4]+$counts[5]; " . + "GL: $counts[6]+$counts[7]+$counts[8]; " . + "Names: $counts[9]\n" if ($verbose); # Write file if changed. # if ($body ne $obody) { - local *OUT; - open (OUT, ">$file") || error ("$file: $!"); - print OUT $body; - close OUT; + open (my $out, '>', $file) || error ("$file: $!"); + print $out $body; + close $out; print STDERR "$progname: wrote $file\n"; } elsif ($verbose) { print STDERR "$progname: $file unchanged\n";