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 our %_sourcetobinary;
 173 sub binary_to_source{
 174     my %param = validate_with(params => \@_,
 175                               spec   => {binary => {type => SCALAR|ARRAYREF,
 176                                                     },
 177                                          version => {type => SCALAR|ARRAYREF,
 178                                                      optional => 1,
 179                                                     },
 180                                          arch    => {type => SCALAR|ARRAYREF,
 181                                                      optional => 1,
 182                                                     },
 183                                          source_only => {default => 0,
 184                                                         },
 185                                          scalar_only => {default => 0,
 186                                                         },
 187                                          cache => {type => HASHREF,
 188                                                    default => {},
 189                                                   },
 190                                          schema => {type => OBJECT,
 191                                                     optional => 1,
 192                                                    },
 193                                         },
 194                              );
 195
 196     # TODO: This gets hit a lot, especially from buggyversion() - probably
 197     # need an extra cache for speed here.
 198     return () unless defined $gBinarySourceMap or defined $param{schema};
 199
 200     if ($param{scalar_only} or not wantarray) {
 201         $param{source_only} = 1;
 202         $param{scalar_only} = 1;
 203     }
 204
 205     my @source;
 206     my @binaries = grep {defined $_} make_list(exists $param{binary}?$param{binary}:[]);
 207     my @versions = grep {defined $_} make_list(exists $param{version}?$param{version}:[]);
 208     my @archs = grep {defined $_} make_list(exists $param{arch}?$param{arch}:[]);
 209     return () unless @binaries;
 210
 211     # any src:foo is source package foo with unspecified version
 212     @source = map {/^src:(.+)$/?
 213                        [$1,'']:()} @binaries;
 214     @binaries = grep {$_ !~ /^src:/} @binaries;
 215     if ($param{schema}) {
 216         if ($param{source_only}) {
 217             @source = map {$_->[0]} @source;
 218             my $src_rs = $param{schema}->resultset('SrcPkg')->
 219                 search_rs({'binpkg.pkg' => [@binaries],
 220                            @versions?('bin_vers.ver'    => [@versions]):(),
 221                            @archs?('arch.arch' => [@archs]):(),
 222                           },
 223                          {join => {'src_vers'=>
 224                                   {'bin_vers'=> ['arch','bin_pkg']}
 225                                   },
 226                           distinct => 1,
 227                          },
 228                          );
 229             push @source,
 230                 map {$_->pkg} $src_rs->all;
 231             if ($param{scalar_only}) {
 232                 return join(',',@source);
 233             }
 234             return @source;
 235
 236         }
 237         my $src_rs = $param{schema}->resultset('SrcVer')->
 238             search_rs({'bin_pkg.pkg' => [@binaries],
 239                        @versions?('bin_vers.ver' => [@versions]):(),
 240                        @archs?('arch.arch' => [@archs]):(),
 241                       },
 242                      {join => ['src_pkg',
 243                               {'bin_vers' => ['arch','binpkg']},
 244                               ],
 245                       distinct => 1,
 246                      },
 247                      );
 248         push @source,
 249             map {[$_->get_column('src_pkg.pkg'),
 250                   $_->get_column('src_ver.ver'),
 251                  ]} $src_rs->all;
 252         if (not @source and not @versions and not @archs) {
 253             $src_rs = $param{schema}->resultset('SrcPkg')->
 254                 search_rs({pkg => [@binaries]},
 255                          {distinct => 1},
 256                          );
 257             push @source,
 258                 map {[$_->pkg,
 259                      ]} $src_rs->all;
 260         }
 261         return @source;
 262     }
 263     my $cache_key = join("\1",
 264                          join("\0",@binaries),
 265                          join("\0",@versions),
 266                          join("\0",@archs),
 267                          join("\0",@param{qw(source_only scalar_only)}));
 268     if (exists $param{cache}{$cache_key}) {
 269         return $param{scalar_only} ? $param{cache}{$cache_key}[0]:
 270             @{$param{cache}{$cache_key}};
 271     }
 272     for my $binary (@binaries) {
 273         if (not tied %_binarytosource) {
 274             tie %_binarytosource, MLDBM => $config{binary_source_map}, O_RDONLY or
 275                 die "Unable to open $config{binary_source_map} for reading";
 276         }
 277         # avoid autovivification
 278         my $bin = $_binarytosource{$binary};
 279         next unless defined $bin;
 280         if (not @versions) {
 281             for my $ver (keys %{$bin}) {
 282                 for my $ar (keys %{$bin->{$ver}}) {
 283                     my $src = $bin->{$ver}{$ar};
 284                     next unless defined $src;
 285                     push @source,[$src->[0],$src->[1]];
 286                 }
 287             }
 288         }
 289         else {
 290             for my $version (@versions) {
 291                 next unless exists $bin->{$version};
 292                 if (exists $bin->{$version}{all}) {
 293                     push @source,dclone($bin->{$version}{all});
 294                     next;
 295                 }
 296                 my @t_archs;
 297                 if (@archs) {
 298                     @t_archs = @archs;
 299                 }
 300                 else {
 301                     @t_archs = keys %{$bin->{$version}};
 302                 }
 303                 for my $arch (@t_archs) {
 304                     push @source,dclone($bin->{$version}{$arch}) if
 305                         exists $bin->{$version}{$arch};
 306                 }
 307             }
 308         }
 309     }
 310
 311     if (not @source and not @versions and not @archs) {
 312         # ok, we haven't found any results at all. If we weren't given
 313         # a specific version and architecture, then we should try
 314         # really hard to figure out the right source
 315
 316         # if any the packages we've been given are a valid source
 317         # package name, and there's no binary of the same name (we got
 318         # here, so there isn't), return it.
 319
 320         if (not tied %_sourcetobinary) {
 321             tie %_sourcetobinary, MLDBM => $config{source_binary_map}, O_RDONLY or
 322                 die "Unable top open $gSourceBinaryMap for reading";
 323         }
 324         for my $maybe_sourcepkg (@binaries) {
 325             if (exists $_sourcetobinary{$maybe_sourcepkg}) {
 326                 push @source,[$maybe_sourcepkg,$_] for keys %{$_sourcetobinary{$maybe_sourcepkg}};
 327             }
 328         }
 329         # if @source is still empty here, it's probably a non-existant
 330         # source package, so don't return anything.
 331     }
 332
 333     my @result;
 334
 335     if ($param{source_only}) {
 336         my %uniq;
 337         for my $s (@source) {
 338             # we shouldn't need to do this, but do this temporarily to
 339             # stop the warning.
 340             next unless defined $s->[0];
 341             $uniq{$s->[0]} = 1;
 342         }
 343         @result = sort keys %uniq;
 344         if ($param{scalar_only}) {
 345             @result = join(', ',@result);
 346         }
 347     }
 348     else {
 349         my %uniq;
 350         for my $s (@source) {
 351             $uniq{$s->[0]}{$s->[1]} = 1;
 352         }
 353         for my $sn (sort keys %uniq) {
 354             push @result, [$sn, $_] for sort keys %{$uniq{$sn}};
 355         }
 356     }
 357
 358     # No $gBinarySourceMap, or it didn't have an entry for this name and
 359     # version.
 360     $param{cache}{$cache_key} = \@result;
 361     return $param{scalar_only} ? $result[0] : @result;
 362 }
 363
 364 =head2 sourcetobinary
 365
 366 Returns a list of references to triplets of binary package names, versions,
 367 and architectures corresponding to a given source package name and version.
 368 If the given source package name and version cannot be found in the database
 369 but the source package name is in the unversioned package-to-source map
 370 file, then a reference to a binary package name and version pair will be
 371 returned, without the architecture.
 372
 373 =cut
 374
 375 sub sourcetobinary {
 376     my ($srcname, $srcver) = @_;
 377
 378     if (not tied %_sourcetobinary) {
 379         tie %_sourcetobinary, MLDBM => $config{source_binary_map}, O_RDONLY or
 380             die "Unable top open $config{source_binary_map} for reading";
 381     }
 382
 383
 384
 385     # avoid autovivification
 386     my $source = $_sourcetobinary{$srcname};
 387     return () unless defined $source;
 388     if (exists $source->{$srcver}) {
 389          my $bin = $source->{$srcver};
 390          return () unless defined $bin;
 391          return @$bin;
 392     }
 393     # No $gSourceBinaryMap, or it didn't have an entry for this name and
 394     # version. Try $gPackageSource (unversioned) instead.
 395     my @srcpkgs = getsrcpkgs($srcname);
 396     return map [$_, $srcver], @srcpkgs;
 397 }
 398
 399 =head2 getversions
 400
 401 Returns versions of the package in a distribution at a specific
 402 architecture
 403
 404 =cut
 405
 406 sub getversions {
 407     my ($pkg, $dist, $arch) = @_;
 408     return get_versions(package=>$pkg,
 409                         dist => $dist,
 410                         defined $arch ? (arch => $arch):(),
 411                        );
 412 }
 413
 414
 415
 416 =head2 get_versions
 417
 418      get_versions(package=>'foopkg',
 419                   dist => 'unstable',
 420                   arch => 'i386',
 421                  );
 422
 423 Returns a list of the versions of package in the distributions and
 424 architectures listed. This routine only returns unique values.
 425
 426 =over
 427
 428 =item package -- package to return list of versions
 429
 430 =item dist -- distribution (unstable, stable, testing); can be an
 431 arrayref
 432
 433 =item arch -- architecture (i386, source, ...); can be an arrayref
 434
 435 =item time -- returns a version=>time hash at which the newest package
 436 matching this version was uploaded
 437
 438 =item source -- returns source/version instead of just versions
 439
 440 =item no_source_arch -- discards the source architecture when arch is
 441 not passed. [Used for finding the versions of binary packages only.]
 442 Defaults to 0, which does not discard the source architecture. (This
 443 may change in the future, so if you care, please code accordingly.)
 444
 445 =item return_archs -- returns a version=>[archs] hash indicating which
 446 architectures are at which versions.
 447
 448 =item largest_source_version_only -- if there is more than one source
 449 version in a particular distribution, discards all versions but the
 450 largest in that distribution. Defaults to 1, as this used to be the
 451 way that the Debian archive worked.
 452
 453 =back
 454
 455 When called in scalar context, this function will return hashrefs or
 456 arrayrefs as appropriate, in list context, it will return paired lists
 457 or unpaired lists as appropriate.
 458
 459 =cut
 460
 461 our %_versions;
 462 our %_versions_time;
 463
 464 sub get_versions{
 465      my %param = validate_with(params => \@_,
 466                                 spec   => {package => {type => SCALAR|ARRAYREF,
 467                                                       },
 468                                            dist    => {type => SCALAR|ARRAYREF,
 469                                                        default => 'unstable',
 470                                                       },
 471                                            arch    => {type => SCALAR|ARRAYREF,
 472                                                        optional => 1,
 473                                                       },
 474                                            time    => {type    => BOOLEAN,
 475                                                        default => 0,
 476                                                       },
 477                                            source  => {type    => BOOLEAN,
 478                                                        default => 0,
 479                                                       },
 480                                            no_source_arch => {type => BOOLEAN,
 481                                                               default => 0,
 482                                                              },
 483                                            return_archs => {type => BOOLEAN,
 484                                                             default => 0,
 485                                                            },
 486                                            largest_source_version_only => {type => BOOLEAN,
 487                                                                        default => 1,
 488                                                                           },
 489                                           },
 490                                );
 491      my $versions;
 492      if ($param{time}) {
 493           return () if not defined $gVersionTimeIndex;
 494           unless (tied %_versions_time) {
 495                tie %_versions_time, 'MLDBM', $gVersionTimeIndex, O_RDONLY
 496                     or die "can't open versions index $gVersionTimeIndex: $!";
 497           }
 498           $versions = \%_versions_time;
 499      }
 500      else {
 501           return () if not defined $gVersionIndex;
 502           unless (tied %_versions) {
 503                tie %_versions, 'MLDBM', $gVersionIndex, O_RDONLY
 504                     or die "can't open versions index $gVersionIndex: $!";
 505           }
 506           $versions = \%_versions;
 507      }
 508      my %versions;
 509      for my $package (make_list($param{package})) {
 510           my $source_only = 0;
 511           if ($package =~ s/^src://) {
 512                $source_only = 1;
 513           }
 514           my $version = $versions->{$package};
 515           next unless defined $version;
 516           for my $dist (make_list($param{dist})) {
 517                for my $arch (exists $param{arch}?
 518                              make_list($param{arch}):
 519                              (grep {not $param{no_source_arch} or
 520                                         $_ ne 'source'
 521                                     } $source_only?'source':keys %{$version->{$dist}})) {
 522                     next unless defined $version->{$dist}{$arch};
 523                     my @vers = ref $version->{$dist}{$arch} eq 'HASH' ?
 524                         keys %{$version->{$dist}{$arch}} :
 525                             make_list($version->{$dist}{$arch});
 526                     if ($param{largest_source_version_only} and
 527                         $arch eq 'source' and @vers > 1) {
 528                         # order the versions, then pick the biggest version number
 529                         @vers = sort_versions(@vers);
 530                         @vers = $vers[-1];
 531                     }
 532                     for my $ver (@vers) {
 533                          my $f_ver = $ver;
 534                          if ($param{source}) {
 535                               ($f_ver) = make_source_versions(package => $package,
 536                                                               arch => $arch,
 537                                                               versions => $ver);
 538                               next unless defined $f_ver;
 539                          }
 540                          if ($param{time}) {
 541                               $versions{$f_ver} = max($versions{$f_ver}||0,$version->{$dist}{$arch}{$ver});
 542                          }
 543                          else {
 544                               push @{$versions{$f_ver}},$arch;
 545                          }
 546                     }
 547                }
 548           }
 549      }
 550      if ($param{time} or $param{return_archs}) {
 551           return wantarray?%versions :\%versions;
 552      }
 553      return wantarray?keys %versions :[keys %versions];
 554 }
 555
 556
 557 =head2 makesourceversions
 558
 559      @{$cgi_var{found}} = makesourceversions($cgi_var{package},undef,@{$cgi_var{found}});
 560
 561 Canonicalize versions into source versions, which have an explicitly
 562 named source package. This is used to cope with source packages whose
 563 names have changed during their history, and with cases where source
 564 version numbers differ from binary version numbers.
 565
 566 =cut
 567
 568 our %_sourceversioncache = ();
 569 sub makesourceversions {
 570     my ($package,$arch,@versions) = @_;
 571     die "Package $package is multiple packages; split on , and call makesourceversions multiple times"
 572          if $package =~ /,/;
 573     return make_source_versions(package => $package,
 574                                 (defined $arch)?(arch => $arch):(),
 575                                 versions => \@versions
 576                                );
 577 }
 578
 579 =head2 make_source_versions
 580
 581      make_source_versions(package => 'foo',
 582                           arch    => 'source',
 583                           versions => '0.1.1',
 584                           guess_source => 1,
 585                           warnings => \$warnings,
 586                          );
 587
 588 An extended version of makesourceversions (which calls this function
 589 internally) that allows for multiple packages, architectures, and
 590 outputs warnings and debugging information to provided SCALARREFs or
 591 HANDLEs.
 592
 593 The guess_source option determines whether the source package is
 594 guessed at if there is no obviously correct package. Things that use
 595 this function for non-transient output should set this to false,
 596 things that use it for transient output can set this to true.
 597 Currently it defaults to true, but that is not a sane option.
 598
 599
 600 =cut
 601
 602 sub make_source_versions {
 603     my %param = validate_with(params => \@_,
 604                               spec   => {package => {type => SCALAR|ARRAYREF,
 605                                                     },
 606                                          arch    => {type => SCALAR|ARRAYREF|UNDEF,
 607                                                      default => ''
 608                                                     },
 609                                          versions => {type => SCALAR|ARRAYREF,
 610                                                       default => [],
 611                                                      },
 612                                          guess_source => {type => BOOLEAN,
 613                                                           default => 1,
 614                                                          },
 615                                          source_version_cache => {type => HASHREF,
 616                                                                   optional => 1,
 617                                                                  },
 618                                          debug    => {type => SCALARREF|HANDLE,
 619                                                       optional => 1,
 620                                                      },
 621                                          warnings => {type => SCALARREF|HANDLE,
 622                                                       optional => 1,
 623                                                      },
 624                                         },
 625                              );
 626     my ($warnings) = globify_scalar(exists $param{warnings}?$param{warnings}:undef);
 627
 628     my @packages = grep {defined $_ and length $_ } make_list($param{package});
 629     my @archs    = grep {defined $_ } make_list ($param{arch});
 630     if (not @archs) {
 631         push @archs, '';
 632     }
 633     if (not exists $param{source_version_cache}) {
 634         $param{source_version_cache} = \%_sourceversioncache;
 635     }
 636     if (grep {/,/} make_list($param{package})) {
 637         croak "Package names contain ,; split on /,/ and call make_source_versions with an arrayref of packages"
 638     }
 639     my %sourceversions;
 640     for my $version (make_list($param{versions})) {
 641         if ($version =~ m{(.+)/([^/]+)$}) {
 642             # Already a source version.
 643             $sourceversions{$version} = 1;
 644             next unless exists $param{warnings};
 645             # check to see if this source version is even possible
 646             my @bin_versions = sourcetobinary($1,$2);
 647             if (not @bin_versions or
 648                 @{$bin_versions[0]} != 3) {
 649                 print {$warnings} "The source $1 and version $2 do not appear to match any binary packages\n";
 650             }
 651         } else {
 652             if (not @packages) {
 653                 croak "You must provide at least one package if the versions are not fully qualified";
 654             }
 655             for my $pkg (@packages) {
 656                 if ($pkg =~ /^src:(.+)/) {
 657                     $sourceversions{"$1/$version"} = 1;
 658                     next unless exists $param{warnings};
 659                     # check to see if this source version is even possible
 660                     my @bin_versions = sourcetobinary($1,$version);
 661                     if (not @bin_versions or
 662                         @{$bin_versions[0]} != 3) {
 663                         print {$warnings} "The source '$1' and version '$version' do not appear to match any binary packages\n";
 664                     }
 665                     next;
 666                 }
 667                 for my $arch (@archs) {
 668                     my $cachearch = (defined $arch) ? $arch : '';
 669                     my $cachekey = "$pkg/$cachearch/$version";
 670                     if (exists($param{source_version_cache}{$cachekey})) {
 671                         for my $v (@{$param{source_version_cache}{$cachekey}}) {
 672                             $sourceversions{$v} = 1;
 673                         }
 674                         next;
 675                     }
 676                     elsif ($param{guess_source} and
 677                            exists$param{source_version_cache}{$cachekey.'/guess'}) {
 678                         for my $v (@{$param{source_version_cache}{$cachekey.'/guess'}}) {
 679                             $sourceversions{$v} = 1;
 680                         }
 681                         next;
 682                     }
 683                     my @srcinfo = binary_to_source(binary => $pkg,
 684                                                    version => $version,
 685                                                    length($arch)?(arch    => $arch):());
 686                     if (not @srcinfo) {
 687                         # We don't have explicit information about the
 688                         # binary-to-source mapping for this version
 689                         # (yet).
 690                         print {$warnings} "There is no source info for the package '$pkg' at version '$version' with architecture '$arch'\n";
 691                         if ($param{guess_source}) {
 692                             # Lets guess it
 693                             my $pkgsrc = getpkgsrc();
 694                             if (exists $pkgsrc->{$pkg}) {
 695                                 @srcinfo = ([$pkgsrc->{$pkg}, $version]);
 696                             } elsif (getsrcpkgs($pkg)) {
 697                                 # If we're looking at a source package
 698                                 # that doesn't have a binary of the
 699                                 # same name, just try the same
 700                                 # version.
 701                                 @srcinfo = ([$pkg, $version]);
 702                             } else {
 703                                 next;
 704                             }
 705                             # store guesses in a slightly different location
 706                             $param{source_version_cache}{$cachekey.'/guess'} = [ map { "$_->[0]/$_->[1]" } @srcinfo ];
 707                         }
 708                     }
 709                     else {
 710                         # only store this if we didn't have to guess it
 711                         $param{source_version_cache}{$cachekey} = [ map { "$_->[0]/$_->[1]" } @srcinfo ];
 712                     }
 713                     $sourceversions{"$_->[0]/$_->[1]"} = 1 foreach @srcinfo;
 714                 }
 715             }
 716         }
 717     }
 718     return sort keys %sourceversions;
 719 }
 720
 721
 722
 723 1;