X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FPackages.pm;h=00eda54950b24f4937297ae6da92eff8bb309416;hb=a54f07e01f95b7ab702a9f08375dc8dad3394ac9;hp=4ae58a5d9078b569005dd9e7aa1bcf1b4492d2ad;hpb=9f108ef05e27f5f725510a94a83523620ccdf10a;p=debbugs.git

diff --git a/Debbugs/Packages.pm b/Debbugs/Packages.pm
index 4ae58a5..00eda54 100644
--- 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