+=head2 package_maintainer
+
+ my @s = package_maintainer(source => [qw(foo bar baz)],
+ binary => [qw(bleh blah)],
+ );
+
+=over
+
+=item source -- scalar or arrayref of source package names to return
+maintainers for, defaults to the empty arrayref.
+
+=item binary -- scalar or arrayref of binary package names to return
+maintainers for; automatically returns source package maintainer if
+the package name starts with 'src:', defaults to the empty arrayref.
+
+=item reverse -- whether to return the source/binary packages a
+maintainer maintains instead
+
+=item rehash -- whether to reread the maintainer and source maintainer
+files; defaults to 0
+
+=back
+
+=cut
+
+our $_source_maintainer = undef;
+our $_source_maintainer_rev = undef;
+sub package_maintainer {
+ my %param = validate_with(params => \@_,
+ spec => {source => {type => SCALAR|ARRAYREF,
+ default => [],
+ },
+ binary => {type => SCALAR|ARRAYREF,
+ default => [],
+ },
+ maintainer => {type => SCALAR|ARRAYREF,
+ default => [],
+ },
+ rehash => {type => BOOLEAN,
+ default => 0,
+ },
+ reverse => {type => BOOLEAN,
+ default => 0,
+ },
+ },
+ );
+ my @binary = make_list($param{binary});
+ my @source = make_list($param{source});
+ my @maintainers = make_list($param{maintainer});
+ if ((@binary or @source) and @maintainers) {
+ croak "It is nonsensical to pass both maintainers and source or binary";
+ }
+ if ($param{rehash}) {
+ $_source_maintainer = undef;
+ $_source_maintainer_rev = undef;
+ $_maintainer = undef;
+ $_maintainer_rev = undef;
+ }
+ if (not defined $_source_maintainer or
+ not defined $_source_maintainer_rev) {
+ $_source_maintainer = {};
+ $_source_maintainer_rev = {};
+ for my $fn (@config{('source_maintainer_file',
+ 'source_maintainer_file_override',
+ 'pseudo_maint_file')}) {
+ next unless defined $fn;
+ if (not -e $fn) {
+ warn "Missing source maintainer file '$fn'";
+ next;
+ }
+ __add_to_hash($fn,$_source_maintainer,
+ $_source_maintainer_rev);
+ }
+ }
+ if (not defined $_maintainer or
+ not defined $_maintainer_rev) {
+ $_maintainer = {};
+ $_maintainer_rev = {};
+ for my $fn (@config{('maintainer_file',
+ 'maintainer_file_override',
+ 'pseudo_maint_file')}) {
+ next unless defined $fn;
+ if (not -e $fn) {
+ warn "Missing maintainer file '$fn'";
+ next;
+ }
+ __add_to_hash($fn,$_maintainer,
+ $_maintainer_rev);
+ }
+ }
+ my @return;
+ for my $binary (@binary) {
+ if (not $param{reverse} and $binary =~ /^src:/) {
+ push @source,$binary;
+ next;
+ }
+ push @return,grep {defined $_} make_list($_maintainer->{$binary});
+ }
+ for my $source (@source) {
+ $source =~ s/^src://;
+ push @return,grep {defined $_} make_list($_source_maintainer->{$source});
+ }
+ for my $maintainer (grep {defined $_} @maintainers) {
+ push @return,grep {defined $_}
+ make_list($_maintainer_rev->{$maintainer});
+ push @return,map {$_ !~ /^src:/?'src:'.$_:$_}
+ grep {defined $_}
+ make_list($_source_maintainer_rev->{$maintainer});
+ }
+ return @return;
+}
+
+#=head2 __add_to_hash
+#
+# __add_to_hash($file,$forward_hash,$reverse_hash,'address');
+#
+# Reads a maintainer/source maintainer/pseudo desc file and adds the
+# maintainers from it to the forward and reverse hashref; assumes that
+# the forward is unique; makes no assumptions of the reverse.
+#
+#=cut
+
+sub __add_to_hash {
+ my ($fn,$forward,$reverse,$type) = @_;
+ if (ref($forward) ne 'HASH') {
+ croak "__add_to_hash must be passed a hashref for the forward";
+ }
+ if (defined $reverse and not ref($reverse) eq 'HASH') {
+ croak "if reverse is passed to __add_to_hash, it must be a hashref";
+ }
+ $type //= 'address';
+ my $fh = IO::File->new($fn,'r') or
+ die "Unable to open $fn for reading: $!";
+ binmode($fh,':encoding(UTF-8)');
+ while (<$fh>) {
+ chomp;
+ next unless m/^(\S+)\s+(\S.*\S)\s*$/;
+ my ($key,$value)=($1,$2);
+ $key = lc $key;
+ $forward->{$key}= $value;
+ if (defined $reverse) {
+ if ($type eq 'address') {
+ for my $m (map {lc($_->address)} (getparsedaddrs($value))) {
+ push @{$reverse->{$m}},$key;
+ }
+ }
+ else {
+ push @{$reverse->{$value}}, $key;
+ }
+ }
+ }
+}
+
+
+=head2 getpseudodesc
+
+ my $pseudopkgdesc = getpseudodesc(...);
+
+Returns the entry for a pseudo package from the
+$config{pseudo_desc_file}. In cases where pseudo_desc_file is not
+defined, returns an empty arrayref.
+
+This function can be used to see if a particular package is a
+pseudopackage or not.
+
+=cut
+
+our $_pseudodesc = undef;
+sub getpseudodesc {
+ return $_pseudodesc if defined $_pseudodesc;
+ $_pseudodesc = {};
+ __add_to_hash($config{pseudo_desc_file},$_pseudodesc) if
+ defined $config{pseudo_desc_file};
+ return $_pseudodesc;
+}
+
+=head2 sort_versions
+
+ sort_versions('1.0-2','1.1-2');
+
+Sorts versions using AptPkg::Versions::compare if it is available, or
+Debbugs::Versions::Dpkg::vercmp if it isn't.
+
+=cut
+
+our $vercmp;
+BEGIN{
+ use Debbugs::Versions::Dpkg;
+ $vercmp=\&Debbugs::Versions::Dpkg::vercmp;
+
+# eventually we'll use AptPkg:::Version or similar, but the current
+# implementation makes this *super* difficult.
+
+# eval {
+# use AptPkg::Version;
+# $vercmp=\&AptPkg::Version::compare;
+# };
+}
+
+sub sort_versions{
+ return sort {$vercmp->($a,$b)} @_;
+}
+
+
+=head1 DATE
+
+ my $english = secs_to_english($seconds);
+ my ($days,$english) = secs_to_english($seconds);
+
+XXX This should probably be changed to use Date::Calc
+
+=cut
+
+sub secs_to_english{
+ my ($seconds) = @_;
+
+ my $days = int($seconds / 86400);
+ my $years = int($days / 365);
+ $days %= 365;
+ my $result;
+ my @age;
+ push @age, "1 year" if ($years == 1);
+ push @age, "$years years" if ($years > 1);
+ push @age, "1 day" if ($days == 1);
+ push @age, "$days days" if ($days > 1);
+ $result .= join(" and ", @age);
+
+ return wantarray?(int($seconds/86400),$result):$result;
+}
+