+ my ($file,@data) = @_;
+ my $fh = IO::File->new($file,'a') or
+ die "Unable top open $file for appending: $!";
+ print {$fh} @data or die "Unable to write to $file: $!";
+ close $fh or die "Unable to close $file: $!";
+}
+
+=head2 overwritefile
+
+ ovewritefile($file,'data','to','append');
+
+Opens file.new, writes data to it, then moves file.new to file.
+
+=cut
+
+sub overwritefile {
+ my ($file,@data) = @_;
+ my $fh = IO::File->new("${file}.new",'w') or
+ die "Unable top open ${file}.new for writing: $!";
+ print {$fh} @data or die "Unable to write to ${file}.new: $!";
+ close $fh or die "Unable to close ${file}.new: $!";
+ rename("${file}.new",$file) or
+ die "Unable to rename ${file}.new to $file: $!";
+}
+
+
+
+
+
+=head2 getparsedaddrs
+
+ my $address = getparsedaddrs($address);
+ my @address = getparsedaddrs($address);
+
+Returns the output from Mail::Address->parse, or the cached output if
+this address has been parsed before. In SCALAR context returns the
+first address parsed.
+
+=cut
+
+
+our %_parsedaddrs;
+sub getparsedaddrs {
+ my $addr = shift;
+ return () unless defined $addr;
+ return wantarray?@{$_parsedaddrs{$addr}}:$_parsedaddrs{$addr}[0]
+ if exists $_parsedaddrs{$addr};
+ {
+ # don't display the warnings from Mail::Address->parse
+ local $SIG{__WARN__} = sub { };
+ @{$_parsedaddrs{$addr}} = Mail::Address->parse($addr);
+ }
+ return wantarray?@{$_parsedaddrs{$addr}}:$_parsedaddrs{$addr}[0];
+}
+
+=head2 getmaintainers
+
+ my $maintainer = getmaintainers()->{debbugs}
+
+Returns a hashref of package => maintainer pairs.
+
+=cut
+
+our $_maintainer = undef;
+our $_maintainer_rev = undef;
+sub getmaintainers {
+ return $_maintainer if defined $_maintainer;
+ package_maintainer(rehash => 1);
+ return $_maintainer;
+}
+
+=head2 getmaintainers_reverse
+
+ my @packages = @{getmaintainers_reverse->{'don@debian.org'}||[]};
+
+Returns a hashref of maintainer => [qw(list of packages)] pairs.
+
+=cut
+
+sub getmaintainers_reverse{
+ return $_maintainer_rev if defined $_maintainer_rev;
+ package_maintainer(rehash => 1);
+ return $_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 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);