* Add mldbm stuff

[debbugs.git] / Debbugs / Common.pm

diff --git a/Debbugs/Common.pm b/Debbugs/Common.pm
index feb76ed117e0a77e5b892be83da0c66976b9883b..453720fc6c3672d3017ef4d5c7094d9b35a61ba4 100644 (file)
--- a/Debbugs/Common.pm
+++ b/Debbugs/Common.pm
@@ -34,11 +34,12 @@ BEGIN{
                                qw(appendfile buglog getparsedaddrs getmaintainers),
                                qw(getmaintainers_reverse)
                               ],
+                    misc   => [qw(make_list)],
                     quit   => [qw(quit)],
-                    lock   => [qw(filelock unfilelock)],
+                    lock   => [qw(filelock unfilelock @cleanups)],
                    );
      @EXPORT_OK = ();
-     Exporter::export_ok_tags(qw(lock quit util));
+     Exporter::export_ok_tags(qw(lock quit util misc));
      $EXPORT_TAGS{all} = [@EXPORT_OK];
 }
 
@@ -47,9 +48,12 @@ use Debbugs::Config qw(:config);
 use IO::File;
 use Debbugs::MIME qw(decode_rfc1522);
 use Mail::Address;
+use Cwd qw(cwd);
 
 use Fcntl qw(:flock);
 
+our $DEBUG_FH = \*STDERR if not defined $DEBUG_FH;
+
 =head1 UTILITIES
 
 The following functions are exported by the C<:util> tag
@@ -75,10 +79,9 @@ sub getbugcomponent {
        return undef if defined $location and
                        ($location ne 'db' and $location ne 'db-h');
     }
-    return undef if not defined $location;
     my $dir = getlocationpath($location);
     return undef if not defined $dir;
-    if ($location eq 'db') {
+    if (defined $location and $location eq 'db') {
        return "$dir/$bugnum.$ext";
     } else {
        my $hash = get_hashname($bugnum);
@@ -167,8 +170,8 @@ Opens a file for appending and writes data to it.
 sub appendfile {
        my $file = shift;
        if (!open(AP,">>$file")) {
-               print DEBUG "failed open log<\n";
-               print DEBUG "failed open log err $!<\n";
+               print $DEBUG_FH "failed open log<\n" if $DEBUG;
+               print $DEBUG_FH "failed open log err $!<\n" if $DEBUG;
                &quit("opening $file (appendfile): $!");
        }
        print(AP @_) || &quit("writing $file (appendfile): $!");
@@ -187,7 +190,7 @@ first address parsed.
 =cut
 
 
-my %_parsedaddrs;
+our %_parsedaddrs;
 sub getparsedaddrs {
     my $addr = shift;
     return () unless defined $addr;
@@ -197,8 +200,8 @@ sub getparsedaddrs {
     return wantarray?@{$_parsedaddrs{$addr}}:$_parsedaddrs{$addr}[0];
 }
 
-my $_maintainer;
-my $_maintainer_rev;
+our $_maintainer;
+our $_maintainer_rev;
 sub getmaintainers {
     return $_maintainer if $_maintainer;
     my %maintainer;
@@ -241,21 +244,24 @@ FLOCKs the passed file. Use unfilelock to unlock it.
 
 =cut
 
-my @filelocks;
-my @cleanups;
+our @filelocks;
+our @cleanups;
 
 sub filelock {
     # NB - NOT COMPATIBLE WITH `with-lock'
     my ($lockfile) = @_;
-    my ($count,$errors) = @_;
+    if ($lockfile !~ m{^/}) {
+        $lockfile = cwd().'/'.$lockfile;
+    }
+    my ($count,$errors);
     $count= 10; $errors= '';
     for (;;) {
        my $fh = eval {
-            my $fh = new IO::File $lockfile,'w'
+            my $fh2 = IO::File->new($lockfile,'w')
                  or die "Unable to open $lockfile for writing: $!";
-            flock($fh,LOCK_EX|LOCK_NB)
+            flock($fh2,LOCK_EX|LOCK_NB)
                  or die "Unable to lock $lockfile $!";
-            return $fh;
+            return $fh2;
        };
        if ($@) {
             $errors .= $@;
@@ -297,7 +303,7 @@ sub unfilelock {
     close($fl{fh})
         or warn "Unable to close lockfile $fl{file}: $!";
     unlink($fl{file})
-        or warn "Unable to unlink locfile $fl{file}: $!";
+        or warn "Unable to unlink lockfile $fl{file}: $!";
 }
 
 
@@ -318,12 +324,31 @@ instead. (Or possibly a die handler, if the cleanups are important)
 =cut
 
 sub quit {
-    print DEBUG "quitting >$_[0]<\n";
+    print $DEBUG_FH "quitting >$_[0]<\n" if $DEBUG;
     my ($u);
     while ($u= $cleanups[$#cleanups]) { &$u; }
     die "*** $_[0]\n";
 }
 
+=head1 MISC
+
+These functions are exported with the :misc tag
+
+=head2 make_list
+
+     LIST = make_list(@_);
+
+Turns a scalar or an arrayref into a list; expands a list of arrayrefs
+into a list.
+
+That is, make_list([qw(a b c)]); returns qw(a b c); make_list([qw(a
+b)],[qw(c d)] returns qw(a b c d);
+
+=cut
+
+sub make_list {
+     return map {(ref($_) eq 'ARRAY')?@{$_}:$_} @_;
+}