- # 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{$ver}}) {
- my $src = $binary{$ver}{$ar};
- next unless defined $src;
- $uniq{$src->[0]} = 1;
- }
- }
- return keys %uniq;
+ my @source;
+ my @packages = grep {defined $_} make_list(exists $param{package}?$param{package}:[]);
+ my @versions = grep {defined $_} make_list(exists $param{version}?$param{version}:[]);
+ my @archs = grep {defined $_} make_list(exists $param{arch}?$param{arch}:[]);
+ return () unless @packages;
+ my $cache_key = join("\1",
+ join("\0",@packages),
+ join("\0",@versions),
+ join("\0",@archs),
+ join("\0",@param{qw(source_only scalar_only)}));
+ if (exists $param{cache}{$cache_key}) {
+ return $param{scalar_only} ? $param{cache}{$cache_key}[0]:
+ @{$param{cache}{$cache_key}};
+ }
+ for my $package (make_list($param{package})) {
+ if ($package =~ 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 $binary = $_binarytosource{$package};
+ if (not @versions) {
+ next unless defined $binary;
+ for my $ver (keys %{$binary}) {
+ for my $ar (keys %{$binary->{$ver}}) {
+ my $src = $binary->{$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 $binary->{$version};
+ if (exists $binary->{$version}{all}) {
+ push @source,dclone($binary->{$version}{all});
+ next;
+ }
+ my @t_archs;
+ if (@archs) {
+ @t_archs = @archs;
+ }
+ else {
+ @t_archs = keys %{$binary->{$version}};
+ }
+ for my $arch (@t_archs) {
+ push @source,dclone($binary->{$version}{$arch}) if
+ exists $binary->{$version}{$arch};
+ }
+ }
+ }
+ }
+ my @result;
+
+ if ($param{source_only}) {
+ my %uniq;
+ for my $s (@source) {
+ $uniq{$s->[0]} = 1;
+ }
+ @result = sort keys %uniq;
+ if ($param{scalar_only}) {
+ @result = join(', ',@result);
+ }