- 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;
- }
+ for my $binary (@binaries) {
+ if ($binary =~ m/^src:(.+)$/) {
+ push @source,[$1,''];
+ next;
+ }
+ if (not tied %_binarytosource) {
+ tie %_binarytosource, MLDBM => $config{binary_source_map}, O_RDONLY or
+ die "Unable to open $config{binary_source_map} for reading";
+ }
+ # avoid autovivification
+ my $bin = $_binarytosource{$binary};
+ next unless defined $bin;
+ if (not @versions) {
+ for my $ver (keys %{$bin}) {
+ for my $ar (keys %{$bin->{$ver}}) {
+ my $src = $bin->{$ver}{$ar};
+ next unless defined $src;
+ push @source,[$src->[0],$src->[1]];
+ }
+ }
+ }
+ else {
+ my $found_one_version = 0;
+ for my $version (@versions) {
+ next unless exists $bin->{$version};
+ if (exists $bin->{$version}{all}) {
+ push @source,dclone($bin->{$version}{all});
+ next;
+ }
+ my @t_archs;
+ if (@archs) {
+ @t_archs = @archs;
+ }
+ else {
+ @t_archs = keys %{$bin->{$version}};
+ }
+ for my $arch (@t_archs) {
+ push @source,dclone($bin->{$version}{$arch}) if
+ exists $bin->{$version}{$arch};
+ }
+ }
+ }
+ }
+
+ if (not @source and not @versions and not @archs) {
+ # ok, we haven't found any results at all. If we weren't given
+ # a specific version and architecture, then we should try
+ # really hard to figure out the right source
+
+ # if any the packages we've been given are a valid source
+ # package name, and there's no binary of the same name (we got
+ # here, so there isn't), return it.
+
+ if (not tied %_sourcetobinary) {
+ tie %_sourcetobinary, MLDBM => $config{source_binary_map}, O_RDONLY or
+ die "Unable top open $gSourceBinaryMap for reading";
+ }
+ for my $maybe_sourcepkg (@binaries) {
+ if (exists $_sourcetobinary{$maybe_sourcepkg}) {
+ push @source,[$maybe_sourcepkg,$_] for keys %{$_sourcetobinary{$maybe_sourcepkg}};
+ }
+ }
+ # if @source is still empty here, it's probably a non-existant
+ # source package, so don't return anything.
+ }
+
+ my @result;
+
+ if ($param{source_only}) {
+ my %uniq;
+ for my $s (@source) {
+ # we shouldn't need to do this, but do this temporarily to
+ # stop the warning.
+ next unless defined $s->[0];
+ $uniq{$s->[0]} = 1;
+ }
+ @result = sort keys %uniq;
+ if ($param{scalar_only}) {
+ @result = join(', ',@result);
+ }
+ }
+ else {
+ my %uniq;
+ for my $s (@source) {
+ $uniq{$s->[0]}{$s->[1]} = 1;
+ }
+ for my $sn (sort keys %uniq) {
+ push @result, [$sn, $_] for sort keys %{$uniq{$sn}};
+ }