* Add Debbugs::SOAP::Status

[debbugs.git] / Debbugs / Packages.pm

diff --git a/Debbugs/Packages.pm b/Debbugs/Packages.pm
index 4ae58a5d9078b569005dd9e7aa1bcf1b4492d2ad..00eda54950b24f4937297ae6da92eff8bb309416 100644 (file)
--- a/Debbugs/Packages.pm
+++ b/Debbugs/Packages.pm
@@ -1,22 +1,25 @@
 package Debbugs::Packages;
 
+use warnings;
 use strict;
 
-# TODO: move config handling to a separate module
-my $config_path = '/etc/debbugs';
-require "$config_path/config";
-# Allow other modules to load config into their namespace.
-delete $INC{"$config_path/config"};
+use Debbugs::Config qw(:config :globals);
 
-use Exporter ();
-use vars qw($VERSION @ISA @EXPORT);
+use base qw(Exporter);
+use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS @EXPORT);
 
 BEGIN {
     $VERSION = 1.00;
 
-    @ISA = qw(Exporter);
-    @EXPORT = qw(getpkgsrc getpkgcomponent getsrcpkgs
-                binarytosource sourcetobinary);
+     @EXPORT = ();
+     %EXPORT_TAGS = (versions => [qw(getversions)],
+                    mapping  => [qw(getpkgsrc getpkgcomponent getsrcpkgs),
+                                 qw(binarytosource sourcetobinary)
+                                ],
+                   );
+     @EXPORT_OK = ();
+     Exporter::export_ok_tags(qw(versions mapping));
+     $EXPORT_TAGS{all} = [@EXPORT_OK];
 }
 
 use Fcntl qw(O_RDONLY);
@@ -56,7 +59,7 @@ sub getpkgsrc {
     my %pkgcomponent;
 
     open(MM,"$Debbugs::Packages::gPackageSource")
-       or &quitcgi("open $Debbugs::Packages::gPackageSource: $!");
+       or die("open $Debbugs::Packages::gPackageSource: $!");
     while(<MM>) {
        next unless m/^(\S+)\s+(\S+)\s+(\S.*\S)\s*$/;
        my ($bin,$cmp,$src)=($1,$2,$3);
@@ -188,6 +191,46 @@ sub sourcetobinary {
     return map [$_, $srcver], @srcpkgs;
 }
 
+=item getversions
+
+Returns versions of the package in distribution at a specific architecture
+
+=cut
+
+my %_versions;
+sub getversions {
+    my ($pkg, $dist, $arch) = @_;
+    return () unless defined $gVersionIndex;
+    $dist = 'unstable' unless defined $dist;
+
+    unless (tied %_versions) {
+        tie %_versions, 'MLDBM', $gVersionIndex, O_RDONLY
+            or die "can't open versions index: $!";
+    }
+
+    if (defined $arch and exists $_versions{$pkg}{$dist}{$arch}) {
+        my $ver = $_versions{$pkg}{$dist}{$arch};
+        return $ver if defined $ver;
+        return ();
+    } else {
+        my %uniq;
+        for my $ar (keys %{$_versions{$pkg}{$dist}}) {
+            $uniq{$_versions{$pkg}{$dist}{$ar}} = 1 unless $ar eq 'source';
+        }
+        if (%uniq) {
+            return keys %uniq;
+        } elsif (exists $_versions{$pkg}{$dist}{source}) {
+            # Maybe this is actually a source package with no corresponding
+            # binaries?
+            return $_versions{$pkg}{$dist}{source};
+        } else {
+            return ();
+        }
+    }
+}
+
+
+
 =back
 
 =cut