Jitterbug n",
where n is the bug ID.
The search generates a list of all files changes for this bug, together with the specific revisions in each file that are relevant (there may be more than one).
In the diff list, select a file name link to see the CVS log for that file.
Select a revision link to see changes checked in against that revision. "Diff" revision links show diffs against the previous revision. "View" links show initial check in revisions.
If a file contains more than one revision relevant to this Jitterbug ID, then an overall revision link will be available. Use this to see the effect of all changes at once. If the revisions are not contiguous, then this diff will contain changes not related to this Jitterbug. In that case you may prefer to view the individual diffs instead.
Incl. Attic causes files under any directory named "Attic" to be included.
Local Diff enables special links that look like this [*] which cause your browser to download a Windows batch file. The batch file, when executed, will bring up the relevant diffs in Compare It!. For this to work, you need the following:
C:\\Program Files\\GNU\\WinCVS 1.2 to your PATH.
C:\\Program Files\\Compare
It! to your PATH.
Modules lists the modules to be searched. By default
this is "icu icu4j" but any modules (under /usr/cvs) may be listed.
Full module names (e.g., "icu/icuapps") may be used. The following
abbreviations are recognized: ", join(" ", @_), "$x.
END
}
######################################################################
# Admin GUI
######################################################################
# Emit the HTML for the top frameset in admin mode
sub emit_admintop {
# Propagate url parameters down to the frames within the frameset
my $self = $QUERY->url(-full=>1, -query=>1);
my $f = urlPathInfo($self, '/adminform');
my $r = urlPathInfo($self, '/adminresult');
my $TITLETXT = $TITLE;
#if ($id ne '') {
#`h TITLETXT = "$id - $TITLETXT";
# }
print <
";
print 'Tags may be specified in full, e.g. '
, '"release-2-4", or as release numbers, such as "2.4". ',
'Specify module(s) here for commands below.',
'
';
print "Modules: ";
print $QUERY->textfield(-name=>'mod',
-default=>$DEFAULT_MOD,
-size=>30);
print "
";
print "List Bugs Between CVS Tags
";
print "
";
print 'Bugs are listed that occur after the start tag, up to and including the end tag. Specify module(s) above.';
print "Start Tag: ";
print $QUERY->textfield(-name=>'tag_lo',-size=>30);
print " End Tag: ";
print $QUERY->textfield(-name=>'tag_hi',-size=>30);
print " ";
print $QUERY->submit(-name=>'Find Bugs');
print "
\n";
print "DCUT Helper
";
print "
";
print 'Enter a CVS tag and list of bugs to incorporate '
, 'those bugs into the tag. '
, 'Specify module(s) above.';
print "Tag: ";
print $QUERY->textfield(-name=>'dcut_tag',-size=>33);
print " Bug IDs: ";
print $QUERY->textarea(-name=>'dcut_ids',-rows=>8,-columns=>26);
print " ";
print $QUERY->submit(-name=>'Check');
print "
\n";
print $QUERY->submit(-name=>'Reset Insta Cache'), "
";
print 'The insta cache contains the HTML output for previous'
, ' bug diff search results. In some cases (typically during script'
, ' development), it can get out of sync.';
print "
\n";
print $QUERY->submit(-name=>'Delete Cache File:'), " ";
print $QUERY->textfield(-name=>'del_cache',-size=>17), "
";
print 'Delete a file from the cache. Path is relative'
, ' to cache root and must begin with the module path'
, ' (e.g. "icu/icu").';
# Propagate params that don't have corresponding form elements
print $QUERY->hidden('user');
print $QUERY->hidden('debug');
print $QUERY->end_form;
}
# Implement the admin functions.
sub emit_adminresult {
print $QUERY->start_html(-title=>$TITLE);
if ($QUERY->param('Find Bugs')) {
&do_tagscan;
return;
}
if ($QUERY->param('Check')) {
&do_dcuthelp;
return;
}
if ($QUERY->param('Reset Insta Cache')) {
resetInstaCache(1);
print "Cache at $INSTA has been erased.";
return;
}
if ($QUERY->param('Delete Cache File:')) {
my $f = $QUERY->param('del_cache');
# Careful here -- don't let the user delete anything but a
# legitimate cache file. Watch out for "..", "~", "$", etc.
if ($f !~ m|^[a-z0-9_]+(/[a-z0-9_]+)+\.[a-z0-9]+$|i) {
print "\"$f\" does not look like a valid path.";
return;
}
$f = $CACHE . '/' . $f . ',v';
if (! -e $f) {
print "\"$f\" does not exist.";
return;
}
if (! -f $f) {
print "\"$f\" is not a file.";
return;
}
unlink($f);
# This check doesn't seem to work.
#if (! -e $f) {
# print "Error: Could not delete \"$f\".";
# return;
#} else {
print "Cache file \"$f\" deleted.";
#}
return;
}
}
######################################################################
# Jitterbug diffs
######################################################################
#---------------------------------------------------------------------
# Find the diffs for a jitterbug and display them.
# Also display other useful links for this bug.
# Param: ID number
# Param: module name ("icu/icu" or "icu4j/icu4j" or other)
# Return: The generated HTML. Also print it to STDOUT
# on the fly.
sub generateDiffsList {
my $ID = shift;
my $module = shift;
my $result;
my $greproot = "$CACHE/$module";
my $log_url = "$LOG_URL/$module/";
my $show_url = "$SHOW_URL/$module/";
my $diff_url = "$DIFF_URL/$module/";
# ID matching pattern
my $pat = "0*$ID";
# During merging, the bug IDs 1-98 for icu4j were migrated to
# 1301-1398. Therefore, when the user requests a bug in the range
# 1301-1398, we search under both n and n-1300 in icu4j
# repository.
if ($module =~ /^icu4j/ && $ID >= 1301 && $ID <= 1398) {
my $ID2 = $ID - 1300;
$pat = "($pat|0*$ID2)";
}
# -E use extended regexp
# -i ignore case
# -I ignore binary files
# -l stop at first match and list file name
# -r recurse
# N/A now that we cache the rlog output
#my $flags = $ignoreBinaries ? "-EiIlr" : "-Eilr";
# (1 of 3 REGEXPS) SEE ALSO other regexps; keep them in sync
# TODO improve error handling in following line
my @files = `grep -Eilr "($CVS_MSG_KW)[ \\t]*$pat\\b" $greproot`;
if (!$QUERY->param('include_attic')) {
@files = grep(!m|/attic/|i, @files);
}
if (@files < 1) {
$result .= out("No changes found for Jitterbug $ID.\n");
return $result;
}
$result .= out("");
my $first = 1;
foreach my $f (sort cmpfiles @files) {
my @r = findRevisions($f, $pat);
if ($first) {
$first = 0;
} else {
$result .= out("
\n");
}
my $localDiff = $QUERY->param('localdiff');
my $relFile = $f;
$relFile =~ s/^$greproot\///;
$relFile =~ s/,v//;
my $a = '';
my $b = $relFile;
if ($b =~ m|(.*/)(.+)|) {
($a ,$b) = ($1, $2);
}
$result .= out("$a$b
");
if (@r > 1) {
# Show diff of earliest to latest.
my $discontiguous = 0;
for (my $i=0; $i<$#r; $i++) { # [sic] from first to last-1
if ($r[$i]->{old} ne $r[$i+1]->{new}) {
$discontiguous = 1;
last;
}
}
my $new = $r[0]->{new};
my $old = $r[$#r]->{old};
$result .= out("
\n(");
$first = 0;
} else {
$result .= out("
\n");
}
if ($old eq $BASE_REV) {
$result .= out("");
$result .= out("View $new");
} else {
$result .= out("");
$result .= out("Diff $new vs $old");
if ($localDiff) {
my $self = $QUERY->url(-full=>1, -query=>1);
my $url = urlPathInfo($self, '/localdiff');
my $mod = $module;
$mod =~ s|/.+||;
out(" [*]");
}
}
}
$result .= out(")");
}
$result .= out("
");
$result .= out($h->{comment});
$result .= out("
\n");
}
}
$result .= out("");
$result;
}
# Sort criterion for file diffs
sub cmpfiles {
my $aa = $a;
my $bb = $b;
$aa =~ s|/unicode(/[^/]+)$|$1|;
$bb =~ s|/unicode(/[^/]+)$|$1|;
$aa =~ s|\.h,|.1h,|;
$bb =~ s|\.h,|.1h,|;
return $aa cmp $bb;
}
# Sort criterion for revision numbers, e.g. "1.9" vs "1.10"
sub cmprevs {
my @a = split('\.', $a);
my @b = split('\.', $b);
for (my $i=0; $i<=$#a && $i<=$#b; ++$i) {
my $c = $b[$i] - $a[$i];
return $c if ($c);
}
return $#b - $#a;
}
######################################################################
# tagscan
######################################################################
# Perform a "tagscan" and emit the results. A tagscan is a scan of
# the CVS rlog cache in which bug IDs between two tags are compiled.
# If a file is marked 'dead' it is ignored. If it was created after
# the latest date of the HI tag (as determined by checking _every_
# file's date for that tag) then it is ignored.
sub do_tagscan {
$TAGSCAN_TAG_LO = expandTag($QUERY->param('tag_lo'));
$TAGSCAN_TAG_HI = expandTag($QUERY->param('tag_hi'));
$TAGSCAN_TAG_HI_DATE = '';
if (!$TAGSCAN_TAG_LO || !$TAGSCAN_TAG_HI) {
print "Please enter two CVS tags and try again.";
return;
}
my $user = $QUERY->param('user');
my @m;
return if (!parseMod(\@m)); # what modules are we searching?
# Slight limitation -- our tagLink will only refer to the first module
print "Searching module(s) ", join(", ", @m)
, " for bugs after tag ",
tagLink($TAGSCAN_TAG_LO,$m[0],'grepj_2'),
" up to and including tag ",
tagLink($TAGSCAN_TAG_HI,$m[0],'grepj_2'),
". Note: Dead files and Attic files will be ignored.
\n";
foreach (@m) {
updateCacheDir($_);
}
if ($UPDATE_COUNT) {
print "done ($UPDATE_NONATTIC_COUNT,$UPDATE_ATTIC_COUNT).";
}
%TAGSCAN_IDS = ();
#at %TAGSCAN_ALLTAGS = ();
%TAGSCAN_WHY = ();
$TAGSCAN_COUNT = 0;
print "
Scanning CVS tree for bug IDs...";
foreach (@m) {
tagscanDir($_);
}
print "done.
";
# Filter out tagless files that were created after the HI tag
# date.
my @a;
foreach my $f (@TAGLESS_FILES) {
my $d = getRev11Date("$CACHE/$f");
if ($d && $d le $TAGSCAN_TAG_HI_DATE) {
push @a, $f;
}
}
@TAGLESS_FILES = @a;
if (@NO_JITTERBUG_FILES) {
print "The following revisions have no associated Jitterbug, or the bug number could not be parsed from the checkin comment.\n";
print "Checkins older than a year are not listed.\n";
print "";
print join("
\n",
map {logLink($_->[0],'grepj_2') .
", " . $_->[1] . "" .
$_->[2] . ""}
@NO_JITTERBUG_FILES);
print "
\n";
}
if (@TAGLESS_FILES) {
print "The following ", scalar @TAGLESS_FILES
, " files were ignored because they are missing one or both tags."
, " Files created after $TAGSCAN_TAG_HI should not be listed"
, " here.\n";
print join("
\n",
map {logLink($_,'grepj_2')}
@TAGLESS_FILES)
, "
\n";
}
if (@BRANCHED_FILES) {
print "The following ", scalar @BRANCHED_FILES
, " files were ignored because the tags occur on different"
, " branches.\n";
print join("
\n",
map {logLink($_->[0],'grepj_2') .
": " . $_->[1] . " => " . $_->[2]}
@BRANCHED_FILES)
, "
\n";
}
#at print "Other tags seen: ",
#at join(" ",
#at map {my $a=tagToRelease($_); $a?"$_($a)":"$_*"}
#at sort keys %TAGSCAN_ALLTAGS), "\n
";
print "Details: "
, join("; ",
map {"(" . jitterbugLink($user, $_, 'grepj_2') .
": " . join(", ",
map {s|^.+?/||; s|,v$||; $_} sort keys %{$TAGSCAN_WHY{$_}}) . ")"}
sort {$a<=>$b} keys %TAGSCAN_WHY)
, "
\n";
print "Jitterbug IDs found (",scalar keys %TAGSCAN_IDS,"): "
, join(", ",
map {jitterbugLink($user, $_, 'grepj_2')}
sort {$a<=>$b} keys %TAGSCAN_IDS);
my $bugs = join(',', sort {$a<=>$b} keys %TAGSCAN_IDS);
print <
Scanning CVS tree...";
foreach (@m) {
dcuthelpDir($_);
}
print "done.";
if (@NO_JITTERBUG_FILES) {
print "
The following revisions have no associated Jitterbug, or the bug number could not be parsed from the checkin comment.\n";
print "Checkins older than a year are not listed.\n";
print "";
print join("
\n";
}
my %tagless;
if (@TAGLESS_FILES) {
print "
\n",
map {logLink($_->[0],'grepj_2') .
", " . $_->[1] . "" .
$_->[2] . ""}
@NO_JITTERBUG_FILES);
print "
The following ", scalar @TAGLESS_FILES
, " files are missing the tag "
, $DCUTHELP_TAG, ". They were treated as if the tag existed "
, "on the initial revision.\n";
print join("
\n";
for my $f (@TAGLESS_FILES) { $tagless{$f} = 1; }
}
if (@BRANCHED_FILES) {
print "
\n",
map {logLink($_, 'grepj_2')}
@TAGLESS_FILES);
print "
Error: The following ", scalar @BRANCHED_FILES
, " files contain the listed bug changes on different "
, " branches.\n";
print join("
\n";
}
if (@DCUTHELP_BADFILES) {
print "
\n",
map {logLink($_->[0],'grepj_2') .
": " . $_->[1] . ", " . $_->[2]}
@BRANCHED_FILES)
, "
Error: The following "
, scalar @DCUTHELP_BADFILES,
" files contain intermingled bug fixes not specified in the list.",
"\n";
my %badids;
foreach (@DCUTHELP_BADFILES) {
my $relFile = $_->[0];
my $ids = $_->[1];
print logLink($relFile, 'grepj_2'), ": "
, join(", ",
map {jitterbugLink($user, $_, 'grepj_2')}
@$ids)
, "
\n";
print "Jitterbug changes not in the list: "
, join(", ",
map {jitterbugLink($user, $_, 'grepj_2')}
sort {$a<=>$b} keys %badids)
, "\n";
}
if (@DCUTHELP_RETAGS) {
print "
\n";
foreach my $i (@$ids) { $badids{$i} = 1; }
}
print "
CVS commands to update the tags in files containing "
,"only the listed bugs (copy & paste into a shell window).";
if (@DCUTHELP_BADFILES || @BRANCHED_FILES) {
print "WARNING! Some files (see above) contain other bug changes! Files below are all \"legal\" but you may wish to address above problems before retagging.";
}
print "";
print "cd $CVSROOT";
} else {
print "
\n";
# Two passes, one for normal files, another for tagless
my $tagless_count = 0;
for (my $pass=0; $pass<2; ++$pass) {
print "# The following files do not contain the tag $DCUTHELP_TAG
\n" if ($pass);
foreach (@DCUTHELP_RETAGS) {
my $relFile = $_->[0];
if ($pass == 0) {
if ($tagless{$relFile}) {
++$tagless_count;
next;
}
} else {
next unless ($tagless{$relFile});
}
my $rev_hi = $_->[1];
$relFile =~ s/,v$//;
my $onBranch = ($rev_hi =~ /\d+\.\d+\.\d+/);
print "" if ($onBranch);
print "cvs tag -F -r $rev_hi $DCUTHELP_TAG $relFile";
print "" if ($onBranch);
print "
\n";
}
last unless ($tagless_count);
print "\n" if ($pass);
}
print "
Nothing to do; no clean checkins for bugs "
, join(", ",
map {jitterbugLink($user, $_, 'grepj_2')}
sort {$a<=>$b} keys %DCUTHELP_IDS)
, " after "
, tagLink($DCUTHELP_TAG,$m[0],'grepj_2')
, " in module(s) "
, join(", ", @m), ".\n"
;
}
}
# Given a relative path to $CVSROOT, dcuthelp the
# corresponding item under $CACHE. Path may point to a
# file or a directory.
# @param relative directory, not ending in "/", e.g. "icu/icu"
# @param item name in that directory
sub dcuthelpEntry {
my $relDir = shift;
my $item = shift; # A file or dir in $CVSROOT/$relDir
# Ignore stuff in the Attic
return if ($item eq 'Attic');
if (-d "$CACHE/$relDir/$item") {
dcuthelpDir("$relDir/$item");
} elsif ($item =~ /,v$/) {
dcuthelpFile("$relDir/$item");
}
}
# Given a relative directory path to $CACHE, dcuthelp the
# underlying files.
# @param relative directory, not ending in "/", e.g. "icu/icu"
sub dcuthelpDir {
my $relDir = shift;
debugOut("dcuthelpDir($relDir)") if ($DEBUG);
my $cacheDir = "$CACHE/$relDir";
# First dcuthelp files in this directory
opendir(DIR, $cacheDir);
my @cacheList = grep !/^\.\.?$/, readdir(DIR);
closedir(DIR);
# Dcuthelp each individual entry
foreach (@cacheList) {
dcuthelpEntry($relDir, $_);
}
}
# Given a relative file path to $CVSROOT, dcuthelp the
# corresponding file under $CACHE.
# @param relative file path
sub dcuthelpFile {
my $relFile = shift;
# Display progress; it takes awhile
if (++$DCUTHELP_COUNT % 100 == 0) {
print " $DCUTHELP_COUNT...";
}
# This file contains the output of rlog.
my $file = "$CACHE/$relFile";
# Parse the rlog file. Start by extracting the tag names. Look
# for the DCUTHELP_TAG and its associated revision
# number.
open(IN, $file);
while (
Updating cache...";
if(! -e "$CACHE/$relFile") {
debugOut ( " because $CACHE/$relFile was not cached.." ) if ($DEBUG);
} else {
debugOut ( " because $relFile was updated.." ) if ($DEBUG);
}
} elsif ($UPDATE_COUNT % 25 == 0) {
print " $UPDATE_COUNT...";
}
++$UPDATE_COUNT;
if ($relFile =~ m|/attic/|i) {
++$UPDATE_ATTIC_COUNT;
} else {
++$UPDATE_NONATTIC_COUNT;
}
my $f = "$CACHE/$relFile";
command("rlog $CVSROOT/$relFile > $f", $f);
my $size = -s $f;
if ($size <= 0) {
print " {Fatal Error: rlog of $relFile failed} ";
unlink($f);
}
command("touch -r $CVSROOT/$relFile $f");
}
}
######################################################################
# instaCache
######################################################################
#---------------------------------------------------------------------
# Lookup an ID in the instaCache, and return the diffs stored
# there. If there is no entry for the ID, then return the
# empty string. The ID will be suffixed with 'a' if the
# Attic is included.
sub instaGet {
my $id = shift;
my $diffs;
my $dir = $QUERY->param('include_attic') ? $INSTA_ATTIC : $INSTA;
my $file = "$dir/$id";
if (-e $file) {
if (open(IN, $file)) {
while (",
join(" ", @badMod), "";
print "
Did you try the full module name (e.g. \"icu/charset\")? Only some modules can be abbreviated: ", join(" ", sort keys %MOD_ABBREV), ".";
return 0;
}
1;
}
# Return the HTML for a link to the given jitterbug.
# @param user
# @param bug ID
# @param OPTIONAL target
# @return HTML for A tag
sub jitterbugLink {
my $user = shift;
my $id = shift;
my $targ = shift || '';
if ($id eq $NO_JITTERBUG) {
return "no jitterbug";
}
$targ = " target=\"$targ\"" if ($targ);
"$id";
}
# Return the HTML for a link to the WebCVS log of a file.
# @param relative path (from $CVSROOT) to file, optionally with
# trailing ",v"
# @param OPTIONAL target
# @return HTML for A tag
sub logLink {
my $relFile = shift;
my $targ = shift;
$targ = " target=\"$targ\"" if ($targ);
$relFile =~ s/,v$//;
"$relFile";
}
# Return the HTML for a link to the WebCVS "tag" page. This will
# just be the page for the root of the given module, with the given
# tag selected.
# @param tag
# @param module, e.g., "icu/icu"
# @param OPTIONAL target
# @return HTML for A tag
sub tagLink {
my $tag = shift;
my $mod = shift;
my $targ = shift;
$targ = " target=\"$targ\"" if ($targ);
"$tag";
}
# Emit an error (in HTML) about failing to parse a line.
# @param what can't be parsed, e.g., 'revision'
# @param relative file path, e.g., 'icu/icu/readme.html'
# @param the line that can't be parsed
# @param revision
sub cantParse {
my $what = shift;
my $relFile = shift;
my $line = shift;
my $rev = shift;
$rev = ', '.$rev if ($rev);
print "
Error: Can't parse $what in "
, logLink($relFile, 'grepj_2'), "$rev:
\n";
print "$line
";
}
# Print the given string(s) to STDOUT and also return the
# output as a single string.
sub out {
local $_ = join('', @_);
print;
$_;
}
# Given an array of numbers, return a sorted unique list.
sub sortedUniqueInts {
my @a = @_;
my %a;
foreach (@a) {
s/^0+(\d)/$1/;
$a{$_} = 1;
}
sort {$a<=>$b} keys %a;
}
# Convert a revision number to a branch number.
# Generally this means dropping the last dotted integer, but if
# the last two dotted integers are 0.n, then the 0. must be dropped:
# 1.14.0.2 => 1.14.2. (This is a magic CVS revision representing
# the branch.) Also 'HEAD' is branch '1'.
sub revToBranch {
local $_ = shift;
s/\.0(\.\d+)$/$1/ || s/\.\d+$// || s/HEAD/1/;
$_;
}
# Given two CVS revisions, return a sequence of revisions traversing
# the logical path between them.
#
# WARNING!: The revisions must actually have a path between them. If
# you pass in 1.4 => 1.2 or 1.5 => 1.2.2.4 the sub will run
# infinitely.
#
# @param low revision, e.g. 1.2 or 1.2.0.4
# @param high revision, e.g., 1.5.2.3
# @return an array of revisions from low to high inclusive
sub traverseRevisions {
my $rev_lo = shift;
my $rev_hi = shift;
my @a = split(/\./, $rev_lo);
my @limit = split(/\./, $rev_hi);
my @list;
for (;;) {
push @list, join('.', @a);
if (@a == @limit) {
last if ($a[-1] == $limit[-1]);
# Fall through
} else {
my $a = join('.', @a);
if ($rev_hi =~ /^\Q$a\E\./) {
push @a, $limit[@a];
push @a, 1;
next;
}
# Else fall through
}
if ($a[-2] == 0) {
# Handle magic CVS revisions like 1.14.0.2
$a[-2] = $a[-1];
$a[-1] = 1;
} else {
$a[-1]++;
}
}
@list;
}
# Given a CVS numeric revision, increment it (increment last integer)
sub incRev {
local $_ = shift;
if (/(\d+)$/) {
my $i = $1 + 1;
s/\d+$/$i/;
return $_;
}
die "Can't increment $_";
}
# Given a CVS numeric revisions, decrement it. This handles
# branches. If the resulting revision number goes to zero,
# return BASE_REV. Does not handle magic revisions like 1.14.0.2.
# 1.3 => 1.2
# 1.3.2.1 => 1.3
# 1.3.2.2 => 1.3.2.1
sub decRev {
local $_ = shift;
if (/(\d+)$/) {
my $i = $1 - 1;
if ($i >= 1) {
s/\d+$/$i/;
} elsif (s/(^1\.\d+)\.2\.1$/$1/) {
# 1.3.2.1 => 1.3
} else {
return $BASE_REV;
}
return $_;
}
die "Can't decrement $_";
}
# Given a date string, in CVS format, like "2003/05/29 22:10:17",
# return the duration $NOW - x, in days.
sub ageInDays {
local $_ = shift;
if (m|(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+)|) {
my ($y,$m,$d,$H,$M,$S) = ($1,$2-1,$3,$4,$5,$6);
if ($y =~ /^\d\d$/) {
$y = 100*int($YEAR / 100) + $y;
$y -= 100 if ($y > $YEAR);
}
return ($NOW - timelocal_nocheck($S,$M,$H,$d,$m,$y)) / 86400.0;
} else {
die "Can't parse date $_\n";
}
}
# Filter for which files we care about that don't have jitterbugs.
# Our rule is that if the checkin is over a year old, we don't care
# about it. We used to also require the revision to be 1.1 or 1.1.1.1
# to be ignored, but we dropped this.
sub noJitterbugFilter {
my $rev = shift;
my $date = shift;
#if ($rev eq '1.1' || $rev eq '1.1.1.1') {
return ageInDays($date) <= 365.25;
#}
#1;
}
# Execute a command, trapping errors.
# Options second arg: Path to a file to delete upon failure
sub command {
my $cmd = shift;
my $fileToDeleteOnFailure = shift;
my $err = "$CACHE/grepj.stderr";
my $status = system($cmd . " 2> $err");
if ($status != 0) {
unlink($fileToDeleteOnFailure) if defined($fileToDeleteOnFailure);
print "
Fatal Error: "
. "\"$cmd\" exited with value "
. ($status >> 8)
. " (signal " . ($status & 127) . ")"
. (($status & 128) ? " (core dumped)" : "")
. "
";
print "stderr:
";
if (open(IN, $err)) {
while (
";
}
close(IN);
}
croak "Couldn't execute \"$cmd\"";
}
}
#eof