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.3 $ =~ /^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 $gSpoolPath = "/org/bugs.debian.org/spool";
  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 "$gSpoolPath/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     open($uf, "< $p") or bless $user, "Debbugs::User";
 151     if ($need_lock) {
 152         flock($uf, LOCK_EX);
 153         $user->{"locked"} = $uf;
 154     }
 155
 156     while(1) {
 157         my @stanza = read_stanza($uf);
 158         last if ($#stanza == -1);
 159         if ($stanza[0] eq "Tag") {
 160             my %tag = @stanza;
 161             my $t = $tag{"Tag"};
 162             $ut->{$t} = [] unless defined $ut->{$t};
 163             push @{$ut->{$t}}, split /\s*,\s*/, $tag{Bugs};
 164         } elsif ($stanza[0] eq "Category") {
 165             my @cat = ();
 166             my %stanza = @stanza;
 167             my $catname = $stanza{"Category"};
 168             my $i = 0;
 169             while (++$i && defined $stanza{"Cat${i}"}) {
 170                 if (defined $stanza{"Cat${i}Options"}) {
 171                     # parse into a hash
 172                     my %c = ("nam" => $stanza{"Cat${i}"});
 173                     $c{"def"} = $stanza{"Cat${i}Default"}
 174                         if defined $stanza{"Cat${i}Default"};
 175                     $c{"ord"} = [ split /,/, $stanza{"Cat${i}Order"} ]
 176                         if defined $stanza{"Cat${i}Order"};
 177                     my @pri; my @ttl;
 178                     for my $l (split /\n/, $stanza{"Cat${i}Options"}) {
 179                         if ($l =~ m/^\s*(\S+)\s+-\s+(.*\S)\s*$/) {
 180                             push @pri, $1;
 181                             push @ttl, $2;
 182                         } elsif ($l =~ m/^\s*(\S+)\s*$/) {
 183                             push @pri, $1;
 184                             push @ttl, $1;
 185                         }
 186                     }
 187                     $c{"ttl"} = [@ttl];
 188                     $c{"pri"} = [@pri];
 189                     push @cat, { %c };
 190                 } else {
 191                     push @cat, $stanza{"Cat${i}"};
 192                 }
 193             }
 194             $user->{"categories"}->{$catname} = [@cat];
 195             push @{$user->{"visible_cats"}}, $catname
 196                 unless ($stanza{"Hidden"} || "no") eq "yes";
 197         } else {
 198             push @{$user->{"unknown_stanzas"}}, [@stanza];
 199         }
 200     }
 201     close($uf) unless $need_lock;
 202
 203     bless $user, "Debbugs::User";
 204     return $user;
 205 }
 206
 207 sub write {
 208     my $user = shift;
 209     my $uf;
 210     my $ut = $user->{"tags"};
 211     my $p = $user->{"filename"};
 212
 213     if ($p =~ m/^(.+)$/) { $p = $1; } else { return; }
 214     open $uf, "> $p" or return;
 215
 216     for my $us (@{$user->{"unknown_stanzas"}}) {
 217         my @us = @{$us};
 218         while (@us) {
 219             my $k = shift @us; my $v = shift @us;
 220             $v =~ s/\n/\n /g;
 221             print $uf "$k: $v\n";
 222         }
 223         print $uf "\n";
 224     }
 225
 226     for my $t (keys %{$ut}) {
 227         next if @{$ut->{$t}} == 0;
 228         print $uf "Tag: $t\n";
 229         print $uf fmt("Bugs: " . join(", ", @{$ut->{$t}}), 77) . "\n";
 230         print $uf "\n";
 231     }
 232
 233     my $uc = $user->{"categories"};
 234     my %vis = map { $_, 1 } @{$user->{"visible_cats"}};
 235     for my $c (keys %{$uc}) {
 236         next if @{$uc->{$c}} == 0;
 237
 238         print $uf "Category: $c\n";
 239         print $uf "Hidden: yes\n" unless defined $vis{$c};
 240         my $i = 0;
 241         for my $cat (@{$uc->{$c}}) {
 242             $i++;
 243             if (ref($cat) eq "HASH") {
 244                 printf $uf "Cat%d: %s\n", $i, $cat->{"nam"};
 245                 printf $uf "Cat%dOptions:\n", $i;
 246                 for my $j (0..$#{$cat->{"pri"}}) {
 247                     if (defined $cat->{"ttl"}->[$j]) {
 248                         printf $uf " %s - %s\n",
 249                             $cat->{"pri"}->[$j], $cat->{"ttl"}->[$j];
 250                     } else {
 251                         printf $uf " %s\n", $cat->{"pri"}->[$j];
 252                     }
 253                 }
 254                 printf $uf "Cat%dDefault: %s\n", $i, $cat->{"def"}
 255                     if defined $cat->{"def"};
 256                 printf $uf "Cat%dOrder: %s\n", $i, join(", ", @{$cat->{"ord"}})
 257                     if defined $cat->{"ord"};
 258             } else {
 259                 printf $uf "Cat%d: %s\n", $i, $cat;
 260             }
 261         }
 262         print $uf "\n";
 263     }
 264
 265     close($uf);
 266     delete $user->{"locked"};
 267 }
 268
 269 1;
 270
 271 __END__