fix mistake in the import options of POSIX

[debbugs.git] / Debbugs / User.pm

diff --git a/Debbugs/User.pm b/Debbugs/User.pm
index 68ae1c4566e642943652fe867843c77e3e64c96e..b82ce704a6bb8162f7399ee5dc8dad28365a683e 100644 (file)
--- a/Debbugs/User.pm
+++ b/Debbugs/User.pm
@@ -1,3 +1,13 @@
+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people have contributed to this file; their copyrights should
+# go here too.]
+# Copyright 2004 by Anthony Towns
+
+
 
 package Debbugs::User;
 
@@ -44,17 +54,18 @@ use Fcntl ':flock';
 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
 use base qw(Exporter);
 
+use Debbugs::Config qw(:globals);
+use List::Util qw(min);
+
 BEGIN {
-    ($VERSION) = q$Revision: 1.3 $ =~ /^Revision:\s+([^\s+])/;
+    ($VERSION) = q$Revision: 1.4 $ =~ /^Revision:\s+([^\s+])/;
     $DEBUG = 0 unless defined $DEBUG;
 
     @EXPORT = ();
-    @EXPORT_OK = qw(is_valid_user open);
+    @EXPORT_OK = qw(is_valid_user open read_usertags write_usertags);
     $EXPORT_TAGS{all} = [@EXPORT_OK];
 }
 
-my $gSpoolPath = "/org/bugs.debian.org/spool";
-
 # Obsolete compatability functions
 
 sub read_usertags {
@@ -83,7 +94,7 @@ sub write_usertags {
 sub filefromemail {
     my $e = shift;
     my $l = length($e) % 7;
-    return "$gSpoolPath/user/$l/" . join("", 
+    return "$gSpoolDir/user/$l/" . join("", 
         map { m/^[0-9a-zA-Z_+.-]$/ ? $_ : sprintf("%%%02X", ord($_)) }
             split //, $e);
 }
@@ -147,7 +158,10 @@ sub get_user {
 
     my $uf;
     $user->{"filename"} = $p;
-    open($uf, "< $p") or bless $user, "Debbugs::User";
+    if (not -r $p) {
+        return bless $user, "Debbugs::User";
+    }
+    open($uf, "< $p") or die "Unable to open file $p for reading: $!";
     if ($need_lock) {
         flock($uf, LOCK_EX); 
         $user->{"locked"} = $uf;
@@ -172,8 +186,16 @@ sub get_user {
                     my %c = ("nam" => $stanza{"Cat${i}"});
                     $c{"def"} = $stanza{"Cat${i}Default"}
                         if defined $stanza{"Cat${i}Default"};
-                    $c{"ord"} = [ split /,/, $stanza{"Cat${i}Order"} ]
-                        if defined $stanza{"Cat${i}Order"};
+                    if (defined $stanza{"Cat${i}Order"}) {
+                        my @temp = split /\s*,\s*/, $stanza{"Cat${i}Order"};
+                        my %temp;
+                        my $min = min(@temp);
+                        # Order to 0 minimum; strip duplicates
+                        $c{ord} = [map {$temp{$_}++;
+                                        $temp{$_}>1?():($_-$min);
+                                   } @temp
+                                  ];
+                   }
                     my @pri; my @ttl;
                     for my $l (split /\n/, $stanza{"Cat${i}Options"}) {
                         if ($l =~ m/^\s*(\S+)\s+-\s+(.*\S)\s*$/) {