#!/usr/bin/env perl use strict; use warnings; use Getopt::Long; use File::Spec; use File::Path (); use File::Temp (); use DBM::Deep; use IPC::Cmd (); my $dualLivedDiffCmd = 'dualLivedDiff'; sub usage { my $msg = shift; warn "$msg\n" if defined $msg; warn < \&usage, 'd|dir|directory=s' => \$confDir, 'o|outfile=s' => \$outFile, 'b|blead=s' => \$bleadPath, 'r|reverse' => \$reverse, ); usage("Could not find configuration directory") if not defined $confDir or not -d $confDir; usage() if not defined $outFile; usage("Blead perl path does not exist") if not defined $bleadPath or not -d $bleadPath; my $db = DBM::Deep->new( $outFile ); my @confDirs; { opendir(my $dh, $confDir) or die $!; @confDirs = grep {-d File::Spec->catdir($confDir, $_)} grep {!/^\.\.?$/} grep {!/^\.svn$/} readdir $dh; closedir $dh; } foreach my $conf (sort @confDirs) { my $confFile = File::Spec->catfile($confDir, $conf, '.dualLivedDiffConfig'); my $modname = $conf; $modname =~ s/-/::/g; print STDERR "modname: $modname"; if (not -f $confFile) { warn "Config file for $modname does not exist ($confFile)!\n"; next; } my ($tempFH, $tmpOutFile) = File::Temp::tempfile( "dldiffTmpXXXXXX", UNLINK => 0, DIR => File::Spec->tmpdir(), EXLOCK => 0, ); my $outBuffer; my @cmd = ( $dualLivedDiffCmd, ($reverse ? ('-r') : ()), '-b', $bleadPath, '-o', $tmpOutFile, '-d', $modname, '-c', $confFile, '-w', ); my $res = IPC::Cmd::run( command => \@cmd, buffer => \$outBuffer, ); if (!$res) { unlink $tmpOutFile; warn "Error running dualLivedDiff: '$outBuffer'!"; next; } $outBuffer =~ /Found the '([^']+)' distribution on CPAN/i or die; my $dist = $1; seek $tempFH, 0, 0; my $diff = join '', <$tempFH>; my $isDiff = ($diff =~ /\S/); close $tempFH; #$db->begin_work; $db->{$dist} = { name => $dist, diff => $diff, status => ($isDiff ? 'not ok' : 'ok'), cmd => \@cmd, module => $modname, date => time(), config => do {open my $fh, '<', $confFile or die $!; local $/ = undef; <$fh>}, }; #$db->rollback; #$db->commit; warn " - " . uc($db->{$dist}{status}) . "\n"; }