$_"; } else { "none
none
"; } return $result; } sub ChangeDir { # directory, logical name my ($dir,$name) = @_; chomp($dir); if ( $VERBOSE ) { print "Changing To: $name ($dir)\n"; } chdir($dir) || die "Cannot change directory to: $name ($dir) "; } sub CopyFile { #filename, newfile my ($file, $newfile) = @_; chomp($file); if ($VERBOSE) { print "Copying $file to $newfile\n"; } copy($file, $newfile); } sub GetDir { my $Suffix = shift; opendir DH, $WebDir; my @Result = reverse sort grep !/$DATE/, grep /[-0-9]+$Suffix/, readdir DH; closedir DH; return @Result; } # DiffFiles - Diff the current version of the file against the last version of # the file, reporting things added and removed. This is used to report, for # example, added and removed warnings. This returns a pair (added, removed) # sub DiffFiles { my $Suffix = shift; my @Others = GetDir $Suffix; if (@Others == 0) { # No other files? We added all entries... return (`cat $WebDir/$DATE$Suffix`, ""); } # Diff the files now... my @Diffs = split "\n", `diff $WebDir/$DATE$Suffix $WebDir/$Others[0]`; my $Added = join "\n", grep /^/, @Diffs; $Added =~ s/^< //gm; $Removed =~ s/^> //gm; return ($Added, $Removed); } # FormatTime - Convert a time from 1m23.45 into 83.45 sub FormatTime { my $Time = shift; if ($Time =~ m/([0-9]+)m([0-9.]+)/) { $Time = sprintf("%7.4f", $1*60.0+$2); } return $Time; } sub GetRegexNum { my ($Regex, $Num, $Regex2, $File) = @_; my @Items = split "\n", `grep '$Regex' $File`; return GetRegex $Regex2, $Items[$Num]; } sub GetDejagnuTestResults { # (filename, log) my ($filename, $DejagnuLog) = @_; my @lines; my $firstline; $/ = "\n"; #Make sure we're going line at a time. print "DEJAGNU TEST RESULTS:\n"; if (open SRCHFILE, $filename) { # Process test results my $first_list = 1; my $should_break = 1; my $nocopy = 0; my $readingsum = 0; while (\n");
print "\nDEJAGNU STATISTICS:\n";
$should_break = 0;
$nocopy = 0;
$readingsum = 1;
} elsif ( $readingsum ) {
push(@lines,"$_\n");
print " $_\n";
}
}
}
}
push(@lines, "\n");
close SRCHFILE;
my $content = join("", @lines);
return "$content