#!/usr/bin/perl
use Getopt::GUI::Long;
use QWizard;
use QWizard::API;
use Data::Dumper;
use Cwd;
use Getopt::Std;
Getopt::GUI::Long::Configure(qw(display_help no_ignore_case));
use strict;
our %opts =
(
'd' => $ENV{'HOME'} . "/src/snmp/patme/",
'b' => 'main,5.6,5.5,5.4,5.3',
'p' => '-p0',
);
# sets the order shown
our @codetrees = ('main',
'5.6',
'5.5',
'5.4',
'5.3',
'5.2',
'5.1',
'5.0',
'UCD');
our %codetrees = ('5.0' => 'V5-0-patches',
'5.1' => 'V5-1-patches',
'5.2' => 'V5-2-patches',
'5.3' => 'V5-3-patches',
'5.4' => 'V5-4-patches',
'5.5' => 'V5-5-patches',
'5.6' => 'V5-6-patches',
'main' => 'net-snmp',
'UCD' => 'V4-2-patches');
our (@captures, $capfilt, $result, %captures, $capturenum);
GetOptions(\%opts,
['f|file=s', 'Patch file'],
['d|base-directory=s', 'Base directory of checkouts'],
['p|patch-args=s', 'Default patch arguments (-p1)'],
['GUI:separator', 'Patch application specifics;'],
['b|braches=s', 'Branches to apply to (eg 5.1,5.2,...)'],
['m|commit-msg=s', 'Default commit message to use'],
['D|subdir=s', 'Apply patches to a subdirectory'],
['u|no-update', 'Do not run svn status/update in the directory first. Only use this if it\'s known clean.'],
);
my %bs;
if ($opts{'b'}) {
map { $bs{$_} = 1; } split(/,\s*/,$opts{'b'});
}
$opts{'d'} .= "/" if ($opts{'d'} !~ /\/$/);
my $qw = new QWizard();
my $pris = load_primaries();
$qw->{'primaries'} = $pris;
$qw->qwparam('svncommit',$opts{'m'}) if ($opts{'m'});
$qw->magic('top');
sub make_tops {
my @tops;
foreach my $k (@codetrees) {
push @tops,
qw_checkbox($k, "Apply to $k", 1, 0,
default => $qw->qwparam($k) || $bs{$k},
override => 1);
}
return @tops;
}
sub load_primaries {
my @tops = make_tops();
return
{
top =>
qw_primary('top','Select packages to apply the patch to:', '',
[@tops,
qw_text('basedir', 'Base code directory:',
default => $opts{'d'}),
qw_hidden('no_confirm',1),
qw_text('patchfile','Patch file:', default => $opts{f},
check_value => sub {
return "patch file doesn't exist" if (! -f qwparam('patchfile'))
}),
qw_checkbox('noupdate','Don\'t run svn update/revert first:',
1, 0, default => $opts{'u'} || 0)],
[],[],sub_modules => ['commit', 'commitmsg', 'maketest',
'edit', 'applying', 'check',
'patch_info']),
patch_info =>
qw_primary('check','Checking code directory status:', '',
[qw_paragraph('patch pieces:',
sub { capture("egrep '^(---|\\+\\+\\+)' " .
qwparam('patchfile'))},
width => 80,
height => 30),
qw_text('patchargs','Patch arguments',
default => $opts{'p'}),
qw_text('subdir', 'Apply in package subdir:',
default => $opts{'D'}),
qw_paragraph('Note:','Hitting next below will first clean your local repositories which could take a bit (watch the console for deails on what it\'s doing at any moment)', doif => sub {!qwparam('noupdate')}),
]),
check =>
qw_primary('check','Checking code directory status:', '',
[qw_paragraph('removed .rej files:',
sub { my $it = captureeachdir('find . -name \*.rej');
captureeachdir('find . -name \*.rej | xargs rm -f');
return $it;
},
preformatted => 1,
width => 80,
height => 60,
),
qw_paragraph('svn update:',
sub {
my ($res, $one);
foreach my $k (@codetrees) {
next if (!qwparam($k));
$res .= "$k:\n";
$one = capturedir($codetrees{$k},
"svn update");
$res .= $one;
$one = capturedir($codetrees{$k},
"svn revert -R .");
$res .= $one;
}
return $res;
},
preformatted => 1,
width => 80,
height => 60,
doif => sub{!qwparam('noupdate')}
) ],
),
applying =>
qw_primary("applying", 'Applying patches to the code bases', '',
[{type => 'table',
text => 'Results:',
values => sub {
my @tab;
foreach my $k (@codetrees) {
next if (!qwparam($k));
push @tab, [$k,
qw_paragraph("r$k","",
preformatted => 1,
width => 80,
height => 20,
values =>
sub { my $cmd = "patch " . qwparam('patchargs') . " < " . qwparam('patchfile');
my $results = "Running on $k: $cmd" . "\n" . capturedir($codetrees{$k},$cmd);
return $results})];
}
return [\@tab];
}}],[],[]),
edit =>
qw_primary('edit','Fix the following files:','',
[qw_paragraph('Fix these (maybe):',
sub {
$capfilt = '(.*.rej)';
my $res =
captureeachdir('find . -name \*.rej');
print Dumper(\%captures);
$capfilt = undef;
return $res;
},
preformatted => 1,
width => 80,
height => 60,
),
qw_label('failed files:',
sub { $capturenum = 0;
map { $capturenum += $#{$captures{$_}} + 1;
} (keys(%captures));
return $capturenum;
}),
qw_checkbox('edithem','Open an editor on the failed files?',
1, 0, doif => sub { return $capturenum > 0 }),
qw_text('editor','Editor:',default => $ENV{'EDITOR'} || 'vi',
doif => sub { return $capturenum > 0 })],
[sub {
if (qwparam('edithem')) {
foreach my $k (keys(%captures)) {
foreach my $f (@{$captures{$k}}) {
my $file = qwparam('basedir') .
$codetrees{$k} .
qwparam('subdir') . '/' . $f->[0];
print STDERR "editing: $file\n";
system(qwparam('editor') . " " . $file);
}
}
}
}]
),
maketest =>
qw_primary("maketest", "Run make?",'',
[qw_checkbox('makeit','Run make?', 1, 0),
qw_checkbox('maketest', 'Run make test?', 1, 0)
],
[sub {
if (qwparam('makeit') || qwparam('maketest')) {
$_[0]->add_todos(-early, 'domake');
}
}]
),
domake =>
qw_primary("domake", "Make results",'',
[qw_paragraph('Make results:',
sub { return captureeachdir('make'); },
preformatted => 1,
width => 80,
height => 20,
doif => sub { qwparam('makeit') }
),
qw_paragraph('Make test results:',
sub { return captureeachdir('make test'); },
preformatted => 1,
width => 80,
height => 20,
doif => sub { qwparam('maketest') }
)]
),
commitmsg =>
qw_primary("commitmsg", 'Commit info:', '',
[qw_text('svncommit','Commit message',
default => qwparam('svncommit') || $opts{'m'}),
{type => 'dynamic',
values => sub { my @tops = make_tops(1); return \@tops}}]),
commit =>
qw_primary("commit", 'running commit:', '',
[qw_paragraph('committing files:',
sub { my $msg = qwparam('svncommit');
$msg =~ s/\'/\'\"\'\"\'/g; # escape 's
return capturedir($opts{'d'},
'svn commit -m \'' . $msg . '\' ' . get_codedirs_str()); },
preformatted => 1,
width => 80,
height => 20,
)]),
editing =>
qw_primary("applying", 'Edit the following files:', '',
[{type => 'table',
text => 'Results:',
values => sub { return [\@captures]},
}],[],[])
}
}
sub capture {
my $cmd = join(" ",@_);
my $results = "Running: $cmd\n";
my @a;
print $results;
open(I,"$cmd 2>&1|");
while (<I>) {
$results .= $_;
print $_;
if ($capfilt) {
print "capfilt: $capfilt\n";
@a = /$capfilt/;
print " capfilt: @a\n";
push @captures, [@a];
}
}
close(I);
$result = $? >> 8;
$results .= "RESULT: " . (($result) ? "FAIL" : "SUCCESS") . "($result)\n";
return $results;
}
sub capturedir {
my $dir = shift;
$dir .= "/" if ($dir !~ /\/$/);
my $basedir = qwparam('basedir');
$basedir .= "/" if ($basedir !~ /\/$/);
my $olddir = getcwd();
my $newdir = "$basedir$dir" . qwparam('subdir');
my $res = "changing to: $newdir\n";
print $res;
chdir($newdir);
$res .= capture(@_);
chdir($olddir);
return $res;
}
sub get_codedirs_str() {
my $res = "";
foreach my $k (@codetrees) {
next if (!qwparam($k));
$res .= " $opts{'d'}$codetrees{$k}";
}
$res =~ s/^ //;
return $res;
}
sub captureeachdir {
my $out;
%captures = ();
foreach my $k (@codetrees) {
next if (!qwparam($k));
$out .= "$k:\n";
$out .= capturedir($codetrees{$k}, @_) . "\n";
if ($#captures > -1) {
@{$captures{$k}} = @captures;
@captures = ();
}
}
return $out;
}
sub dodir {
my $text = shift;
return
[{type => 'table',
text => $text,
values => [[sub {
my @tab;
foreach my $k (@codetrees) {
next if (!qwparam($k));
push @tab, [$k,
qw_paragraph("r$k","",
preformatted => 1,
width => 80,
height => 20,
values =>
[[sub { $_->[0]($k)},
@_]])];
}
return [\@tab];
}, @_]]
}];
}