$cgi_var{package} Version Graph

X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=cgi%2Fversion.cgi;h=36e3ee879a9a05d4719eb85ee994b2860e97932b;hb=4e825a8244209a9daec474381912df08470eae6f;hp=f6f377c22f5e909f1f94c723edc281132acd85b9;hpb=9c907cb68374f814eb419956de9b302bf19e5ee9;p=debbugs.git diff --git a/cgi/version.cgi b/cgi/version.cgi index f6f377c..36e3ee8 100755 --- a/cgi/version.cgi +++ b/cgi/version.cgi @@ -5,33 +5,59 @@ use strict; # Hack to work on merkel where suexec is in place BEGIN{ - if ($ENV{HTTP_HOST} eq 'merkel.debian.org') { + if (defined $ENV{HTTP_HOST} and $ENV{HTTP_HOST} eq 'merkel.debian.org') { unshift @INC, qw(/home/don/perl/usr/share/perl5 /home/don/perl/usr/lib/perl5 /home/don/source); $ENV{DEBBUGS_CONFIG_FILE}="/home/don/config_internal"; } } +# if we're running out of git, we want to use the git base directory as the +# first INC directory. If you're not running out of git, don't do that. +use File::Basename qw(dirname); +use Cwd qw(abs_path); +our $debbugs_dir; +BEGIN { + $debbugs_dir = + abs_path(dirname(abs_path(__FILE__)) . '/../'); + # clear the taint; we'll assume that the absolute path to __FILE__ is the + # right path if there's a .git directory there + ($debbugs_dir) = $debbugs_dir =~ /([[:print:]]+)/; + if (defined $debbugs_dir and + -d $debbugs_dir . '/.git/') { + } else { + undef $debbugs_dir; + } + # if the first directory in @INC is not an absolute directory, assume that + # someone has overridden us via -I. + if ($INC[0] !~ /^\//) { + } +} +use if defined $debbugs_dir, lib => $debbugs_dir; use CGI::Simple; # by default send this message nowhere -use CGI::Alert q(nobody@example.com); +# use CGI::Alert q(nobody@example.com); use Debbugs::Config qw(:config); -BEGIN{ - $CGI::Alert::Maintainer = $config{maintainer}; -} - -use Debbugs::CGI qw(htmlize_packagelinks html_escape cgi_parameters munge_url); +our $VERSION=1; +use Debbugs::DB; +use Debbugs::CGI qw(htmlize_packagelinks html_escape cgi_parameters munge_url :cache); use Debbugs::Versions; use Debbugs::Versions::Dpkg; -use Debbugs::Packages qw(get_versions makesourceversions); +use Debbugs::Packages qw(get_versions make_source_versions); use HTML::Entities qw(encode_entities); use File::Temp qw(tempdir); use IO::File; use IO::Handle; +my @schema_arg = (); +if (defined $config{database}) { + my $s = Debbugs::DB->connect($config{database}) or + die "Unable to connect to DB"; + @schema_arg = ('schema',$s); +} my %img_types = (svg => 'image/svg+xml', png => 'image/png', @@ -56,21 +82,6 @@ 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} = [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; - } -} - if (defined $cgi_var{width}) { $cgi_var{width} =~ /(\d+)/; $cgi_var{width} = $1; @@ -88,20 +99,38 @@ else { $cgi_var{format} = 'png'; } +my $etag; if ($cgi_var{info} and not defined $cgi_var{dot}) { - print "Content-Type: text/html\n\n"; - print <$q, + additional_data=>[grep {defined $_ ? $_ : ()} + @cgi_var{(qw(package ignore_boring), + qw(collapse)) + }, + $this, + $VERSION], + ); + if (not $etag) { + print $q->header(-status => 304); + print "304: Not modified\n"; + exit 0; + } + print $q->header(-status => 200, + -cache_control => 'public, max-age=86400', + -etag => $etag, + -content_type => 'text/html', + ); + print < -$cgi_var{package} Version Graph - END + print ''.html_escape($cgi_var{package}).' Version Graph'."\n"; + print "\n"; print '['.($cgi_var{ignore_boring}?"Don't i":'I').'gnore boring] '; print '['.($cgi_var{collapse}?"Don't c":'C').'ollapse] '; print '[Dot]
'; + '">[Dot]
'; print '

