+# This module is part of debbugs, and is released
+# under the terms of the GPL version 2, or any later
+# version at your option.
+# See the file README and COPYING for more information.
+#
+# [Other people have contributed to this file; their copyrights should
+# go here too.]
+# Copyright 2004 by Anthony Towns
+# Copyright 2008 by Don Armstrong <don@donarmstrong.com>
+
package Debbugs::User;
use Debbugs::User qw(is_valid_user read_usertags write_usertags);
+Debbugs::User::is_valid_user($userid);
+
+$u = Debbugs::User::open($userid);
+$u = Debbugs::User::open(user => $userid, locked => 0);
+
+$u = Debbugs::User::open(user => $userid, locked => 1);
+$u->write();
+
+$u->{"tags"}
+$u->{"categories"}
+$u->{"is_locked"}
+$u->{"name"}
+
+
read_usertags(\%ut, $userid);
write_usertags(\%ut, $userid);
+=head1 USERTAG FILE FORMAT
+
+Usertags are in a file which has (roughly) RFC822 format, with stanzas
+separated by newlines. For example:
+
+ Tag: search
+ Bugs: 73671, 392392
+
+ Value: priority
+ Bug-73671: 5
+ Bug-73487: 2
+
+ Value: bugzilla
+ Bug-72341: http://bugzilla/2039471
+ Bug-1022: http://bugzilla/230941
+
+ Category: normal
+ Cat1: status
+ Cat2: debbugs.tasks
+
+ Category: debbugs.tasks
+ Hidden: yes
+ Cat1: debbugs.tasks
+
+ Cat1Options:
+ tag=quick
+ tag=medium
+ tag=arch
+ tag=not-for-me
+
+
=head1 EXPORT TAGS
=over
use warnings;
use strict;
+use Fcntl ':flock';
use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
use base qw(Exporter);
+use Debbugs::Config qw(:config);
+use List::Util qw(min);
+
+use Carp;
+use IO::File;
+
BEGIN {
- ($VERSION) = q$Revision: 1.2 $ =~ /^Revision:\s+([^\s+])/;
+ ($VERSION) = q$Revision: 1.4 $ =~ /^Revision:\s+([^\s+])/;
$DEBUG = 0 unless defined $DEBUG;
@EXPORT = ();
}
-my $gSpoolPath = "/org/bugs.debian.org/spool";
-
-sub esc {
- my $s = shift;
- if ($s =~ m/^[0-9a-zA-Z_+.-]$/) { return $s; }
- else { return sprintf("%%%02X", ord($s)); }
-}
+#######################################################################
+# Helper functions
-sub filefromemail {
- my $e = shift;
- my $l = length($e) % 7;
- return "$gSpoolPath/user/$l/" . join("", map { esc($_); } split //, $e);
+sub is_valid_user {
+ my $u = shift;
+ return ($u =~ /^[a-zA-Z0-9._+-]+[@][a-z0-9-.]{4,}$/);
}
-sub read_stanza {
- my $f = shift;
- my $field = 0;
- my @res;
- while (<$f>) {
- chomp;
- last if (m/^$/);
-
- if ($field && m/^ (.*)$/) {
- $res[-1] .= "\n" . $1;
- } elsif (m/^([^:]+):\s+(.*)$/) {
- $field = $1;
- push @res, ($1, $2);
- }
- }
- return @res;
+#######################################################################
+# The real deal
+
+sub get_user {
+ return Debbugs::User->new(@_);
}
-sub read_usertags {
- my $ut = shift;
- my $u = shift;
- my $p = filefromemail($u);
- my $uf;
+=head2 new
+
+ my $user = Debbugs::User->new('foo@bar.com',$lock);
+
+Reads the user file associated with 'foo@bar.com' and returns a
+Debbugs::User object.
+
+=cut
+
+sub new {
+ my $class = shift;
+ $class = ref($class) || $class;
+ my ($email,$need_lock) = @_;
+ $need_lock ||= 0;
+
+ my $ut = {};
+ my $self = {"tags" => $ut,
+ "categories" => {},
+ "visible_cats" => [],
+ "unknown_stanzas" => [],
+ values => {},
+ email => $email,
+ };
+ bless $self, $class;
+
+ $self->{filename} = _file_from_email($self->{email});
+ if (not -r $self->{filename}) {
+ return $self;
+ }
+ 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);
+ $self->{"locked"} = $uf;
+ }
- open($uf, "< $p") or return;
while(1) {
- my @stanza = read_stanza($uf);
- last if ($#stanza == -1);
- if ($stanza[0] eq "Tag") {
+ my @stanza = _read_stanza($uf);
+ last unless @stanza;
+ if ($stanza[0] eq "Tag") {
my %tag = @stanza;
my $t = $tag{"Tag"};
$ut->{$t} = [] unless defined $ut->{$t};
push @{$ut->{$t}}, split /\s*,\s*/, $tag{Bugs};
+ } elsif ($stanza[0] eq "Category") {
+ my @cat = ();
+ my %stanza = @stanza;
+ my $catname = $stanza{"Category"};
+ my $i = 0;
+ while (++$i && defined $stanza{"Cat${i}"}) {
+ if (defined $stanza{"Cat${i}Options"}) {
+ # parse into a hash
+ my %c = ("nam" => $stanza{"Cat${i}"});
+ $c{"def"} = $stanza{"Cat${i}Default"}
+ if defined $stanza{"Cat${i}Default"};
+ if (defined $stanza{"Cat${i}Order"}) {
+ my @temp = split /\s*,\s*/, $stanza{"Cat${i}Order"};
+ my %temp;
+ my $min = min(@temp);
+ # Order to 0 minimum; strip duplicates
+ $c{ord} = [map {$temp{$_}++;
+ $temp{$_}>1?():($_-$min);
+ } @temp
+ ];
+ }
+ my @pri; my @ttl;
+ for my $l (split /\n/, $stanza{"Cat${i}Options"}) {
+ if ($l =~ m/^\s*(\S+)\s+-\s+(.*\S)\s*$/) {
+ push @pri, $1;
+ push @ttl, $2;
+ } elsif ($l =~ m/^\s*(\S+)\s*$/) {
+ push @pri, $1;
+ push @ttl, $1;
+ }
+ }
+ $c{"ttl"} = [@ttl];
+ $c{"pri"} = [@pri];
+ push @cat, { %c };
+ } else {
+ push @cat, $stanza{"Cat${i}"};
+ }
+ }
+ $self->{"categories"}->{$catname} = [@cat];
+ push @{$self->{"visible_cats"}}, $catname
+ unless ($stanza{"Hidden"} || "no") eq "yes";
+ }
+ elsif ($stanza[0] eq 'Value') {
+ my ($value,$value_name,%bug_values) = @stanza;
+ while (my ($k,$v) = each %bug_values) {
+ my ($bug) = $k =~ m/^Bug-(\d+)/;
+ next unless defined $bug;
+ $self->{values}{$bug}{$value_name} = $v;
+ }
+ }
+ else {
+ push @{$self->{"unknown_stanzas"}}, [@stanza];
}
}
- close($uf);
+
+ return $self;
}
-
-sub fmt {
- my $s = shift;
- my $n = shift;
- my $sofar = 0;
- my $res = "";
- while ($s =~ m/^([^,]*,\s*)(.*)$/ || $s =~ m/^([^,]+)()$/) {
- my $k = $1;
- $s = $2;
- unless ($sofar == 0 or $sofar + length($k) <= $n) {
- $res .= "\n ";
- $sofar = 1;
+
+sub write {
+ my $self = shift;
+
+ my $ut = $self->{"tags"};
+ my $p = $self->{"filename"};
+
+ if (not defined $self->{filename} or not
+ length $self->{filename}) {
+ carp "Tried to write a usertag with no filename defined";
+ return;
+ }
+ my $uf = IO::File->new($self->{filename},'w');
+ if (not $uf) {
+ carp "Unable to open $self->{filename} for writing: $!";
+ return;
+ }
+
+ for my $us (@{$self->{"unknown_stanzas"}}) {
+ my @us = @{$us};
+ while (my ($k,$v) = splice (@us,0,2)) {
+ $v =~ s/\n/\n /g;
+ print {$uf} "$k: $v\n";
}
- $res .= $k;
- $sofar += length($k);
+ print {$uf} "\n";
}
- return $res . $s;
+
+ for my $t (keys %{$ut}) {
+ next if @{$ut->{$t}} == 0;
+ print {$uf} "Tag: $t\n";
+ print {$uf} _wrap_to_length("Bugs: " . join(", ", @{$ut->{$t}}), 77) . "\n";
+ print $uf "\n";
+ }
+
+ my $uc = $self->{"categories"};
+ my %vis = map { $_, 1 } @{$self->{"visible_cats"}};
+ for my $c (keys %{$uc}) {
+ next if @{$uc->{$c}} == 0;
+
+ print $uf "Category: $c\n";
+ print $uf "Hidden: yes\n" unless defined $vis{$c};
+ my $i = 0;
+ for my $cat (@{$uc->{$c}}) {
+ $i++;
+ if (ref($cat) eq "HASH") {
+ printf $uf "Cat%d: %s\n", $i, $cat->{"nam"};
+ printf $uf "Cat%dOptions:\n", $i;
+ for my $j (0..$#{$cat->{"pri"}}) {
+ if (defined $cat->{"ttl"}->[$j]) {
+ printf $uf " %s - %s\n",
+ $cat->{"pri"}->[$j], $cat->{"ttl"}->[$j];
+ } else {
+ printf $uf " %s\n", $cat->{"pri"}->[$j];
+ }
+ }
+ printf $uf "Cat%dDefault: %s\n", $i, $cat->{"def"}
+ if defined $cat->{"def"};
+ printf $uf "Cat%dOrder: %s\n", $i, join(", ", @{$cat->{"ord"}})
+ if defined $cat->{"ord"};
+ } else {
+ printf $uf "Cat%d: %s\n", $i, $cat;
+ }
+ }
+ print $uf "\n";
+ }
+ # handle the value stanzas
+ my %value;
+ # invert the bug->value hash slightly
+ for my $bug (keys %{$self->{values}}) {
+ for my $value (keys %{$self->{values}{$bug}}) {
+ $value{$value}{$bug} = $self->{values}{$bug}{$value}
+ }
+ }
+ for my $value (keys %value) {
+ print {$uf} "Value: $value\n";
+ for my $bug (keys %{$value{$value}}) {
+ my $bug_value = $value{$value}{$bug};
+ $bug_value =~ s/\n/\n /g;
+ print {$uf} "Bug-$bug: $bug_value\n";
+ }
+ print {$uf} "\n";
+ }
+
+ close($uf);
+ delete $self->{"locked"};
+}
+
+=head1 OBSOLETE FUNCTIONS
+
+=cut
+
+=head2 read_usertags
+
+ read_usertags($usertags,$email)
+
+
+=cut
+
+sub read_usertags {
+ my ($usertags,$email) = @_;
+
+# carp "read_usertags is deprecated";
+ my $user = get_user($email);
+ for my $tag (keys %{$user->{"tags"}}) {
+ $usertags->{$tag} = [] unless defined $usertags->{$tag};
+ push @{$usertags->{$tag}}, @{$user->{"tags"}->{$tag}};
+ }
+ return $usertags;
}
+=head2 write_usertags
+
+ write_usertags($usertags,$email);
+
+Gets a lock on the usertags, applies the usertags passed, and writes
+them out.
+
+=cut
+
sub write_usertags {
- my $ut = shift;
- my $u = shift;
- my $p = filefromemail($u);
+ my ($usertags,$email) = @_;
- open(U, "> $p") or die "couldn't write to $p";
- for my $t (keys %{$ut}) {
- next if @{$ut->{$t}} == 0;
- print U "Tag: $t\n";
- print U fmt("Bugs: " . join(", ", @{$ut->{$t}}), 77) . "\n";
- print U "\n";
+# carp "write_usertags is deprecated";
+ my $user = Debbugs::User->new($email,1); # locked
+ $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);
+
+Reads a single stanza from a filehandle and returns it
+
+=cut
+
+sub _read_stanza {
+ my ($file_handle) = @_;
+ my $field = 0;
+ my @res;
+ while (<$file_handle>) {
+ chomp;
+ last if (m/^$/);
+ if ($field && m/^ (.*)$/) {
+ $res[-1] .= "\n" . $1;
+ } elsif (m/^([^:]+):(\s+(.*))?$/) {
+ $field = $1;
+ push @res, ($1, $3||'');
+ }
}
- close(U);
+ return @res;
}
-sub is_valid_user {
- my $u = shift;
- return ($u =~ /^[a-zA-Z0-9._+-]+[@][a-z0-9-.]{4,}$/);
+
+=head2 _wrap_to_length
+
+ _wrap_to_length
+
+Wraps a line to a specific length by splitting at commas
+
+=cut
+
+sub _wrap_to_length {
+ my ($content,$line_length) = @_;
+ my $current_line_length = 0;
+ my $result = "";
+ while ($content =~ m/^([^,]*,\s*)(.*)$/ || $content =~ m/^([^,]+)()$/) {
+ my $current_word = $1;
+ $content = $2;
+ if ($current_line_length != 0 and
+ $current_line_length + length($current_word) <= $line_length) {
+ $result .= "\n ";
+ $current_line_length = 1;
+ }
+ $result .= $current_word;
+ $current_line_length += length($current_word);
+ }
+ return $result . $content;
}
+
+
1;
__END__