Debbugs/User.pm

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