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  local-debbugs [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 = dirname(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     $options{base_dir} = $base_dir;
 158     eval "use lib '$options{base_dir}'";
 159 } else {
 160     $options{cgi_bin} = '/var/lib/debbugs/www/cgi';
 161     $options{css} = '/var/lib/debbugs/www/bugs.css';
 162     $options{template_dir} = "/usr/share/debbugs/templates";
 163 }
 164
 165 eval "use Debbugs::Common qw(checkpid lockpid get_hashname)";
 166 eval "use Debbugs::Mail qw(get_addresses)";
 167
 168 pod2usage() if $options{help};
 169 pod2usage({verbose=>2}) if $options{man};
 170
 171 $DEBUG = $options{debug};
 172
 173 my @USAGE_ERRORS;
 174 if (1 != grep {exists $options{$_}} qw(daemon show search mirror stop)) {
 175      push @USAGE_ERRORS,"You must pass one (and only one) of --daemon --show --search --mirror or --stop";
 176 }
 177 $options{verbose} = $options{verbose} - $options{quiet};
 178
 179 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 180
 181
 182 # munge in local configuration
 183
 184 local_config(\%options);
 185
 186 mkpath($options{mirror_location});
 187
 188 if ($options{daemon}) {
 189      # daemonize, do stuff
 190      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 191      if (defined $pid and $pid != 0) {
 192           print STDERR "Unable to start daemon; it's already running\n";
 193           exit 1;
 194      }
 195      if (-e $options{mirror_location}.'/local-debbugs.pid' and
 196          not defined $pid) {
 197           print STDERR "Unable to determine if daemon is running: $!\n";
 198           exit 1;
 199      }
 200      my $conf = IO::File->new($options{mirror_location}.'/debbugs_config_local','w') or
 201          die "Unable to open $options{mirror_location}/debbugs_config_local for writing: $!";
 202      print {$conf} <<"EOF";
 203 \$gConfigDir = "$options{mirror_location}";
 204 \$gSpoolDir = "$options{mirror_location}";
 205 \$gTemplateDir = "$options{template_dir}";
 206 \$gWebHost = 'localhost:$options{port}';
 207 \$gPackageSource = '';
 208 \$gPseudoDescFile = '';
 209 \$gPseudoMaintFile = '';
 210 \$gMaintainerFile = '';
 211 \$gMaintainerFileOverride = '';
 212 \$config{source_maintainer_file} = '';
 213 \$config{source_maintainer_file_override} = '';
 214 \$gProject = 'Local Debbugs';
 215 1;
 216 EOF
 217      close $conf;
 218      $ENV{DEBBUGS_CONFIG_FILE} = $options{mirror_location}.'/debbugs_config_local';
 219      # ok, now lets daemonize
 220
 221      # XXX make sure that all paths have been turned into absolute
 222      # paths
 223      chdir '/' or die "Can't chdir to /: $!";
 224      # allow us not to detach for debugging
 225      if ($options{detach}) {
 226           open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
 227           open STDOUT, '>/dev/null'
 228                or die "Can't write to /dev/null: $!";
 229           defined(my $pid = fork) or die "Can't fork: $!";
 230           exit if $pid;
 231           setsid or die "Can't start a new session: $!";
 232           open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
 233      }
 234      lockpid($options{mirror_location}.'/local-debbugs.pid') or
 235           die "Unable to deal with the pidfile";
 236      # this is the subclass of HTTP::Server::Simple::CGI which handles
 237      # the "hard" bits of actually running a tiny webserver for us
 238      {
 239           package local_debbugs::server;
 240           use IO::File;
 241           use HTTP::Server::Simple;
 242           use File::Basename qw(dirname);
 243           use base qw(HTTP::Server::Simple::CGI HTTP::Server::Simple::CGI::Environment);
 244
 245           sub net_server {
 246                return 'Net::Server::Fork';
 247           }
 248
 249           sub redirect {
 250                my ($cgi,$url) = @_;
 251                print "HTTP/1.1 302 Found\r\n";
 252                print "Location: $url\r\n";
 253           }
 254
 255           # here we want to call cgi-bin/pkgreport or cgi-bin/bugreport
 256           sub handle_request {
 257                my ($self,$cgi) = @_;
 258
 259                $ENV{DEBBUGS_CONFIG_FILE} = $options{mirror_location}.'/debbugs_config_local';
 260                my $base_uri = 'http://'.$cgi->virtual_host;
 261                if ($cgi->virtual_port ne 80) {
 262                     $base_uri .= ':'.$cgi->virtual_port;
 263                }
 264                my $path = $cgi->path_info();
 265                # RewriteRule ^/[[:space:]]*#?([[:digit:]][[:digit:]][[:digit:]]+)([;&].+)?$ /cgi-bin/bugreport.cgi?bug=$1$2 [L,R,NE]
 266                if ($path =~ m{^/?\s*\#?(\d+)((?:[;&].+)?)$}) {
 267                     redirect($cgi,$base_uri."/cgi-bin/bugreport.cgi?bug=$1$2");
 268                }
 269                # RewriteRule ^/[Ff][Rr][Oo][Mm]:([^/]+\@.+)$ /cgi-bin/pkgreport.cgi?submitter=$1 [L,R,NE]
 270                elsif ($path =~ m{^/?\s*from:([^/]+\@.+)$}i) {
 271                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?submitter=$1");
 272                }
 273                # RewriteRule ^/([^/]+\@.+)$ /cgi-bin/pkgreport.cgi?maint=$1 [L,R,NE]
 274                elsif ($path =~ m{^/?\s*([^/]+\@.+)$}i) {
 275                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?maint=$1");
 276                }
 277                # RewriteRule ^/mbox:([[:digit:]][[:digit:]][[:digit:]]+)([;&].+)?$ /cgi-bin/bugreport.cgi?mbox=yes&bug=$1$2 [L,R,NE]
 278                elsif ($path =~ m{^/?\s*mbox:\#?(\d+)((?:[;&].+)?)$}i) {
 279                     redirect($cgi,$base_uri."/cgi-bin/bugreport.cgi?mbox=yes;bug=$1$2");
 280                }
 281                # RewriteRule ^/src:([^/]+)$ /cgi-bin/pkgreport.cgi?src=$1 [L,R,NE]
 282                elsif ($path =~ m{^/?src:([^/]+)$}i) {
 283                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?src=$1");
 284                }
 285                # RewriteRule ^/severity:([^/]+)$ /cgi-bin/pkgreport.cgi?severity=$1 [L,R,NE]
 286                elsif ($path =~ m{^/?severity:([^/]+)$}i) {
 287                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?severity=$1");
 288                }
 289                # RewriteRule ^/tag:([^/]+)$ /cgi-bin/pkgreport.cgi?tag=$1 [L,R,NE]
 290                elsif ($path =~ m{^/?tag:([^/]+)$}i) {
 291                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?tag=$1");
 292                }
 293                # RewriteRule ^/([^/]+)$ /cgi-bin/pkgreport.cgi?pkg=$1 [L,R,NE]
 294                elsif ($path =~ m{^/?([^/]+)$}i) {
 295                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?pkg=$1");
 296                }
 297                elsif ($path =~ m{^/?cgi(?:-bin)?/((?:(?:bug|pkg)report|version)\.cgi)}) {
 298                    my @exec_options = "$options{cgi_bin}/$1";
 299                    if ($options{git_mode}) {
 300                        unshift @exec_options,
 301                            'perl','-I',$options{base_dir},'-T';
 302                    }
 303                    open(my $fh,'-|',@exec_options) or
 304                        die "Unable to execute $options{cgi_bin}/$1";
 305                     my $status;
 306                     my $cache = '';
 307                     while (<$fh>) {
 308                         if (/Status: (\d+\s+.+?)\n?$/) {
 309                             $status = $1;
 310                             print "HTTP/1.1 $status\n";
 311                             print STDERR "'$status'\n";
 312                             last;
 313                         }
 314                         $cache .= $_;
 315                         if (/^$/) {
 316                             print "HTTP/1.1 200 OK\n";
 317                             last;
 318                         }
 319                     }
 320                     print $cache;
 321                     print <$fh>;
 322                     close($fh) or die "Unable to close";
 323                 }
 324                elsif ($path =~ m{^/?css/bugs.css}) {
 325                     my $fh = IO::File->new($options{css},'r') or
 326                          die "Unable to open $options{css} for reading: $!";
 327                     print "HTTP/1.1 200 OK\n";
 328                     print "Content-type: text/css\n";
 329                     print "\n";
 330                     print <$fh>;
 331                }
 332                elsif ($path =~ m{^/?$}) {
 333                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?package=put%20package%20here");
 334                }
 335                else {
 336                     print "HTTP/1.1 404 Not Found\n";
 337                     print "Content-Type: text/html\n";
 338                     print "\n";
 339                     print "<h1>That which you were seeking, found I have not.</h1>\n";
 340                }
 341                # RewriteRule ^/$ /Bugs/ [L,R,NE]
 342           }
 343      }
 344      my $debbugs_server = local_debbugs::server->new($options{port}) or
 345           die "Unable to create debbugs server";
 346      $debbugs_server->run() or
 347           die 'Unable to run debbugs server';
 348 }
 349 elsif ($options{stop}) {
 350      # stop the daemon
 351      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 352      if (not defined $pid or $pid == 0) {
 353           print STDERR "Unable to open pidfile or daemon not running: $!\n";
 354           exit 1;
 355      }
 356      exit !(kill(15,$pid) == 1);
 357 }
 358 elsif ($options{mirror}) {
 359      # run the mirror jobies
 360      # figure out which bugs we need
 361      my $bugs = select_bugs(\%options);
 362      # get them
 363      my $tempdir = tempdir();#CLEANUP => 1);
 364      my $mirror_log = IO::File->new($options{mirror_location}.'/mirror.log','>') or
 365           die "Unable to open $options{mirror_location}/mirror.log for writing: $!";
 366      write_bug_list("$tempdir/unarchived_bug_list",$bugs->{unarchived});
 367      write_bug_list("$tempdir/archived_bug_list",$bugs->{archived});
 368      my ($wrf,$rfh,$efh);
 369      my @common_rsync_options = ('-avz','--partial');
 370      print "Rsyncing bugs\n" if not $options{quiet};
 371      run_rsync(log => $mirror_log,
 372                ($options{debug}?(debug => \*STDERR):()),
 373                options => [@common_rsync_options,
 374                            '--delete-after',
 375                            '--files-from',"$tempdir/unarchived_bug_list",
 376                            'rsync://'.$options{bug_mirror}.'/bts-spool-db/',
 377                            $options{mirror_location}.'/db-h/']
 378               );
 379      print "Rsyncing archived bugs\n" if $options{verbose};
 380      run_rsync(log => $mirror_log,
 381                ($options{debug}?(debug => \*STDERR):()),
 382                options => [@common_rsync_options,
 383                            '--delete-after',
 384                            '--files-from',"$tempdir/archived_bug_list",
 385                            'rsync://'.$options{bug_mirror}.'/bts-spool-archive/',
 386                            $options{mirror_location}.'/archive/',
 387                           ],
 388               );
 389      print "Rsyncing indexes\n" if $options{verbose};
 390      run_rsync(log => $mirror_log,
 391                ($options{debug}?(debug => \*STDERR):()),
 392                options => [@common_rsync_options,
 393                            '--exclude','*old',
 394                            '--exclude','*.bak',
 395                            '--exclude','by-reverse*',
 396                            'rsync://'.$options{bug_mirror}.'/bts-spool-index/',
 397                            $options{mirror_location}.'/',
 398                           ],
 399               );
 400      print "Rsyncing versions\n" if $options{verbose};
 401      run_rsync(log => $mirror_log,
 402                ($options{debug}?(debug => \*STDERR):()),
 403                options => [@common_rsync_options,
 404                            '--delete-after',
 405                            '--exclude','*old',
 406                            '--exclude','*.bak',
 407                            'rsync://'.$options{bug_mirror}.'/bts-versions/',
 408                            $options{mirror_location}.'/versions/',
 409                           ],
 410               );
 411 }
 412 elsif ($options{show}) {
 413      # figure out the url
 414      # see if the daemon is running
 415      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 416      if (not defined $pid or $pid == 0) {
 417           print STDERR "Unable to open pidfile or daemon not running: $!\n";
 418           print STDERR qq(Mr. T: "I pity da fool who tries to show a bug without a running daemon"\n);
 419           print STDERR "Hint: try the --daemon option first\n";
 420           exit 1;
 421      }
 422      # twist and shout
 423      my $url = qq(http://localhost:$options{port}/$ARGV[0]);
 424      exec('/usr/bin/sensible-browser',$url) or
 425           die "Unable to run sensible-browser (try feeding me cheetos?)";
 426 }
 427 elsif ($options{search}) {
 428      my $url = qq(http://localhost:$options{port}/cgi-bin/pkgreport.cgi?).
 429           join(';',map {if (/:/) {s/:/=/; $_;} else {qq(pkg=$_);}} @ARGV);
 430      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 431      if (not defined $pid or $pid == 0) {
 432           print STDERR "Unable to open pidfile or daemon not running: $!\n";
 433           print STDERR qq(Mr. T: "I pity da fool who tries to search for bugs without a running daemon"\n);
 434           print STDERR "Hint: try the --daemon option first\n";
 435           exit 1;
 436      }
 437      # twist and shout
 438      exec('/usr/bin/sensible-browser',$url) or
 439           die "Unable to run sensible-browser (Maybe chorizo is required?)";
 440 }
 441 else {
 442      # you get here, you were an idiot in checking for @USAGE_ERRORS
 443      # above
 444      die "No option that we understand was passed (the first check for this is now buggy, so shoot your maintainer)"
 445 }
 446
 447
 448 # determine the local configuration
 449 sub local_config{
 450      my ($options) = @_;
 451      my $config = {};
 452      if (-e '/etc/debbugs/local_debbugs.conf') {
 453           Config::Simple->import_from('/etc/debbugs/local_debbugs.conf', $config) or
 454                     die "Unable to read configuration from /etc/debbugs/local_debbugs.conf: $!";
 455      }
 456      if (-e User->Home.'/.debbugs/local_debbugs.conf') {
 457           Config::Simple->import_from(User->Home.'/.debbugs/local_debbugs.conf', $config) or
 458                     die "Unable to read configuration from ".User->Home.'/.debbugs/local_debbugs.conf: '.$!;
 459      }
 460      for (keys %option_defaults) {
 461           if (exists $config->{$_} and not defined $options->{$_}) {
 462                $options->{$_} = $config->{$_};
 463           }
 464           if (not defined $options->{$_}) {
 465                $options->{$_} = $option_defaults{$_};
 466           }
 467      }
 468 }
 469
 470 sub write_bug_list {
 471     my ($file,$bug_list) = @_;
 472     my $inc_fh = IO::File->new($file,'w') or
 473         die "Unable to open $file for writing: $!";
 474     foreach my $bug (keys %{$bug_list}) {
 475         my $file_loc = get_hashname($bug).'/'.$bug;
 476         print {$inc_fh} map {$file_loc.'.'.$_.qq(\n)} qw(log summary report status) or
 477             die "Unable to write to $file: $!";
 478     }
 479     close $inc_fh or
 480         die "Unable to close $file: $!";
 481 }
 482
 483 # actually run rsync with the passed options
 484 sub run_rsync{
 485      my %param = validate_with(params => \@_,
 486                                spec   => {log => {type => HANDLE,
 487                                                  },
 488                                           debug => {type => HANDLE,
 489                                                     optional => 1,
 490                                                    },
 491                                           options => {type => ARRAYREF,
 492                                                      },
 493                                          }
 494                               );
 495      my ($output,$error) = ('','');
 496      my $h = IPC::Run::start(['rsync',@{$param{options}}],
 497                              \undef,$param{log},$param{log});
 498      while ($h->pump) {
 499          #print {$param{debug}} $error if defined $param{debug};
 500      }
 501      $h->finish();
 502      my $exit = $h->result(0);
 503      # this is suboptimal, but we currently don't know whether we've
 504      # selected an archive or unarchived bug, so..
 505      if (defined $exit and not ($exit == 0 or $exit == 3 or $exit == 23)) {
 506          print STDERR "Rsync exited with non-zero status: $exit\n";
 507      }
 508 }
 509
 510
 511
 512 # select a set of bugs
 513 sub select_bugs{
 514      my ($options) = @_;
 515
 516      my %valid_keys = (package => 'package',
 517                        pkg     => 'package',
 518                        src     => 'src',
 519                        source  => 'src',
 520                        maint   => 'maint',
 521                        maintainer => 'maint',
 522                        submitter => 'submitter',
 523                        from => 'submitter',
 524                        status    => 'status',
 525                        tag       => 'tag',
 526                        tags      => 'tag',
 527                        usertag   => 'tag',
 528                        usertags  => 'tag',
 529                        owner     => 'owner',
 530                        dist      => 'dist',
 531                        distribution => 'dist',
 532                        bugs       => 'bugs',
 533                        archive    => 'archive',
 534                        severity   => 'severity',
 535                        correspondent => 'correspondent',
 536                        affects       => 'affects',
 537                       );
 538
 539      my $soap = SOAP::Lite
 540           -> uri('Debbugs/SOAP/V1')
 541                -> proxy("http://$options{bug_site}/cgi-bin/soap.cgi");
 542      my @bugs;
 543      my @bug_selections = ();
 544      if (not -e $options{bugs_to_get}) {
 545           my ($addr) = get_addresses(exists $ENV{DEBEMAIL}?
 546                                      $ENV{DEBEMAIL} :
 547                                      (User->Login . '@' . qx(hostname --fqdn)));
 548           # by default include bugs talked to by this user packages
 549           # maintained by this user, submitted by this user, and rc
 550           # bugs
 551           push @bug_selections,
 552                ("correspondent:$addr archive:0",
 553                 "maint:$addr archive:0",
 554                 "submitter:$addr archive:0",
 555                 "severity:serious severity:grave severity:critical archive:0",
 556                );
 557      }
 558      else {
 559           my $btg_fh = IO::File->new($options{bugs_to_get},'r') or
 560                die "unable to open bugs to get file '$options{bugs_to_get}' for reading: $!";
 561           while (<$btg_fh>) {
 562                chomp;
 563                next if /^\s*#/;
 564                if (/^\d+$/) {
 565                     push @bugs,$_;
 566                }
 567                elsif (/\s\w+\:/) {
 568                     push @bug_selections, $_;
 569                }
 570            }
 571      }
 572      # Split archive:both into archive:1 and archive:0
 573      @bug_selections =
 574          map {
 575              if (m/archive:both/) {
 576                  my $y_archive = $_;
 577                  my $n_archive = $_;
 578                  $y_archive =~ s/archive:both/archive:1/;
 579                  $n_archive =~ s/archive:both/archive:0/;
 580                  ($y_archive,$n_archive);
 581              }
 582              else {
 583                  $_;
 584              }
 585          } @bug_selections;
 586      my %bugs;
 587      for my $selection (@bug_selections) {
 588          my $archived_bugs = "unarchived";
 589          if ($selection =~ /archive:(\S+)/ and $1) {
 590              $archived_bugs = "archived";
 591          }
 592          my @subselects = split /\s+/,$selection;
 593          my %search_parameters;
 594          my %users;
 595          for my $subselect (@subselects) {
 596              my ($key,$value) = split /:/, $subselect, 2;
 597              next unless $key;
 598              if (exists $valid_keys{$key}) {
 599                  push @{$search_parameters{$valid_keys{$key}}},
 600                      $value if $value;
 601              } elsif ($key =~/users?$/) {
 602                  $users{$value} = 1 if $value;
 603              }
 604          }
 605          my %usertags;
 606          for my $user (keys %users) {
 607              my $ut = $soap->get_usertag($user)->result();
 608              next unless defined $ut and $ut ne "";
 609              for my $tag (keys %{$ut}) {
 610                  push @{$usertags{$tag}},
 611                      @{$ut->{$tag}};
 612              }
 613          }
 614          my $bugs = $soap->get_bugs(%search_parameters,
 615                                     (keys %usertags)?(usertags=>\%usertags):()
 616                                    )->result();
 617          if (defined $bugs and @{$bugs}) {
 618              $bugs{$archived_bugs}{$_} = 1 for @{$bugs};
 619          }
 620      }
 621      for my $bug (@bugs) {
 622          $bugs{archived}{$bug} = 1;
 623          $bugs{unarchived}{$bug} = 1;
 624      }
 625      return \%bugs;
 626 }
 627
 628
 629 __END__
 630 # Local Variables:
 631 # cperl-indent-level: 4
 632 # indent-tabs-mode: nil
 633 # End: