use CGI::Alert 'don@donarmstrong.com';
use Debbugs::Config qw(:config);
-use Debbugs::CGI qw(htmlize_packagelinks html_escape cgi_parameters);
+use Debbugs::CGI qw(htmlize_packagelinks html_escape cgi_parameters munge_url);
use Debbugs::Versions;
use Debbugs::Versions::Dpkg;
-use Debbugs::Packages qw(getversions makesourceversions);
+use Debbugs::Packages qw(get_versions makesourceversions);
use HTML::Entities qw(encode_entities);
use File::Temp qw(tempdir);
use IO::File;
my $q = new CGI::Simple;
my %cgi_var = cgi_parameters(query => $q,
- single => [qw(package format ignore_boring width height collapse)],
+ single => [qw(package format ignore_boring width height collapse info)],
default => {package => 'spamass-milter',
found => [],
fixed => [],
ignore_boring => 1,
- collapse => 1,
+ collapse => 0,
format => 'png',
width => undef,
height => undef,
+ info => 0,
},
);
+my $this = munge_url('version.cgi?',
+ %cgi_var,
+ );
# we want to first load the appropriate file,
# then figure out which versions are there in which architectures,
my %versions;
my %version_to_dist;
for my $dist (@{$config{distributions}}) {
- $versions{$dist} = [getversions($cgi_var{package},$dist)];
+ $versions{$dist} = [get_versions(package => [split /\s*,\s*/, $cgi_var{package}],
+ dist => $dist,
+ source => 1,
+ )];
# make version_to_dist
foreach my $version (@{$versions{$dist}}){
push @{$version_to_dist{$version}}, $dist;
$cgi_var{format} = 'png';
}
+if ($cgi_var{info} and not defined $cgi_var{dot}) {
+ print "Content-Type: text/html\n\n";
+ print <<END;
+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html>
+<head><title>$cgi_var{package} Version Graph</title></head>
+<body>
+END
+ print '<a href="'.html_escape(munge_url($this,ignore_boring=>$cgi_var{ignore_boring}?0:1)).
+ '">['.($cgi_var{ignore_boring}?"Don't i":'I').'gnore boring]</a> ';
+ print '<a href="'.html_escape(munge_url($this,collapse=>$cgi_var{collapse}?0:1)).
+ '">['.($cgi_var{collapse}?"Don't c":'C').'ollapse]</a> ';
+ print '<a href="'.html_escape(munge_url($this,dot=>1)).
+ '">[Dot]</a><br/>';
+ print '<img src="'.html_escape(munge_url($this,info=>0)).'">';
+ print <<END;
+</body>
+</html>
+END
+ exit 0;
+}
+
# then figure out which are affected.
# turn found and fixed into full versions
-@{$cgi_var{found}} = makesourceversions($cgi_var{package},undef,@{$cgi_var{found}});
-@{$cgi_var{fixed}} = makesourceversions($cgi_var{package},undef,@{$cgi_var{fixed}});
-my @interesting_versions = makesourceversions($cgi_var{package},undef,keys %version_to_dist);
+@{$cgi_var{found}} = map {makesourceversions($_,undef,@{$cgi_var{found}})} split/\s*,\s*/, $cgi_var{package};
+@{$cgi_var{fixed}} = map {makesourceversions($_,undef,@{$cgi_var{fixed}})} split/\s*,\s*/, $cgi_var{package};
+my @interesting_versions = map {makesourceversions($_,undef,keys %version_to_dist)} split/\s*,\s*/, $cgi_var{package};
# We need to be able to rip out leaves which the versions that do not affect the current versions of unstable/testing
my %sources;
or $all_states{$key} eq 'absent');
next if $cgi_var{ignore_boring} and not version_relevant($version,$key,\@interesting_versions);
if (defined $version->{parent}{$key}) {
- push @{$reversed_nodes{$version->{parent}{$key}}}, $key;
+ next if $cgi_var{ignore_boring} and (not defined $all_states{$version->{parent}{$key}}
+ or $all_states{$version->{parent}{$key}} eq 'absent');
+ next if $cgi_var{ignore_boring} and not version_relevant($version,$version->{parent}{$key},\@interesting_versions);
+ push @{$reversed_nodes{$version->{parent}{$key}}},$key;
}
else {
$reversed_nodes{$key} ||=[];
my %used_node;
foreach my $group (values %group_nodes) {
next if $used_node{$group->{name}};
+ next if not defined $group->{parent};
$used_node{$group->{name}} = 1;
$dot .= qq("$group->{name}").'->'.q(").
(exists $collapsed_nodes{$group->{parent}}?
}
-my %_version_relevant_cache;
+our %_version_relevant_cache;
sub version_relevant {
my ($version,$test_version,$relevant_versions) = @_;
for my $dist_version (@{$relevant_versions}) {