X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FUser.pm;h=3c4cf6a02da445d3a33d4c764e0847409b981cac;hb=cc06d9ad3fdd35582118b87fa1b2be5d5b0de7db;hp=cbb0fa857989d8d8d4a9c59695d63a057c5349c9;hpb=66eac9ad8bcf3ff13c8d3bad46a3c02ffb782a2f;p=debbugs.git diff --git a/Debbugs/User.pm b/Debbugs/User.pm index cbb0fa8..3c4cf6a 100644 --- a/Debbugs/User.pm +++ b/Debbugs/User.pm @@ -83,10 +83,10 @@ use warnings; use strict; use Fcntl ':flock'; use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); -use base qw(Exporter); +use Exporter qw(import); use Debbugs::Config qw(:config); -use List::Util qw(min); +use List::AllUtils qw(min); use Carp; use IO::File; @@ -109,6 +109,23 @@ sub is_valid_user { return ($u =~ /^[a-zA-Z0-9._+-]+[@][a-z0-9-.]{4,}$/); } +=head2 usertag_file_from_email + + my $filename = usertag_file_from_email($email) + +Turns an email into the filename where the usertag can be located. + +=cut + +sub usertag_file_from_email { + my ($email) = @_; + my $email_length = length($email) % 7; + my $escaped_email = $email; + $escaped_email =~ s/([^0-9a-zA-Z_+.-])/sprintf("%%%02X", ord($1))/eg; + return "$config{usertag_dir}/$email_length/$escaped_email"; +} + + ####################################################################### # The real deal @@ -137,11 +154,12 @@ sub new { "visible_cats" => [], "unknown_stanzas" => [], values => {}, + bug_tags => {}, email => $email, }; bless $self, $class; - $self->{filename} = _file_from_email($self->{email}); + $self->{filename} = usertag_file_from_email($self->{email}); if (not -r $self->{filename}) { return $self; } @@ -159,7 +177,12 @@ sub new { my %tag = @stanza; my $t = $tag{"Tag"}; $ut->{$t} = [] unless defined $ut->{$t}; - push @{$ut->{$t}}, split /\s*,\s*/, $tag{Bugs}; + my @bugs = split /\s*,\s*/, $tag{Bugs}; + push @{$ut->{$t}}, @bugs; + for my $bug (@bugs) { + push @{$self->{bug_tags}{$bug}}, + $t; + } } elsif ($stanza[0] eq "Category") { my @cat = (); my %stanza = @stanza; @@ -218,6 +241,22 @@ sub new { return $self; } +sub email { + my $self = shift; + return $self->{email}; +} + +sub tags { + my $self = shift; + + return $self->{"tags"}; +} + +sub tags_on_bug { + my $self = shift; + return map {@{$self->{"bug_tags"}{$_}//[]}} @_; +} + sub write { my $self = shift; @@ -318,7 +357,7 @@ sub write { sub read_usertags { my ($usertags,$email) = @_; - carp "read_usertags is deprecated"; +# carp "read_usertags is deprecated"; my $user = get_user($email); for my $tag (keys %{$user->{"tags"}}) { $usertags->{$tag} = [] unless defined $usertags->{$tag}; @@ -339,7 +378,7 @@ them out. sub write_usertags { my ($usertags,$email) = @_; - carp "write_usertags is deprecated"; +# carp "write_usertags is deprecated"; my $user = Debbugs::User->new($email,1); # locked $user->{"tags"} = { %{$usertags} }; $user->write(); @@ -348,22 +387,6 @@ sub write_usertags { =head1 PRIVATE FUNCTIONS -=head2 _file_from_email - - my $filename = _file_from_email($email) - -Turns an email into the filename where the usertag can be located. - -=cut - -sub _file_from_email { - my ($email) = @_; - my $email_length = length($email) % 7; - my $escaped_email = $email; - $escaped_email =~ s/([^0-9a-zA-Z_+.-])/sprintf("%%%02X", ord($1))/eg; - return "$config{usertag_dir}/$email_length/$escaped_email"; -} - =head2 _read_stanza my @stanza = _read_stanza($fh); @@ -400,7 +423,7 @@ Wraps a line to a specific length by splitting at commas sub _wrap_to_length { my ($content,$line_length) = @_; - my $current_line_length; + my $current_line_length = 0; my $result = ""; while ($content =~ m/^([^,]*,\s*)(.*)$/ || $content =~ m/^([^,]+)()$/) { my $current_word = $1;