cgi/pkgreport.cgi

   1 #!/usr/bin/perl -wT
   2 # This script is part of debbugs, and is released
   3 # under the terms of the GPL version 2, or any later
   4 # version at your option.
   5 # See the file README and COPYING for more information.
   6 #
   7 # [Other people have contributed to this file; their copyrights should
   8 # go here too.]
   9 # Copyright 2004-2006 by Anthony Towns <ajt@debian.org>
  10 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
  11
  12
  13 use warnings;
  14 use strict;
  15
  16 use POSIX qw(strftime nice);
  17
  18 use Debbugs::Config qw(:globals :text :config);
  19
  20 use Debbugs::User;
  21
  22 use Debbugs::Common qw(getparsedaddrs make_list getmaintainers getpseudodesc);
  23
  24 use Debbugs::Bugs qw(get_bugs bug_filter newest_bug);
  25 use Debbugs::Packages qw(getsrcpkgs getpkgsrc get_versions);
  26
  27 use Debbugs::Status qw(splitpackages);
  28
  29 use Debbugs::CGI qw(:all);
  30
  31 use Debbugs::CGI::Pkgreport qw(:all);
  32
  33 use Debbugs::Text qw(:templates);
  34
  35 use CGI::Simple;
  36 my $q = new CGI::Simple;
  37
  38 if ($q->request_method() eq 'HEAD') {
  39      print $q->header(-type => "text/html",
  40                       -charset => 'utf-8',
  41                      );
  42      exit 0;
  43 }
  44
  45 my $default_params = {ordering => 'normal',
  46                       archive  => 0,
  47                       repeatmerged => 0,
  48                       include      => [],
  49                       exclude      => [],
  50                      };
  51
  52 our %param = cgi_parameters(query => $q,
  53                             single => [qw(ordering archive repeatmerged),
  54                                        qw(bug-rev pend-rev sev-rev),
  55                                        qw(maxdays mindays version),
  56                                        qw(data which dist newest),
  57                                        qw(noaffects),
  58                                       ],
  59                             default => $default_params,
  60                            );
  61
  62 my ($form_options,$param) = ({},undef);
  63 ($form_options,$param)= form_options_and_normal_param(\%param)
  64      if $param{form_options};
  65
  66 %param = %{$param} if defined $param;
  67
  68 if (exists $param{form_options} and defined $param{form_options}) {
  69      delete $param{form_options};
  70      delete $param{submit} if exists $param{submit};
  71      for my $default (keys %{$default_params}) {
  72           if (exists $param{$default} and
  73               not ref($default_params->{$default}) and
  74               $default_params->{$default} eq $param{$default}
  75              ) {
  76                delete $param{$default};
  77           }
  78      }
  79      for my $incexc (qw(include exclude)) {
  80           next unless exists $param{$incexc};
  81           # normalize tag to tags
  82           $param{$incexc} = [map {s/^tag:/tags:/; $_} grep /\S\:\S/, make_list($param{$incexc})];
  83      }
  84      for my $key (keys %package_search_keys) {
  85           next unless exists $param{key};
  86           $param{$key} = [map {split /\s*,\s*/} make_list($param{$key})];
  87      }
  88      # kill off keys for which empty values are meaningless
  89      for my $key (qw(package src submitter affects severity status dist)) {
  90           next unless exists $param{$key};
  91           $param{$key} = [grep {defined $_ and length $_}
  92                           make_list($param{$key})];
  93      }
  94      print $q->redirect(munge_url('pkgreport.cgi?',%param));
  95      exit 0;
  96 }
  97
  98 # normalize innclude/exclude keys; currently this is in two locations,
  99 # which is suboptimal. Closes: #567407
 100 for my $incexc (qw(include exclude)) {
 101     next unless exists $param{$incexc};
 102     # normalize tag to tags
 103     $param{$incexc} = [map {s/^tag:/tags:/; $_} make_list($param{$incexc})];
 104 }
 105
 106
 107
 108 # map from yes|no to 1|0
 109 for my $key (qw(repeatmerged bug-rev pend-rev sev-rev)) {
 110      if (exists $param{$key}){
 111           if ($param{$key} =~ /^no$/i) {
 112                $param{$key} = 0;
 113           }
 114           elsif ($param{$key}) {
 115                $param{$key} = 1;
 116           }
 117      }
 118 }
 119
 120 if (lc($param{archive}) eq 'no') {
 121      $param{archive} = 0;
 122 }
 123 elsif (lc($param{archive}) eq 'yes') {
 124      $param{archive} = 1;
 125 }
 126
 127 # fixup dist
 128 if (exists $param{dist} and $param{dist} eq '') {
 129      delete $param{dist};
 130 }
 131
 132 my $include = $param{'&include'} || $param{'include'} || "";
 133 my $exclude = $param{'&exclude'} || $param{'exclude'} || "";
 134
 135 my $users = $param{'users'} || "";
 136
 137 my $ordering = $param{'ordering'};
 138 my $raw_sort = ($param{'raw'} || "no") eq "yes";
 139 my $old_view = ($param{'oldview'} || "no") eq "yes";
 140 my $age_sort = ($param{'age'} || "no") eq "yes";
 141 unless (defined $ordering) {
 142    $ordering = "normal";
 143    $ordering = "oldview" if $old_view;
 144    $ordering = "raw" if $raw_sort;
 145    $ordering = 'age' if $age_sort;
 146 }
 147 $param{ordering} = $ordering;
 148
 149 our ($bug_order) = $ordering =~ /(age(?:rev)?)/;
 150 $bug_order = '' if not defined $bug_order;
 151
 152 my $bug_rev = ($param{'bug-rev'} || "no") eq "yes";
 153 my $pend_rev = ($param{'pend-rev'} || "no") eq "yes";
 154 my $sev_rev = ($param{'sev-rev'} || "no") eq "yes";
 155
 156 my @inc_exc_mapping = ({name   => 'pending',
 157                         incexc => 'include',
 158                         key    => 'pend-inc',
 159                        },
 160                        {name   => 'pending',
 161                         incexc => 'exclude',
 162                         key    => 'pend-exc',
 163                        },
 164                        {name   => 'severity',
 165                         incexc => 'include',
 166                         key    => 'sev-inc',
 167                        },
 168                        {name   => 'severity',
 169                         incexc => 'exclude',
 170                         key    => 'sev-exc',
 171                        },
 172                        {name   => 'subject',
 173                         incexc => 'include',
 174                         key    => 'includesubj',
 175                        },
 176                        {name   => 'subject',
 177                         incexc => 'exclude',
 178                         key    => 'excludesubj',
 179                        },
 180                       );
 181 for my $incexcmap (@inc_exc_mapping) {
 182      push @{$param{$incexcmap->{incexc}}}, map {"$incexcmap->{name}:$_"}
 183           map{split /\s*,\s*/} make_list($param{$incexcmap->{key}})
 184                if exists $param{$incexcmap->{key}};
 185      delete $param{$incexcmap->{key}};
 186 }
 187
 188
 189 my $maxdays = ($param{'maxdays'} || -1);
 190 my $mindays = ($param{'mindays'} || 0);
 191 my $version = $param{'version'} || undef;
 192
 193
 194 our %hidden = map { $_, 1 } qw(status severity classification);
 195 our %cats = (
 196     "status" => [ {
 197         "nam" => "Status",
 198         "pri" => [map { "pending=$_" }
 199             qw(pending forwarded pending-fixed fixed done absent)],
 200         "ttl" => ["Outstanding","Forwarded","Pending Upload",
 201                   "Fixed in NMU","Resolved","From other Branch"],
 202         "def" => "Unknown Pending Status",
 203         "ord" => [0,1,2,3,4,5,6],
 204     } ],
 205     "severity" => [ {
 206         "nam" => "Severity",
 207         "pri" => [map { "severity=$_" } @gSeverityList],
 208         "ttl" => [map { $gSeverityDisplay{$_} } @gSeverityList],
 209         "def" => "Unknown Severity",
 210         "ord" => [0..@gSeverityList],
 211     } ],
 212     "classification" => [ {
 213         "nam" => "Classification",
 214         "pri" => [qw(pending=pending+tag=wontfix
 215                      pending=pending+tag=moreinfo
 216                      pending=pending+tag=patch
 217                      pending=pending+tag=confirmed
 218                      pending=pending)],
 219         "ttl" => ["Will Not Fix","More information needed",
 220                   "Patch Available","Confirmed"],
 221         "def" => "Unclassified",
 222         "ord" => [2,3,4,1,0,5],
 223     } ],
 224     "oldview" => [ qw(status severity) ],
 225     "normal" => [ qw(status severity classification) ],
 226 );
 227
 228 if (exists $param{which} and exists $param{data}) {
 229      $param{$param{which}} = [exists $param{$param{which}}?(make_list($param{$param{which}})):(),
 230                               make_list($param{data}),
 231                              ];
 232      delete $param{which};
 233      delete $param{data};
 234 }
 235
 236 if (defined $param{maintenc}) {
 237      $param{maint} = maint_decode($param{maintenc});
 238      delete $param{maintenc}
 239 }
 240
 241 if (exists $param{pkg}) {
 242      $param{package} = $param{pkg};
 243      delete $param{pkg};
 244 }
 245
 246 if (not grep {exists $param{$_}} keys %package_search_keys and exists $param{users}) {
 247      $param{usertag} = [make_list($param{users})];
 248 }
 249
 250 my %bugusertags;
 251 my %ut;
 252 my %seen_users;
 253
 254 for my $user (map {split /[\s*,\s*]+/} make_list($param{users}||[])) {
 255     next unless length($user);
 256     add_user($user,\%ut,\%bugusertags,\%seen_users,\%cats,\%hidden);
 257 }
 258
 259 if (defined $param{usertag}) {
 260      for my $usertag (make_list($param{usertag})) {
 261           my %select_ut = ();
 262           my ($u, $t) = split /:/, $usertag, 2;
 263           Debbugs::User::read_usertags(\%select_ut, $u);
 264           unless (defined $t && $t ne "") {
 265                $t = join(",", keys(%select_ut));
 266           }
 267           add_user($u,\%ut,\%bugusertags,\%seen_users,\%cats,\%hidden);
 268           push @{$param{tag}}, split /,/, $t;
 269      }
 270 }
 271
 272 quitcgi("You have to choose something to select by") unless grep {exists $param{$_}} keys %package_search_keys;
 273
 274
 275 my $Archived = $param{archive} ? " Archived" : "";
 276
 277 my $this = munge_url('pkgreport.cgi?',
 278                       %param,
 279                      );
 280
 281 my %indexentry;
 282 my %strings = ();
 283
 284 my @bugs;
 285
 286 # addusers for source and binary packages being searched for
 287 my $pkgsrc = getpkgsrc();
 288 my $srcpkg = getsrcpkgs();
 289 for my $package (# For binary packages, add the binary package
 290                  # and corresponding source package
 291                  make_list($param{package}||[]),
 292                  (map {defined $pkgsrc->{$_}?($pkgsrc->{$_}):()}
 293                   make_list($param{package}||[]),
 294                  ),
 295                  # For source packages, add the source package
 296                  # and corresponding binary packages
 297                  make_list($param{src}||[]),
 298                  (map {defined $srcpkg->{$_}?($srcpkg->{$_}):()}
 299                   make_list($param{src}||[]),
 300                  ),
 301                 ) {
 302      next unless defined $package;
 303      add_user($package.'@'.$config{usertag_package_domain},
 304               \%ut,\%bugusertags,\%seen_users,\%cats,\%hidden)
 305           if defined $config{usertag_package_domain};
 306 }
 307
 308
 309 # walk through the keys and make the right get_bugs query.
 310
 311 my $form_option_variables = {};
 312 $form_option_variables->{search_key_order} = [@package_search_key_order];
 313
 314 # Set the title sanely and clean up parameters
 315 my @title;
 316 my @temp = @package_search_key_order;
 317 while (my ($key,$value) = splice @temp, 0, 2) {
 318      next unless exists $param{$key};
 319      my @entries = ();
 320      for my $entry (make_list($param{$key})) {
 321           # we'll handle newest below
 322           next if $key eq 'newest';
 323           my $extra = '';
 324           if (exists $param{dist} and ($key eq 'package' or $key eq 'src')) {
 325                my %versions = get_versions(package => $entry,
 326                                            (exists $param{dist}?(dist => $param{dist}):()),
 327                                            (exists $param{arch}?(arch => $param{arch}):(arch => $config{default_architectures})),
 328                                            ($key eq 'src'?(arch => q(source)):()),
 329                                            no_source_arch => 1,
 330                                            return_archs => 1,
 331                                           );
 332                my $verdesc;
 333                if (keys %versions > 1) {
 334                     $verdesc = 'versions '. join(', ',
 335                                     map { $_ .' ['.join(', ',
 336                                                     sort @{$versions{$_}}
 337                                                    ).']';
 338                                    } keys %versions);
 339                }
 340                else {
 341                     $verdesc = 'version '.join(', ',
 342                                                keys %versions
 343                                               );
 344                }
 345                $extra= " ($verdesc)" if keys %versions;
 346           }
 347           if ($key eq 'maint' and $entry eq '') {
 348                push @entries, "no one (packages without maintainers)"
 349           }
 350           else {
 351                push @entries, $entry.$extra;
 352           }
 353      }
 354      push @title,$value.' '.join(' or ', @entries) if @entries;
 355 }
 356 if (defined $param{newest}) {
 357      my $newest_bug = newest_bug();
 358      @bugs = ($newest_bug - $param{newest} + 1) .. $newest_bug;
 359      push @title, 'in '.@bugs.' newest reports';
 360      $param{bugs} = [exists $param{bugs}?make_list($param{bugs}):(),
 361                      @bugs,
 362                     ];
 363 }
 364
 365 my $title = $gBugs.' '.join(' and ', map {/ or /?"($_)":$_} @title);
 366 @title = ();
 367
 368 #yeah for magick!
 369 @bugs = get_bugs((map {exists $param{$_}?($_,$param{$_}):()}
 370                   grep {$_ ne 'newest'}
 371                   keys %package_search_keys, 'archive'),
 372                  usertags => \%ut,
 373                 );
 374
 375 # shove in bugs which affect this package if there is a package or a
 376 # source given (by default), but no affects options given
 377 if (not exists $param{affects} and not exists $param{noaffects} and
 378     (exists $param{src} or
 379      exists $param{package})) {
 380     push @bugs, get_bugs((map {my $key = $_;
 381                                exists $param{$key}?($key =~ /^(?:package|src)$/?'affects':$key,
 382                                                   ($key eq 'src'?[map {"src:$_"}make_list($param{$key})]:$param{$_})):()}
 383                           grep {$_ ne 'newest'}
 384                           keys %package_search_keys, 'archive'),
 385                          usertags => \%ut,
 386                         );
 387 }
 388
 389 # filter out included or excluded bugs
 390
 391
 392 if (defined $param{version}) {
 393      $title .= " at version $param{version}";
 394 }
 395 elsif (defined $param{dist}) {
 396      $title .= " in $param{dist}";
 397 }
 398
 399 $title = html_escape($title);
 400
 401 my @names; my @prior; my @order;
 402 determine_ordering(cats => \%cats,
 403                    param => \%param,
 404                    ordering => \$ordering,
 405                    names => \@names,
 406                    prior => \@prior,
 407                    title => \@title,
 408                    order => \@order,
 409                   );
 410
 411 # strip out duplicate bugs
 412 my %bugs;
 413 @bugs{@bugs} = @bugs;
 414 @bugs = keys %bugs;
 415
 416 my $result = pkg_htmlizebugs(bugs => \@bugs,
 417                              names => \@names,
 418                              title => \@title,
 419                              order => \@order,
 420                              prior => \@prior,
 421                              ordering => $ordering,
 422                              bugusertags => \%bugusertags,
 423                              bug_rev => $bug_rev,
 424                              bug_order => $bug_order,
 425                              repeatmerged => $param{repeatmerged},
 426                              include => $include,
 427                              exclude => $exclude,
 428                              this => $this,
 429                              options => \%param,
 430                              (exists $param{dist})?(dist    => $param{dist}):(),
 431                             );
 432
 433 print "Content-Type: text/html; charset=utf-8\n\n";
 434
 435 print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n";
 436 print "<HTML><HEAD>\n" .
 437     "<TITLE>$title -- $gProject$Archived $gBug report logs</TITLE>\n" .
 438     qq(<link rel="stylesheet" href="$gWebHostBugDir/css/bugs.css" type="text/css">) .
 439     "</HEAD>\n" .
 440     '<BODY onload="pagemain();">' .
 441     "\n";
 442 print qq(<DIV id="status_mask"></DIV>\n);
 443 print "<H1>" . "$gProject$Archived $gBug report logs: $title" .
 444       "</H1>\n";
 445
 446 my $showresult = 1;
 447
 448 my $pkg = $param{package} if defined $param{package};
 449 my $src = $param{src} if defined $param{src};
 450
 451 my $pseudodesc = getpseudodesc();
 452 if (defined $pseudodesc and defined $pkg and exists $pseudodesc->{$pkg}) {
 453      delete $param{dist};
 454 }
 455
 456 # output information about the packages
 457
 458 for my $package (make_list($param{package}||[])) {
 459      print generate_package_info(binary => 1,
 460                                  package => $package,
 461                                  options => \%param,
 462                                  bugs    => \@bugs,
 463                                 );
 464 }
 465 for my $package (make_list($param{src}||[])) {
 466      print generate_package_info(binary => 0,
 467                                  package => $package,
 468                                  options => \%param,
 469                                  bugs    => \@bugs,
 470                                 );
 471 }
 472
 473 if (exists $param{maint} or exists $param{maintenc}) {
 474     print "<p>Note that maintainers may use different Maintainer fields for\n";
 475     print "different packages, so there may be other reports filed under\n";
 476     print "different addresses.\n";
 477 }
 478 if (exists $param{submitter}) {
 479     print "<p>Note that people may use different email accounts for\n";
 480     print "different bugs, so there may be other reports filed under\n";
 481     print "different addresses.\n";
 482 }
 483
 484 print $result;
 485
 486 print fill_in_template(template=>'cgi/pkgreport_javascript');
 487
 488 print qq(<h2 class="outstanding"><!--<a class="options" href="javascript:toggle(1)">-->Options<!--</a>--></h2>\n);
 489
 490 print option_form(template => 'cgi/pkgreport_options',
 491                   param    => \%param,
 492                   form_options => $form_options,
 493                   variables => $form_option_variables,
 494                  );
 495
 496 print "<hr>\n";
 497 print fill_in_template(template=>'html/html_tail',
 498                        hole_var => {'&strftime' => \&POSIX::strftime,
 499                                    },
 500                       );
 501 print "</body></html>\n";
 502