use warnings;
use strict;
use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
-use base qw(Exporter);
+use Exporter qw(import);
BEGIN{
$VERSION = 1.00;
@EXPORT = ();
%EXPORT_TAGS = (util => [qw(getbugcomponent getbuglocation getlocationpath get_hashname),
qw(appendfile overwritefile buglog getparsedaddrs getmaintainers),
+ qw(getsourcemaintainers getsourcemaintainers_reverse),
qw(bug_status),
qw(getmaintainers_reverse),
qw(getpseudodesc),
qw(package_maintainer),
qw(sort_versions),
+ qw(open_compressed_file),
],
misc => [qw(make_list globify_scalar english_join checkpid),
qw(cleanup_eval_fail),
die "Unable to rename ${file}.new to $file: $!";
}
+=head2 open_compressed_file
+ my $fh = open_compressed_file('foo.gz') or
+ die "Unable to open compressed file: $!";
+
+
+Opens a file; if the file ends in .gz, .xz, or .bz2, the appropriate
+decompression program is forked and output from it is read.
+
+This routine by default opens the file with UTF-8 encoding; if you want some
+other encoding, specify it with the second option.
+
+=cut
+sub open_compressed_file {
+ my ($file,$encoding) = @_;
+ $encoding //= ':encoding(UTF-8)';
+ my $fh;
+ my $mode = "<$encoding";
+ my @opts;
+ if ($file =~ /\.gz$/) {
+ $mode = "-|$encoding";
+ push @opts,'gzip','-dc';
+ }
+ if ($file =~ /\.xz$/) {
+ $mode = "-|$encoding";
+ push @opts,'xz','-dc';
+ }
+ if ($file =~ /\.bz2$/) {
+ $mode = "-|$encoding";
+ push @opts,'bzip2','-dc';
+ }
+ open($fh,$mode,@opts,$file);
+ return $fh;
+}
return $_maintainer_rev;
}
+=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)],
=cut
-our $_source_maintainer = undef;
-our $_source_maintainer_rev = undef;
sub package_maintainer {
my %param = validate_with(params => \@_,
spec => {source => {type => SCALAR|ARRAYREF,
for my $fn (@config{('source_maintainer_file',
'source_maintainer_file_override',
'pseudo_maint_file')}) {
- next unless defined $fn;
+ next unless defined $fn and length $fn;
if (not -e $fn) {
warn "Missing source maintainer file '$fn'";
next;
for my $fn (@config{('maintainer_file',
'maintainer_file_override',
'pseudo_maint_file')}) {
- next unless defined $fn;
+ next unless defined $fn and length $fn;
if (not -e $fn) {
warn "Missing maintainer file '$fn'";
next;
}
$type //= 'address';
my $fh = IO::File->new($fn,'r') or
- die "Unable to open $fn for reading: $!";
+ croak "Unable to open $fn for reading: $!";
binmode($fh,':encoding(UTF-8)');
while (<$fh>) {
chomp;
- my @elements = split /\t/;
- next unless @elements >=2;
- # we do this because the source maintainer file contains the
- # archive location, which we don't care about
- my ($key,$value)=($elements[0],$elements[-1]);
+ next unless m/^(\S+)\s+(\S.*\S)\s*$/;
+ my ($key,$value)=($1,$2);
$key = lc $key;
$forward->{$key}= $value;
if (defined $reverse) {
return $_pseudodesc if defined $_pseudodesc;
$_pseudodesc = {};
__add_to_hash($config{pseudo_desc_file},$_pseudodesc) if
- defined $config{pseudo_desc_file};
+ defined $config{pseudo_desc_file} and
+ length $config{pseudo_desc_file};
return $_pseudodesc;
}
# ditch the "at foo/bar/baz.pm line 5"
$error =~ s/\sat\s\S+\sline\s\d+//;
# ditch croak messages
- $error =~ s/^\t+.+\n?//g;
+ $error =~ s/^\t+.+\n?//mg;
# ditch trailing multiple periods in case there was a cascade of
# die messages.
$error =~ s/\.+$/\./;