#!/local/perl586/bin/perl # get-rulemetadata-for-revision -- find out metadata for a given # rule revision, and store it in the filesystem for later access # by the ruleqa.cgi web UI. If the metadata is already in the fsys, # don't bother re-extracting it, as it's an expensive operation. # settings are located in $HOME/.corpus sub usage { die qq{ usage: get-rulemetadata-for-revision --rev=NNNNN [--outputdir=/path/to/output/dir] }; } use strict; use warnings; use Getopt::Long; use File::Path; use File::Copy; use Time::ParseDate; use Cwd; my $perl = $^X; my $EARLIEST_REV = 428771; # before this, mkrules won't work use vars qw( $opt_outputdir $opt_rev ); GetOptions( "rev=s" => \$opt_rev, "outputdir=s" => \$opt_outputdir, ); $opt_outputdir ||= '.'; $opt_rev or usage(); my $conf_file = "$ENV{HOME}/.corpus"; my $outfile = "$opt_outputdir/rulemetadata.xml"; my %conf; configure(); if (already_cached()) { print "rule metadata already cached: $outfile\n"; exit; } if ($opt_rev < $EARLIEST_REV) { print "rule metadata cannot be generated, too early: $outfile\n"; exit; } print "creating rule metadata file: $outfile\n"; my $tmpdir = "/tmp/rulemd.$$"; $SIG{TERM} = $SIG{INT} = sub { cleanup_tmpdir(); die "killed"; }; eval { svn_and_build(); copy_md($outfile); }; if ($@) { my $err = $@; cleanup_tmpdir(); die $err; } cleanup_tmpdir(); exit; sub cleanup_tmpdir { system ("rm -rf $tmpdir"); } sub configure { # does rough equivalent of source open(C, $conf_file) || die "open failed: $conf_file: $!\n"; my $pwd = getcwd; while () { chomp; s/#.*//; if (/^\s*(.*?)\s*=\s*(.*?)\s*$/) { my ($key, $val) = ($1, $2); $val =~ s/\$PWD/$pwd/gs; $conf{$key} = $val; } } close(C); } sub already_cached { return (-f $outfile && -s _ > 0); } sub svn_and_build { mkdir $tmpdir, 0700 or die "cannot mkdir $tmpdir"; # note: copies .svn dir from the existing SVN checkout; # that way, the path and credentials are preserved, just the # revision number changes. In fact, copy the lot; minimize # the amount of work that has to be done to "svn up" to the # correct revision, hopefully. my $cmd; $cmd = "cd $tmpdir && ". "cp -pr $conf{tree}/. . && ". "rm -rf rules rulesrc && ". "svn update --non-interactive -r$opt_rev < /dev/null"; print "[$cmd]\n"; system $cmd; if ($? >> 8 != 0) { die "'$cmd' failed"; } $cmd = "cd $tmpdir; ". # "$perl Makefile.PL < /dev/null; make; ". "$perl build/mkrules --src rulesrc --out rules ". "--rulemetadata=rules/rulemetadata.xml"; print "[$cmd]\n"; system $cmd; if ($? >> 8 != 0) { die "'$cmd' failed"; } } sub copy_md { my $outfile = shift; my $infile = "$tmpdir/rules/rulemetadata.xml"; if (!-f $infile) { die "no $infile!"; } copy ($infile, $outfile) or die "copy $infile $outfile failed"; }