+ } elsif (m/^user\s+(\S+)\s*$/i) {
+ my $newuser = $1;
+ if (Debbugs::User::is_valid_user($newuser)) {
+ my $olduser = ($user ne "" ? " (was $user)" : "");
+ &transcript("Setting user to $newuser$olduser.\n");
+ $user = $newuser;
+ } else {
+ &transcript("Selected user id ($newuser) invalid, sorry\n");
+ $user = "";
+ }
+ } elsif (m/^usercategory\s+(\S+)(\s+\[hidden\])?\s*$/i) {
+ $ok++;
+ my $catname = $1;
+ my $hidden = ($2 ne "");
+
+ my $prefix = "";
+ my @cats;
+ my $bad = 0;
+ my $catsec = 0;
+ while (++$procline <= $#bodylines) {
+ unless ($bodylines[$procline] =~ m/^\s*([*+])\s*(\S.*)$/) {
+ $procline--;
+ last;
+ }
+ &transcript("> $bodylines[$procline]\n");
+ next if $bad;
+ my ($o, $txt) = ($1, $2);
+ if ($#cats == -1 && $o eq "+") {
+ &transcript("User defined category specification must start with a category name. Skipping.\n\n");
+ $bad = 1;
+ next;
+ }
+ if ($o eq "+") {
+ unless (ref($cats[-1]) eq "HASH") {
+ $cats[-1] = { "nam" => $cats[-1],
+ "pri" => [], "ttl" => [] };
+ }
+ $catsec++;
+ my ($desc, $ord, $op);
+ if ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?\]\s*$/) {
+ $desc = $1; $ord = $3; $op = "";
+ } elsif ($txt =~ m/^(.*\S)\s*\[((\d+):\s*)?(\S+)\]\s*$/) {
+ $desc = $1; $ord = $3; $op = $4;
+ } elsif ($txt =~ m/^([^[\s]+)\s*$/) {
+ $desc = ""; $op = $1;
+ } else {
+ &transcript("Unrecognised syntax for category section. Skipping.\n\n");
+ $bad = 1;
+ next;
+ }
+ $ord = 999 unless defined $ord;
+
+ if ($op) {
+ push @{$cats[-1]->{"pri"}}, $prefix . $op;
+ push @{$cats[-1]->{"ttl"}}, $desc;
+ push @ords, "$ord $catsec";
+ } else {
+ @cats[-1]->{"def"} = $desc;
+ push @ords, "$ord DEF";
+ $catsec--;
+ }
+ @ords = sort { my ($a1, $a2, $b1, $b2) = split / /, "$a $b";
+ $a1 <=> $b1 || $a2 <=> $b2; } @ords;
+ $cats[-1]->{"ord"} = [map { m/^.* (\S+)/; $1 eq "DEF" ? $catsec + 1 : $1 } @ords];
+ } elsif ($o eq "*") {
+ $catsec = 0;
+ my ($name);
+ if ($txt =~ m/^(.*\S)(\s*\[(\S+)\])\s*$/) {
+ $name = $1; $prefix = $3;
+ } else {
+ $name = $txt; $prefix = "";
+ }
+ push @cats, $name;
+ }
+ }
+ # XXX: got @cats, now do something with it
+ my $u = Debbugs::User::get_user($user);
+ if (@cats) {
+ &transcript("Added usercategory $catname.\n\n");
+ $u->{"categories"}->{$catname} = [ @cats ];
+ } else {
+ &transcript("Removed usercategory $catname.\n\n");
+ delete $u->{"categories"}->{$catname};
+ }
+ $u->write();
+ } elsif (m/^usertags?\s+\#?(-?\d+)\s+(([=+-])\s*)?(\S.*)?$/i) {
+ $ok++;
+ $ref = $1; $addsubcode = $3 || "+"; $tags = $4;
+ if ($user eq "") {
+ &transcript("No valid user selected\n");
+ } else {
+ my %ut;
+ Debbugs::User::read_usertags(\%ut, $user);
+ my @oldtags = (); my @newtags = (); my @badtags = ();
+ my %chtags;
+ for my $t (split /[,\s]+/, $tags) {
+ if ($t =~ m/^[a-zA-Z0-9.+\@-]+$/) {
+ $chtags{$t} = 1;
+ } else {
+ push @badtags, $t;
+ }
+ }
+ if (@badtags) {
+ &transcript("Ignoring illegal tag/s: ".join(', ', @badtags).".\nPlease use only alphanumerics, at, dot, plus and dash.\n");
+ }
+ for my $t (keys %chtags) {
+ $ut{$t} = [] unless defined $ut{$t};
+ }
+ for my $t (keys %ut) {
+ my %res = map { ($_, 1) } @{$ut{$t}};
+ push @oldtags, $t if defined $res{$ref};
+ my $addop = ($addsubcode eq "+" or $addsubcode eq "=");
+ my $del = (defined $chtags{$t} ? $addsubcode eq "-"
+ : $addsubcode eq "=");
+ $res{$ref} = 1 if ($addop && defined $chtags{$t});
+ delete $res{$ref} if ($del);
+ push @newtags, $t if defined $res{$ref};
+ $ut{$t} = [ sort { $a <=> $b } (keys %res) ];
+ }
+ if (@oldtags == 0) {
+ &transcript("There were no usertags set.\n");
+ } else {
+ &transcript("Usertags were: " . join(" ", @oldtags) . ".\n");
+ }
+ &transcript("Usertags are now: " . join(" ", @newtags) . ".\n");
+ Debbugs::User::write_usertags(\%ut, $user);
+ }