+++ /dev/null
-# 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;
-
-=head1 NAME
-
-Debbugs::User -- User settings
-
-=head1 SYNOPSIS
-
-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
-
-=item :all -- all functions that can be exported
-
-=back
-
-=head1 FUNCTIONS
-
-=cut
-
-use warnings;
-use strict;
-use Fcntl ':flock';
-use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
-use Exporter qw(import);
-
-use Debbugs::Config qw(:config);
-use List::AllUtils qw(min);
-
-use Carp;
-use IO::File;
-
-BEGIN {
- ($VERSION) = q$Revision: 1.4 $ =~ /^Revision:\s+([^\s+])/;
- $DEBUG = 0 unless defined $DEBUG;
-
- @EXPORT = ();
- @EXPORT_OK = qw(is_valid_user read_usertags write_usertags);
- $EXPORT_TAGS{all} = [@EXPORT_OK];
-}
-
-
-#######################################################################
-# Helper functions
-
-sub is_valid_user {
- my $u = shift;
- 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
-
-sub get_user {
- return Debbugs::User->new(@_);
-}
-
-=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 => {},
- bug_tags => {},
- email => $email,
- };
- bless $self, $class;
-
- $self->{filename} = usertag_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;
- }
-
- while(1) {
- 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};
- 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;
- 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];
- }
- }
-
- 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 has_bug_tags {
- my $self = shift;
- return keys %{$self->{bug_tags}} > 0;
-}
-
-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";
- }
- print {$uf} "\n";
- }
-
- 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 ($usertags,$email) = @_;
-
-# carp "write_usertags is deprecated";
- my $user = Debbugs::User->new($email,1); # locked
- $user->{"tags"} = { %{$usertags} };
- $user->write();
-}
-
-
-=head1 PRIVATE FUNCTIONS
-
-=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||'');
- }
- }
- return @res;
-}
-
-
-=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__
projects / debbugs.git / blobdiff