# 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;
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',
%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;
$cgi_var{format} = 'png';
}
+my $etag;
if ($cgi_var{info} and not defined $cgi_var{dot}) {
- print "Content-Type: text/html\n\n";
- print <<END;
+ $etag = etag_does_not_match(cgi=>$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 <<END;
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
END
print '<head><title>'.html_escape($cgi_var{package}).' Version Graph</title></head>'."\n";
- print "<body>\n"
+ print "<body>\n";
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/>';
+ '">[Dot]</a><br>';
print '<img src="'.html_escape(munge_url($this,info=>0)).'">';
print <<END;
</body>
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->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);
+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;
# 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}
}
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');
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;
}
projects / debbugs.git / blobdiff