Edit: /usr/lib/rpm/rpmdiff.cgi (15674B)
#!/usr/bin/perl
# a web interface to 'cvs rdiff'. This script makes it easy to query
# the tags which are created by the build script.
use CGI ':standard';
use File::Basename;
use File::stat;
use Data::Dumper;
# the big datastructures are:
# $RPM_FILE_BY_FQN{$fqn} is the full path rpm wich is discribed by the fqn
# keys %SORTED_RECENT_FQN is the set of all package names
# $SORTED_RECENT_FQN{$name} is an ordered list of the most recent
# versions of this package
# for a short time there are these datastrutures but they are large
# and expensive to save to disk.
# An rpm_package is a hash of:
# $package{'fqn'}="perl-5.00502-3"
# $package{'rpm_file'}="$RPMS_DIR/".
# "./sparc/perl-5.00502-3.solaris2.6-sparc.rpm"
# $package{'srpm_file'}="$SRPMS_DIR/".
# "./perl-5.00502-3.src.rpm"
# $package{'name'}="perl"
# $package{'version'}="5.00502"
# $package{'release'}="3"
# fqn is "fully qualified name"
# while the $pkg structure exists we find the pkg we want by looking
# it up in this structure. This will hold many more packages then the
# web page ever knows about.
# $BY_NAME{$name}{$version}{$release};
sub usage {
# If they are asking for help then they are clueless so reset all
# their parameters for them, in case they are in a bad state.
param(-name=>'Defaults', -value=>'on');
my $rpmdiff_version = `rpmdiff --version`;
$usage =<
{'fqn'}="$name-$version-$release";
$package->{'name'}=$name;
$package->{'version'}=$version;
$package->{'release'}=$release;
$package->{'rpm_file'}=$rpm_file;
# these are needed to do proper sorting of major/minor numbers in
# the version of the package
$package->{'version_cmp'}=[split(/\./, $version)];
$package->{'release_cmp'}=[split(/\./, $release)];
return $package;
}
sub get_recent_fqn {
my ($name) =(@_);
my @out = ();
foreach $version ( keys %{ $BY_NAME{$name} }) {
foreach $release ( keys %{ $BY_NAME{$name}{$version} }) {
push @out, $BY_NAME{$name}{$version}{$release};
}
}
# the $BY_NAME datastructure is fairly good but the list can not be
# sorted right. Sort again using the Schwartzian Transform as
# discribed in perlfaq4
my @sorted = sort {
# compare the versions but make no assumptions
# about how many elements there are
my $i=0;
my @a_version = @{ $a->{'version_cmp'} };
my @b_version = @{ $b->{'version_cmp'} };
while (
($#a_version > $i) &&
($#b_version > $i) &&
($a_version[$i] == $b_version[$i])
) {
$i++;
}
my $j = 0;
my @a_release = @{ $a->{'release_cmp'} };
my @b_release = @{ $b->{'release_cmp'} };
while (
($#a_release > $j) &&
($#b_release > $j) &&
($a_release[$j] == $b_release[$j])
) {
$j++;
}
return (
($b_version[$i] <=> $a_version[$i])
||
($b_release[$j] <=> $a_release[$j])
);
}
@out;
($#sorted > $MAX_PICK_LIST) &&
(@sorted = @sorted[0 .. $MAX_PICK_LIST]);
# dumping data to disk is expensive so we only save the data we
# need. Limit RPM_FILE_BY_FQN to only those packages which appear
# in the picklist and this explains why we do not store the whole
# pkg in a BY_FQN hash.
foreach $pkg (@sorted) {
$RPM_FILE_BY_FQN{$pkg->{'fqn'}}=$pkg->{'rpm_file'}
}
my @fqns = map { $_->{'fqn'} } @sorted;
return @fqns;
}
sub parse_package_names {
$flush_cache = param("Flush Cache");
if ( (!($flush_cache)) && (-e $CACHE_FILE) && ( -M $CACHE_FILE < 1 ) ) {
my $st = stat($CACHE_FILE) ||
die ("Could not stat: $CACHE_FILE: $!");
$CACHE_LOCALTIME=localtime($st->mtime);
require $CACHE_FILE;
return ;
}
$CACHE_LOCALTIME=$LOCALTIME;
foreach $archive (@RPM_ARCHIVES) {
open(FILES, "-|") ||
exec("find", $archive, "-print") ||
die("Could not run find. $!\n");
while ($filename = ) {
# we want only the binary rpm files of interest
($filename =~ m/\.rpm$/) || next;
($filename =~ m/\.src\.rpm$/) && next;
($filename =~ m/$PICKLIST_PAT/) || next;
chomp $filename;
$pkg = new_rpm_package($filename);
$BY_NAME{$pkg->{'name'}}{$pkg->{'version'}}{$pkg->{'release'}} = $pkg;
}
close(FILES) ||
die("Could not close find. $!\n");
}
foreach $group (keys %BY_NAME) {
$SORTED_RECENT_FQN{$group} = [get_recent_fqn($group)];
}
open(FILE, ">$TMP_CACHE_FILE") ||
die("Could not open filename: '$TMP_CACHE_FILE': $!\n");
print FILE "# cache file created by $0\n";
print FILE "# at $LOCALTIME\n\n";
print FILE Data::Dumper->Dump( [\%RPM_FILE_BY_FQN, \%SORTED_RECENT_FQN],
["SAVED_FQN", "SAVED_SORTED",], );
print FILE "\n\n";
print FILE '%RPM_FILE_BY_FQN = %{ $SAVED_FQN };'."\n";
print FILE '%SORTED_RECENT_FQN = %{ $SAVED_SORTED };'."\n";
print FILE "1;\n";
close(FILE) ||
die("Could not close filename: '$TMP_CACHE_FILE': $!\n");
# In an effort to make the cache update atomic we write to one file
# name and only move it into the gobally known name when the whole
# file is ready.
(!(-e $CACHE_FILE)) ||
unlink($CACHE_FILE) ||
die("Could not unlink $CACHE_FILE: $!\n");
rename($TMP_CACHE_FILE, $CACHE_FILE) ||
die("Could not rename ($TMP_CACHE_FILE, $CACHE_FILE): $!\n");
return ;
}
sub print_pkg_picklists {
print start_form;
# create a set of picklists for the packages based on the package names.
print h3("Choose the criterion for a difference"),
checkbox_group(
-name=>"rpmdiff arguments",
-value=>[ @RPMDIFF_ARGS ],
-default=>[ @RPMDIFF_ARGS_DEFAULT ],
),p();
print h3("Choose one package in each column then hit any submit"),p();
my @rows = ();
foreach $name (sort keys %SORTED_RECENT_FQN) {
push @rows,
# column A
td(
strong("$name "),
p(),
popup_menu(
-name=>"old$name",
-value=>[
'(none)',
@{ $SORTED_RECENT_FQN{$name} },
],
-default=>'(none)',
),
).
# column B
td(
strong("$name "),
p(),
popup_menu(
-name=>"new$name",
-value=>[
'(none)',
@{ $SORTED_RECENT_FQN{$name} },
],
-default=>'(none)',
),
).
td(
defaults(-name=>'Defaults'),
submit(-name=>'Submit'),
).
'';
}
print table(Tr(\@rows));
my $footer_info=<'cvs tag diff'.
EOF
print pre($footer_info);
print "This page generated with data cached at: $CACHE_LOCALTIME\n",p(),
"The time is now: $LOCALTIME\n",p(),
submit(-name=>"Flush Cache"),p(),
submit(-name=>"Help Screen"),p();
print end_form;
return ;
}
sub print_diff {
my($oldpkg_file, $newpkg_file, @args) = @_;
my $cmd = "rpmdiff @args $oldpkg_file $newpkg_file 2>&1";
my $result = "\n".qx{$cmd}."\n";
print pre($result);
return ;
}
# Main
{
set_static_vars();
get_env();
parse_package_names();
my @picked_rpmdiff_args = param("rpmdiff arguments");
@picked_rpmdiff_args = split(/\s+/,
'--'.(join(" --", @picked_rpmdiff_args)));
push @picked_rpmdiff_args, '--';
foreach $name (sort keys %SORTED_RECENT_FQN) {
if ( (param("old$name")) && (param("old$name") ne "(none)") ) {
push @picked_oldpkg, param("old$name");
}
if ( (param("new$name")) && (param("new$name") ne "(none)") ) {
push @picked_newpkg, param("new$name");
}
}
print (header.
start_html(-title=>'rpmdiff'),
h2("rpmdiff"));
if (param("Help Screen")) {
usage();
} elsif ( grep {/^(\-\-)((help)|(version))$/} @picked_rpmdiff_args ) {
print_diff(
'/dev/null',
'/dev/null',
@picked_rpmdiff_args,
);
} elsif (
($#picked_oldpkg == 0) &&
($#picked_newpkg == 0)
) {
print_diff(
$RPM_FILE_BY_FQN{$picked_oldpkg[0]},
$RPM_FILE_BY_FQN{$picked_newpkg[0]},
@picked_rpmdiff_args,
);
} else {
print_pkg_picklists();
print end_html;
print "\n\n\n";
}
}