'; print < @@ -110,24 +139,72 @@ END exit 0; } +# 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} = [get_versions(package => [split /\s*,\s*/, $cgi_var{package}], + dist => $dist, + source => 1, + @schema_arg, + )]; + # make version_to_dist + foreach my $version (@{$versions{$dist}}){ + push @{$version_to_dist{$version}}, $dist; + } +} + # then figure out which are affected. # turn found and fixed into full versions -@{$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}; +@{$cgi_var{found}} = + map {make_source_versions(package => $_, + versions => $cgi_var{found})} + split/\s*,\s*/, $cgi_var{package}; +@{$cgi_var{fixed}} = + map {make_source_versions(package =>$_, + versions => $cgi_var{fixed})} + split/\s*,\s*/, $cgi_var{package}; +my @interesting_versions = + map {make_source_versions(package => $_, + versions => [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; @sources{map {m{(.+)/}; $1} @{$cgi_var{found}}} = (1) x @{$cgi_var{found}}; @sources{map {m{(.+)/}; $1} @{$cgi_var{fixed}}} = (1) x @{$cgi_var{fixed}}; @sources{map {m{(.+)/}; $1} @interesting_versions} = (1) x @interesting_versions; + +# at this point, we know enough to calculate the etag. + +my @versions_files; +foreach my $source (sort keys %sources) { + my $srchash = substr $source, 0, 1; + next unless -e "$config{version_packages_dir}/$srchash/$source"; + push @versions_files, "$config{version_packages_dir}/$srchash/$source"; +} + +$etag = etag_does_not_match(cgi=>$q, + additional_data=>[@cgi_var{(qw(package ignore_boring), + qw(collapse)) + }, + $this, + $VERSION], + files => [@versions_files + ], + ); +if (not $etag) { + print $q->header(-status => 304); + print "304: Not modified\n"; + exit 0; +} + my $version = Debbugs::Versions->new(\&Debbugs::Versions::Dpkg::vercmp); -foreach my $source (keys %sources) { - my $srchash = substr $source, 0, 1; - next unless -e "$config{version_packages_dir}/$srchash/$source"; - my $version_fh = IO::File->("$config{version_packages_dir}/$srchash/$source", 'r') or - warn "Unable to open $config{version_packages_dir}/$srchash/$source for reading: $!"; - $version->load($version_fh); +for my $version_fn (@versions_files) { + my $version_fh = IO::File->new($version_fn, 'r') or + warn "Unable to open $version_fn for reading: $!"; + $version->load($version_fh); } # Here, we need to generate a short version to full version map my %version_map; @@ -193,7 +270,6 @@ if ($cgi_var{collapse}) { # nodes that can be collapsed are those that have one child # 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{$key} and @{$reversed_nodes{$key}} <= 1 and defined $version->{parent}{$key} @@ -243,7 +319,6 @@ if ($cgi_var{collapse}) { } foreach my $key (keys %all_states) { - my ($short_version) = $key =~ m{/(.+)$}; next if exists $collapsed_nodes{$key}; next if $cgi_var{ignore_boring} and (not defined $all_states{$key} or $all_states{$key} eq 'absent'); @@ -294,12 +369,20 @@ if (not defined $cgi_var{dot}) { or print "Content-Type: text\n\nDot failed." and die "Dot failed: $?"; 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 $q->header(-status => 200, + -cache_control => 'public, max-age=300', + -etag => $etag, + -content_type => $img_types{$cgi_var{format}}, + ); print <$img_fh>; close $img_fh; } else { - print "Content-Type: text\n\n"; + print $q->header(-status => 200, + -cache_control => 'public, max-age=300', + -etag => $etag, + -content_type => 'text', + ); print $dot; }