+ if (not @packages) {
+ croak "You must provide at least one package if the versions are not fully qualified";
+ }
+ for my $pkg (@packages) {
+ if ($pkg =~ /^src:(.+)/) {
+ $sourceversions{"$1/$version"} = 1;
+ next unless exists $param{warnings};
+ # check to see if this source version is even possible
+ my @bin_versions = sourcetobinary($1,$version);
+ if (not @bin_versions or
+ @{$bin_versions[0]} != 3) {
+ print {$warnings} "The source '$1' and version '$version' do not appear to match any binary packages\n";
+ }
+ next;
+ }
+ for my $arch (@archs) {
+ my $cachearch = (defined $arch) ? $arch : '';
+ my $cachekey = "$pkg/$cachearch/$version";
+ if (exists($param{source_version_cache}{$cachekey})) {
+ for my $v (@{$param{source_version_cache}{$cachekey}}) {
+ $sourceversions{$v} = 1;
+ }
+ next;
+ }
+ elsif ($param{guess_source} and
+ exists$param{source_version_cache}{$cachekey.'/guess'}) {
+ for my $v (@{$param{source_version_cache}{$cachekey.'/guess'}}) {
+ $sourceversions{$v} = 1;
+ }
+ next;
+ }
+ my @srcinfo = binary_to_source(binary => $pkg,
+ version => $version,
+ length($arch)?(arch => $arch):());
+ if (not @srcinfo) {
+ # We don't have explicit information about the
+ # binary-to-source mapping for this version
+ # (yet).
+ print {$warnings} "There is no source info for the package '$pkg' at version '$version' with architecture '$arch'\n";
+ if ($param{guess_source}) {
+ # Lets guess it
+ my $pkgsrc = getpkgsrc();
+ if (exists $pkgsrc->{$pkg}) {
+ @srcinfo = ([$pkgsrc->{$pkg}, $version]);
+ } elsif (getsrcpkgs($pkg)) {
+ # If we're looking at a source package
+ # that doesn't have a binary of the
+ # same name, just try the same
+ # version.
+ @srcinfo = ([$pkg, $version]);
+ } else {
+ next;
+ }
+ # store guesses in a slightly different location
+ $param{source_version_cache}{$cachekey.'/guess'} = [ map { "$_->[0]/$_->[1]" } @srcinfo ];
+ }
+ }
+ else {
+ # only store this if we didn't have to guess it
+ $param{source_version_cache}{$cachekey} = [ map { "$_->[0]/$_->[1]" } @srcinfo ];
+ }
+ $sourceversions{"$_->[0]/$_->[1]"} = 1 foreach @srcinfo;