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};
760 my $src_rs = $s->resultset('SrcVer')->
761 search({'src_pkg.pkg'=>[@src_packages],
762 -or => {'suite.codename' => [make_list($param{dist})],
763 'suite.suite_name' => [make_list($param{dist})],
768 src_associations=>'suite'},
770 '+select' => [qw(src_pkg.pkg),
772 qw(src_associations.modified),
773 q(CONCAT(src_pkg.pkg,'/',me.ver))],
774 '+as' => ['src_pkg_name','codename',
777 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
778 order_by => {-desc => 'me.ver'},
782 for my $src ($src_rs->all()) {
785 $val = DateTime::Format::Pg->
786 parse_datetime($src->{modified_time})->
789 if ($param{largest_source_version_only}) {
790 next if $completed_dists{$src->{codename}};
791 $completed_dists{$src->{codename}} = 1;
793 if ($param{source}) {
794 $return{$src->{src_pkg_ver}} = $val;
796 $return{$src->{ver}} = $val;
801 my $bin_rs = $s->resultset('BinVer')->
802 search({'bin_pkg.pkg' => [@bin_packages],
803 -or => {'suite.codename' => [make_list($param{dist})],
804 'suite.suite_name' => [make_list($param{dist})],
809 'src_ver'=>'src_pkg'},
811 bin_associations => 'suite'},
814 '+select' => [qw(bin_pkg.pkg arch.arch suite.codename),
815 qw(bin_associations.modified),
816 qw(src_pkg.pkg),q(CONCAT(src_pkg.pkg,'/',me.ver)),
818 '+as' => ['bin_pkg','arch','codename',
820 'src_pkg_name','src_pkg_ver'],
821 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
822 order_by => {-desc => 'src_ver.ver'},
824 if (exists $param{arch}) {
826 $bin_rs->search({'arch.arch' => [make_list($param{arch})]},
832 for my $bin ($bin_rs->all()) {
833 my $key = $bin->{ver};
834 if ($param{source}) {
835 $key = $bin->{src_pkg_ver};
837 my $val = $bin->{arch};
839 $val = DateTime::Format::Pg->
840 parse_datetime($bin->{modified_time})->
843 if ($param{largest_source_version_only}) {
844 if ($completed_dists{$bin->{codename}} and not
845 exists $return{$key}) {
848 $completed_dists{$bin->{codename}} = 1;
850 push @{$return{$key}},
854 if ($param{return_archs}) {
855 if ($param{time} or $param{return_archs}) {
856 return wantarray?%return :\%return;
858 return wantarray?keys %return :[keys %return];
863 return () if not defined $gVersionTimeIndex;
864 unless (tied %_versions_time) {
865 tie %_versions_time, 'MLDBM', $gVersionTimeIndex, O_RDONLY
866 or die "can't open versions index $gVersionTimeIndex: $!";
868 $versions = \%_versions_time;
871 return () if not defined $gVersionIndex;
872 unless (tied %_versions) {
873 tie %_versions, 'MLDBM', $gVersionIndex, O_RDONLY
874 or die "can't open versions index $gVersionIndex: $!";
876 $versions = \%_versions;
879 for my $package (make_list($param{package})) {
881 if ($package =~ s/^src://) {
884 my $version = $versions->{$package};
885 next unless defined $version;
886 for my $dist (make_list($param{dist})) {
887 for my $arch (exists $param{arch}?
888 make_list($param{arch}):
889 (grep {not $param{no_source_arch} or
891 } $source_only?'source':keys %{$version->{$dist}})) {
892 next unless defined $version->{$dist}{$arch};
893 my @vers = ref $version->{$dist}{$arch} eq 'HASH' ?
894 keys %{$version->{$dist}{$arch}} :
895 make_list($version->{$dist}{$arch});
896 if ($param{largest_source_version_only} and
897 $arch eq 'source' and @vers > 1) {
898 # order the versions, then pick the biggest version number
899 @vers = sort_versions(@vers);
902 for my $ver (@vers) {
904 if ($param{source}) {
905 ($f_ver) = make_source_versions(package => $package,
908 next unless defined $f_ver;
911 $versions{$f_ver} = max($versions{$f_ver}||0,$version->{$dist}{$arch}{$ver});
914 push @{$versions{$f_ver}},$arch;
920 if ($param{time} or $param{return_archs}) {
921 return wantarray?%versions :\%versions;
923 return wantarray?keys %versions :[keys %versions];
927 =head2 makesourceversions
929 @{$cgi_var{found}} = makesourceversions($cgi_var{package},undef,@{$cgi_var{found}});
931 Canonicalize versions into source versions, which have an explicitly
932 named source package. This is used to cope with source packages whose
933 names have changed during their history, and with cases where source
934 version numbers differ from binary version numbers.
938 our %_sourceversioncache = ();
939 sub makesourceversions {
940 my ($package,$arch,@versions) = @_;
941 die "Package $package is multiple packages; split on , and call makesourceversions multiple times"
943 return make_source_versions(package => $package,
944 (defined $arch)?(arch => $arch):(),
945 versions => \@versions
949 =head2 make_source_versions
951 make_source_versions(package => 'foo',
955 warnings => \$warnings,
958 An extended version of makesourceversions (which calls this function
959 internally) that allows for multiple packages, architectures, and
960 outputs warnings and debugging information to provided SCALARREFs or
963 The guess_source option determines whether the source package is
964 guessed at if there is no obviously correct package. Things that use
965 this function for non-transient output should set this to false,
966 things that use it for transient output can set this to true.
967 Currently it defaults to true, but that is not a sane option.
972 sub make_source_versions {
973 my %param = validate_with(params => \@_,
974 spec => {package => {type => SCALAR|ARRAYREF,
976 arch => {type => SCALAR|ARRAYREF|UNDEF,
979 versions => {type => SCALAR|ARRAYREF,
982 guess_source => {type => BOOLEAN,
985 source_version_cache => {type => HASHREF,
988 debug => {type => SCALARREF|HANDLE,
991 warnings => {type => SCALARREF|HANDLE,
994 schema => {type => OBJECT,
999 my ($warnings) = globify_scalar(exists $param{warnings}?$param{warnings}:undef);
1001 my @packages = grep {defined $_ and length $_ } make_list($param{package});
1002 my @archs = grep {defined $_ } make_list ($param{arch});
1006 if (not exists $param{source_version_cache}) {
1007 $param{source_version_cache} = \%_sourceversioncache;
1009 if (grep {/,/} make_list($param{package})) {
1010 croak "Package names contain ,; split on /,/ and call make_source_versions with an arrayref of packages"
1013 for my $version (make_list($param{versions})) {
1014 if ($version =~ m{(.+)/([^/]+)$}) {
1015 # Already a source version.
1016 $sourceversions{$version} = 1;
1017 next unless exists $param{warnings};
1018 # check to see if this source version is even possible
1019 my @bin_versions = sourcetobinary($1,$2);
1020 if (not @bin_versions or
1021 @{$bin_versions[0]} != 3) {
1022 print {$warnings} "The source $1 and version $2 do not appear to match any binary packages\n";
1025 if (not @packages) {
1026 croak "You must provide at least one package if the versions are not fully qualified";
1028 for my $pkg (@packages) {
1029 if ($pkg =~ /^src:(.+)/) {
1030 $sourceversions{"$1/$version"} = 1;
1031 next unless exists $param{warnings};
1032 # check to see if this source version is even possible
1033 my @bin_versions = sourcetobinary($1,$version);
1034 if (not @bin_versions or
1035 @{$bin_versions[0]} != 3) {
1036 print {$warnings} "The source '$1' and version '$version' do not appear to match any binary packages\n";
1040 for my $arch (@archs) {
1041 my $cachearch = (defined $arch) ? $arch : '';
1042 my $cachekey = "$pkg/$cachearch/$version";
1043 if (exists($param{source_version_cache}{$cachekey})) {
1044 for my $v (@{$param{source_version_cache}{$cachekey}}) {
1045 $sourceversions{$v} = 1;
1049 elsif ($param{guess_source} and
1050 exists$param{source_version_cache}{$cachekey.'/guess'}) {
1051 for my $v (@{$param{source_version_cache}{$cachekey.'/guess'}}) {
1052 $sourceversions{$v} = 1;
1056 my @srcinfo = binary_to_source(binary => $pkg,
1057 version => $version,
1058 length($arch)?(arch => $arch):());
1060 # We don't have explicit information about the
1061 # binary-to-source mapping for this version
1063 print {$warnings} "There is no source info for the package '$pkg' at version '$version' with architecture '$arch'\n";
1064 if ($param{guess_source}) {
1066 my $pkgsrc = getpkgsrc();
1067 if (exists $pkgsrc->{$pkg}) {
1068 @srcinfo = ([$pkgsrc->{$pkg}, $version]);
1069 } elsif (getsrcpkgs($pkg)) {
1070 # If we're looking at a source package
1071 # that doesn't have a binary of the
1072 # same name, just try the same
1074 @srcinfo = ([$pkg, $version]);
1078 # store guesses in a slightly different location
1079 $param{source_version_cache}{$cachekey.'/guess'} = [ map { "$_->[0]/$_->[1]" } @srcinfo ];
1083 # only store this if we didn't have to guess it
1084 $param{source_version_cache}{$cachekey} = [ map { "$_->[0]/$_->[1]" } @srcinfo ];
1086 $sourceversions{"$_->[0]/$_->[1]"} = 1 foreach @srcinfo;
1091 return sort keys %sourceversions;