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.
6 # [Other people have contributed to this file; their copyrights should
8 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
10 package Debbugs::Packages;
15 use Exporter qw(import);
16 use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS @EXPORT);
20 use Debbugs::Config qw(:config :globals);
26 %EXPORT_TAGS = (versions => [qw(getversions get_versions make_source_versions)],
27 mapping => [qw(getpkgsrc getpkgcomponent getsrcpkgs),
28 qw(binary_to_source sourcetobinary makesourceversions),
33 Exporter::export_ok_tags(qw(versions mapping));
34 $EXPORT_TAGS{all} = [@EXPORT_OK];
37 use Fcntl qw(O_RDONLY);
38 use MLDBM qw(DB_File Storable);
39 use Storable qw(dclone);
40 use Params::Validate qw(validate_with :types);
41 use Debbugs::Common qw(make_list globify_scalar sort_versions);
42 use DateTime::Format::Pg;
43 use List::AllUtils qw(min max uniq);
47 $MLDBM::DumpMeth = 'portable';
48 $MLDBM::RemoveTaint = 1;
52 Debbugs::Packages - debbugs binary/source package handling
56 The Debbugs::Packages module provides support functions to map binary
57 packages to their corresponding source packages and vice versa. (This makes
58 sense for software distributions, where developers may work on a single
59 source package which produces several binary packages for use by users; it
60 may not make sense in other contexts.)
66 Returns a reference to a hash of binary package names to their corresponding
75 return $_pkgsrc if $_pkgsrc;
76 return {} unless defined $config{package_source} and
77 length $config{package_source};
82 my $fh = IO::File->new($config{package_source},'r')
83 or croak("Unable to open $config{package_source} for reading: $!");
85 next unless m/^(\S+)\s+(\S+)\s+(\S.*\S)\s*$/;
86 my ($bin,$cmp,$src)=($1,$2,$3);
89 push @{$srcpkg{$src}}, $bin;
90 $pkgcomponent{$bin}= $cmp;
94 $_pkgcomponent = \%pkgcomponent;
99 =head2 getpkgcomponent
101 Returns a reference to a hash of binary package names to the component of
102 the archive containing those binary packages (e.g. "main", "contrib",
107 sub getpkgcomponent {
108 return $_pkgcomponent if $_pkgcomponent;
110 return $_pkgcomponent;
115 Returns a list of the binary packages produced by a given source package.
121 getpkgsrc() if not defined $_srcpkg;
122 return () if not defined $src or not exists $_srcpkg->{$src};
123 return @{$_srcpkg->{$src}};
126 =head2 binary_to_source
128 binary_to_source(package => 'foo',
133 Turn a binary package (at optional version in optional architecture)
134 into a single (or set) of source packages (optionally) with associated
137 By default, in LIST context, returns a LIST of array refs of source
138 package, source version pairs corresponding to the binary package(s),
139 arch(s), and verion(s) passed.
141 In SCALAR context, only the corresponding source packages are
142 returned, concatenated with ', ' if necessary.
144 If no source can be found, returns undef in scalar context, or the
145 empty list in list context.
149 =item binary -- binary package name(s) as a SCALAR or ARRAYREF
151 =item version -- binary package version(s) as a SCALAR or ARRAYREF;
152 optional, defaults to all versions.
154 =item arch -- binary package architecture(s) as a SCALAR or ARRAYREF;
155 optional, defaults to all architectures.
157 =item source_only -- return only the source name (forced on if in
158 SCALAR context), defaults to false.
160 =item scalar_only -- return a scalar only (forced true if in SCALAR
161 context, also causes source_only to be true), defaults to false.
163 =item cache -- optional HASHREF to be used to cache results of
170 # the two global variables below are used to tie the source maps; we
171 # probably should be retying them in long lived processes.
172 our %_binarytosource;
173 sub _tie_binarytosource {
174 if (not tied %_binarytosource) {
175 tie %_binarytosource, MLDBM => $config{binary_source_map}, O_RDONLY or
176 die "Unable to open $config{binary_source_map} for reading";
179 our %_sourcetobinary;
180 sub _tie_sourcetobinary {
181 if (not tied %_sourcetobinary) {
182 tie %_sourcetobinary, MLDBM => $config{source_binary_map}, O_RDONLY or
183 die "Unable to open $config{source_binary_map} for reading";
186 sub binary_to_source{
187 my %param = validate_with(params => \@_,
188 spec => {binary => {type => SCALAR|ARRAYREF,
190 version => {type => SCALAR|ARRAYREF,
193 arch => {type => SCALAR|ARRAYREF,
196 source_only => {default => 0,
198 scalar_only => {default => 0,
200 cache => {type => HASHREF,
203 schema => {type => OBJECT,
209 # TODO: This gets hit a lot, especially from buggyversion() - probably
210 # need an extra cache for speed here.
211 return () unless defined $gBinarySourceMap or defined $param{schema};
213 if ($param{scalar_only} or not wantarray) {
214 $param{source_only} = 1;
215 $param{scalar_only} = 1;
219 my @binaries = grep {defined $_} make_list(exists $param{binary}?$param{binary}:[]);
220 my @versions = grep {defined $_} make_list(exists $param{version}?$param{version}:[]);
221 my @archs = grep {defined $_} make_list(exists $param{arch}?$param{arch}:[]);
222 return () unless @binaries;
224 my $cache_key = join("\1",
225 join("\0",@binaries),
226 join("\0",@versions),
228 join("\0",@param{qw(source_only scalar_only)}));
229 if (exists $param{cache}{$cache_key}) {
230 return $param{scalar_only} ? $param{cache}{$cache_key}[0]:
231 @{$param{cache}{$cache_key}};
233 # any src:foo is source package foo with unspecified version
234 @source = map {/^src:(.+)$/?
235 [$1,'']:()} @binaries;
236 @binaries = grep {$_ !~ /^src:/} @binaries;
237 if ($param{schema}) {
238 if ($param{source_only}) {
239 @source = map {$_->[0]} @source;
240 my $src_rs = $param{schema}->resultset('SrcPkg')->
241 search_rs({'bin_pkg.pkg' => [@binaries],
242 @versions?('bin_vers.ver' => [@versions]):(),
243 @archs?('arch.arch' => [@archs]):(),
245 {join => {'src_vers'=>
246 {'bin_vers'=> ['arch','bin_pkg']}
248 columns => [qw(pkg)],
249 order_by => [qw(pkg)],
250 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
255 map {$_->{pkg}} $src_rs->all;
256 if ($param{scalar_only}) {
257 @source = join(',',@source);
259 $param{cache}{$cache_key} = \@source;
260 return $param{scalar_only}?$source[0]:@source;
262 my $src_rs = $param{schema}->resultset('SrcVer')->
263 search_rs({'bin_pkg.pkg' => [@binaries],
264 @versions?('bin_vers.ver' => [@versions]):(),
265 @archs?('arch.arch' => [@archs]):(),
268 {'bin_vers' => ['arch','binpkg']},
270 columns => ['src_pkg.pkg','src_ver.ver'],
271 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
272 order_by => ['src_pkg.pkg','src_ver.ver'],
277 map {[$_->{src_pkg}{pkg},
280 if (not @source and not @versions and not @archs) {
281 $src_rs = $param{schema}->resultset('SrcPkg')->
282 search_rs({pkg => [@binaries]},
283 {join => ['src_vers'],
284 columns => ['src_pkg.pkg','src_vers.ver'],
289 map {[$_->{src_pkg}{pkg},
293 $param{cache}{$cache_key} = \@source;
294 return $param{scalar_only}?$source[0]:@source;
296 for my $binary (@binaries) {
298 # avoid autovivification
299 my $bin = $_binarytosource{$binary};
300 next unless defined $bin;
302 for my $ver (keys %{$bin}) {
303 for my $ar (keys %{$bin->{$ver}}) {
304 my $src = $bin->{$ver}{$ar};
305 next unless defined $src;
306 push @source,[$src->[0],$src->[1]];
311 for my $version (@versions) {
312 next unless exists $bin->{$version};
313 if (exists $bin->{$version}{all}) {
314 push @source,dclone($bin->{$version}{all});
322 @t_archs = keys %{$bin->{$version}};
324 for my $arch (@t_archs) {
325 push @source,dclone($bin->{$version}{$arch}) if
326 exists $bin->{$version}{$arch};
332 if (not @source and not @versions and not @archs) {
333 # ok, we haven't found any results at all. If we weren't given
334 # a specific version and architecture, then we should try
335 # really hard to figure out the right source
337 # if any the packages we've been given are a valid source
338 # package name, and there's no binary of the same name (we got
339 # here, so there isn't), return it.
340 _tie_sourcetobinary();
341 for my $maybe_sourcepkg (@binaries) {
342 if (exists $_sourcetobinary{$maybe_sourcepkg}) {
343 push @source,[$maybe_sourcepkg,$_] for keys %{$_sourcetobinary{$maybe_sourcepkg}};
346 # if @source is still empty here, it's probably a non-existant
347 # source package, so don't return anything.
352 if ($param{source_only}) {
354 for my $s (@source) {
355 # we shouldn't need to do this, but do this temporarily to
357 next unless defined $s->[0];
360 @result = sort keys %uniq;
361 if ($param{scalar_only}) {
362 @result = join(', ',@result);
367 for my $s (@source) {
368 $uniq{$s->[0]}{$s->[1]} = 1;
370 for my $sn (sort keys %uniq) {
371 push @result, [$sn, $_] for sort keys %{$uniq{$sn}};
375 # No $gBinarySourceMap, or it didn't have an entry for this name and
377 $param{cache}{$cache_key} = \@result;
378 return $param{scalar_only} ? $result[0] : @result;
381 =head2 source_to_binary
383 source_to_binary(package => 'foo',
388 Turn a source package (at optional version) into a single (or set) of all binary
389 packages (optionally) with associated versions.
391 By default, in LIST context, returns a LIST of array refs of binary package,
392 binary version, architecture triples corresponding to the source package(s) and
395 In SCALAR context, only the corresponding binary packages are returned,
396 concatenated with ', ' if necessary.
398 If no binaries can be found, returns undef in scalar context, or the
399 empty list in list context.
403 =item source -- source package name(s) as a SCALAR or ARRAYREF
405 =item version -- binary package version(s) as a SCALAR or ARRAYREF;
406 optional, defaults to all versions.
408 =item dist -- list of distributions to return corresponding binary packages for
409 as a SCALAR or ARRAYREF.
411 =item binary_only -- return only the source name (forced on if in SCALAR
412 context), defaults to false. [If in LIST context, returns a list of binary
415 =item scalar_only -- return a scalar only (forced true if in SCALAR
416 context, also causes binary_only to be true), defaults to false.
418 =item cache -- optional HASHREF to be used to cache results of
425 # the two global variables below are used to tie the source maps; we
426 # probably should be retying them in long lived processes.
427 sub source_to_binary{
428 my %param = validate_with(params => \@_,
429 spec => {source => {type => SCALAR|ARRAYREF,
431 version => {type => SCALAR|ARRAYREF,
434 dist => {type => SCALAR|ARRAYREF,
437 binary_only => {default => 0,
439 scalar_only => {default => 0,
441 cache => {type => HASHREF,
444 schema => {type => OBJECT,
449 if (not defined $config{source_binary_map} and
450 not defined $param{schema}
455 if ($param{scalar_only} or not wantarray) {
456 $param{binary_only} = 1;
457 $param{scalar_only} = 1;
461 my @sources = sort grep {defined $_}
462 make_list(exists $param{source}?$param{source}:[]);
463 my @versions = sort grep {defined $_}
464 make_list(exists $param{version}?$param{version}:[]);
465 return () unless @sources;
467 # any src:foo is source package foo with unspecified version
468 @sources = map {s/^src://; $_} @sources;
469 if ($param{schema}) {
470 if ($param{binary_only}) {
471 my $bin_rs = $param{schema}->resultset('BinPkg')->
472 search_rs({'src_pkg.pkg' => [@sources],
473 @versions?('src_ver.ver' => [@versions]):(),
475 {join => {'bin_vers'=>
476 {'src_ver'=> 'src_pkg'}
478 columns => [qw(pkg)],
479 order_by => [qw(pkg)],
480 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
484 if (exists $param{dist}) {
487 {'suite.codename' => [make_list($param{dist})],
488 'suite.suite_name' => [make_list($param{dist})],
490 {join => {'bin_vers' =>
491 {'bin_associations' =>
497 map {$_->{pkg}} $bin_rs->all;
498 if ($param{scalar_only}) {
499 return join(', ',@binaries);
504 my $src_rs = $param{schema}->resultset('BinVer')->
505 search_rs({'src_pkg.pkg' => [@sources],
506 @versions?('src_ver.ver' => [@versions]):(),
510 {'src_ver' => ['src_pkg']},
512 columns => ['src_pkg.pkg','src_ver.ver','arch.arch'],
513 order_by => ['src_pkg.pkg','src_ver.ver','arch.arch'],
514 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
519 map {[$_->{src_pkg}{pkg},
524 if (not @binaries and not @versions) {
525 $src_rs = $param{schema}->resultset('BinPkg')->
526 search_rs({pkg => [@sources]},
527 {join => {'bin_vers' =>
529 {'src_ver'=>'src_pkg'}],
532 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
533 columns => ['src_pkg.pkg','src_ver.ver','arch.arch'],
534 order_by => ['src_pkg.pkg','src_ver.ver','arch.arch'],
538 map {[$_->{src_pkg}{pkg},
545 my $cache_key = join("\1",
547 join("\0",@versions),
548 join("\0",@param{qw(binary_only scalar_only)}));
549 if (exists $param{cache}{$cache_key}) {
550 return $param{scalar_only} ? $param{cache}{$cache_key}[0]:
551 @{$param{cache}{$cache_key}};
555 if ($param{binary_only}) {
556 for my $source (@sources) {
558 # avoid autovivification
559 my $src = $_sourcetobinary{$source};
560 if (not defined $src) {
563 if (exists $_binarytosource{$source}) {
564 $binaries{$source} = 1;
568 my @src_vers = @versions;
570 @src_vers = keys %{$src};
572 for my $ver (@src_vers) {
573 $binaries{$_->[0]} = 1
574 foreach @{$src->{$ver}//[]};
577 # return if we have any results.
578 @return = sort keys %binaries;
579 if ($param{scalar_only}) {
580 @return = join(', ',@return);
584 for my $source (@sources) {
586 my $src = $_sourcetobinary{$source};
587 # there isn't a source package, so return this as a binary packages if a
588 # version hasn't been specified
589 if (not defined $src) {
592 if (exists $_binarytosource{$source}) {
593 my $bin = $_binarytosource{$source};
594 for my $ver (keys %{$bin}) {
595 for my $arch (keys %{$bin->{$ver}}) {
596 $binaries{$bin}{$ver}{$arch} = 1;
602 for my $bin_ver_archs (values %{$src}) {
603 for my $bva (@{$bin_ver_archs}) {
604 $binaries{$bva->[0]}{$bva->[1]}{$bva->[2]} = 1;
608 for my $bin (sort keys %binaries) {
609 for my $ver (sort keys %{$binaries{$bin}}) {
610 for my $arch (sort keys %{$binaries{$bin}{$ver}}) {
617 $param{cache}{$cache_key} = \@return;
618 return $param{scalar_only} ? $return[0] : @return;
622 =head2 sourcetobinary
624 Returns a list of references to triplets of binary package names, versions,
625 and architectures corresponding to a given source package name and version.
626 If the given source package name and version cannot be found in the database
627 but the source package name is in the unversioned package-to-source map
628 file, then a reference to a binary package name and version pair will be
629 returned, without the architecture.
634 my ($srcname, $srcver) = @_;
636 # avoid autovivification
637 my $source = $_sourcetobinary{$srcname};
638 return () unless defined $source;
639 if (exists $source->{$srcver}) {
640 my $bin = $source->{$srcver};
641 return () unless defined $bin;
644 # No $gSourceBinaryMap, or it didn't have an entry for this name and
645 # version. Try $gPackageSource (unversioned) instead.
646 my @srcpkgs = getsrcpkgs($srcname);
647 return map [$_, $srcver], @srcpkgs;
652 Returns versions of the package in a distribution at a specific
658 my ($pkg, $dist, $arch) = @_;
659 return get_versions(package=>$pkg,
661 defined $arch ? (arch => $arch):(),
669 get_versions(package=>'foopkg',
674 Returns a list of the versions of package in the distributions and
675 architectures listed. This routine only returns unique values.
679 =item package -- package to return list of versions
681 =item dist -- distribution (unstable, stable, testing); can be an
684 =item arch -- architecture (i386, source, ...); can be an arrayref
686 =item time -- returns a version=>time hash at which the newest package
687 matching this version was uploaded
689 =item source -- returns source/version instead of just versions
691 =item no_source_arch -- discards the source architecture when arch is
692 not passed. [Used for finding the versions of binary packages only.]
693 Defaults to 0, which does not discard the source architecture. (This
694 may change in the future, so if you care, please code accordingly.)
696 =item return_archs -- returns a version=>[archs] hash indicating which
697 architectures are at which versions.
699 =item largest_source_version_only -- if there is more than one source
700 version in a particular distribution, discards all versions but the
701 largest in that distribution. Defaults to 1, as this used to be the
702 way that the Debian archive worked.
706 When called in scalar context, this function will return hashrefs or
707 arrayrefs as appropriate, in list context, it will return paired lists
708 or unpaired lists as appropriate.
716 my %param = validate_with(params => \@_,
717 spec => {package => {type => SCALAR|ARRAYREF,
719 dist => {type => SCALAR|ARRAYREF,
720 default => 'unstable',
722 arch => {type => SCALAR|ARRAYREF,
725 time => {type => BOOLEAN,
728 source => {type => BOOLEAN,
731 no_source_arch => {type => BOOLEAN,
734 return_archs => {type => BOOLEAN,
737 largest_source_version_only => {type => BOOLEAN,
740 schema => {type => OBJECT,
745 if (defined $param{schema}) {
748 for my $pkg (make_list($param{package})) {
749 if ($pkg =~ /^src:(.+)/) {
753 push @bin_packages,$pkg;
757 my $s = $param{schema};
762 my $src_rs = $s->resultset('SrcVer')->
763 search({'src_pkg.pkg'=>[@src_packages],
764 -or => {'suite.codename' => [make_list($param{dist})],
765 'suite.suite_name' => [make_list($param{dist})],
770 src_associations=>'suite'},
772 '+select' => [qw(src_pkg.pkg),
774 qw(src_associations.modified),
775 q(CONCAT(src_pkg.pkg,'/',me.ver))],
776 '+as' => ['src_pkg_name','codename',
779 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
780 order_by => {-desc => 'me.ver'},
784 for my $src ($src_rs->all()) {
787 $val = DateTime::Format::Pg->
788 parse_datetime($src->{modified_time})->
791 if ($param{largest_source_version_only}) {
792 next if $completed_dists{$src->{codename}};
793 $completed_dists{$src->{codename}} = 1;
795 if ($param{source}) {
796 $return{$src->{src_pkg_ver}} = $val;
798 $return{$src->{ver}} = $val;
803 my $bin_rs = $s->resultset('BinVer')->
804 search({'bin_pkg.pkg' => [@bin_packages],
805 -or => {'suite.codename' => [make_list($param{dist})],
806 'suite.suite_name' => [make_list($param{dist})],
811 'src_ver'=>'src_pkg'},
813 bin_associations => 'suite'},
816 '+select' => [qw(bin_pkg.pkg arch.arch suite.codename),
817 qw(bin_associations.modified),
818 qw(src_pkg.pkg),q(CONCAT(src_pkg.pkg,'/',me.ver)),
820 '+as' => ['bin_pkg','arch','codename',
822 'src_pkg_name','src_pkg_ver'],
823 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
824 order_by => {-desc => 'src_ver.ver'},
826 if (exists $param{arch}) {
828 $bin_rs->search({'arch.arch' => [make_list($param{arch})]},
834 for my $bin ($bin_rs->all()) {
835 my $key = $bin->{ver};
836 if ($param{source}) {
837 $key = $bin->{src_pkg_ver};
839 my $val = $bin->{arch};
841 $val = DateTime::Format::Pg->
842 parse_datetime($bin->{modified_time})->
845 if ($param{largest_source_version_only}) {
846 if ($completed_dists{$bin->{codename}} and not
847 exists $return{$key}) {
850 $completed_dists{$bin->{codename}} = 1;
852 push @{$return{$key}},
856 if ($param{return_archs}) {
857 if ($param{time} or $param{return_archs}) {
858 return wantarray?%return :\%return;
860 return wantarray?keys %return :[keys %return];
865 return () if not defined $gVersionTimeIndex;
866 unless (tied %_versions_time) {
867 tie %_versions_time, 'MLDBM', $gVersionTimeIndex, O_RDONLY
868 or die "can't open versions index $gVersionTimeIndex: $!";
870 $versions = \%_versions_time;
873 return () if not defined $gVersionIndex;
874 unless (tied %_versions) {
875 tie %_versions, 'MLDBM', $gVersionIndex, O_RDONLY
876 or die "can't open versions index $gVersionIndex: $!";
878 $versions = \%_versions;
881 for my $package (make_list($param{package})) {
883 if ($package =~ s/^src://) {
886 my $version = $versions->{$package};
887 next unless defined $version;
888 for my $dist (make_list($param{dist})) {
889 for my $arch (exists $param{arch}?
890 make_list($param{arch}):
891 (grep {not $param{no_source_arch} or
893 } $source_only?'source':keys %{$version->{$dist}})) {
894 next unless defined $version->{$dist}{$arch};
895 my @vers = ref $version->{$dist}{$arch} eq 'HASH' ?
896 keys %{$version->{$dist}{$arch}} :
897 make_list($version->{$dist}{$arch});
898 if ($param{largest_source_version_only} and
899 $arch eq 'source' and @vers > 1) {
900 # order the versions, then pick the biggest version number
901 @vers = sort_versions(@vers);
904 for my $ver (@vers) {
906 if ($param{source}) {
907 ($f_ver) = make_source_versions(package => $package,
910 next unless defined $f_ver;
913 $versions{$f_ver} = max($versions{$f_ver}||0,$version->{$dist}{$arch}{$ver});
916 push @{$versions{$f_ver}},$arch;
922 if ($param{time} or $param{return_archs}) {
923 return wantarray?%versions :\%versions;
925 return wantarray?keys %versions :[keys %versions];
929 =head2 makesourceversions
931 @{$cgi_var{found}} = makesourceversions($cgi_var{package},undef,@{$cgi_var{found}});
933 Canonicalize versions into source versions, which have an explicitly
934 named source package. This is used to cope with source packages whose
935 names have changed during their history, and with cases where source
936 version numbers differ from binary version numbers.
940 our %_sourceversioncache = ();
941 sub makesourceversions {
942 my ($package,$arch,@versions) = @_;
943 die "Package $package is multiple packages; split on , and call makesourceversions multiple times"
945 return make_source_versions(package => $package,
946 (defined $arch)?(arch => $arch):(),
947 versions => \@versions
951 =head2 make_source_versions
953 make_source_versions(package => 'foo',
957 warnings => \$warnings,
960 An extended version of makesourceversions (which calls this function
961 internally) that allows for multiple packages, architectures, and
962 outputs warnings and debugging information to provided SCALARREFs or
965 The guess_source option determines whether the source package is
966 guessed at if there is no obviously correct package. Things that use
967 this function for non-transient output should set this to false,
968 things that use it for transient output can set this to true.
969 Currently it defaults to true, but that is not a sane option.
974 sub make_source_versions {
975 my %param = validate_with(params => \@_,
976 spec => {package => {type => SCALAR|ARRAYREF,
978 arch => {type => SCALAR|ARRAYREF|UNDEF,
981 versions => {type => SCALAR|ARRAYREF,
984 guess_source => {type => BOOLEAN,
987 source_version_cache => {type => HASHREF,
990 debug => {type => SCALARREF|HANDLE,
993 warnings => {type => SCALARREF|HANDLE,
996 schema => {type => OBJECT,
1001 my ($warnings) = globify_scalar(exists $param{warnings}?$param{warnings}:undef);
1003 my @packages = grep {defined $_ and length $_ } make_list($param{package});
1004 my @archs = grep {defined $_ } make_list ($param{arch});
1008 if (not exists $param{source_version_cache}) {
1009 $param{source_version_cache} = \%_sourceversioncache;
1011 if (grep {/,/} make_list($param{package})) {
1012 croak "Package names contain ,; split on /,/ and call make_source_versions with an arrayref of packages"
1015 for my $version (make_list($param{versions})) {
1016 if ($version =~ m{(.+)/([^/]+)$}) {
1017 # Already a source version.
1018 $sourceversions{$version} = 1;
1019 next unless exists $param{warnings};
1020 # check to see if this source version is even possible
1021 my @bin_versions = sourcetobinary($1,$2);
1022 if (not @bin_versions or
1023 @{$bin_versions[0]} != 3) {
1024 print {$warnings} "The source $1 and version $2 do not appear to match any binary packages\n";
1027 if (not @packages) {
1028 croak "You must provide at least one package if the versions are not fully qualified";
1030 for my $pkg (@packages) {
1031 if ($pkg =~ /^src:(.+)/) {
1032 $sourceversions{"$1/$version"} = 1;
1033 next unless exists $param{warnings};
1034 # check to see if this source version is even possible
1035 my @bin_versions = sourcetobinary($1,$version);
1036 if (not @bin_versions or
1037 @{$bin_versions[0]} != 3) {
1038 print {$warnings} "The source '$1' and version '$version' do not appear to match any binary packages\n";
1042 for my $arch (@archs) {
1043 my $cachearch = (defined $arch) ? $arch : '';
1044 my $cachekey = "$pkg/$cachearch/$version";
1045 if (exists($param{source_version_cache}{$cachekey})) {
1046 for my $v (@{$param{source_version_cache}{$cachekey}}) {
1047 $sourceversions{$v} = 1;
1051 elsif ($param{guess_source} and
1052 exists$param{source_version_cache}{$cachekey.'/guess'}) {
1053 for my $v (@{$param{source_version_cache}{$cachekey.'/guess'}}) {
1054 $sourceversions{$v} = 1;
1058 my @srcinfo = binary_to_source(binary => $pkg,
1059 version => $version,
1060 length($arch)?(arch => $arch):());
1062 # We don't have explicit information about the
1063 # binary-to-source mapping for this version
1065 print {$warnings} "There is no source info for the package '$pkg' at version '$version' with architecture '$arch'\n";
1066 if ($param{guess_source}) {
1068 my $pkgsrc = getpkgsrc();
1069 if (exists $pkgsrc->{$pkg}) {
1070 @srcinfo = ([$pkgsrc->{$pkg}, $version]);
1071 } elsif (getsrcpkgs($pkg)) {
1072 # If we're looking at a source package
1073 # that doesn't have a binary of the
1074 # same name, just try the same
1076 @srcinfo = ([$pkg, $version]);
1080 # store guesses in a slightly different location
1081 $param{source_version_cache}{$cachekey.'/guess'} = [ map { "$_->[0]/$_->[1]" } @srcinfo ];
1085 # only store this if we didn't have to guess it
1086 $param{source_version_cache}{$cachekey} = [ map { "$_->[0]/$_->[1]" } @srcinfo ];
1088 $sourceversions{"$_->[0]/$_->[1]"} = 1 foreach @srcinfo;
1093 return sort keys %sourceversions;