$cgi_var{package} Version Graph

X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=cgi%2Fversion.cgi;h=ed0be6304ac58e094ffe4e3d8d458238e9391e48;hb=refs%2Fheads%2Fdon%2Fcookies;hp=f0765f9a151ac61df1e9d9d0c9150b3b08adc16d;hpb=94c5aea057994bf33e906f73308035bbb160df52;p=debbugs.git diff --git a/cgi/version.cgi b/cgi/version.cgi index f0765f9..ed0be63 100755 --- a/cgi/version.cgi +++ b/cgi/version.cgi @@ -14,13 +14,19 @@ BEGIN{ use CGI::Simple; -use CGI::Alert 'don@donarmstrong.com'; +# by default send this message nowhere +# use CGI::Alert q(nobody@example.com); use Debbugs::Config qw(:config); -use Debbugs::CGI qw(htmlize_packagelinks html_escape cgi_parameters); + +BEGIN{ + # $CGI::Alert::Maintainer = $config{maintainer}; +} + +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; @@ -31,10 +37,10 @@ my %img_types = (svg => 'image/svg+xml', png => 'image/png', ); -my $q = new CGI::Simple; +my $q = CGI::Simple->new(); 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 => [], @@ -43,15 +49,22 @@ my %cgi_var = cgi_parameters(query => $q, 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; @@ -75,11 +88,33 @@ else { $cgi_var{format} = 'png'; } +if ($cgi_var{info} and not defined $cgi_var{dot}) { + print "Content-Type: text/html\n\n"; + print < + +$cgi_var{package} Version Graph + +END + print '['.($cgi_var{ignore_boring}?"Don't i":'I').'gnore boring] '; + print '['.($cgi_var{collapse}?"Don't c":'C').'ollapse] '; + print '[Dot]
'; + print '

'; + print < + +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; @@ -89,7 +124,9 @@ my %sources; my $version = Debbugs::Versions->new(\&Debbugs::Versions::Dpkg::vercmp); foreach my $source (keys %sources) { my $srchash = substr $source, 0, 1; - my $version_fh = new IO::File "$config{version_packages_dir}/$srchash/$source", 'r'; + next unless -e "$config{version_packages_dir}/$srchash/$source"; + my $version_fh = IO::File->new("$config{version_packages_dir}/$srchash/$source", 'r') or + warn "Unable to open $config{version_packages_dir}/$srchash/$source for reading: $!"; $version->load($version_fh); } # Here, we need to generate a short version to full version map @@ -144,7 +181,10 @@ if ($cgi_var{collapse}) { 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} ||=[]; @@ -154,7 +194,7 @@ if ($cgi_var{collapse}) { # are in the same state as their parent, and are not in a suite foreach my $key (keys %reversed_nodes) { my ($short_version) = $key =~ m{/(.+)$}; - if (not exists $version_to_dist{$short_version} + if (not exists $version_to_dist{$key} and @{$reversed_nodes{$key}} <= 1 and defined $version->{parent}{$key} and $all_states{$key} eq $all_states{$version->{parent}{$key}} @@ -209,8 +249,8 @@ foreach my $key (keys %all_states) { or $all_states{$key} eq 'absent'); next if $cgi_var{ignore_boring} and not version_relevant($version,$key,\@interesting_versions); my @attributes = @{$state{$all_states{$key}}}; - if (length $short_version and exists $version_to_dist{$short_version}) { - push @attributes, 'label="'.$key.'\n'."(".join(', ',@{$version_to_dist{$short_version}}).")\""; + if (exists $version_to_dist{$key}) { + push @attributes, 'label="'.$key.'\n'."(".join(', ',@{$version_to_dist{$key}}).")\""; } my $node_attributes = qq("$key" [).join(',',@attributes).qq(]\n); $dot .= $node_attributes; @@ -233,6 +273,7 @@ if ($cgi_var{collapse}) { 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}}? @@ -245,13 +286,13 @@ $dot .= "}\n"; my $temp_dir = tempdir(CLEANUP => 1); if (not defined $cgi_var{dot}) { - my $dot_fh = new IO::File "$temp_dir/temp.dot",'w' or + my $dot_fh = IO::File->new("$temp_dir/temp.dot",'w') or die "Unable to open $temp_dir/temp.dot for writing: $!"; print {$dot_fh} $dot or die "Unable to print output to the dot file: $!"; close $dot_fh or die "Unable to close the dot file: $!"; system('dot','-T'.$cgi_var{format},"$temp_dir/temp.dot",'-o',"$temp_dir/temp.$cgi_var{format}") == 0 or print "Content-Type: text\n\nDot failed." and die "Dot failed: $?"; - my $img_fh = new IO::File "$temp_dir/temp.$cgi_var{format}", 'r' or + my $img_fh = IO::File->new("$temp_dir/temp.$cgi_var{format}", 'r') or die "Unable to open $temp_dir/temp.$cgi_var{format} for reading: $!"; print "Content-Type: $img_types{$cgi_var{format}}\n\n"; print <$img_fh>; @@ -263,7 +304,7 @@ else { } -my %_version_relevant_cache; +our %_version_relevant_cache; sub version_relevant { my ($version,$test_version,$relevant_versions) = @_; for my $dist_version (@{$relevant_versions}) {