X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FUser.pm;h=2457e54c4e5d51633794b909c2f18f0e2f9da004;hb=refs%2Fheads%2Fdebian;hp=52116a7242dcda0bff37bfb76de8b65c7e969187;hpb=f2610fe47aae5a9378db9da21064abc5456688c9;p=debbugs.git diff --git a/Debbugs/User.pm b/Debbugs/User.pm index 52116a7..2457e54 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 @@ -141,15 +158,15 @@ sub new { }; bless $self, $class; - $self->{filename} = _file_from_email($self->{email}); - if (not -r $p) { - return bless $user, "Debbugs::User"; + $self->{filename} = usertag_file_from_email($self->{email}); + if (not -r $self->{filename}) { + return $self; } - my $uf = IO::File->new($p,'r') - or die "Unable to open file $p for reading: $!"; + my $uf = IO::File->new($self->{filename},'r') + or die "Unable to open file $self->{filename} for reading: $!"; if ($need_lock) { flock($uf, LOCK_EX); - $user->{"locked"} = $uf; + $self->{"locked"} = $uf; } while(1) { @@ -220,7 +237,7 @@ sub new { sub write { my $self = shift; - my $uf; + my $ut = $self->{"tags"}; my $p = $self->{"filename"}; @@ -318,11 +335,11 @@ 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 $t (keys %{$user->{"tags"}}) { - $ut->{$t} = [] unless defined $ut->{$t}; - push @{$ut->{$t}}, @{$user->{"tags"}->{$t}}; + for my $tag (keys %{$user->{"tags"}}) { + $usertags->{$tag} = [] unless defined $usertags->{$tag}; + push @{$usertags->{$tag}}, @{$user->{"tags"}->{$tag}}; } return $usertags; } @@ -339,31 +356,15 @@ 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"} = { %{$ut} }; + $user->{"tags"} = { %{$usertags} }; $user->write(); } =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 +401,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; @@ -422,4 +423,3 @@ sub _wrap_to_length { 1; __END__ -# -*- cperl-set-style: PerlStyle -*-