+=head2 getsourcemaintainers
+
+ my $maintainer = getsourcemaintainers()->{debbugs}
+
+Returns a hashref of src_package => maintainer pairs.
+
+=cut
+
+our $_source_maintainer = undef;
+our $_source_maintainer_rev = undef;
+sub getsourcemaintainers {
+ return $_source_maintainer if defined $_source_maintainer;
+ package_maintainer(rehash => 1);
+ return $_source_maintainer;
+}
+
+=head2 getsourcemaintainers_reverse
+
+ my @src_packages = @{getsourcemaintainers_reverse->{'don@debian.org'}||[]};
+
+Returns a hashref of maintainer => [qw(list of source packages)] pairs.
+
+=cut
+
+sub getsourcemaintainers_reverse{
+ return $_source_maintainer_rev if defined $_source_maintainer_rev;
+ package_maintainer(rehash => 1);
+ return $_source_maintainer_rev;
+}
+
+=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 maintainer -- scalar or arrayref of maintainers to return source packages
+for. If given, binary and source cannot be given.
+
+=item rehash -- whether to reread the maintainer and source maintainer
+files; defaults to 0
+
+=item schema -- Debbugs::DB schema. If set, uses the database for maintainer
+information.
+
+=back
+
+=cut
+
+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,
+ },
+ schema => {type => OBJECT,
+ optional => 1,
+ }
+ },
+ );
+ 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 (@binary) {
+ @source = grep {/^src:/} @binary;
+ @binary = grep {!/^src:/} @binary;
+ }
+ # remove leading src: from source package names
+ s/^src:// foreach @source;
+ if ($param{schema}) {
+ my $s = $param{schema};
+ if (@maintainers) {
+ my $m_rs = $s->resultset('SrcPkg')->
+ search({'correspondent.addr' => [@maintainers]},
+ {join => {src_vers =>
+ {maintainer =>
+ 'correspondent'},
+ },
+ columns => ['pkg'],
+ group_by => [qw(me.pkg)],
+ });
+ return $m_rs->get_column('pkg')->all();
+ } elsif (@binary or @source) {
+ my $rs = $s->resultset('Maintainer');
+ if (@binary) {
+ $rs =
+ $rs->search({'bin_pkg.pkg' => [@binary]},
+ {join => {src_vers =>
+ {bin_vers => 'bin_pkg'},
+ },
+ columns => ['name'],
+ group_by => [qw(me.name)],
+ }
+ );
+ }
+ if (@source) {
+ $rs =
+ $rs->search({'src_pkg.pkg' => [@source]},
+ {join => {src_vers =>
+ 'src_pkg',
+ },
+ columns => ['name'],
+ group_by => [qw(me.name)],
+ }
+ );
+ }
+ return $rs->get_column('name')->all();
+ }
+ return ();
+ }
+ 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 = {};
+ if (-e $config{spool_dir}.'/source_maintainers.idx' and
+ -e $config{spool_dir}.'/source_maintainers_reverse.idx'
+ ) {
+ tie %{$_source_maintainer},
+ MLDBM => $config{spool_dir}.'/source_maintainers.idx',
+ O_RDONLY or
+ die "Unable to tie source maintainers: $!";
+ tie %{$_source_maintainer_rev},
+ MLDBM => $config{spool_dir}.'/source_maintainers_reverse.idx',
+ O_RDONLY or
+ die "Unable to tie source maintainers reverse: $!";
+ } else {
+ for my $fn (@config{('source_maintainer_file',
+ 'source_maintainer_file_override',
+ 'pseudo_maint_file')}) {
+ next unless defined $fn and length $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 = {};
+ if (-e $config{spool_dir}.'/maintainers.idx' and
+ -e $config{spool_dir}.'/maintainers_reverse.idx'
+ ) {
+ tie %{$_maintainer},
+ MLDBM => $config{spool_dir}.'/binary_maintainers.idx',
+ O_RDONLY or
+ die "Unable to tie binary maintainers: $!";
+ tie %{$_maintainer_rev},
+ MLDBM => $config{spool_dir}.'/binary_maintainers_reverse.idx',
+ O_RDONLY or
+ die "Unable to binary maintainers reverse: $!";
+ } else {
+ for my $fn (@config{('maintainer_file',
+ 'maintainer_file_override',
+ 'pseudo_maint_file')}) {
+ next unless defined $fn and length $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 ($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
+ croak "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;
+ }
+ }
+ }
+}
+
+