Debbugs/Packages.pm

   1 # This module is part of debbugs, and is released
   2 # under the terms of the GPL version 2, or any later
   3 # version at your option.
   4 # See the file README and COPYING for more information.
   5 #
   6 # [Other people have contributed to this file; their copyrights should
   7 # go here too.]
   8 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
   9
  10 package Debbugs::Packages;
  11
  12 use warnings;
  13 use strict;
  14
  15 use Exporter qw(import);
  16 use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS @EXPORT);
  17
  18 use Carp;
  19
  20 use Debbugs::Config qw(:config :globals);
  21
  22 BEGIN {
  23     $VERSION = 1.00;
  24
  25      @EXPORT = ();
  26      %EXPORT_TAGS = (versions => [qw(getversions get_versions make_source_versions)],
  27                      mapping  => [qw(getpkgsrc getpkgcomponent getsrcpkgs),
  28                                   qw(binary_to_source sourcetobinary makesourceversions)
  29                                  ],
  30                     );
  31      @EXPORT_OK = ();
  32      Exporter::export_ok_tags(qw(versions mapping));
  33      $EXPORT_TAGS{all} = [@EXPORT_OK];
  34 }
  35
  36 use Fcntl qw(O_RDONLY);
  37 use MLDBM qw(DB_File Storable);
  38 use Storable qw(dclone);
  39 use Params::Validate qw(validate_with :types);
  40 use Debbugs::Common qw(make_list globify_scalar sort_versions);
  41
  42 use List::AllUtils qw(min max);
  43
  44 use IO::File;
  45
  46 $MLDBM::DumpMeth = 'portable';
  47 $MLDBM::RemoveTaint = 1;
  48
  49 =head1 NAME
  50
  51 Debbugs::Packages - debbugs binary/source package handling
  52
  53 =head1 DESCRIPTION
  54
  55 The Debbugs::Packages module provides support functions to map binary
  56 packages to their corresponding source packages and vice versa. (This makes
  57 sense for software distributions, where developers may work on a single
  58 source package which produces several binary packages for use by users; it
  59 may not make sense in other contexts.)
  60
  61 =head1 METHODS
  62
  63 =head2 getpkgsrc
  64
  65 Returns a reference to a hash of binary package names to their corresponding
  66 source package names.
  67
  68 =cut
  69
  70 our $_pkgsrc;
  71 our $_pkgcomponent;
  72 our $_srcpkg;
  73 sub getpkgsrc {
  74     return $_pkgsrc if $_pkgsrc;
  75     return {} unless defined $config{package_source} and
  76         length $config{package_source};
  77     my %pkgsrc;
  78     my %pkgcomponent;
  79     my %srcpkg;
  80
  81     my $fh = IO::File->new($config{package_source},'r')
  82         or croak("Unable to open $config{package_source} for reading: $!");
  83     while(<$fh>) {
  84         next unless m/^(\S+)\s+(\S+)\s+(\S.*\S)\s*$/;
  85         my ($bin,$cmp,$src)=($1,$2,$3);
  86         $bin = lc($bin);
  87         $pkgsrc{$bin}= $src;
  88         push @{$srcpkg{$src}}, $bin;
  89         $pkgcomponent{$bin}= $cmp;
  90     }
  91     close($fh);
  92     $_pkgsrc = \%pkgsrc;
  93     $_pkgcomponent = \%pkgcomponent;
  94     $_srcpkg = \%srcpkg;
  95     return $_pkgsrc;
  96 }
  97
  98 =head2 getpkgcomponent
  99
 100 Returns a reference to a hash of binary package names to the component of
 101 the archive containing those binary packages (e.g. "main", "contrib",
 102 "non-free").
 103
 104 =cut
 105
 106 sub getpkgcomponent {
 107     return $_pkgcomponent if $_pkgcomponent;
 108     getpkgsrc();
 109     return $_pkgcomponent;
 110 }
 111
 112 =head2 getsrcpkgs
 113
 114 Returns a list of the binary packages produced by a given source package.
 115
 116 =cut
 117
 118 sub getsrcpkgs {
 119     my $src = shift;
 120     getpkgsrc() if not defined $_srcpkg;
 121     return () if not defined $src or not exists $_srcpkg->{$src};
 122     return @{$_srcpkg->{$src}};
 123 }
 124
 125 =head2 binary_to_source
 126
 127      binary_to_source(package => 'foo',
 128                       version => '1.2.3',
 129                       arch    => 'i386');
 130
 131
 132 Turn a binary package (at optional version in optional architecture)
 133 into a single (or set) of source packages (optionally) with associated
 134 versions.
 135
 136 By default, in LIST context, returns a LIST of array refs of source
 137 package, source version pairs corresponding to the binary package(s),
 138 arch(s), and verion(s) passed.
 139
 140 In SCALAR context, only the corresponding source packages are
 141 returned, concatenated with ', ' if necessary.
 142
 143 If no source can be found, returns undef in scalar context, or the
 144 empty list in list context.
 145
 146 =over
 147
 148 =item binary -- binary package name(s) as a SCALAR or ARRAYREF
 149
 150 =item version -- binary package version(s) as a SCALAR or ARRAYREF;
 151 optional, defaults to all versions.
 152
 153 =item arch -- binary package architecture(s) as a SCALAR or ARRAYREF;
 154 optional, defaults to all architectures.
 155
 156 =item source_only -- return only the source name (forced on if in
 157 SCALAR context), defaults to false.
 158
 159 =item scalar_only -- return a scalar only (forced true if in SCALAR
 160 context, also causes source_only to be true), defaults to false.
 161
 162 =item cache -- optional HASHREF to be used to cache results of
 163 binary_to_source.
 164
 165 =back
 166
 167 =cut
 168
 169 # the two global variables below are used to tie the source maps; we
 170 # probably should be retying them in long lived processes.
 171 our %_binarytosource;
 172 sub _tie_binarytosource {
 173     if (not tied %_binarytosource) {
 174         tie %_binarytosource, MLDBM => $config{binary_source_map}, O_RDONLY or
 175             die "Unable to open $config{binary_source_map} for reading";
 176     }
 177 }
 178 our %_sourcetobinary;
 179 sub _tie_sourcetobinary {
 180     if (not tied %_sourcetobinary) {
 181         tie %_sourcetobinary, MLDBM => $config{source_binary_map}, O_RDONLY or
 182             die "Unable to open $config{source_binary_map} for reading";
 183     }
 184 }
 185 sub binary_to_source{
 186     my %param = validate_with(params => \@_,
 187                               spec   => {binary => {type => SCALAR|ARRAYREF,
 188                                                     },
 189                                          version => {type => SCALAR|ARRAYREF,
 190                                                      optional => 1,
 191                                                     },
 192                                          arch    => {type => SCALAR|ARRAYREF,
 193                                                      optional => 1,
 194                                                     },
 195                                          source_only => {default => 0,
 196                                                         },
 197                                          scalar_only => {default => 0,
 198                                                         },
 199                                          cache => {type => HASHREF,
 200                                                    default => {},
 201                                                   },
 202                                          schema => {type => OBJECT,
 203                                                     optional => 1,
 204                                                    },
 205                                         },
 206                              );
 207
 208     # TODO: This gets hit a lot, especially from buggyversion() - probably
 209     # need an extra cache for speed here.
 210     return () unless defined $gBinarySourceMap or defined $param{schema};
 211
 212     if ($param{scalar_only} or not wantarray) {
 213         $param{source_only} = 1;
 214         $param{scalar_only} = 1;
 215     }
 216
 217     my @source;
 218     my @binaries = grep {defined $_} make_list(exists $param{binary}?$param{binary}:[]);
 219     my @versions = grep {defined $_} make_list(exists $param{version}?$param{version}:[]);
 220     my @archs = grep {defined $_} make_list(exists $param{arch}?$param{arch}:[]);
 221     return () unless @binaries;
 222
 223     # any src:foo is source package foo with unspecified version
 224     @source = map {/^src:(.+)$/?
 225                        [$1,'']:()} @binaries;
 226     @binaries = grep {$_ !~ /^src:/} @binaries;
 227     if ($param{schema}) {
 228         if ($param{source_only}) {
 229             @source = map {$_->[0]} @source;
 230             my $src_rs = $param{schema}->resultset('SrcPkg')->
 231                 search_rs({'binpkg.pkg' => [@binaries],
 232                            @versions?('bin_vers.ver'    => [@versions]):(),
 233                            @archs?('arch.arch' => [@archs]):(),
 234                           },
 235                          {join => {'src_vers'=>
 236                                   {'bin_vers'=> ['arch','bin_pkg']}
 237                                   },
 238                           distinct => 1,
 239                          },
 240                          );
 241             push @source,
 242                 map {$_->pkg} $src_rs->all;
 243             if ($param{scalar_only}) {
 244                 return join(',',@source);
 245             }
 246             return @source;
 247
 248         }
 249         my $src_rs = $param{schema}->resultset('SrcVer')->
 250             search_rs({'bin_pkg.pkg' => [@binaries],
 251                        @versions?('bin_vers.ver' => [@versions]):(),
 252                        @archs?('arch.arch' => [@archs]):(),
 253                       },
 254                      {join => ['src_pkg',
 255                               {'bin_vers' => ['arch','binpkg']},
 256                               ],
 257                       distinct => 1,
 258                      },
 259                      );
 260         push @source,
 261             map {[$_->get_column('src_pkg.pkg'),
 262                   $_->get_column('src_ver.ver'),
 263                  ]} $src_rs->all;
 264         if (not @source and not @versions and not @archs) {
 265             $src_rs = $param{schema}->resultset('SrcPkg')->
 266                 search_rs({pkg => [@binaries]},
 267                          {distinct => 1},
 268                          );
 269             push @source,
 270                 map {[$_->pkg,
 271                      ]} $src_rs->all;
 272         }
 273         return @source;
 274     }
 275     my $cache_key = join("\1",
 276                          join("\0",@binaries),
 277                          join("\0",@versions),
 278                          join("\0",@archs),
 279                          join("\0",@param{qw(source_only scalar_only)}));
 280     if (exists $param{cache}{$cache_key}) {
 281         return $param{scalar_only} ? $param{cache}{$cache_key}[0]:
 282             @{$param{cache}{$cache_key}};
 283     }
 284     for my $binary (@binaries) {
 285         _tie_binarytosource;
 286         # avoid autovivification
 287         my $bin = $_binarytosource{$binary};
 288         next unless defined $bin;
 289         if (not @versions) {
 290             for my $ver (keys %{$bin}) {
 291                 for my $ar (keys %{$bin->{$ver}}) {
 292                     my $src = $bin->{$ver}{$ar};
 293                     next unless defined $src;
 294                     push @source,[$src->[0],$src->[1]];
 295                 }
 296             }
 297         }
 298         else {
 299             for my $version (@versions) {
 300                 next unless exists $bin->{$version};
 301                 if (exists $bin->{$version}{all}) {
 302                     push @source,dclone($bin->{$version}{all});
 303                     next;
 304                 }
 305                 my @t_archs;
 306                 if (@archs) {
 307                     @t_archs = @archs;
 308                 }
 309                 else {
 310                     @t_archs = keys %{$bin->{$version}};
 311                 }
 312                 for my $arch (@t_archs) {
 313                     push @source,dclone($bin->{$version}{$arch}) if
 314                         exists $bin->{$version}{$arch};
 315                 }
 316             }
 317         }
 318     }
 319
 320     if (not @source and not @versions and not @archs) {
 321         # ok, we haven't found any results at all. If we weren't given
 322         # a specific version and architecture, then we should try
 323         # really hard to figure out the right source
 324
 325         # if any the packages we've been given are a valid source
 326         # package name, and there's no binary of the same name (we got
 327         # here, so there isn't), return it.
 328         _tie_sourcetobinary();
 329         for my $maybe_sourcepkg (@binaries) {
 330             if (exists $_sourcetobinary{$maybe_sourcepkg}) {
 331                 push @source,[$maybe_sourcepkg,$_] for keys %{$_sourcetobinary{$maybe_sourcepkg}};
 332             }
 333         }
 334         # if @source is still empty here, it's probably a non-existant
 335         # source package, so don't return anything.
 336     }
 337
 338     my @result;
 339
 340     if ($param{source_only}) {
 341         my %uniq;
 342         for my $s (@source) {
 343             # we shouldn't need to do this, but do this temporarily to
 344             # stop the warning.
 345             next unless defined $s->[0];
 346             $uniq{$s->[0]} = 1;
 347         }
 348         @result = sort keys %uniq;
 349         if ($param{scalar_only}) {
 350             @result = join(', ',@result);
 351         }
 352     }
 353     else {
 354         my %uniq;
 355         for my $s (@source) {
 356             $uniq{$s->[0]}{$s->[1]} = 1;
 357         }
 358         for my $sn (sort keys %uniq) {
 359             push @result, [$sn, $_] for sort keys %{$uniq{$sn}};
 360         }
 361     }
 362
 363     # No $gBinarySourceMap, or it didn't have an entry for this name and
 364     # version.
 365     $param{cache}{$cache_key} = \@result;
 366     return $param{scalar_only} ? $result[0] : @result;
 367 }
 368
 369 =head2 sourcetobinary
 370
 371 Returns a list of references to triplets of binary package names, versions,
 372 and architectures corresponding to a given source package name and version.
 373 If the given source package name and version cannot be found in the database
 374 but the source package name is in the unversioned package-to-source map
 375 file, then a reference to a binary package name and version pair will be
 376 returned, without the architecture.
 377
 378 =cut
 379
 380 sub sourcetobinary {
 381     my ($srcname, $srcver) = @_;
 382     _tie_sourcetobinary;
 383     # avoid autovivification
 384     my $source = $_sourcetobinary{$srcname};
 385     return () unless defined $source;
 386     if (exists $source->{$srcver}) {
 387          my $bin = $source->{$srcver};
 388          return () unless defined $bin;
 389          return @$bin;
 390     }
 391     # No $gSourceBinaryMap, or it didn't have an entry for this name and
 392     # version. Try $gPackageSource (unversioned) instead.
 393     my @srcpkgs = getsrcpkgs($srcname);
 394     return map [$_, $srcver], @srcpkgs;
 395 }
 396
 397 =head2 getversions
 398
 399 Returns versions of the package in a distribution at a specific
 400 architecture
 401
 402 =cut
 403
 404 sub getversions {
 405     my ($pkg, $dist, $arch) = @_;
 406     return get_versions(package=>$pkg,
 407                         dist => $dist,
 408                         defined $arch ? (arch => $arch):(),
 409                        );
 410 }
 411
 412
 413
 414 =head2 get_versions
 415
 416      get_versions(package=>'foopkg',
 417                   dist => 'unstable',
 418                   arch => 'i386',
 419                  );
 420
 421 Returns a list of the versions of package in the distributions and
 422 architectures listed. This routine only returns unique values.
 423
 424 =over
 425
 426 =item package -- package to return list of versions
 427
 428 =item dist -- distribution (unstable, stable, testing); can be an
 429 arrayref
 430
 431 =item arch -- architecture (i386, source, ...); can be an arrayref
 432
 433 =item time -- returns a version=>time hash at which the newest package
 434 matching this version was uploaded
 435
 436 =item source -- returns source/version instead of just versions
 437
 438 =item no_source_arch -- discards the source architecture when arch is
 439 not passed. [Used for finding the versions of binary packages only.]
 440 Defaults to 0, which does not discard the source architecture. (This
 441 may change in the future, so if you care, please code accordingly.)
 442
 443 =item return_archs -- returns a version=>[archs] hash indicating which
 444 architectures are at which versions.
 445
 446 =item largest_source_version_only -- if there is more than one source
 447 version in a particular distribution, discards all versions but the
 448 largest in that distribution. Defaults to 1, as this used to be the
 449 way that the Debian archive worked.
 450
 451 =back
 452
 453 When called in scalar context, this function will return hashrefs or
 454 arrayrefs as appropriate, in list context, it will return paired lists
 455 or unpaired lists as appropriate.
 456
 457 =cut
 458
 459 our %_versions;
 460 our %_versions_time;
 461
 462 sub get_versions{
 463      my %param = validate_with(params => \@_,
 464                                 spec   => {package => {type => SCALAR|ARRAYREF,
 465                                                       },
 466                                            dist    => {type => SCALAR|ARRAYREF,
 467                                                        default => 'unstable',
 468                                                       },
 469                                            arch    => {type => SCALAR|ARRAYREF,
 470                                                        optional => 1,
 471                                                       },
 472                                            time    => {type    => BOOLEAN,
 473                                                        default => 0,
 474                                                       },
 475                                            source  => {type    => BOOLEAN,
 476                                                        default => 0,
 477                                                       },
 478                                            no_source_arch => {type => BOOLEAN,
 479                                                               default => 0,
 480                                                              },
 481                                            return_archs => {type => BOOLEAN,
 482                                                             default => 0,
 483                                                            },
 484                                            largest_source_version_only => {type => BOOLEAN,
 485                                                                        default => 1,
 486                                                                           },
 487                                           },
 488                                );
 489      my $versions;
 490      if ($param{time}) {
 491           return () if not defined $gVersionTimeIndex;
 492           unless (tied %_versions_time) {
 493                tie %_versions_time, 'MLDBM', $gVersionTimeIndex, O_RDONLY
 494                     or die "can't open versions index $gVersionTimeIndex: $!";
 495           }
 496           $versions = \%_versions_time;
 497      }
 498      else {
 499           return () if not defined $gVersionIndex;
 500           unless (tied %_versions) {
 501                tie %_versions, 'MLDBM', $gVersionIndex, O_RDONLY
 502                     or die "can't open versions index $gVersionIndex: $!";
 503           }
 504           $versions = \%_versions;
 505      }
 506      my %versions;
 507      for my $package (make_list($param{package})) {
 508           my $source_only = 0;
 509           if ($package =~ s/^src://) {
 510                $source_only = 1;
 511           }
 512           my $version = $versions->{$package};
 513           next unless defined $version;
 514           for my $dist (make_list($param{dist})) {
 515                for my $arch (exists $param{arch}?
 516                              make_list($param{arch}):
 517                              (grep {not $param{no_source_arch} or
 518                                         $_ ne 'source'
 519                                     } $source_only?'source':keys %{$version->{$dist}})) {
 520                     next unless defined $version->{$dist}{$arch};
 521                     my @vers = ref $version->{$dist}{$arch} eq 'HASH' ?
 522                         keys %{$version->{$dist}{$arch}} :
 523                             make_list($version->{$dist}{$arch});
 524                     if ($param{largest_source_version_only} and
 525                         $arch eq 'source' and @vers > 1) {
 526                         # order the versions, then pick the biggest version number
 527                         @vers = sort_versions(@vers);
 528                         @vers = $vers[-1];
 529                     }
 530                     for my $ver (@vers) {
 531                          my $f_ver = $ver;
 532                          if ($param{source}) {
 533                               ($f_ver) = make_source_versions(package => $package,
 534                                                               arch => $arch,
 535                                                               versions => $ver);
 536                               next unless defined $f_ver;
 537                          }
 538                          if ($param{time}) {
 539                               $versions{$f_ver} = max($versions{$f_ver}||0,$version->{$dist}{$arch}{$ver});
 540                          }
 541                          else {
 542                               push @{$versions{$f_ver}},$arch;
 543                          }
 544                     }
 545                }
 546           }
 547      }
 548      if ($param{time} or $param{return_archs}) {
 549           return wantarray?%versions :\%versions;
 550      }
 551      return wantarray?keys %versions :[keys %versions];
 552 }
 553
 554
 555 =head2 makesourceversions
 556
 557      @{$cgi_var{found}} = makesourceversions($cgi_var{package},undef,@{$cgi_var{found}});
 558
 559 Canonicalize versions into source versions, which have an explicitly
 560 named source package. This is used to cope with source packages whose
 561 names have changed during their history, and with cases where source
 562 version numbers differ from binary version numbers.
 563
 564 =cut
 565
 566 our %_sourceversioncache = ();
 567 sub makesourceversions {
 568     my ($package,$arch,@versions) = @_;
 569     die "Package $package is multiple packages; split on , and call makesourceversions multiple times"
 570          if $package =~ /,/;
 571     return make_source_versions(package => $package,
 572                                 (defined $arch)?(arch => $arch):(),
 573                                 versions => \@versions
 574                                );
 575 }
 576
 577 =head2 make_source_versions
 578
 579      make_source_versions(package => 'foo',
 580                           arch    => 'source',
 581                           versions => '0.1.1',
 582                           guess_source => 1,
 583                           warnings => \$warnings,
 584                          );
 585
 586 An extended version of makesourceversions (which calls this function
 587 internally) that allows for multiple packages, architectures, and
 588 outputs warnings and debugging information to provided SCALARREFs or
 589 HANDLEs.
 590
 591 The guess_source option determines whether the source package is
 592 guessed at if there is no obviously correct package. Things that use
 593 this function for non-transient output should set this to false,
 594 things that use it for transient output can set this to true.
 595 Currently it defaults to true, but that is not a sane option.
 596
 597
 598 =cut
 599
 600 sub make_source_versions {
 601     my %param = validate_with(params => \@_,
 602                               spec   => {package => {type => SCALAR|ARRAYREF,
 603                                                     },
 604                                          arch    => {type => SCALAR|ARRAYREF|UNDEF,
 605                                                      default => ''
 606                                                     },
 607                                          versions => {type => SCALAR|ARRAYREF,
 608                                                       default => [],
 609                                                      },
 610                                          guess_source => {type => BOOLEAN,
 611                                                           default => 1,
 612                                                          },
 613                                          source_version_cache => {type => HASHREF,
 614                                                                   optional => 1,
 615                                                                  },
 616                                          debug    => {type => SCALARREF|HANDLE,
 617                                                       optional => 1,
 618                                                      },
 619                                          warnings => {type => SCALARREF|HANDLE,
 620                                                       optional => 1,
 621                                                      },
 622                                         },
 623                              );
 624     my ($warnings) = globify_scalar(exists $param{warnings}?$param{warnings}:undef);
 625
 626     my @packages = grep {defined $_ and length $_ } make_list($param{package});
 627     my @archs    = grep {defined $_ } make_list ($param{arch});
 628     if (not @archs) {
 629         push @archs, '';
 630     }
 631     if (not exists $param{source_version_cache}) {
 632         $param{source_version_cache} = \%_sourceversioncache;
 633     }
 634     if (grep {/,/} make_list($param{package})) {
 635         croak "Package names contain ,; split on /,/ and call make_source_versions with an arrayref of packages"
 636     }
 637     my %sourceversions;
 638     for my $version (make_list($param{versions})) {
 639         if ($version =~ m{(.+)/([^/]+)$}) {
 640             # Already a source version.
 641             $sourceversions{$version} = 1;
 642             next unless exists $param{warnings};
 643             # check to see if this source version is even possible
 644             my @bin_versions = sourcetobinary($1,$2);
 645             if (not @bin_versions or
 646                 @{$bin_versions[0]} != 3) {
 647                 print {$warnings} "The source $1 and version $2 do not appear to match any binary packages\n";
 648             }
 649         } else {
 650             if (not @packages) {
 651                 croak "You must provide at least one package if the versions are not fully qualified";
 652             }
 653             for my $pkg (@packages) {
 654                 if ($pkg =~ /^src:(.+)/) {
 655                     $sourceversions{"$1/$version"} = 1;
 656                     next unless exists $param{warnings};
 657                     # check to see if this source version is even possible
 658                     my @bin_versions = sourcetobinary($1,$version);
 659                     if (not @bin_versions or
 660                         @{$bin_versions[0]} != 3) {
 661                         print {$warnings} "The source '$1' and version '$version' do not appear to match any binary packages\n";
 662                     }
 663                     next;
 664                 }
 665                 for my $arch (@archs) {
 666                     my $cachearch = (defined $arch) ? $arch : '';
 667                     my $cachekey = "$pkg/$cachearch/$version";
 668                     if (exists($param{source_version_cache}{$cachekey})) {
 669                         for my $v (@{$param{source_version_cache}{$cachekey}}) {
 670                             $sourceversions{$v} = 1;
 671                         }
 672                         next;
 673                     }
 674                     elsif ($param{guess_source} and
 675                            exists$param{source_version_cache}{$cachekey.'/guess'}) {
 676                         for my $v (@{$param{source_version_cache}{$cachekey.'/guess'}}) {
 677                             $sourceversions{$v} = 1;
 678                         }
 679                         next;
 680                     }
 681                     my @srcinfo = binary_to_source(binary => $pkg,
 682                                                    version => $version,
 683                                                    length($arch)?(arch    => $arch):());
 684                     if (not @srcinfo) {
 685                         # We don't have explicit information about the
 686                         # binary-to-source mapping for this version
 687                         # (yet).
 688                         print {$warnings} "There is no source info for the package '$pkg' at version '$version' with architecture '$arch'\n";
 689                         if ($param{guess_source}) {
 690                             # Lets guess it
 691                             my $pkgsrc = getpkgsrc();
 692                             if (exists $pkgsrc->{$pkg}) {
 693                                 @srcinfo = ([$pkgsrc->{$pkg}, $version]);
 694                             } elsif (getsrcpkgs($pkg)) {
 695                                 # If we're looking at a source package
 696                                 # that doesn't have a binary of the
 697                                 # same name, just try the same
 698                                 # version.
 699                                 @srcinfo = ([$pkg, $version]);
 700                             } else {
 701                                 next;
 702                             }
 703                             # store guesses in a slightly different location
 704                             $param{source_version_cache}{$cachekey.'/guess'} = [ map { "$_->[0]/$_->[1]" } @srcinfo ];
 705                         }
 706                     }
 707                     else {
 708                         # only store this if we didn't have to guess it
 709                         $param{source_version_cache}{$cachekey} = [ map { "$_->[0]/$_->[1]" } @srcinfo ];
 710                     }
 711                     $sourceversions{"$_->[0]/$_->[1]"} = 1 foreach @srcinfo;
 712                 }
 713             }
 714         }
 715     }
 716     return sort keys %sourceversions;
 717 }
 718
 719
 720
 721 1;