use warnings;
use strict;
-use Debbugs::Config qw(:config :globals);
-
use base qw(Exporter);
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS @EXPORT);
+use Debbugs::Config qw(:config :globals);
+
BEGIN {
$VERSION = 1.00;
use List::Util qw(min max);
+use IO::File;
+
$MLDBM::DumpMeth = 'portable';
$MLDBM::RemoveTaint = 1;
my %pkgcomponent;
my %srcpkg;
- open(MM,"$Debbugs::Packages::gPackageSource")
- or die("open $Debbugs::Packages::gPackageSource: $!");
- while(<MM>) {
+ my $fh = IO::File->new($config{package_source},'r')
+ or die("Unable to open $config{package_source} for reading: $!");
+ while(<$fh>) {
next unless m/^(\S+)\s+(\S+)\s+(\S.*\S)\s*$/;
my ($bin,$cmp,$src)=($1,$2,$3);
- $bin =~ y/A-Z/a-z/;
+ $bin = lc($bin);
$pkgsrc{$bin}= $src;
push @{$srcpkg{$src}}, $bin;
$pkgcomponent{$bin}= $cmp;
}
- close(MM);
+ close($fh);
$_pkgsrc = \%pkgsrc;
$_pkgcomponent = \%pkgcomponent;
$_srcpkg = \%srcpkg;
=item binarytosource
Returns a reference to the source package name and version pair
-corresponding to a given binary package name, version, and architecture. If
-undef is passed as the architecture, returns a list of references to all
-possible pairs of source package names and versions for all architectures,
-with any duplicates removed.
+corresponding to a given binary package name, version, and architecture.
+
+If undef is passed as the architecture, returns a list of references
+to all possible pairs of source package names and versions for all
+architectures, with any duplicates removed.
+
+If the binary version is not passed either, returns a list of possible
+source package names for all architectures at all versions, with any
+duplicates removed.
=cut
my $binary = $_binarytosource{$binname};
return () unless defined $binary;
my %binary = %{$binary};
- if (exists $binary{$binver}) {
+ if (not defined $binver) {
+ my %uniq;
+ for my $ver (keys %binary) {
+ for my $ar (keys %{$binary{$ver}}) {
+ my $src = $binary{$ver}{$ar};
+ next unless defined $src;
+ $uniq{$src->[0]} = 1;
+ }
+ }
+ return keys %uniq;
+ }
+ elsif (exists $binary{$binver}) {
if (defined $binarch) {
my $src = $binary{$binver}{$binarch};
return () unless defined $src; # not on this arch
=head2 get_versions
- get_version(package=>'foopkg',
- dist => 'unstable',
- arch => 'i386',
- );
+ get_versions(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.
=back
+When called in scalar context, this function will return hashrefs or
+arrayrefs as appropriate, in list context, it will return paired lists
+or unpaired lists as appropriate.
+
=cut
our %_versions;
}
}
}
- if ($param{time}) {
- return %versions;
- }
- elsif ($param{return_archs}) {
- return %versions;
+ if ($param{time} or $param{return_archs}) {
+ return wantarray?%versions :\%versions;
}
- return keys %versions;
+ return wantarray?keys %versions :[keys %versions];
}