* Add munge_url to Debbugs::CGI to abstract out code in _url methods

[debbugs.git] / cgi / version.cgi
diff --git a/cgi/version.cgi b/cgi/version.cgi

index 0fc1dafc6961569f02683bc3add90c866c612734..b5967be6ef778f7a5c0af453698cba9a96caf0fc 100755 (executable)
--- a/cgi/version.cgi
+++ b/cgi/version.cgi
@@ -17,7 +17,7 @@ use CGI::Simple;
  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);
@@ -34,17 +34,21 @@ my %img_types = (svg => 'image/svg+xml',
  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,
@@ -75,6 +79,28 @@ else {
       $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}});
@@ -144,7 +170,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} ||=[];
@@ -233,6 +262,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}}?
@@ -263,7 +293,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}) {