use Params::Validate qw(validate_with :types);
use Debbugs::Common qw(make_list);
+use List::Util qw(min max);
+
$MLDBM::DumpMeth = 'portable';
$MLDBM::RemoveTaint = 1;
=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
# need an extra cache for speed here.
return () unless defined $gBinarySourceMap;
- if (tied %_binarytosource or
- tie %_binarytosource, 'MLDBM',
- $gBinarySourceMap, O_RDONLY) {
- # avoid autovivification
- my $binary = $_binarytosource{$binname};
- return () unless defined $binary;
- my %binary = %{$binary};
- if (exists $binary{$binver}) {
- if (defined $binarch) {
- my $src = $binary{$binver}{$binarch};
- return () unless defined $src; # not on this arch
- # Copy the data to avoid tiedness problems.
- return dclone($src);
- } else {
- # Get (srcname, srcver) pairs for all architectures and
- # remove any duplicates. This involves some slightly tricky
- # multidimensional hashing; sorry. Fortunately there'll
- # usually only be one pair returned.
- my %uniq;
- for my $ar (keys %{$binary{$binver}}) {
- my $src = $binary{$binver}{$ar};
- next unless defined $src;
- $uniq{$src->[0]}{$src->[1]} = 1;
- }
- my @uniq;
- for my $sn (sort keys %uniq) {
- push @uniq, [$sn, $_] for sort keys %{$uniq{$sn}};
- }
- return @uniq;
- }
- }
+ if (not tied %_binarytosource) {
+ tie %_binarytosource, MLDBM => $gBinarySourceMap, O_RDONLY or
+ die "Unable to open $gBinarySourceMap for reading";
+ }
+
+ # avoid autovivification
+ my $binary = $_binarytosource{$binname};
+ return () unless defined $binary;
+ my %binary = %{$binary};
+ if (not defined $binver) {
+ my %uniq;
+ for my $ver (keys %binary) {
+ for my $ar (keys %{$binary{$binver}}) {
+ my $src = $binary{$binver}{$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
+ # Copy the data to avoid tiedness problems.
+ return dclone($src);
+ } else {
+ # Get (srcname, srcver) pairs for all architectures and
+ # remove any duplicates. This involves some slightly tricky
+ # multidimensional hashing; sorry. Fortunately there'll
+ # usually only be one pair returned.
+ my %uniq;
+ for my $ar (keys %{$binary{$binver}}) {
+ my $src = $binary{$binver}{$ar};
+ next unless defined $src;
+ $uniq{$src->[0]}{$src->[1]} = 1;
+ }
+ my @uniq;
+ for my $sn (sort keys %uniq) {
+ push @uniq, [$sn, $_] for sort keys %{$uniq{$sn}};
+ }
+ return @uniq;
+ }
}
# No $gBinarySourceMap, or it didn't have an entry for this name and
sub sourcetobinary {
my ($srcname, $srcver) = @_;
- if (tied %_sourcetobinary or
- tie %_sourcetobinary, 'MLDBM',
- $gSourceBinaryMap, O_RDONLY) {
- # avoid autovivification
- my $source = $_sourcetobinary{$srcname};
- return () unless defined $source;
- my %source = %{$source};
- if (exists $source{$srcver}) {
- my $bin = $source{$srcver};
- return () unless defined $bin;
- return @$bin;
- }
+ if (not tied %_sourcetobinary) {
+ tie %_sourcetobinary, MLDBM => $gSourceBinaryMap, O_RDONLY or
+ die "Unable top open $gSourceBinaryMap for reading";
}
+
+
+ # avoid autovivification
+ my $source = $_sourcetobinary{$srcname};
+ return () unless defined $source;
+ my %source = %{$source};
+ if (exists $source{$srcver}) {
+ my $bin = $source{$srcver};
+ return () unless defined $bin;
+ return @$bin;
+ }
# No $gSourceBinaryMap, or it didn't have an entry for this name and
# version. Try $gPackageSource (unversioned) instead.
my @srcpkgs = getsrcpkgs($srcname);
=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.
=item source -- returns source/version instead of just versions
+=item no_source_arch -- discards the source architecture when arch is
+not passed. [Used for finding the versions of binary packages only.]
+Defaults to 0, which does not discard the source architecture. (This
+may change in the future, so if you care, please code accordingly.)
+
+=item return_archs -- returns a version=>[archs] hash indicating which
+architectures are at which versions.
+
=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;
sub get_versions{
my %param = validate_with(params => \@_,
- spec => {package => {type => SCALAR,
+ spec => {package => {type => SCALAR|ARRAYREF,
},
dist => {type => SCALAR|ARRAYREF,
default => 'unstable',
source => {type => BOOLEAN,
default => 0,
},
+ no_source_arch => {type => BOOLEAN,
+ default => 0,
+ },
+ return_archs => {type => BOOLEAN,
+ default => 0,
+ },
},
);
my $versions;
for my $dist (make_list($param{dist})) {
for my $arch (exists $param{arch}?
make_list($param{arch}):
- (keys %{$version->{$dist}})) {
+ (grep {not $param{no_source_arch} or
+ $_ ne 'source'
+ } keys %{$version->{$dist}})) {
next unless defined $version->{$dist}{$arch};
for my $ver (ref $version->{$dist}{$arch} ?
keys %{$version->{$dist}{$arch}} :
) {
my $f_ver = $ver;
if ($param{source}) {
- $f_ver = makesourceversions($package,$arch,$ver)
+ ($f_ver) = makesourceversions($package,$arch,$ver);
+ next unless defined $f_ver;
}
if ($param{time}) {
$versions{$f_ver} = max($versions{$f_ver}||0,$version->{$dist}{$arch}{$ver});
}
else {
- $versions{$f_ver} = 1;
+ push @{$versions{$f_ver}},$arch;
}
}
}
}
}
- if ($param{time}) {
- return %versions
+ if ($param{time} or $param{return_archs}) {
+ return wantarray?%versions :\%versions;
}
- return keys %versions;
+ return wantarray?keys %versions :[keys %versions];
}
my $pkg = shift;
my $arch = shift;
my %sourceversions;
+ die "Package $pkg is multiple packages; split on , and call makesourceversions multiple times"
+ if $pkg =~ /,/;
for my $version (@_) {
if ($version =~ m[/]) {
projects / debbugs.git / blobdiff