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