Debbugs/CGI/Pkgreport.pm

   1 # This module is part of debbugs, and is released
   2 # under the terms of the GPL version 2, or any later version. See the
   3 # file README and COPYING for more information.
   4 #
   5 # [Other people have contributed to this file; their copyrights should
   6 # be listed here too.]
   7 # Copyright 2008 by Don Armstrong <don@donarmstrong.com>.
   8
   9
  10 package Debbugs::CGI::Pkgreport;
  11
  12 =head1 NAME
  13
  14 Debbugs::CGI::Pkgreport -- specific routines for the pkgreport cgi script
  15
  16 =head1 SYNOPSIS
  17
  18
  19 =head1 DESCRIPTION
  20
  21
  22 =head1 BUGS
  23
  24 None known.
  25
  26 =cut
  27
  28 use warnings;
  29 use strict;
  30 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
  31 use base qw(Exporter);
  32
  33 use IO::Scalar;
  34 use Params::Validate qw(validate_with :types);
  35
  36 use Debbugs::Config qw(:config :globals);
  37 use Debbugs::CGI qw(:url :html :util);
  38 use Debbugs::Common qw(:misc :util :date);
  39 use Debbugs::Status qw(:status);
  40 use Debbugs::Bugs qw(bug_filter);
  41 use Debbugs::Packages qw(:mapping);
  42
  43 use Debbugs::Text qw(:templates);
  44
  45 use POSIX qw(strftime);
  46
  47
  48 BEGIN{
  49      ($VERSION) = q$Revision: 494 $ =~ /^Revision:\s+([^\s+])/;
  50      $DEBUG = 0 unless defined $DEBUG;
  51
  52      @EXPORT = ();
  53      %EXPORT_TAGS = (html => [qw(short_bug_status_html pkg_htmlizebugs),
  54                               qw(pkg_javascript),
  55                               qw(pkg_htmlselectyesno pkg_htmlselectsuite),
  56                               qw(buglinklist pkg_htmlselectarch)
  57                              ],
  58                      misc => [qw(generate_package_info make_order_list),
  59                               qw(myurl),
  60                               qw(get_bug_order_index determine_ordering),
  61                              ],
  62                     );
  63      @EXPORT_OK = (qw());
  64      Exporter::export_ok_tags(keys %EXPORT_TAGS);
  65      $EXPORT_TAGS{all} = [@EXPORT_OK];
  66 }
  67
  68 =head2 generate_package_info
  69
  70      generate_package_info($srcorbin,$package)
  71
  72 Generates the informational bits for a package and returns it
  73
  74 =cut
  75
  76 sub generate_package_info{
  77      my %param = validate_with(params => \@_,
  78                                spec  => {binary => {type => BOOLEAN,
  79                                                     default => 1,
  80                                                    },
  81                                          package => {type => SCALAR|ARRAYREF,
  82                                                     },
  83                                          options => {type => HASHREF,
  84                                                     },
  85                                          bugs    => {type => ARRAYREF,
  86                                                     },
  87                                         },
  88                               );
  89
  90      my $output_scalar = '';
  91      my $output = globify_scalar(\$output_scalar);
  92
  93      my $package = $param{package};
  94
  95      my %pkgsrc = %{getpkgsrc()};
  96      my $srcforpkg = $package;
  97      if ($param{binary} and exists $pkgsrc{$package}
  98          and defined $pkgsrc{$package}) {
  99           $srcforpkg = $pkgsrc{$package};
 100      }
 101
 102      my $showpkg = html_escape($package);
 103      my $maintainers = getmaintainers();
 104      my $maint = $maintainers->{$srcforpkg};
 105      if (defined $maint) {
 106           print {$output} '<p>';
 107           print {$output} (($maint =~ /,/)? "Maintainer for $showpkg is "
 108                            : "Maintainers for $showpkg are ") .
 109                                 package_links(maint => $maint);
 110           print {$output} ".</p>\n";
 111      }
 112      else {
 113           print {$output} "<p>No maintainer for $showpkg. Please do not report new bugs against this package.</p>\n";
 114      }
 115      my @pkgs = getsrcpkgs($srcforpkg);
 116      @pkgs = grep( !/^\Q$package\E$/, @pkgs );
 117      if ( @pkgs ) {
 118           @pkgs = sort @pkgs;
 119           if ($param{binary}) {
 120                print {$output} "<p>You may want to refer to the following packages that are part of the same source:\n";
 121           }
 122           else {
 123                print {$output} "<p>You may want to refer to the following individual bug pages:\n";
 124           }
 125           #push @pkgs, $src if ( $src && !grep(/^\Q$src\E$/, @pkgs) );
 126           print {$output} scalar package_links(package=>[@pkgs]);
 127           print {$output} ".\n";
 128      }
 129      my @references;
 130      my $pseudodesc = getpseudodesc();
 131      if ($package and defined($pseudodesc) and exists($pseudodesc->{$package})) {
 132           push @references, "to the <a href=\"http://${debbugs::gWebDomain}/pseudo-packages${debbugs::gHTMLSuffix}\">".
 133                "list of other pseudo-packages</a>";
 134      }
 135      else {
 136           if ($package and defined $gPackagePages) {
 137                push @references, sprintf "to the <a href=\"%s\">%s package page</a>",
 138                     html_escape("http://${gPackagePages}/$package"), html_escape("$package");
 139           }
 140           if (defined $gSubscriptionDomain) {
 141                my $ptslink = $param{binary} ? $srcforpkg : $package;
 142                push @references, q(to the <a href="http://).html_escape("$gSubscriptionDomain/$ptslink").q(">Package Tracking System</a>);
 143           }
 144           # Only output this if the source listing is non-trivial.
 145           if ($param{binary} and $srcforpkg) {
 146                push @references,
 147                     "to the source package ".
 148                          package_links(src=>$srcforpkg,
 149                                        options => $param{options}) .
 150                               "'s bug page";
 151           }
 152      }
 153      if (@references) {
 154           $references[$#references] = "or $references[$#references]" if @references > 1;
 155           print {$output} "<p>You might like to refer ", join(", ", @references), ".</p>\n";
 156      }
 157      if (defined $param{maint} || defined $param{maintenc}) {
 158           print {$output} "<p>If you find a bug not listed here, please\n";
 159           printf {$output} "<a href=\"%s\">report it</a>.</p>\n",
 160                html_escape("http://${debbugs::gWebDomain}/Reporting${debbugs::gHTMLSuffix}");
 161      }
 162      if (not $maint and not @{$param{bugs}}) {
 163           print {$output} "<p>There is no record of the " . html_escape($package) .
 164                ($param{binary} ? " package" : " source package") .
 165                     ", and no bugs have been filed against it.</p>";
 166      }
 167      return $output_scalar;
 168 }
 169
 170
 171 =head2 short_bug_status_html
 172
 173      print short_bug_status_html(status => read_bug(bug => 5),
 174                                  options => \%param,
 175                                 );
 176
 177 =over
 178
 179 =item status -- status hashref as returned by read_bug
 180
 181 =item options -- hashref of options to pass to package_links (defaults
 182 to an empty hashref)
 183
 184 =item bug_options -- hashref of options to pass to bug_links (default
 185 to an empty hashref)
 186
 187 =item snippet -- optional snippet of information about the bug to
 188 display below
 189
 190
 191 =back
 192
 193
 194
 195 =cut
 196
 197 sub short_bug_status_html {
 198      my %param = validate_with(params => \@_,
 199                                spec   => {status => {type => HASHREF,
 200                                                     },
 201                                           options => {type => HASHREF,
 202                                                       default => {},
 203                                                      },
 204                                           bug_options => {type => HASHREF,
 205                                                           default => {},
 206                                                          },
 207                                           snippet => {type => SCALAR,
 208                                                       default => '',
 209                                                      },
 210                                          },
 211                               );
 212
 213      my %status = %{$param{status}};
 214
 215      $status{tags_array} = [sort(split(/\s+/, $status{tags}))];
 216      $status{date_text} = strftime('%a, %e %b %Y %T UTC', gmtime($status{date}));
 217      $status{mergedwith_array} = [split(/ /,$status{mergedwith})];
 218
 219      my @blockedby= split(/ /, $status{blockedby});
 220      $status{blockedby_array} = [];
 221      if (@blockedby && $status{"pending"} ne 'fixed' && ! length($status{done})) {
 222           for my $b (@blockedby) {
 223                my %s = %{get_bug_status($b)};
 224                next if $s{"pending"} eq 'fixed' || length $s{done};
 225                push @{$status{blockedby_array}},{bug_num => $b, subject => $s{subject}, status => \%s};
 226           }
 227      }
 228
 229      my @blocks= split(/ /, $status{blocks});
 230      $status{blocks_array} = [];
 231      if (@blocks && $status{"pending"} ne 'fixed' && ! length($status{done})) {
 232           for my $b (@blocks) {
 233                my %s = %{get_bug_status($b)};
 234                next if $s{"pending"} eq 'fixed' || length $s{done};
 235                push @{$status{blocks_array}}, {bug_num => $b, subject => $s{subject}, status => \%s};
 236           }
 237      }
 238      my $days = bug_archiveable(bug => $status{id},
 239                                 status => \%status,
 240                                 days_until => 1,
 241                                );
 242      $status{archive_days} = $days;
 243      return fill_in_template(template => 'cgi/short_bug_status',
 244                              variables => {status => \%status,
 245                                            isstrongseverity => \&Debbugs::Status::isstrongseverity,
 246                                            html_escape   => \&Debbugs::CGI::html_escape,
 247                                            looks_like_number => \&Scalar::Util::looks_like_number,
 248                                           },
 249                              hole_var  => {'&package_links' => \&Debbugs::CGI::package_links,
 250                                            '&bug_links'     => \&Debbugs::CGI::bug_links,
 251                                            '&version_url'   => \&Debbugs::CGI::version_url,
 252                                            '&secs_to_english' => \&Debbugs::Common::secs_to_english,
 253                                            '&strftime'      => \&POSIX::strftime,
 254                                            '&maybelink'     => \&Debbugs::CGI::maybelink,
 255                                           },
 256                             );
 257
 258      my $result = "";
 259
 260      my $showseverity;
 261      if ($status{severity} eq 'normal') {
 262           $showseverity = '';
 263      }
 264      elsif (isstrongseverity($status{severity})) {
 265           $showseverity = "Severity: <em class=\"severity\">$status{severity}</em>;\n";
 266      }
 267      else {
 268           $showseverity = "Severity: <em>$status{severity}</em>;\n";
 269      }
 270
 271      $result .= package_links(package => $status{package},
 272                               options  => $param{options},
 273                              );
 274
 275      my $showversions = '';
 276      if (@{$status{found_versions}}) {
 277           my @found = @{$status{found_versions}};
 278           $showversions .= join ', ', map {s{/}{ }; html_escape($_)} @found;
 279      }
 280      if (@{$status{fixed_versions}}) {
 281           $showversions .= '; ' if length $showversions;
 282           $showversions .= '<strong>fixed</strong>: ';
 283           my @fixed = @{$status{fixed_versions}};
 284           $showversions .= join ', ', map {s{/}{ }; html_escape($_)} @fixed;
 285      }
 286      $result .= ' (<a href="'.
 287           version_url(package => $status{package},
 288                       found   => $status{found_versions},
 289                       fixed   => $status{fixed_versions},
 290                      ).qq{">$showversions</a>)} if length $showversions;
 291      $result .= ";\n";
 292
 293      $result .= $showseverity;
 294      $result .= "Reported by: ".package_links(submitter=>$status{originator},
 295                                               class => "submitter",
 296                                              );
 297      $result .= ";\nOwned by: " . package_links(owner => $status{owner},
 298                                                 class => "submitter",
 299                                                )
 300           if length $status{owner};
 301      $result .= ";\nTags: <strong>"
 302           . html_escape(join(", ", sort(split(/\s+/, $status{tags}))))
 303                . "</strong>"
 304                     if (length($status{tags}));
 305
 306      $result .= (length($status{mergedwith})?";\nMerged with ":"") .
 307           bug_links(bug => [split(/ /,$status{mergedwith})],
 308                     class => "submitter",
 309                    );
 310      $result .= (length($status{blockedby})?";\nBlocked by ":"") .
 311           bug_links(bug => [split(/ /,$status{blockedby})],
 312                     class => "submitter",
 313                    );
 314      $result .= (length($status{blocks})?";\nBlocks ":"") .
 315           bug_links(bug => [split(/ /,$status{blocks})],
 316                     class => "submitter",
 317                    );
 318
 319      if (length($status{done})) {
 320           $result .= "<br><strong>Done:</strong> " . html_escape($status{done});
 321           my $days = bug_archiveable(bug => $status{id},
 322                                      status => \%status,
 323                                      days_until => 1,
 324                                     );
 325           if ($days >= 0 and defined $status{location} and $status{location} ne 'archive') {
 326                $result .= ";\n<strong>Can be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . "</strong>";
 327           }
 328           elsif (defined $status{location} and $status{location} eq 'archived') {
 329                $result .= ";\n<strong>Archived.</strong>";
 330           }
 331      }
 332
 333      unless (length($status{done})) {
 334           if (length($status{forwarded})) {
 335                $result .= ";\n<strong>Forwarded</strong> to "
 336                     . join(', ',
 337                            map {maybelink($_)}
 338                            split /\,\s+/,$status{forwarded}
 339                           );
 340           }
 341           # Check the age of the logfile
 342           my ($days_last,$eng_last) = secs_to_english(time - $status{log_modified});
 343           my ($days,$eng) = secs_to_english(time - $status{date});
 344
 345           if ($days >= 7) {
 346                my $font = "";
 347                my $efont = "";
 348                $font = "em" if ($days > 30);
 349                $font = "strong" if ($days > 60);
 350                $efont = "</$font>" if ($font);
 351                $font = "<$font>" if ($font);
 352
 353                $result .= ";\n ${font}$eng old$efont";
 354           }
 355           if ($days_last > 7) {
 356                my $font = "";
 357                my $efont = "";
 358                $font = "em" if ($days_last > 30);
 359                $font = "strong" if ($days_last > 60);
 360                $efont = "</$font>" if ($font);
 361                $font = "<$font>" if ($font);
 362
 363                $result .= ";\n ${font}Modified $eng_last ago$efont";
 364           }
 365      }
 366
 367      $result .= ".";
 368
 369      return $result;
 370 }
 371
 372
 373 sub pkg_htmlizebugs {
 374      my %param = validate_with(params => \@_,
 375                                spec   => {bugs => {type => ARRAYREF,
 376                                                   },
 377                                           names => {type => ARRAYREF,
 378                                                    },
 379                                           title => {type => ARRAYREF,
 380                                                    },
 381                                           prior => {type => ARRAYREF,
 382                                                    },
 383                                           order => {type => ARRAYREF,
 384                                                    },
 385                                           ordering => {type => SCALAR,
 386                                                       },
 387                                           bugusertags => {type => HASHREF,
 388                                                           default => {},
 389                                                          },
 390                                           bug_rev => {type => BOOLEAN,
 391                                                       default => 0,
 392                                                      },
 393                                           bug_order => {type => SCALAR,
 394                                                        },
 395                                           repeatmerged => {type => BOOLEAN,
 396                                                            default => 1,
 397                                                           },
 398                                           include => {type => ARRAYREF,
 399                                                       default => [],
 400                                                      },
 401                                           exclude => {type => ARRAYREF,
 402                                                       default => [],
 403                                                      },
 404                                           this     => {type => SCALAR,
 405                                                        default => '',
 406                                                       },
 407                                           options  => {type => HASHREF,
 408                                                        default => {},
 409                                                       },
 410                                           dist     => {type => SCALAR,
 411                                                        optional => 1,
 412                                                       },
 413                                          }
 414                               );
 415      my @bugs = @{$param{bugs}};
 416
 417      my @status = ();
 418      my %count;
 419      my $header = '';
 420      my $footer = "<h2 class=\"outstanding\">Summary</h2>\n";
 421
 422      my @dummy = ($gRemoveAge); #, @gSeverityList, @gSeverityDisplay);  #, $gHTMLExpireNote);
 423
 424      if (@bugs == 0) {
 425           return "<HR><H2>No reports found!</H2></HR>\n";
 426      }
 427
 428      if ( $param{bug_rev} ) {
 429           @bugs = sort {$b<=>$a} @bugs;
 430      }
 431      else {
 432           @bugs = sort {$a<=>$b} @bugs;
 433      }
 434      my %seenmerged;
 435
 436      my %common = (
 437                    'show_list_header' => 1,
 438                    'show_list_footer' => 1,
 439                   );
 440
 441      my %section = ();
 442      # Make the include/exclude map
 443      my %include;
 444      my %exclude;
 445      for my $include (make_list($param{include})) {
 446           next unless defined $include;
 447           my ($key,$value) = split /\s*:\s*/,$include,2;
 448           unless (defined $value) {
 449                $key = 'tags';
 450                $value = $include;
 451           }
 452           push @{$include{$key}}, split /\s*,\s*/, $value;
 453      }
 454      for my $exclude (make_list($param{exclude})) {
 455           next unless defined $exclude;
 456           my ($key,$value) = split /\s*:\s*/,$exclude,2;
 457           unless (defined $value) {
 458                $key = 'tags';
 459                $value = $exclude;
 460           }
 461           push @{$exclude{$key}}, split /\s*,\s*/, $value;
 462      }
 463
 464      foreach my $bug (@bugs) {
 465           my %status = %{get_bug_status(bug=>$bug,
 466                                         (exists $param{dist}?(dist => $param{dist}):()),
 467                                         bugusertags => $param{bugusertags},
 468                                         (exists $param{version}?(version => $param{version}):()),
 469                                         (exists $param{arch}?(arch => $param{arch}):(arch => $config{default_architectures})),
 470                                        )};
 471           next unless %status;
 472           next if bug_filter(bug => $bug,
 473                              status => \%status,
 474                              repeat_merged => $param{repeatmerged},
 475                              seen_merged => \%seenmerged,
 476                              (keys %include ? (include => \%include):()),
 477                              (keys %exclude ? (exclude => \%exclude):()),
 478                             );
 479
 480           my $html = "<li>"; #<a href=\"%s\">#%d: %s</a>\n<br>",
 481                #bug_url($bug), $bug, html_escape($status{subject});
 482           $html .= short_bug_status_html(status  => \%status,
 483                                          options => $param{options},
 484                                         ) . "\n";
 485           push @status, [ $bug, \%status, $html ];
 486      }
 487      if ($param{bug_order} eq 'age') {
 488           # MWHAHAHAHA
 489           @status = sort {$a->[1]{log_modified} <=> $b->[1]{log_modified}} @status;
 490      }
 491      elsif ($param{bug_order} eq 'agerev') {
 492           @status = sort {$b->[1]{log_modified} <=> $a->[1]{log_modified}} @status;
 493      }
 494      for my $entry (@status) {
 495           my $key = "";
 496           for my $i (0..$#{$param{prior}}) {
 497                my $v = get_bug_order_index($param{prior}[$i], $entry->[1]);
 498                $count{"g_${i}_${v}"}++;
 499                $key .= "_$v";
 500           }
 501           $section{$key} .= $entry->[2];
 502           $count{"_$key"}++;
 503      }
 504
 505      my $result = "";
 506      if ($param{ordering} eq "raw") {
 507           $result .= "<UL class=\"bugs\">\n" . join("", map( { $_->[ 2 ] } @status ) ) . "</UL>\n";
 508      }
 509      else {
 510           $header .= "<div class=\"msgreceived\">\n<ul>\n";
 511           my @keys_in_order = ("");
 512           for my $o (@{$param{order}}) {
 513                push @keys_in_order, "X";
 514                while ((my $k = shift @keys_in_order) ne "X") {
 515                     for my $k2 (@{$o}) {
 516                          $k2+=0;
 517                          push @keys_in_order, "${k}_${k2}";
 518                     }
 519                }
 520           }
 521           for my $order (@keys_in_order) {
 522                next unless defined $section{$order};
 523                my @ttl = split /_/, $order;
 524                shift @ttl;
 525                my $title = $param{title}[0]->[$ttl[0]] . " bugs";
 526                if ($#ttl > 0) {
 527                     $title .= " -- ";
 528                     $title .= join("; ", grep {($_ || "") ne ""}
 529                                    map { $param{title}[$_]->[$ttl[$_]] } 1..$#ttl);
 530                }
 531                $title = html_escape($title);
 532
 533                my $count = $count{"_$order"};
 534                my $bugs = $count == 1 ? "bug" : "bugs";
 535
 536                $header .= "<li><a href=\"#$order\">$title</a> ($count $bugs)</li>\n";
 537                if ($common{show_list_header}) {
 538                     my $count = $count{"_$order"};
 539                     my $bugs = $count == 1 ? "bug" : "bugs";
 540                     $result .= "<H2 CLASS=\"outstanding\"><a name=\"$order\"></a>$title ($count $bugs)</H2>\n";
 541                }
 542                else {
 543                     $result .= "<H2 CLASS=\"outstanding\">$title</H2>\n";
 544                }
 545                $result .= "<div class=\"msgreceived\">\n<UL class=\"bugs\">\n";
 546                $result .= "\n\n\n\n";
 547                $result .= $section{$order};
 548                $result .= "\n\n\n\n";
 549                $result .= "</UL>\n</div>\n";
 550           }
 551           $header .= "</ul></div>\n";
 552
 553           $footer .= "<div class=\"msgreceived\">\n<ul>\n";
 554           for my $i (0..$#{$param{prior}}) {
 555                my $local_result = '';
 556                foreach my $key ( @{$param{order}[$i]} ) {
 557                     my $count = $count{"g_${i}_$key"};
 558                     next if !$count or !$param{title}[$i]->[$key];
 559                     $local_result .= "<li>$count $param{title}[$i]->[$key]</li>\n";
 560                }
 561                if ( $local_result ) {
 562                     $footer .= "<li>$param{names}[$i]<ul>\n$local_result</ul></li>\n";
 563                }
 564           }
 565           $footer .= "</ul>\n</div>\n";
 566      }
 567
 568      $result = $header . $result if ( $common{show_list_header} );
 569      $result .= $footer if ( $common{show_list_footer} );
 570      return $result;
 571 }
 572
 573 sub pkg_javascript {
 574      return fill_in_template(template=>'cgi/pkgreport_javascript',
 575                             );
 576 }
 577
 578 sub pkg_htmlselectyesno {
 579      my ($name, $n, $y, $default) = @_;
 580      return sprintf('<select name="%s"><option value=no%s>%s</option><option value=yes%s>%s</option></select>', $name, ($default ? "" : " selected"), $n, ($default ? " selected" : ""), $y);
 581 }
 582
 583 sub pkg_htmlselectsuite {
 584      my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2];
 585      my @suites = ("stable", "testing", "unstable", "experimental");
 586      my %suiteaka = ("stable", "etch", "testing", "lenny", "unstable", "sid");
 587      my $defaultsuite = "unstable";
 588
 589      my $result = sprintf '<select name=dist id="%s">', $id;
 590      for my $s (@suites) {
 591           $result .= sprintf '<option value="%s"%s>%s%s</option>',
 592                $s, ($defaultsuite eq $s ? " selected" : ""),
 593                     $s, (defined $suiteaka{$s} ? " (" . $suiteaka{$s} . ")" : "");
 594      }
 595      $result .= '</select>';
 596      return $result;
 597 }
 598
 599 sub pkg_htmlselectarch {
 600      my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2];
 601      my @arches = qw(alpha amd64 arm hppa i386 ia64 m68k mips mipsel powerpc s390 sparc);
 602
 603      my $result = sprintf '<select name=arch id="%s">', $id;
 604      $result .= '<option value="any">any architecture</option>';
 605      for my $a (@arches) {
 606           $result .= sprintf '<option value="%s">%s</option>', $a, $a;
 607      }
 608      $result .= '</select>';
 609      return $result;
 610 }
 611
 612 sub myurl {
 613      my %param = @_;
 614      return html_escape(pkg_url(map {exists $param{$_}?($_,$param{$_}):()}
 615                                 qw(archive repeatmerged mindays maxdays),
 616                                 qw(version dist arch package src tag maint submitter)
 617                                )
 618                        );
 619 }
 620
 621 sub make_order_list {
 622      my $vfull = shift;
 623      my @x = ();
 624
 625      if ($vfull =~ m/^([^:]+):(.*)$/) {
 626           my $v = $1;
 627           for my $vv (split /,/, $2) {
 628                push @x, "$v=$vv";
 629           }
 630      }
 631      else {
 632           for my $v (split /,/, $vfull) {
 633                next unless $v =~ m/.=./;
 634                push @x, $v;
 635           }
 636      }
 637      push @x, "";               # catch all
 638      return @x;
 639 }
 640
 641 sub get_bug_order_index {
 642      my $order = shift;
 643      my $status = shift;
 644      my $pos = -1;
 645
 646      my %tags = ();
 647      %tags = map { $_, 1 } split / /, $status->{"tags"}
 648           if defined $status->{"tags"};
 649
 650      for my $el (@${order}) {
 651           $pos++;
 652           my $match = 1;
 653           for my $item (split /[+]/, $el) {
 654                my ($f, $v) = split /=/, $item, 2;
 655                next unless (defined $f and defined $v);
 656                my $isokay = 0;
 657                $isokay = 1 if (defined $status->{$f} and $v eq $status->{$f});
 658                $isokay = 1 if ($f eq "tag" && defined $tags{$v});
 659                unless ($isokay) {
 660                     $match = 0;
 661                     last;
 662                }
 663           }
 664           if ($match) {
 665                return $pos;
 666                last;
 667           }
 668      }
 669      return $pos + 1;
 670 }
 671
 672 sub buglinklist {
 673      my ($prefix, $infix, @els) = @_;
 674      return '' if not @els;
 675      return $prefix . bug_linklist($infix,'submitter',@els);
 676 }
 677
 678
 679 # sets: my @names; my @prior; my @title; my @order;
 680
 681 sub determine_ordering {
 682      my %param = validate_with(params => \@_,
 683                               spec => {cats => {type => HASHREF,
 684                                                },
 685                                        param => {type => HASHREF,
 686                                                 },
 687                                        ordering => {type => SCALARREF,
 688                                                    },
 689                                        names    => {type => ARRAYREF,
 690                                                    },
 691                                        pend_rev => {type => BOOLEAN,
 692                                                     default => 0,
 693                                                    },
 694                                        sev_rev  => {type => BOOLEAN,
 695                                                     default => 0,
 696                                                    },
 697                                        prior    => {type => ARRAYREF,
 698                                                    },
 699                                        title    => {type => ARRAYREF,
 700                                                    },
 701                                        order    => {type => ARRAYREF,
 702                                                    },
 703                                       },
 704                              );
 705      $param{cats}{status}[0]{ord} = [ reverse @{$param{cats}{status}[0]{ord}} ]
 706           if ($param{pend_rev});
 707      $param{cats}{severity}[0]{ord} = [ reverse @{$param{cats}{severity}[0]{ord}} ]
 708           if ($param{sev_rev});
 709
 710      my $i;
 711      if (defined $param{param}{"pri0"}) {
 712           my @c = ();
 713           $i = 0;
 714           while (defined $param{param}{"pri$i"}) {
 715                my $h = {};
 716
 717                my ($pri) = make_list($param{param}{"pri$i"});
 718                if ($pri =~ m/^([^:]*):(.*)$/) {
 719                     $h->{"nam"} = $1; # overridden later if necesary
 720                     $h->{"pri"} = [ map { "$1=$_" } (split /,/, $2) ];
 721                }
 722                else {
 723                     $h->{"pri"} = [ split /,/, $pri ];
 724                }
 725
 726                ($h->{"nam"}) = make_list($param{param}{"nam$i"})
 727                     if (defined $param{param}{"nam$i"});
 728                $h->{"ord"} = [ map {split /\s*,\s*/} make_list($param{param}{"ord$i"}) ]
 729                     if (defined $param{param}{"ord$i"});
 730                $h->{"ttl"} = [ map {split /\s*,\s*/} make_list($param{param}{"ttl$i"}) ]
 731                     if (defined $param{param}{"ttl$i"});
 732
 733                push @c, $h;
 734                $i++;
 735           }
 736           $param{cats}{"_"} = [@c];
 737           ${$param{ordering}} = "_";
 738      }
 739
 740      ${$param{ordering}} = "normal" unless defined $param{cats}{${$param{ordering}}};
 741
 742      sub get_ordering {
 743           my @res;
 744           my $cats = shift;
 745           my $o = shift;
 746           for my $c (@{$cats->{$o}}) {
 747                if (ref($c) eq "HASH") {
 748                     push @res, $c;
 749                }
 750                else {
 751                     push @res, get_ordering($cats, $c);
 752                }
 753           }
 754           return @res;
 755      }
 756      my @cats = get_ordering($param{cats}, ${$param{ordering}});
 757
 758      sub toenglish {
 759           my $expr = shift;
 760           $expr =~ s/[+]/ and /g;
 761           $expr =~ s/[a-z]+=//g;
 762           return $expr;
 763      }
 764
 765      $i = 0;
 766      for my $c (@cats) {
 767           $i++;
 768           push @{$param{prior}}, $c->{"pri"};
 769           push @{$param{names}}, ($c->{"nam"} || "Bug attribute #" . $i);
 770           if (defined $c->{"ord"}) {
 771                push @{$param{order}}, $c->{"ord"};
 772           }
 773           else {
 774                push @{$param{order}}, [ 0..$#{$param{prior}[-1]} ];
 775           }
 776           my @t = @{ $c->{"ttl"} } if defined $c->{ttl};
 777           if (@t < $#{$param{prior}[-1]}) {
 778                push @t, map { toenglish($param{prior}[-1][$_]) } @t..($#{$param{prior}[-1]});
 779           }
 780           push @t, $c->{"def"} || "";
 781           push @{$param{title}}, [@t];
 782      }
 783 }
 784
 785
 786
 787
 788 1;
 789
 790
 791 __END__
 792
 793
 794
 795
 796
 797