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