+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
package Debbugs::Bugs;
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people have contributed to this file; their copyrights should
+# go here too.]
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
package Debbugs::CGI;
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people have contributed to this file; their copyrights should
+# go here too.]
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
package Debbugs::Common;
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
package Debbugs::Config;
qw($gIncomingDir $gWebDir $gDocDir $gMaintainerFile),
qw($gMaintainerFileOverride $gPseudoDescFile $gPackageSource),
qw($gVersionPackagesDir $gVersionIndex $gBinarySourceMap $gSourceBinaryMap),
+ qw($gVersionTimeIndex),
qw($gSendmail $gLibPath $gSpamScan @gExcludeFromControl),
qw(%gSeverityDisplay @gTags @gSeverityList @gStrongSeverities),
qw(%gSearchEstraier),
set_default(\%config,'pseudo_desc_file',$config{config_dir}.'/pseudo-packages.description');
set_default(\%config,'package_source',$config{config_dir}.'/indices/sources');
+
+=item version_packages_dir
+
+Location where the version package information is kept; defaults to
+spool_dir/../versions/pkg
+
+=cut
+
set_default(\%config,'version_packages_dir',$config{spool_dir}.'/../versions/pkg');
+=item version_time_index
+
+Location of the version/time index file. Defaults to
+spool_dir/../versions/idx/versions_time.idx
+
+=cut
+
+
+set_default(\%config,'version_time_index',$config{spool_dir}.'../versions/idx/versions_time.idx');
+
+=item version_index
+
+Location of the version index file. Defaults to
+spool_dir/../versions/idx/versions.idx
+
+=cut
+
+set_default(\%config,'version_index',$config{spool_dir}.'../versions/idx/versions.idx');
+
+=item binary_source_map
+
+Location of the binary -> source map. Defaults to
+spool_dir/../versions/idx/binsrc.idx
+
+=cut
+
+set_default(\%config,'binary_source_map',$config{spool_dir}.'../versions/idx/binsrc.idx');
+
+=item source_binary_map
+
+Location of the source -> binary map. Defaults to
+spool_dir/../versions/idx/srcbin.idx
+
+=cut
+
+set_default(\%config,'source_binary_map',$config{spool_dir}.'../versions/idx/srcbin.idx');
+
+
+
set_default(\%config,'post_processall',[]);
=item sendmail
-package Debbugs::Email;
+package Debbugs::Email;
use strict;
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
package Debbugs::Estraier;
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people have contributed to this file; their copyrights should
+# go here too.]
+# Copyright 2004 by Collin Waston <cjwatson@debian.org>
+
+
package Debbugs::Log;
use strict;
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people have contributed to this file; their copyrights should
+# go here too.]
+# Copyright 2006 by Don Armstrong <don@donarmstrong.com>.
+
+
package Debbugs::MIME;
use strict;
-# $Id: Mail.pm,v 1.1 2005/08/17 21:46:16 don Exp $
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# Copyright 2004-7 by Don Armstrong <don@donarmstrong.com>.
package Debbugs::Mail;
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people have contributed to this file; their copyrights should
+# go here too.]
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
+
package Debbugs::Packages;
use warnings;
$VERSION = 1.00;
@EXPORT = ();
- %EXPORT_TAGS = (versions => [qw(getversions)],
+ %EXPORT_TAGS = (versions => [qw(getversions get_versions)],
mapping => [qw(getpkgsrc getpkgcomponent getsrcpkgs),
qw(binarytosource sourcetobinary makesourceversions)
],
use Fcntl qw(O_RDONLY);
use MLDBM qw(DB_File Storable);
use Storable qw(dclone);
+use Params::Validate qw(validate_with :types);
+use Debbugs::Common qw(make_list);
$MLDBM::DumpMeth = 'portable';
$MLDBM::RemoveTaint = 1;
=cut
-our %_versions;
sub getversions {
my ($pkg, $dist, $arch) = @_;
- return () unless defined $gVersionIndex;
- $dist = 'unstable' unless defined $dist;
+ return get_versions(package=>$pkg,
+ dist => $dist,
+ defined $arch ? (arch => $arch):(),
+ );
+}
- unless (tied %_versions) {
- tie %_versions, 'MLDBM', $gVersionIndex, O_RDONLY
- or die "can't open versions index: $!";
- }
- my $version = $_versions{$pkg};
- return () unless defined $version;
- my %version = %{$version};
-
- if (defined $arch and exists $version{$dist}{$arch}) {
- my $ver = $version{$dist}{$arch};
- return $ver if defined $ver;
- return ();
- } else {
- my %uniq;
- for my $ar (keys %{$version{$dist}}) {
- $uniq{$version{$dist}{$ar}} = 1 unless $ar eq 'source';
- }
- if (%uniq) {
- return keys %uniq;
- } elsif (exists $version{$dist}{source}) {
- # Maybe this is actually a source package with no corresponding
- # binaries?
- return $version{$dist}{source};
- } else {
- return ();
- }
- }
+
+
+=head2 get_versions
+
+ get_version(package=>'foopkg',
+ dist => 'unstable',
+ arch => 'i386',
+ );
+
+Returns a list of the versions of package in the distributions and
+architectures listed. This routine only returns unique values.
+
+=over
+
+=item package -- package to return list of versions
+
+=item dist -- distribution (unstable, stable, testing); can be an
+arrayref
+
+=item arch -- architecture (i386, source, ...); can be an arrayref
+
+=item time -- returns a version=>time hash at which the newest package
+matching this version was uploaded
+
+=item source -- returns source/version instead of just versions
+
+=back
+
+=cut
+
+our %_versions;
+our %_versions_time;
+
+sub get_versions{
+ my %param = validate_with(params => \@_,
+ spec => {package => {type => SCALAR,
+ },
+ dist => {type => SCALAR|ARRAYREF,
+ default => 'unstable',
+ },
+ arch => {type => SCALAR|ARRAYREF,
+ optional => 1,
+ },
+ time => {type => BOOLEAN,
+ default => 0,
+ },
+ source => {type => BOOLEAN,
+ default => 0,
+ },
+ },
+ );
+ my $versions;
+ if ($param{time}) {
+ return () if not defined $gVersionTimeIndex;
+ unless (tied %_versions_time) {
+ tie %_versions_time, 'MLDBM', $gVersionTimeIndex, O_RDONLY
+ or die "can't open versions index $gVersionTimeIndex: $!";
+ }
+ $versions = \%_versions_time;
+ }
+ else {
+ return () if not defined $gVersionIndex;
+ unless (tied %_versions) {
+ tie %_versions, 'MLDBM', $gVersionIndex, O_RDONLY
+ or die "can't open versions index $gVersionIndex: $!";
+ }
+ $versions = \%_versions;
+ }
+ my %versions;
+ for my $package (make_list($param{package})) {
+ my $version = $versions->{$package};
+ next unless defined $version;
+ for my $dist (make_list($param{dist})) {
+ for my $arch (exists $param{arch}?
+ make_list($param{arch}):
+ (keys %{$version->{$dist}})) {
+ next unless defined $version->{$dist}{$arch};
+ for my $ver (ref $version->{$dist}{$arch} ?
+ keys %{$version->{$dist}{$arch}} :
+ $version->{$dist}{$arch}
+ ) {
+ my $f_ver = $ver;
+ if ($param{source}) {
+ $f_ver = makesourceversions($package,$arch,$ver)
+ }
+ if ($param{time}) {
+ $versions{$f_ver} = max($versions{$f_ver}||0,$version->{$dist}{$arch}{$ver});
+ }
+ else {
+ $versions{$f_ver} = 1;
+ }
+ }
+ }
+ }
+ }
+ if ($param{time}) {
+ return %versions
+ }
+ return keys %versions;
}
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people have contributed to this file; their copyrights should
+# go here too.]
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
package Debbugs::Status;
use Debbugs::Common qw(:util :lock :quit :misc);
use Debbugs::Config qw(:config);
use Debbugs::MIME qw(decode_rfc1522 encode_rfc1522);
-use Debbugs::Packages qw(makesourceversions getversions binarytosource);
+use Debbugs::Packages qw(makesourceversions getversions get_versions binarytosource);
use Debbugs::Versions;
use Debbugs::Versions::Dpkg;
use POSIX qw(ceil);
$dists{$tag} = 1;
}
my %source_versions;
- for my $dist (keys %dists){
- my @versions;
- @versions = getversions($status->{package},
- $dist,
- undef);
- # TODO: This should probably be handled further out for efficiency and
- # for more ease of distinguishing between pkg= and src= queries.
- my @sourceversions = makesourceversions($status->{package},
- $dist,
- @versions);
- @source_versions{@sourceversions} = (1) x @sourceversions;
- }
+ my @sourceversions = get_versions(package => $status->{package},
+ dist => [keys %dists],
+ source => 1,
+ );
+ @source_versions{@sourceversions} = (1) x @sourceversions;
if ('found' eq max_buggy(bug => $param{bug},
sourceversions => [keys %source_versions],
found => $status->{found_versions},
)) {
return $cannot_archive;
}
+ # Since the bug has at least been fixed in the architectures
+ # that matters, we check to see how long it has been fixed.
+
}
# 6. at least 28 days have passed since the last action has occured or the bug was closed
- # XXX We still need some more work here before we actually can archive;
- # we really need to track when a bug was closed in a version.
my $age = ceil($config{remove_age} - -M getbugcomponent($param{bug},'log'));
if ($age > 0 ) {
return $param{days_until}?$age:0;
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
+# query_form is
+# Copyright 1995-2003 Gisle Aas.
+# Copyright 1995 Martijn Koster.
+
+
package Debbugs::URI;
=head1 NAME
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people have contributed to this file; their copyrights should
+# go here too.]
+# Copyright 2004 by Anthony Towns
+
+
package Debbugs::User;
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people have contributed to this file; their copyrights should
+# go here too.]
+
package Debbugs::Versions;
use strict;
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# Copyright Colin Watson <cjwatson@debian.org>
+# Copyright Ian Jackson <iwj@debian.org>
+# Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
+
+
package Debbugs::Versions::Dpkg;
use strict;
projects / debbugs.git / commitdiff