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
9 # Copyright 2008 by Don Armstrong <don@donarmstrong.com>
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);
39 =head1 USERTAG FILE FORMAT
41 Usertags are in a file which has (roughly) RFC822 format, with stanzas
42 separated by newlines. For example:
52 Bug-72341: http://bugzilla/2039471
53 Bug-1022: http://bugzilla/230941
59 Category: debbugs.tasks
74 =item :all -- all functions that can be exported
85 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
86 use base qw(Exporter);
88 use Debbugs::Config qw(:config);
89 use List::Util qw(min);
95 ($VERSION) = q$Revision: 1.4 $ =~ /^Revision:\s+([^\s+])/;
96 $DEBUG = 0 unless defined $DEBUG;
99 @EXPORT_OK = qw(is_valid_user read_usertags write_usertags);
100 $EXPORT_TAGS{all} = [@EXPORT_OK];
104 #######################################################################
109 return ($u =~ /^[a-zA-Z0-9._+-]+[@][a-z0-9-.]{4,}$/);
112 #######################################################################
116 return Debbugs::User->new(@_);
121 my $user = Debbugs::User->new('foo@bar.com',$lock);
123 Reads the user file associated with 'foo@bar.com' and returns a
124 Debbugs::User object.
130 $class = ref($class) || $class;
131 my ($email,$need_lock) = @_;
135 my $self = {"tags" => $ut,
137 "visible_cats" => [],
138 "unknown_stanzas" => [],
144 $self->{filename} = _file_from_email($self->{email});
145 if (not -r $self->{filename}) {
148 my $uf = IO::File->new($self->{filename},'r')
149 or die "Unable to open file $self->{filename} for reading: $!";
152 $self->{"locked"} = $uf;
156 my @stanza = _read_stanza($uf);
158 if ($stanza[0] eq "Tag") {
161 $ut->{$t} = [] unless defined $ut->{$t};
162 push @{$ut->{$t}}, split /\s*,\s*/, $tag{Bugs};
163 } elsif ($stanza[0] eq "Category") {
165 my %stanza = @stanza;
166 my $catname = $stanza{"Category"};
168 while (++$i && defined $stanza{"Cat${i}"}) {
169 if (defined $stanza{"Cat${i}Options"}) {
171 my %c = ("nam" => $stanza{"Cat${i}"});
172 $c{"def"} = $stanza{"Cat${i}Default"}
173 if defined $stanza{"Cat${i}Default"};
174 if (defined $stanza{"Cat${i}Order"}) {
175 my @temp = split /\s*,\s*/, $stanza{"Cat${i}Order"};
177 my $min = min(@temp);
178 # Order to 0 minimum; strip duplicates
179 $c{ord} = [map {$temp{$_}++;
180 $temp{$_}>1?():($_-$min);
185 for my $l (split /\n/, $stanza{"Cat${i}Options"}) {
186 if ($l =~ m/^\s*(\S+)\s+-\s+(.*\S)\s*$/) {
189 } elsif ($l =~ m/^\s*(\S+)\s*$/) {
198 push @cat, $stanza{"Cat${i}"};
201 $self->{"categories"}->{$catname} = [@cat];
202 push @{$self->{"visible_cats"}}, $catname
203 unless ($stanza{"Hidden"} || "no") eq "yes";
205 elsif ($stanza[0] eq 'Value') {
206 my ($value,$value_name,%bug_values) = @stanza;
207 while (my ($k,$v) = each %bug_values) {
208 my ($bug) = $k =~ m/^Bug-(\d+)/;
209 next unless defined $bug;
210 $self->{values}{$bug}{$value_name} = $v;
214 push @{$self->{"unknown_stanzas"}}, [@stanza];
224 my $ut = $self->{"tags"};
225 my $p = $self->{"filename"};
227 if (not defined $self->{filename} or not
228 length $self->{filename}) {
229 carp "Tried to write a usertag with no filename defined";
232 my $uf = IO::File->new($self->{filename},'w');
234 carp "Unable to open $self->{filename} for writing: $!";
238 for my $us (@{$self->{"unknown_stanzas"}}) {
240 while (my ($k,$v) = splice (@us,0,2)) {
242 print {$uf} "$k: $v\n";
247 for my $t (keys %{$ut}) {
248 next if @{$ut->{$t}} == 0;
249 print {$uf} "Tag: $t\n";
250 print {$uf} _wrap_to_length("Bugs: " . join(", ", @{$ut->{$t}}), 77) . "\n";
254 my $uc = $self->{"categories"};
255 my %vis = map { $_, 1 } @{$self->{"visible_cats"}};
256 for my $c (keys %{$uc}) {
257 next if @{$uc->{$c}} == 0;
259 print $uf "Category: $c\n";
260 print $uf "Hidden: yes\n" unless defined $vis{$c};
262 for my $cat (@{$uc->{$c}}) {
264 if (ref($cat) eq "HASH") {
265 printf $uf "Cat%d: %s\n", $i, $cat->{"nam"};
266 printf $uf "Cat%dOptions:\n", $i;
267 for my $j (0..$#{$cat->{"pri"}}) {
268 if (defined $cat->{"ttl"}->[$j]) {
269 printf $uf " %s - %s\n",
270 $cat->{"pri"}->[$j], $cat->{"ttl"}->[$j];
272 printf $uf " %s\n", $cat->{"pri"}->[$j];
275 printf $uf "Cat%dDefault: %s\n", $i, $cat->{"def"}
276 if defined $cat->{"def"};
277 printf $uf "Cat%dOrder: %s\n", $i, join(", ", @{$cat->{"ord"}})
278 if defined $cat->{"ord"};
280 printf $uf "Cat%d: %s\n", $i, $cat;
285 # handle the value stanzas
287 # invert the bug->value hash slightly
288 for my $bug (keys %{$self->{values}}) {
289 for my $value (keys %{$self->{values}{$bug}}) {
290 $value{$value}{$bug} = $self->{values}{$bug}{$value}
293 for my $value (keys %value) {
294 print {$uf} "Value: $value\n";
295 for my $bug (keys %{$value{$value}}) {
296 my $bug_value = $value{$value}{$bug};
297 $bug_value =~ s/\n/\n /g;
298 print {$uf} "Bug-$bug: $bug_value\n";
304 delete $self->{"locked"};
307 =head1 OBSOLETE FUNCTIONS
313 read_usertags($usertags,$email)
319 my ($usertags,$email) = @_;
321 # carp "read_usertags is deprecated";
322 my $user = get_user($email);
323 for my $tag (keys %{$user->{"tags"}}) {
324 $usertags->{$tag} = [] unless defined $usertags->{$tag};
325 push @{$usertags->{$tag}}, @{$user->{"tags"}->{$tag}};
330 =head2 write_usertags
332 write_usertags($usertags,$email);
334 Gets a lock on the usertags, applies the usertags passed, and writes
340 my ($usertags,$email) = @_;
342 # carp "write_usertags is deprecated";
343 my $user = Debbugs::User->new($email,1); # locked
344 $user->{"tags"} = { %{$usertags} };
349 =head1 PRIVATE FUNCTIONS
351 =head2 _file_from_email
353 my $filename = _file_from_email($email)
355 Turns an email into the filename where the usertag can be located.
359 sub _file_from_email {
361 my $email_length = length($email) % 7;
362 my $escaped_email = $email;
363 $escaped_email =~ s/([^0-9a-zA-Z_+.-])/sprintf("%%%02X", ord($1))/eg;
364 return "$config{usertag_dir}/$email_length/$escaped_email";
369 my @stanza = _read_stanza($fh);
371 Reads a single stanza from a filehandle and returns it
376 my ($file_handle) = @_;
379 while (<$file_handle>) {
382 if ($field && m/^ (.*)$/) {
383 $res[-1] .= "\n" . $1;
384 } elsif (m/^([^:]+):(\s+(.*))?$/) {
386 push @res, ($1, $3||'');
393 =head2 _wrap_to_length
397 Wraps a line to a specific length by splitting at commas
401 sub _wrap_to_length {
402 my ($content,$line_length) = @_;
403 my $current_line_length = 0;
405 while ($content =~ m/^([^,]*,\s*)(.*)$/ || $content =~ m/^([^,]+)()$/) {
406 my $current_word = $1;
408 if ($current_line_length != 0 and
409 $current_line_length + length($current_word) <= $line_length) {
411 $current_line_length = 1;
413 $result .= $current_word;
414 $current_line_length += length($current_word);
416 return $result . $content;