Debbugs/User.pm

   1
   2 package Debbugs::User;
   3
   4 =head1 NAME
   5
   6 Debbugs::User -- User settings
   7
   8 =head1 SYNOPSIS
   9
  10 use Debbugs::User qw(is_valid_user read_usertags write_usertags);
  11
  12 Debbugs::User::is_valid_user($userid);
  13
  14 $u = Debbugs::User::open($userid);
  15 $u = Debbugs::User::open(user => $userid, locked => 0);
  16
  17 $u = Debbugs::User::open(user => $userid, locked => 1);
  18 $u->write();
  19
  20 $u->{"tags"}
  21 $u->{"categories"}
  22 $u->{"is_locked"}
  23 $u->{"name"}
  24
  25
  26 read_usertags(\%ut, $userid);
  27 write_usertags(\%ut, $userid);
  28
  29 =head1 EXPORT TAGS
  30
  31 =over
  32
  33 =item :all -- all functions that can be exported
  34
  35 =back
  36
  37 =head1 FUNCTIONS
  38
  39 =cut
  40
  41 use warnings;
  42 use strict;
  43 use Fcntl ':flock';
  44 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
  45 use base qw(Exporter);
  46
  47 use Debbugs::Config qw(:globals);
  48 use List::Util qw(min);
  49
  50 BEGIN {
  51     ($VERSION) = q$Revision: 1.4 $ =~ /^Revision:\s+([^\s+])/;
  52     $DEBUG = 0 unless defined $DEBUG;
  53
  54     @EXPORT = ();
  55     @EXPORT_OK = qw(is_valid_user open read_usertags write_usertags);
  56     $EXPORT_TAGS{all} = [@EXPORT_OK];
  57 }
  58
  59 # Obsolete compatability functions
  60
  61 sub read_usertags {
  62     my $ut = shift;
  63     my $u = shift;
  64
  65     my $user = get_user($u);
  66     for my $t (keys %{$user->{"tags"}}) {
  67         $ut->{$t} = [] unless defined $ut->{$t};
  68         push @{$ut->{$t}}, @{$user->{"tags"}->{$t}};
  69     }
  70 }
  71
  72 sub write_usertags {
  73     my $ut = shift;
  74     my $u = shift;
  75
  76     my $user = get_user($u, 1); # locked
  77     $user->{"tags"} = { %{$ut} };
  78     $user->write();
  79 }
  80
  81 #######################################################################
  82 # Helper functions
  83
  84 sub filefromemail {
  85     my $e = shift;
  86     my $l = length($e) % 7;
  87     return "$gSpoolDir/user/$l/" . join("",
  88         map { m/^[0-9a-zA-Z_+.-]$/ ? $_ : sprintf("%%%02X", ord($_)) }
  89             split //, $e);
  90 }
  91
  92 sub read_stanza {
  93     my $f = shift;
  94     my $field = 0;
  95     my @res;
  96     while (<$f>) {
  97            chomp;
  98            last if (m/^$/);
  99
 100         if ($field && m/^ (.*)$/) {
 101             $res[-1] .= "\n" . $1;
 102         } elsif (m/^([^:]+):(\s+(.*))?$/) {
 103             $field = $1;
 104             push @res, ($1, $3);
 105         }
 106     }
 107     return @res;
 108 }
 109
 110 sub fmt {
 111     my $s = shift;
 112     my $n = shift;
 113     my $sofar = 0;
 114     my $res = "";
 115     while ($s =~ m/^([^,]*,\s*)(.*)$/ || $s =~ m/^([^,]+)()$/) {
 116         my $k = $1;
 117         $s = $2;
 118         unless ($sofar == 0 or $sofar + length($k) <= $n) {
 119                 $res .= "\n ";
 120                 $sofar = 1;
 121             }
 122             $res .= $k;
 123             $sofar += length($k);
 124     }
 125     return $res . $s;
 126 }
 127
 128 sub is_valid_user {
 129     my $u = shift;
 130     return ($u =~ /^[a-zA-Z0-9._+-]+[@][a-z0-9-.]{4,}$/);
 131 }
 132
 133 #######################################################################
 134 # The real deal
 135
 136 sub get_user {
 137     my $ut = {};
 138     my $user = {
 139         "tags" => $ut,
 140         "categories" => {},
 141         "visible_cats" => [],
 142         "unknown_stanzas" => []
 143     };
 144
 145     my $u = shift;
 146     my $need_lock = shift || 0;
 147     my $p = filefromemail($u);
 148
 149     my $uf;
 150     $user->{"filename"} = $p;
 151     if (not -r $p) {
 152          return bless $user, "Debbugs::User";
 153     }
 154     open($uf, "< $p") or die "Unable to open file $p for reading: $!";
 155     if ($need_lock) {
 156         flock($uf, LOCK_EX);
 157         $user->{"locked"} = $uf;
 158     }
 159
 160     while(1) {
 161         my @stanza = read_stanza($uf);
 162         last if ($#stanza == -1);
 163         if ($stanza[0] eq "Tag") {
 164             my %tag = @stanza;
 165             my $t = $tag{"Tag"};
 166             $ut->{$t} = [] unless defined $ut->{$t};
 167             push @{$ut->{$t}}, split /\s*,\s*/, $tag{Bugs};
 168         } elsif ($stanza[0] eq "Category") {
 169             my @cat = ();
 170             my %stanza = @stanza;
 171             my $catname = $stanza{"Category"};
 172             my $i = 0;
 173             while (++$i && defined $stanza{"Cat${i}"}) {
 174                 if (defined $stanza{"Cat${i}Options"}) {
 175                     # parse into a hash
 176                     my %c = ("nam" => $stanza{"Cat${i}"});
 177                     $c{"def"} = $stanza{"Cat${i}Default"}
 178                         if defined $stanza{"Cat${i}Default"};
 179                     if (defined $stanza{"Cat${i}Order"}) {
 180                          my @temp = split /\s*,\s*/, $stanza{"Cat${i}Order"};
 181                          my %temp;
 182                          my $min = min(@temp);
 183                          # Order to 0 minimum; strip duplicates
 184                          $c{ord} = [map {$temp{$_}++;
 185                                          $temp{$_}>1?():($_-$min);
 186                                     } @temp
 187                                    ];
 188                     }
 189                     my @pri; my @ttl;
 190                     for my $l (split /\n/, $stanza{"Cat${i}Options"}) {
 191                         if ($l =~ m/^\s*(\S+)\s+-\s+(.*\S)\s*$/) {
 192                             push @pri, $1;
 193                             push @ttl, $2;
 194                         } elsif ($l =~ m/^\s*(\S+)\s*$/) {
 195                             push @pri, $1;
 196                             push @ttl, $1;
 197                         }
 198                     }
 199                     $c{"ttl"} = [@ttl];
 200                     $c{"pri"} = [@pri];
 201                     push @cat, { %c };
 202                 } else {
 203                     push @cat, $stanza{"Cat${i}"};
 204                 }
 205             }
 206             $user->{"categories"}->{$catname} = [@cat];
 207             push @{$user->{"visible_cats"}}, $catname
 208                 unless ($stanza{"Hidden"} || "no") eq "yes";
 209         } else {
 210             push @{$user->{"unknown_stanzas"}}, [@stanza];
 211         }
 212     }
 213     close($uf) unless $need_lock;
 214
 215     bless $user, "Debbugs::User";
 216     return $user;
 217 }
 218
 219 sub write {
 220     my $user = shift;
 221     my $uf;
 222     my $ut = $user->{"tags"};
 223     my $p = $user->{"filename"};
 224
 225     if ($p =~ m/^(.+)$/) { $p = $1; } else { return; }
 226     open $uf, "> $p" or return;
 227
 228     for my $us (@{$user->{"unknown_stanzas"}}) {
 229         my @us = @{$us};
 230         while (@us) {
 231             my $k = shift @us; my $v = shift @us;
 232             $v =~ s/\n/\n /g;
 233             print $uf "$k: $v\n";
 234         }
 235         print $uf "\n";
 236     }
 237
 238     for my $t (keys %{$ut}) {
 239         next if @{$ut->{$t}} == 0;
 240         print $uf "Tag: $t\n";
 241         print $uf fmt("Bugs: " . join(", ", @{$ut->{$t}}), 77) . "\n";
 242         print $uf "\n";
 243     }
 244
 245     my $uc = $user->{"categories"};
 246     my %vis = map { $_, 1 } @{$user->{"visible_cats"}};
 247     for my $c (keys %{$uc}) {
 248         next if @{$uc->{$c}} == 0;
 249
 250         print $uf "Category: $c\n";
 251         print $uf "Hidden: yes\n" unless defined $vis{$c};
 252         my $i = 0;
 253         for my $cat (@{$uc->{$c}}) {
 254             $i++;
 255             if (ref($cat) eq "HASH") {
 256                 printf $uf "Cat%d: %s\n", $i, $cat->{"nam"};
 257                 printf $uf "Cat%dOptions:\n", $i;
 258                 for my $j (0..$#{$cat->{"pri"}}) {
 259                     if (defined $cat->{"ttl"}->[$j]) {
 260                         printf $uf " %s - %s\n",
 261                             $cat->{"pri"}->[$j], $cat->{"ttl"}->[$j];
 262                     } else {
 263                         printf $uf " %s\n", $cat->{"pri"}->[$j];
 264                     }
 265                 }
 266                 printf $uf "Cat%dDefault: %s\n", $i, $cat->{"def"}
 267                     if defined $cat->{"def"};
 268                 printf $uf "Cat%dOrder: %s\n", $i, join(", ", @{$cat->{"ord"}})
 269                     if defined $cat->{"ord"};
 270             } else {
 271                 printf $uf "Cat%d: %s\n", $i, $cat;
 272             }
 273         }
 274         print $uf "\n";
 275     }
 276
 277     close($uf);
 278     delete $user->{"locked"};
 279 }
 280
 281 1;
 282
 283 __END__