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 $min = min(@temp);
 182                          @temp = map {$_-$min} @temp;
 183                          $c{ord} = [@temp];
 184                     }
 185                     my @pri; my @ttl;
 186                     for my $l (split /\n/, $stanza{"Cat${i}Options"}) {
 187                         if ($l =~ m/^\s*(\S+)\s+-\s+(.*\S)\s*$/) {
 188                             push @pri, $1;
 189                             push @ttl, $2;
 190                         } elsif ($l =~ m/^\s*(\S+)\s*$/) {
 191                             push @pri, $1;
 192                             push @ttl, $1;
 193                         }
 194                     }
 195                     $c{"ttl"} = [@ttl];
 196                     $c{"pri"} = [@pri];
 197                     push @cat, { %c };
 198                 } else {
 199                     push @cat, $stanza{"Cat${i}"};
 200                 }
 201             }
 202             $user->{"categories"}->{$catname} = [@cat];
 203             push @{$user->{"visible_cats"}}, $catname
 204                 unless ($stanza{"Hidden"} || "no") eq "yes";
 205         } else {
 206             push @{$user->{"unknown_stanzas"}}, [@stanza];
 207         }
 208     }
 209     close($uf) unless $need_lock;
 210
 211     bless $user, "Debbugs::User";
 212     return $user;
 213 }
 214
 215 sub write {
 216     my $user = shift;
 217     my $uf;
 218     my $ut = $user->{"tags"};
 219     my $p = $user->{"filename"};
 220
 221     if ($p =~ m/^(.+)$/) { $p = $1; } else { return; }
 222     open $uf, "> $p" or return;
 223
 224     for my $us (@{$user->{"unknown_stanzas"}}) {
 225         my @us = @{$us};
 226         while (@us) {
 227             my $k = shift @us; my $v = shift @us;
 228             $v =~ s/\n/\n /g;
 229             print $uf "$k: $v\n";
 230         }
 231         print $uf "\n";
 232     }
 233
 234     for my $t (keys %{$ut}) {
 235         next if @{$ut->{$t}} == 0;
 236         print $uf "Tag: $t\n";
 237         print $uf fmt("Bugs: " . join(", ", @{$ut->{$t}}), 77) . "\n";
 238         print $uf "\n";
 239     }
 240
 241     my $uc = $user->{"categories"};
 242     my %vis = map { $_, 1 } @{$user->{"visible_cats"}};
 243     for my $c (keys %{$uc}) {
 244         next if @{$uc->{$c}} == 0;
 245
 246         print $uf "Category: $c\n";
 247         print $uf "Hidden: yes\n" unless defined $vis{$c};
 248         my $i = 0;
 249         for my $cat (@{$uc->{$c}}) {
 250             $i++;
 251             if (ref($cat) eq "HASH") {
 252                 printf $uf "Cat%d: %s\n", $i, $cat->{"nam"};
 253                 printf $uf "Cat%dOptions:\n", $i;
 254                 for my $j (0..$#{$cat->{"pri"}}) {
 255                     if (defined $cat->{"ttl"}->[$j]) {
 256                         printf $uf " %s - %s\n",
 257                             $cat->{"pri"}->[$j], $cat->{"ttl"}->[$j];
 258                     } else {
 259                         printf $uf " %s\n", $cat->{"pri"}->[$j];
 260                     }
 261                 }
 262                 printf $uf "Cat%dDefault: %s\n", $i, $cat->{"def"}
 263                     if defined $cat->{"def"};
 264                 printf $uf "Cat%dOrder: %s\n", $i, join(", ", @{$cat->{"ord"}})
 265                     if defined $cat->{"ord"};
 266             } else {
 267                 printf $uf "Cat%d: %s\n", $i, $cat;
 268             }
 269         }
 270         print $uf "\n";
 271     }
 272
 273     close($uf);
 274     delete $user->{"locked"};
 275 }
 276
 277 1;
 278
 279 __END__