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.
6 # [Other people have contributed to this file; their copyrights should
8 # Copyright 2004 by Anthony Towns
12 package Debbugs::User;
16 Debbugs::User -- User settings
20 use Debbugs::User qw(is_valid_user read_usertags write_usertags);
22 Debbugs::User::is_valid_user($userid);
24 $u = Debbugs::User::open($userid);
25 $u = Debbugs::User::open(user => $userid, locked => 0);
27 $u = Debbugs::User::open(user => $userid, locked => 1);
36 read_usertags(\%ut, $userid);
37 write_usertags(\%ut, $userid);
43 =item :all -- all functions that can be exported
54 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
55 use base qw(Exporter);
57 use Debbugs::Config qw(:globals);
58 use List::Util qw(min);
61 ($VERSION) = q$Revision: 1.4 $ =~ /^Revision:\s+([^\s+])/;
62 $DEBUG = 0 unless defined $DEBUG;
65 @EXPORT_OK = qw(is_valid_user open read_usertags write_usertags);
66 $EXPORT_TAGS{all} = [@EXPORT_OK];
69 # Obsolete compatability functions
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}};
86 my $user = get_user($u, 1); # locked
87 $user->{"tags"} = { %{$ut} };
91 #######################################################################
96 my $l = length($e) % 7;
97 return "$gSpoolDir/user/$l/" . join("",
98 map { m/^[0-9a-zA-Z_+.-]$/ ? $_ : sprintf("%%%02X", ord($_)) }
110 if ($field && m/^ (.*)$/) {
111 $res[-1] .= "\n" . $1;
112 } elsif (m/^([^:]+):(\s+(.*))?$/) {
125 while ($s =~ m/^([^,]*,\s*)(.*)$/ || $s =~ m/^([^,]+)()$/) {
128 unless ($sofar == 0 or $sofar + length($k) <= $n) {
133 $sofar += length($k);
140 return ($u =~ /^[a-zA-Z0-9._+-]+[@][a-z0-9-.]{4,}$/);
143 #######################################################################
151 "visible_cats" => [],
152 "unknown_stanzas" => []
156 my $need_lock = shift || 0;
157 my $p = filefromemail($u);
160 $user->{"filename"} = $p;
162 return bless $user, "Debbugs::User";
164 open($uf, "< $p") or die "Unable to open file $p for reading: $!";
167 $user->{"locked"} = $uf;
171 my @stanza = read_stanza($uf);
172 last if ($#stanza == -1);
173 if ($stanza[0] eq "Tag") {
176 $ut->{$t} = [] unless defined $ut->{$t};
177 push @{$ut->{$t}}, split /\s*,\s*/, $tag{Bugs};
178 } elsif ($stanza[0] eq "Category") {
180 my %stanza = @stanza;
181 my $catname = $stanza{"Category"};
183 while (++$i && defined $stanza{"Cat${i}"}) {
184 if (defined $stanza{"Cat${i}Options"}) {
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"};
192 my $min = min(@temp);
193 # Order to 0 minimum; strip duplicates
194 $c{ord} = [map {$temp{$_}++;
195 $temp{$_}>1?():($_-$min);
200 for my $l (split /\n/, $stanza{"Cat${i}Options"}) {
201 if ($l =~ m/^\s*(\S+)\s+-\s+(.*\S)\s*$/) {
204 } elsif ($l =~ m/^\s*(\S+)\s*$/) {
213 push @cat, $stanza{"Cat${i}"};
216 $user->{"categories"}->{$catname} = [@cat];
217 push @{$user->{"visible_cats"}}, $catname
218 unless ($stanza{"Hidden"} || "no") eq "yes";
220 push @{$user->{"unknown_stanzas"}}, [@stanza];
223 close($uf) unless $need_lock;
225 bless $user, "Debbugs::User";
232 my $ut = $user->{"tags"};
233 my $p = $user->{"filename"};
235 if ($p =~ m/^(.+)$/) { $p = $1; } else { return; }
236 open $uf, "> $p" or return;
238 for my $us (@{$user->{"unknown_stanzas"}}) {
241 my $k = shift @us; my $v = shift @us;
243 print $uf "$k: $v\n";
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";
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;
260 print $uf "Category: $c\n";
261 print $uf "Hidden: yes\n" unless defined $vis{$c};
263 for my $cat (@{$uc->{$c}}) {
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];
273 printf $uf " %s\n", $cat->{"pri"}->[$j];
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"};
281 printf $uf "Cat%d: %s\n", $i, $cat;
288 delete $user->{"locked"};