352 lines
8.9 KiB
Perl
Executable File
352 lines
8.9 KiB
Perl
Executable File
#!/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];
|
|
}, @_]]
|
|
}];
|
|
}
|