]> git.donarmstrong.com Git - debbugs.git/blobdiff - Debbugs/Common.pm
pass uri_escape to templates in bugreport.cgi
[debbugs.git] / Debbugs / Common.pm
index 732ac2e5bf2f6c02fcaa4b718cb2a7780e3bfc2b..e892d701d411164e742ec47d0dd9242e445e0ce0 100644 (file)
@@ -31,7 +31,7 @@ with equivalent (or better) functionality here.
 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;
@@ -45,6 +45,7 @@ BEGIN{
                                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),
@@ -239,7 +240,40 @@ sub overwritefile {
            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;
+}
 
 
 
@@ -364,7 +398,7 @@ sub package_maintainer {
        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;
@@ -380,7 +414,7 @@ sub package_maintainer {
        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;
@@ -431,12 +465,12 @@ sub __add_to_hash {
     }
     $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;
-       next unless m/^(\S+)\s+(\S.*\S)\s*$/;
-       my ($key,$value)=($1,$2);
+        next unless m/^(\S+)\s+(\S.*\S)\s*$/;
+        my ($key,$value)=($1,$2);
        $key = lc $key;
        $forward->{$key}= $value;
        if (defined $reverse) {
@@ -471,7 +505,8 @@ sub getpseudodesc {
     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;
 }
 
@@ -937,7 +972,7 @@ sub cleanup_eval_fail {
     # 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/\.+$/\./;