bin/local-debbugs

   1 #! /usr/bin/perl
   2 # local-debbugs is part of debbugs, and is released
   3 # under the terms of the GPL version 2, or any later version, at your
   4 # option. See the file README and COPYING for more information.
   5 # Copyright 2008 by Don Armstrong <don@donarmstrong.com>.
   6
   7
   8 use warnings;
   9 use strict;
  10
  11 use Getopt::Long qw(:config no_ignore_case);
  12 use Pod::Usage;
  13
  14 =head1 NAME
  15
  16 local-debbugs - use a local mirror of debbugs
  17
  18 =head1 SYNOPSIS
  19
  20  [options]
  21
  22  Options:
  23   --mirror, -M update local mirror
  24   --daemon, -D start the daemon
  25   --search, -S run a search
  26   --show, -s show a bug
  27   --debug, -d debugging level (Default 0)
  28   --help, -h display this help
  29   --man, -m display manual
  30
  31 =head1 OPTIONS
  32
  33 =over
  34
  35 =item B<--mirror, -M>
  36
  37 Update the local mirror of debbugs bugs
  38
  39 =item B<--daemon, -D>
  40
  41 Start up the daemon on the configured local port to serve bugs which
  42 have been previously retrieved.
  43
  44 =item B<--search, -S>
  45
  46 Cause the running daemon to show the pkgreport.cgi page corresponding
  47 to the search by invoking sensible-browser and an appropriate url.
  48
  49 =item B<--show, -s>
  50
  51 Cause the running daemon to show the bugreport.cgi page corresponding
  52 to the bug by invoking sensible-browser and an appropriate url.
  53
  54 =item B<--port, -p>
  55
  56 The port that the daemon is running on (or will be running on.)
  57
  58 Defaults to the value of the currently running daemon, the value in
  59 the configuration file, or 8080 if nothing is set.
  60
  61 =item B<--bugs-to-get>
  62
  63 File which contains the set of bugs to get.
  64 Defaults to ~/.debbugs/bugs_to_get
  65
  66 =item B<--bug-site>
  67
  68 Hostname for a site which is running a debbugs install.
  69 Defaults to bugs.debian.org
  70
  71 =item B<--bug-mirror>
  72
  73 Hostname for a site which is running an rsyncable mirror of the
  74 debbugs install above.
  75 Defaults to bugs-mirror.debian.org
  76
  77 =item B<--debug, -d>
  78
  79 Debug verbosity.
  80
  81 =item B<--help, -h>
  82
  83 Display brief useage information.
  84
  85 =item B<--man, -m>
  86
  87 Display this manual.
  88
  89 =back
  90
  91 =head1 EXAMPLES
  92
  93 =over
  94
  95 =item Update the local mirror
  96
  97  local-debbugs --mirror
  98
  99 =item Start up the local-debbugs daemon
 100
 101  local-debbugs --daemon
 102
 103 =item Search for bugs with severity serious
 104
 105  local-debbugs --search severity:serious
 106
 107 =back
 108
 109 =cut
 110
 111
 112 use vars qw($DEBUG);
 113
 114 use User;
 115 use Config::Simple;
 116 use File::Basename qw(dirname);
 117 use File::Temp qw(tempdir);
 118 use Params::Validate qw(validate_with :types);
 119 use POSIX 'setsid';
 120 use SOAP::Lite;
 121 use IPC::Run;
 122 use IO::File;
 123 use File::Path;
 124 use File::Spec;
 125
 126 my %options = (debug           => 0,
 127                help            => 0,
 128                man             => 0,
 129                verbose         => 0,
 130                quiet           => 0,
 131                detach          => 1,
 132                git_mode        => -d (dirname(__FILE__).'/../.git') ? 1 : 0,
 133                bug_site        => 'bugs.debian.org',
 134                bug_mirror      => 'bugs-mirror.debian.org',
 135                );
 136
 137 my %option_defaults = (port => 8080,
 138                        debbugs_config => User->Home.'/.debbugs/debbugs_config',
 139                        mirror_location => User->Home.'/.debbugs/mirror',
 140                        bugs_to_get => User->Home.'/.debbugs/bugs_to_get',
 141                       );
 142
 143 GetOptions(\%options,
 144            'daemon|D','show|s','search|select|S','mirror|M', 'stop|exit|quit',
 145            'detach!',
 146            'css=s','cgi_bin|cgi-bin|cgi=s',
 147            'verbose|v+','quiet|q+',
 148            'bug_site|bug-site=s',
 149            'bug_mirror|bug-mirror=s',
 150            'debug|d+','help|h|?','man|m');
 151
 152 if ($options{git_mode}) {
 153     my $base_dir = File::Spec->rel2abs(dirname(__FILE__).'/..');
 154     $options{cgi_bin} = "$base_dir/cgi" unless defined $options{cgi_bin};
 155     $options{css} = "$base_dir/html/bugs.css" unless defined $options{css};
 156     $options{template_dir} = "$base_dir/templates";
 157     eval "use lib '$base_dir'";
 158 } else {
 159     $options{cgi_bin} = '/var/lib/debbugs/www/cgi';
 160     $options{css} = '/var/lib/debbugs/www/bugs.css';
 161     $options{template_dir} = "/usr/share/debbugs/templates";
 162 }
 163
 164 eval "use Debbugs::Common qw(checkpid lockpid get_hashname)";
 165 eval "use Debbugs::Mail qw(get_addresses)";
 166
 167 pod2usage() if $options{help};
 168 pod2usage({verbose=>2}) if $options{man};
 169
 170 $DEBUG = $options{debug};
 171
 172 my @USAGE_ERRORS;
 173 if (1 != grep {exists $options{$_}} qw(daemon show search mirror stop)) {
 174      push @USAGE_ERRORS,"You must pass one (and only one) of --daemon --show --search --mirror or --stop";
 175 }
 176 $options{verbose} = $options{verbose} - $options{quiet};
 177
 178 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 179
 180
 181 # munge in local configuration
 182
 183 local_config(\%options);
 184
 185 mkpath($options{mirror_location});
 186
 187 if ($options{daemon}) {
 188      # daemonize, do stuff
 189      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 190      if (defined $pid and $pid != 0) {
 191           print STDERR "Unable to start daemon; it's already running\n";
 192           exit 1;
 193      }
 194      if (-e $options{mirror_location}.'/local-debbugs.pid' and
 195          not defined $pid) {
 196           print STDERR "Unable to determine if daemon is running: $!\n";
 197           exit 1;
 198      }
 199      my $conf = IO::File->new($options{mirror_location}.'/debbugs_config_local','w') or
 200          die "Unable to open $options{mirror_location}/debbugs_config_local for writing: $!";
 201      print {$conf} <<"EOF";
 202 \$gConfigDir = "$options{mirror_location}";
 203 \$gSpoolDir = "$options{mirror_location}";
 204 \$gTemplateDir = "$options{template_dir}";
 205 \$gWebHost = 'localhost:$options{port}';
 206 \$gPackageSource = '';
 207 \$gPseudoDescFile = '';
 208 \$gPseudoMaintFile = '';
 209 \$gMaintainerFile = '';
 210 \$gMaintainerFileOverride = '';
 211 \$config{source_maintainer_file} = '';
 212 \$config{source_maintainer_file_override} = '';
 213 \$gProject = 'Local Debbugs';
 214 1;
 215 EOF
 216      close $conf;
 217      $ENV{DEBBUGS_CONFIG_FILE} = $options{mirror_location}.'/debbugs_config_local';
 218      # ok, now lets daemonize
 219
 220      # XXX make sure that all paths have been turned into absolute
 221      # paths
 222      chdir '/' or die "Can't chdir to /: $!";
 223      # allow us not to detach for debugging
 224      if ($options{detach}) {
 225           open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
 226           open STDOUT, '>/dev/null'
 227                or die "Can't write to /dev/null: $!";
 228           defined(my $pid = fork) or die "Can't fork: $!";
 229           exit if $pid;
 230           setsid or die "Can't start a new session: $!";
 231           open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
 232      }
 233      lockpid($options{mirror_location}.'/local-debbugs.pid') or
 234           die "Unable to deal with the pidfile";
 235      # this is the subclass of HTTP::Server::Simple::CGI which handles
 236      # the "hard" bits of actually running a tiny webserver for us
 237      {
 238           package local_debbugs::server;
 239           use IO::File;
 240           use HTTP::Server::Simple;
 241           use File::Basename qw(dirname);
 242           use base qw(HTTP::Server::Simple::CGI HTTP::Server::Simple::CGI::Environment);
 243
 244           sub net_server {
 245                return 'Net::Server::Fork';
 246           }
 247
 248           sub redirect {
 249                my ($cgi,$url) = @_;
 250                print "HTTP/1.1 302 Found\r\n";
 251                print "Location: $url\r\n";
 252           }
 253
 254           # here we want to call cgi-bin/pkgreport or cgi-bin/bugreport
 255           sub handle_request {
 256                my ($self,$cgi) = @_;
 257
 258                $ENV{DEBBUGS_CONFIG_FILE} = $options{mirror_location}.'/debbugs_config_local';
 259                if (-d dirname(__FILE__).'../Debbugs' and
 260                    -d dirname(__FILE__).'../.git'
 261                   ) {
 262                    $ENV{PERL5LIB} = dirname(__FILE__).'/../';
 263                }
 264                my $base_uri = 'http://'.$cgi->virtual_host;
 265                if ($cgi->virtual_port ne 80) {
 266                     $base_uri .= ':'.$cgi->virtual_port;
 267                }
 268                my $path = $cgi->path_info();
 269                # RewriteRule ^/[[:space:]]*#?([[:digit:]][[:digit:]][[:digit:]]+)([;&].+)?$ /cgi-bin/bugreport.cgi?bug=$1$2 [L,R,NE]
 270                if ($path =~ m{^/?\s*\#?(\d+)((?:[;&].+)?)$}) {
 271                     redirect($cgi,$base_uri."/cgi-bin/bugreport.cgi?bug=$1$2");
 272                }
 273                # RewriteRule ^/[Ff][Rr][Oo][Mm]:([^/]+\@.+)$ /cgi-bin/pkgreport.cgi?submitter=$1 [L,R,NE]
 274                elsif ($path =~ m{^/?\s*from:([^/]+\@.+)$}i) {
 275                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?submitter=$1");
 276                }
 277                # RewriteRule ^/([^/]+\@.+)$ /cgi-bin/pkgreport.cgi?maint=$1 [L,R,NE]
 278                elsif ($path =~ m{^/?\s*([^/]+\@.+)$}i) {
 279                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?maint=$1");
 280                }
 281                # RewriteRule ^/mbox:([[:digit:]][[:digit:]][[:digit:]]+)([;&].+)?$ /cgi-bin/bugreport.cgi?mbox=yes&bug=$1$2 [L,R,NE]
 282                elsif ($path =~ m{^/?\s*mbox:\#?(\d+)((?:[;&].+)?)$}i) {
 283                     redirect($cgi,$base_uri."/cgi-bin/bugreport.cgi?mbox=yes;bug=$1$2");
 284                }
 285                # RewriteRule ^/src:([^/]+)$ /cgi-bin/pkgreport.cgi?src=$1 [L,R,NE]
 286                elsif ($path =~ m{^/?src:([^/]+)$}i) {
 287                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?src=$1");
 288                }
 289                # RewriteRule ^/severity:([^/]+)$ /cgi-bin/pkgreport.cgi?severity=$1 [L,R,NE]
 290                elsif ($path =~ m{^/?severity:([^/]+)$}i) {
 291                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?severity=$1");
 292                }
 293                # RewriteRule ^/tag:([^/]+)$ /cgi-bin/pkgreport.cgi?tag=$1 [L,R,NE]
 294                elsif ($path =~ m{^/?tag:([^/]+)$}i) {
 295                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?tag=$1");
 296                }
 297                # RewriteRule ^/([^/]+)$ /cgi-bin/pkgreport.cgi?pkg=$1 [L,R,NE]
 298                elsif ($path =~ m{^/?([^/]+)$}i) {
 299                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?pkg=$1");
 300                }
 301                elsif ($path =~ m{^/?cgi(?:-bin)?/((?:(?:bug|pkg)report|version)\.cgi)}) {
 302                     # dispatch to pkgreport.cgi
 303                     #print "HTTP/1.1 200 OK\n";
 304                     open(my $fh,'-|',"$options{cgi_bin}/$1") or
 305                         die "Unable to execute $options{cgi_bin}/$1";
 306                     my $status;
 307                     my $cache = '';
 308                     while (<$fh>) {
 309                         if (/Status: (\d+\s+.+?)\n?$/) {
 310                             $status = $1;
 311                             print "HTTP/1.1 $status\n";
 312                             print STDERR "'$status'\n";
 313                             last;
 314                         }
 315                         $cache .= $_;
 316                         if (/^$/) {
 317                             print "HTTP/1.1 200 OK\n";
 318                             last;
 319                         }
 320                     }
 321                     print $cache;
 322                     print <$fh>;
 323                     close($fh) or die "Unable to close";
 324                 }
 325                elsif ($path =~ m{^/?css/bugs.css}) {
 326                     my $fh = IO::File->new($options{css},'r') or
 327                          die "Unable to open $options{css} for reading: $!";
 328                     print "HTTP/1.1 200 OK\n";
 329                     print "Content-type: text/css\n";
 330                     print "\n";
 331                     print <$fh>;
 332                }
 333                elsif ($path =~ m{^/?$}) {
 334                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?package=put%20package%20here");
 335                }
 336                else {
 337                     print "HTTP/1.1 404 Not Found\n";
 338                     print "Content-Type: text/html\n";
 339                     print "\n";
 340                     print "<h1>That which you were seeking, found I have not.</h1>\n";
 341                }
 342                # RewriteRule ^/$ /Bugs/ [L,R,NE]
 343           }
 344      }
 345      my $debbugs_server = local_debbugs::server->new($options{port}) or
 346           die "Unable to create debbugs server";
 347      $debbugs_server->run() or
 348           die 'Unable to run debbugs server';
 349 }
 350 elsif ($options{stop}) {
 351      # stop the daemon
 352      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 353      if (not defined $pid or $pid == 0) {
 354           print STDERR "Unable to open pidfile or daemon not running: $!\n";
 355           exit 1;
 356      }
 357      exit !(kill(15,$pid) == 1);
 358 }
 359 elsif ($options{mirror}) {
 360      # run the mirror jobies
 361      # figure out which bugs we need
 362      my $bugs = select_bugs(\%options);
 363      # get them
 364      my $tempdir = tempdir();#CLEANUP => 1);
 365      my $mirror_log = IO::File->new($options{mirror_location}.'/mirror.log','>') or
 366           die "Unable to open $options{mirror_location}/mirror.log for writing: $!";
 367      write_bug_list("$tempdir/unarchived_bug_list",$bugs->{unarchived});
 368      write_bug_list("$tempdir/archived_bug_list",$bugs->{archived});
 369      my ($wrf,$rfh,$efh);
 370      my @common_rsync_options = ('-avz','--partial');
 371      print "Rsyncing bugs\n" if not $options{quiet};
 372      run_rsync(log => $mirror_log,
 373                ($options{debug}?(debug => \*STDERR):()),
 374                options => [@common_rsync_options,
 375                            '--delete-after',
 376                            '--files-from',"$tempdir/unarchived_bug_list",
 377                            'rsync://'.$options{bug_mirror}.'/bts-spool-db/',
 378                            $options{mirror_location}.'/db-h/']
 379               );
 380      print "Rsyncing archived bugs\n" if $options{verbose};
 381      run_rsync(log => $mirror_log,
 382                ($options{debug}?(debug => \*STDERR):()),
 383                options => [@common_rsync_options,
 384                            '--delete-after',
 385                            '--files-from',"$tempdir/archived_bug_list",
 386                            'rsync://'.$options{bug_mirror}.'/bts-spool-archive/',
 387                            $options{mirror_location}.'/archive/',
 388                           ],
 389               );
 390      print "Rsyncing indexes\n" if $options{verbose};
 391      run_rsync(log => $mirror_log,
 392                ($options{debug}?(debug => \*STDERR):()),
 393                options => [@common_rsync_options,
 394                            '--exclude','*old',
 395                            '--exclude','*.bak',
 396                            '--exclude','by-reverse*',
 397                            'rsync://'.$options{bug_mirror}.'/bts-spool-index/',
 398                            $options{mirror_location}.'/',
 399                           ],
 400               );
 401      print "Rsyncing versions\n" if $options{verbose};
 402      run_rsync(log => $mirror_log,
 403                ($options{debug}?(debug => \*STDERR):()),
 404                options => [@common_rsync_options,
 405                            '--delete-after',
 406                            '--exclude','*old',
 407                            '--exclude','*.bak',
 408                            'rsync://'.$options{bug_mirror}.'/bts-versions/',
 409                            $options{mirror_location}.'/versions/',
 410                           ],
 411               );
 412 }
 413 elsif ($options{show}) {
 414      # figure out the url
 415      # see if the daemon is running
 416      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 417      if (not defined $pid or $pid == 0) {
 418           print STDERR "Unable to open pidfile or daemon not running: $!\n";
 419           print STDERR qq(Mr. T: "I pity da fool who tries to show a bug without a running daemon"\n);
 420           print STDERR "Hint: try the --daemon option first\n";
 421           exit 1;
 422      }
 423      # twist and shout
 424      my $url = qq(http://localhost:$options{port}/$ARGV[0]);
 425      exec('/usr/bin/sensible-browser',$url) or
 426           die "Unable to run sensible-browser (try feeding me cheetos?)";
 427 }
 428 elsif ($options{search}) {
 429      my $url = qq(http://localhost:$options{port}/cgi-bin/pkgreport.cgi?).
 430           join(';',map {if (/:/) {s/:/=/; $_;} else {qq(pkg=$_);}} @ARGV);
 431      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 432      if (not defined $pid or $pid == 0) {
 433           print STDERR "Unable to open pidfile or daemon not running: $!\n";
 434           print STDERR qq(Mr. T: "I pity da fool who tries to search for bugs without a running daemon"\n);
 435           print STDERR "Hint: try the --daemon option first\n";
 436           exit 1;
 437      }
 438      # twist and shout
 439      exec('/usr/bin/sensible-browser',$url) or
 440           die "Unable to run sensible-browser (Maybe chorizo is required?)";
 441 }
 442 else {
 443      # you get here, you were an idiot in checking for @USAGE_ERRORS
 444      # above
 445      die "No option that we understand was passed (the first check for this is now buggy, so shoot your maintainer)"
 446 }
 447
 448
 449 # determine the local configuration
 450 sub local_config{
 451      my ($options) = @_;
 452      my $config = {};
 453      if (-e '/etc/debbugs/local_debbugs.conf') {
 454           Config::Simple->import_from('/etc/debbugs/local_debbugs.conf', $config) or
 455                     die "Unable to read configuration from /etc/debbugs/local_debbugs.conf: $!";
 456      }
 457      if (-e User->Home.'/.debbugs/local_debbugs.conf') {
 458           Config::Simple->import_from(User->Home.'/.debbugs/local_debbugs.conf', $config) or
 459                     die "Unable to read configuration from ".User->Home.'/.debbugs/local_debbugs.conf: '.$!;
 460      }
 461      for (keys %option_defaults) {
 462           if (exists $config->{$_} and not defined $options->{$_}) {
 463                $options->{$_} = $config->{$_};
 464           }
 465           if (not defined $options->{$_}) {
 466                $options->{$_} = $option_defaults{$_};
 467           }
 468      }
 469 }
 470
 471 sub write_bug_list {
 472     my ($file,$bug_list) = @_;
 473     my $inc_fh = IO::File->new($file,'w') or
 474         die "Unable to open $file for writing: $!";
 475     foreach my $bug (keys %{$bug_list}) {
 476         my $file_loc = get_hashname($bug).'/'.$bug;
 477         print {$inc_fh} map {$file_loc.'.'.$_.qq(\n)} qw(log summary report status) or
 478             die "Unable to write to $file: $!";
 479     }
 480     close $inc_fh or
 481         die "Unable to close $file: $!";
 482 }
 483
 484 # actually run rsync with the passed options
 485 sub run_rsync{
 486      my %param = validate_with(params => \@_,
 487                                spec   => {log => {type => HANDLE,
 488                                                  },
 489                                           debug => {type => HANDLE,
 490                                                     optional => 1,
 491                                                    },
 492                                           options => {type => ARRAYREF,
 493                                                      },
 494                                          }
 495                               );
 496      my ($output,$error) = ('','');
 497      my $h = IPC::Run::start(['rsync',@{$param{options}}],
 498                              \undef,$param{log},$param{log});
 499      while ($h->pump) {
 500          #print {$param{debug}} $error if defined $param{debug};
 501      }
 502      $h->finish();
 503      my $exit = $h->result(0);
 504      # this is suboptimal, but we currently don't know whether we've
 505      # selected an archive or unarchived bug, so..
 506      if (defined $exit and not ($exit == 0 or $exit == 3 or $exit == 23)) {
 507          print STDERR "Rsync exited with non-zero status: $exit\n";
 508      }
 509 }
 510
 511
 512
 513 # select a set of bugs
 514 sub select_bugs{
 515      my ($options) = @_;
 516
 517      my %valid_keys = (package => 'package',
 518                        pkg     => 'package',
 519                        src     => 'src',
 520                        source  => 'src',
 521                        maint   => 'maint',
 522                        maintainer => 'maint',
 523                        submitter => 'submitter',
 524                        from => 'submitter',
 525                        status    => 'status',
 526                        tag       => 'tag',
 527                        tags      => 'tag',
 528                        usertag   => 'tag',
 529                        usertags  => 'tag',
 530                        owner     => 'owner',
 531                        dist      => 'dist',
 532                        distribution => 'dist',
 533                        bugs       => 'bugs',
 534                        archive    => 'archive',
 535                        severity   => 'severity',
 536                        correspondent => 'correspondent',
 537                        affects       => 'affects',
 538                       );
 539
 540      my $soap = SOAP::Lite
 541           -> uri('Debbugs/SOAP/V1')
 542                -> proxy("http://$options{bug_site}/cgi-bin/soap.cgi");
 543      my @bugs;
 544      my @bug_selections = ();
 545      if (not -e $options{bugs_to_get}) {
 546           my ($addr) = get_addresses(exists $ENV{DEBEMAIL}?
 547                                      $ENV{DEBEMAIL} :
 548                                      (User->Login . '@' . qx(hostname --fqdn)));
 549           # by default include bugs talked to by this user packages
 550           # maintained by this user, submitted by this user, and rc
 551           # bugs
 552           push @bug_selections,
 553                ("correspondent:$addr archive:0",
 554                 "maint:$addr archive:0",
 555                 "submitter:$addr archive:0",
 556                 "severity:serious severity:grave severity:critical archive:0",
 557                );
 558      }
 559      else {
 560           my $btg_fh = IO::File->new($options{bugs_to_get},'r') or
 561                die "unable to open bugs to get file '$options{bugs_to_get}' for reading: $!";
 562           while (<$btg_fh>) {
 563                chomp;
 564                next if /^\s*#/;
 565                if (/^\d+$/) {
 566                     push @bugs,$_;
 567                }
 568                elsif (/\s\w+\:/) {
 569                     push @bug_selections, $_;
 570                }
 571            }
 572      }
 573      # Split archive:both into archive:1 and archive:0
 574      @bug_selections =
 575          map {
 576              if (m/archive:both/) {
 577                  my $y_archive = $_;
 578                  my $n_archive = $_;
 579                  $y_archive =~ s/archive:both/archive:1/;
 580                  $n_archive =~ s/archive:both/archive:0/;
 581                  ($y_archive,$n_archive);
 582              }
 583              else {
 584                  $_;
 585              }
 586          } @bug_selections;
 587      my %bugs;
 588      for my $selection (@bug_selections) {
 589          my $archived_bugs = "unarchived";
 590          if ($selection =~ /archive:(\S+)/ and $1) {
 591              $archived_bugs = "archived";
 592          }
 593          my @subselects = split /\s+/,$selection;
 594          my %search_parameters;
 595          my %users;
 596          for my $subselect (@subselects) {
 597              my ($key,$value) = split /:/, $subselect, 2;
 598              next unless $key;
 599              if (exists $valid_keys{$key}) {
 600                  push @{$search_parameters{$valid_keys{$key}}},
 601                      $value if $value;
 602              } elsif ($key =~/users?$/) {
 603                  $users{$value} = 1 if $value;
 604              }
 605          }
 606          my %usertags;
 607          for my $user (keys %users) {
 608              my $ut = $soap->get_usertag($user)->result();
 609              next unless defined $ut and $ut ne "";
 610              for my $tag (keys %{$ut}) {
 611                  push @{$usertags{$tag}},
 612                      @{$ut->{$tag}};
 613              }
 614          }
 615          my $bugs = $soap->get_bugs(%search_parameters,
 616                                     (keys %usertags)?(usertags=>\%usertags):()
 617                                    )->result();
 618          if (defined $bugs and @{$bugs}) {
 619              $bugs{$archived_bugs}{$_} = 1 for @{$bugs};
 620          }
 621      }
 622      for my $bug (@bugs) {
 623          $bugs{archived}{$bug} = 1;
 624          $bugs{unarchived}{$bug} = 1;
 625      }
 626      return \%bugs;
 627 }
 628
 629
 630 __END__