#!/usr/bin/perl -wT # This script is part of debbugs, and is released # under the terms of the GPL version 2, or any later # version at your option. # See the file README and COPYING for more information. # # [Other people have contributed to this file; their copyrights should # go here too.] # Copyright 2004-2006 by Anthony Towns # Copyright 2007 by Don Armstrong . package debbugs; use warnings; use strict; use POSIX qw(strftime nice); use Debbugs::Config qw(:globals :text :config); use Debbugs::User; use Debbugs::CGI qw(version_url maint_decode); use Debbugs::Common qw(getparsedaddrs :date make_list getmaintainers); use Debbugs::Bugs qw(get_bugs bug_filter newest_bug); use Debbugs::Packages qw(getsrcpkgs getpkgsrc get_versions); use Debbugs::Status qw(:status); use Debbugs::CGI qw(:all); use vars qw($gPackagePages $gWebDomain %gSeverityDisplay @gSeverityList); if (defined $ENV{REQUEST_METHOD} and $ENV{REQUEST_METHOD} eq 'HEAD') { print "Content-Type: text/html; charset=utf-8\n\n"; exit 0; } nice(5); use CGI::Simple; my $q = new CGI::Simple; our %param = cgi_parameters(query => $q, single => [qw(ordering archive repeatmerged), qw(bug-rev pend-rev sev-rev), qw(maxdays mindays version), qw(data which dist newest), ], default => {ordering => 'normal', archive => 0, repeatmerged => 1, }, ); # map from yes|no to 1|0 for my $key (qw(repeatmerged bug-rev pend-rev sev-rev)) { if (exists $param{$key}){ if ($param{$key} =~ /^no$/i) { $param{$key} = 0; } elsif ($param{$key}) { $param{$key} = 1; } } } if (lc($param{archive}) eq 'no') { $param{archive} = 0; } elsif (lc($param{archive}) eq 'yes') { $param{archive} = 1; } my $archive = ($param{'archive'} || "no") eq "yes"; my $include = $param{'&include'} || $param{'include'} || ""; my $exclude = $param{'&exclude'} || $param{'exclude'} || ""; my $users = $param{'users'} || ""; my $ordering = $param{'ordering'}; my $raw_sort = ($param{'raw'} || "no") eq "yes"; my $old_view = ($param{'oldview'} || "no") eq "yes"; my $age_sort = ($param{'age'} || "no") eq "yes"; unless (defined $ordering) { $ordering = "normal"; $ordering = "oldview" if $old_view; $ordering = "raw" if $raw_sort; $ordering = 'age' if $age_sort; } our ($bug_order) = $ordering =~ /(age(?:rev)?)/; $bug_order = '' if not defined $bug_order; my $bug_rev = ($param{'bug-rev'} || "no") eq "yes"; my $pend_rev = ($param{'pend-rev'} || "no") eq "yes"; my $sev_rev = ($param{'sev-rev'} || "no") eq "yes"; my @inc_exc_mapping = ({name => 'pending', incexc => 'include', key => 'pend-inc', }, {name => 'pending', incexc => 'exclude', key => 'pend-exc', }, {name => 'severity', incexc => 'include', key => 'sev-inc', }, {name => 'severity', incexc => 'exclude', key => 'sev-exc', }, {name => 'subject', incexc => 'include', key => 'includesubj', }, {name => 'subject', incexc => 'exclude', key => 'excludesubj', }, ); for my $incexcmap (@inc_exc_mapping) { push @{$param{$incexcmap->{incexc}}}, map {"$incexcmap->{name}:$_"} map{split /\s*,\s*/} make_list($param{$incexcmap->{key}}) if exists $param{$incexcmap->{key}}; delete $param{$incexcmap->{key}}; } my $maxdays = ($param{'maxdays'} || -1); my $mindays = ($param{'mindays'} || 0); my $version = $param{'version'} || undef; # XXX Once the options/selection is rewritten, this should go away my $dist = $param{dist} || undef; our %hidden = map { $_, 1 } qw(status severity classification); our %cats = ( "status" => [ { "nam" => "Status", "pri" => [map { "pending=$_" } qw(pending forwarded pending-fixed fixed done absent)], "ttl" => ["Outstanding","Forwarded","Pending Upload", "Fixed in NMU","Resolved","From other Branch"], "def" => "Unknown Pending Status", "ord" => [0,1,2,3,4,5,6], } ], "severity" => [ { "nam" => "Severity", "pri" => [map { "severity=$_" } @gSeverityList], "ttl" => [map { $gSeverityDisplay{$_} } @gSeverityList], "def" => "Unknown Severity", "ord" => [0..@gSeverityList], } ], "classification" => [ { "nam" => "Classification", "pri" => [qw(pending=pending+tag=wontfix pending=pending+tag=moreinfo pending=pending+tag=patch pending=pending+tag=confirmed pending=pending)], "ttl" => ["Will Not Fix","More information needed", "Patch Available","Confirmed"], "def" => "Unclassified", "ord" => [2,3,4,1,0,5], } ], "oldview" => [ qw(status severity) ], "normal" => [ qw(status severity classification) ], ); my @select_key = (qw(submitter maint pkg package src usertag), qw(status tag maintenc owner severity newest) ); if (exists $param{which} and exists $param{data}) { $param{$param{which}} = [exists $param{$param{which}}?(make_list($param{$param{which}})):(), make_list($param{data}), ]; delete $param{which}; delete $param{data}; } if (defined $param{maintenc}) { $param{maint} = maint_decode($param{maintenc}); delete $param{maintenc} } if (not grep {exists $param{$_}} @select_key and exists $param{users}) { $param{usertag} = [make_list($param{users})]; } quitcgi("You have to choose something to select by") unless grep {exists $param{$_}} @select_key; if (exists $param{pkg}) { $param{package} = $param{pkg}; delete $param{pkg}; } our %bugusertags; our %ut; for my $user (map {split /[\s*,\s*]+/} make_list($param{users}||[])) { next unless length($user); add_user($user); } if (defined $param{usertag}) { my %select_ut = (); my ($u, $t) = split /:/, $param{usertag}, 2; Debbugs::User::read_usertags(\%select_ut, $u); unless (defined $t && $t ne "") { $t = join(",", keys(%select_ut)); } add_user($u); push @{$param{tag}}, split /,/, $t; } my $Archived = $archive ? " Archived" : ""; our $this = munge_url('pkgreport.cgi?', %param, ); my %indexentry; my %strings = (); my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime; my $tail_html = $debbugs::gHTMLTail; $tail_html = $debbugs::gHTMLTail; $tail_html =~ s/SUBSTITUTE_DTIME/$dtime/; our %seen_users; sub add_user { my $ut = \%ut; my $u = shift; return if $seen_users{$u}; $seen_users{$u} = 1; my $user = Debbugs::User::get_user($u); my %vis = map { $_, 1 } @{$user->{"visible_cats"}}; for my $c (keys %{$user->{"categories"}}) { $cats{$c} = $user->{"categories"}->{$c}; $hidden{$c} = 1 unless defined $vis{$c}; } for my $t (keys %{$user->{"tags"}}) { $ut->{$t} = [] unless defined $ut->{$t}; push @{$ut->{$t}}, @{$user->{"tags"}->{$t}}; } %bugusertags = (); for my $t (keys %{$ut}) { for my $b (@{$ut->{$t}}) { $bugusertags{$b} = [] unless defined $bugusertags{$b}; push @{$bugusertags{$b}}, $t; } } # set_option("bugusertags", \%bugusertags); } my @bugs; # addusers for source and binary packages being searched for my $pkgsrc = getpkgsrc(); my $srcpkg = getsrcpkgs(); for my $package (# For binary packages, add the binary package # and corresponding source package make_list($param{package}||[]), (map {defined $pkgsrc->{$_}?($pkgsrc->{$_}):()} make_list($param{package}||[]), ), # For source packages, add the source package # and corresponding binary packages make_list($param{src}||[]), (map {defined $srcpkg->{$_}?($srcpkg->{$_}):()} make_list($param{src}||[]), ), ) { next unless defined $package; add_user($package.'@'.$config{usertag_package_domain}) if defined $config{usertag_package_domain}; } # walk through the keys and make the right get_bugs query. my @search_key_order = (package => 'in package', tag => 'tagged', severity => 'with severity', src => 'in source package', maint => 'in packages maintained by', submitter => 'submitted by', owner => 'owned by', status => 'with status', ); my %search_keys = @search_key_order; # Set the title sanely and clean up parameters my @title; while (my ($key,$value) = splice @search_key_order, 0, 2) { next unless exists $param{$key}; my @entries = (); $param{$key} = [map {split /\s*,\s*/} make_list($param{$key})]; for my $entry (make_list($param{$key})) { my $extra = ''; if (exists $param{dist} and ($key eq 'package' or $key eq 'src')) { my @versions = get_versions(package => $entry, (exists $param{dist}?(dist => $param{dist}):()), (exists $param{arch}?(arch => $param{arch}):()), ($key eq 'src'?(arch => q(source)):()), ); my $verdesc = join(', ',@versions); $verdesc = 'version'.(@versions>1?'s ':' ').$verdesc; $extra= " ($verdesc)" if @versions; } push @entries, $entry.$extra; } push @title,$value.' '.join(' or ', @entries); } my $title = $gBugs.' '.join(' and ', map {/ or /?"($_)":$_} @title); @title = (); # we have to special case the maint="" search, unfortunatly. if (defined $param{maint} and $param{maint} eq "") { my %maintainers = %{getmaintainers()}; @bugs = get_bugs(function => sub {my %d=@_; foreach my $try (splitpackages($d{"pkg"})) { return 1 if !getparsedaddrs($maintainers{$try}); } return 0; } ); $title = $gBugs.' in packages with no maintainer'; } elsif (defined $param{newest}) { my $newest_bug = newest_bug(); @bugs = ($newest_bug - $param{newest} + 1) .. $newest_bug; $title = @bugs.' newest '.$gBugs; } else { #yeah for magick! @bugs = get_bugs((map {exists $param{$_}?($_,$param{$_}):()} keys %search_keys, 'archive'), usertags => \%ut, ); } if (defined $param{version}) { $title .= " at version $param{version}"; } elsif (defined $param{dist}) { $title .= " in $param{dist}"; } $title = html_escape($title); my @names; my @prior; my @order; determine_ordering(); # strip out duplicate bugs my %bugs; @bugs{@bugs} = @bugs; @bugs = keys %bugs; my $result = pkg_htmlizebugs(\@bugs); print "Content-Type: text/html; charset=utf-8\n\n"; print "\n"; print "\n" . "$title -- $gProject$Archived $gBug report logs\n" . qq() . "\n" . '' . "\n"; print "

" . "$gProject$Archived $gBug report logs: $title" . "

\n"; my $showresult = 1; my $pkg = $param{package} if defined $param{package}; my $src = $param{src} if defined $param{src}; my $pseudodesc = getpseudodesc(); if (defined $pseudodesc and defined $pkg and exists $pseudodesc->{$pkg}) { delete $param{dist}; } # output infomration about the packages for my $package (make_list($param{package}||[])) { output_package_info('binary',$package); } for my $package (make_list($param{src}||[])) { output_package_info('source',$package); } sub output_package_info{ my ($srcorbin,$package) = @_; my $showpkg = html_escape($package); my $maintainers = getmaintainers(); my $maint = $maintainers->{$package}; if (defined $maint) { print '

'; print htmlize_maintlinks(sub { $_[0] == 1 ? "Maintainer for $showpkg is " : "Maintainers for $showpkg are " }, $maint); print ".

\n"; } else { print "

No maintainer for $showpkg. Please do not report new bugs against this package.

\n"; } my %pkgsrc = %{getpkgsrc()}; my $srcforpkg = $package; if ($srcorbin eq 'binary') { $srcforpkg = $pkgsrc{$package}; defined $srcforpkg or $srcforpkg = $package; } my @pkgs = getsrcpkgs($srcforpkg); @pkgs = grep( !/^\Q$package\E$/, @pkgs ); if ( @pkgs ) { @pkgs = sort @pkgs; if ($srcorbin eq 'binary') { print "

You may want to refer to the following packages that are part of the same source:\n"; } else { print "

You may want to refer to the following individual bug pages:\n"; } #push @pkgs, $src if ( $src && !grep(/^\Q$src\E$/, @pkgs) ); print join( ", ", map( "$_,src=>[],newest=>[])) . "\">$_", @pkgs ) ); print ".\n"; } my @references; my $pseudodesc = getpseudodesc(); if ($package and defined($pseudodesc) and exists($pseudodesc->{$package})) { push @references, "to the ". "list of other pseudo-packages"; } else { if ($package and defined $gPackagePages) { push @references, sprintf "to the %s package page", html_escape("http://${debbugs::gPackagePages}/$package"), html_escape("$package"); } if (defined $gSubscriptionDomain) { my $ptslink = $package ? $srcforpkg : $src; push @references, "to the Package Tracking System"; } # Only output this if the source listing is non-trivial. if ($srcorbin eq 'binary' and $srcforpkg) { push @references, sprintf "to the source package %s's bug page", html_escape(munge_url($this,src=>$srcforpkg,package=>[],newest=>[])), html_escape($srcforpkg); } } if (@references) { $references[$#references] = "or $references[$#references]" if @references > 1; print "

You might like to refer ", join(", ", @references), ".

\n"; } if (defined $param{maint} || defined $param{maintenc}) { print "

If you find a bug not listed here, please\n"; printf "report it.

\n", html_escape("http://${debbugs::gWebDomain}/Reporting${debbugs::gHTMLSuffix}"); } if (not $maint and not @bugs) { print "

There is no record of the " . ($srcorbin eq 'binary' ? html_escape($package) . " package" : html_escape($src) . " source package"). ", and no bugs have been filed against it.

"; $showresult = 0; } } if (exists $param{maint} or exists $param{maintenc}) { print "

Note that maintainers may use different Maintainer fields for\n"; print "different packages, so there may be other reports filed under\n"; print "different addresses.\n"; } if (exists $param{submitter}) { print "

Note that people may use different email accounts for\n"; print "different bugs, so there may be other reports filed under\n"; print "different addresses.\n"; } my $archive_links; my @archive_links; my %archive_values = (both => 'archived and unarchived', 0 => 'not archived', 1 => 'archived', ); while (my ($key,$value) = each %archive_values) { next if $key eq lc($param{archive}); push @archive_links, qq($value reports ); } print '

See the '.join (' or ',@archive_links)."

\n"; print $result if $showresult; print pkg_javascript() . "\n"; print "

Options

\n"; print "
\n"; printf "
\n", myurl(); print "\n"; my ($checked_any, $checked_sui, $checked_ver) = ("", "", ""); if (defined $dist) { $checked_sui = "CHECKED"; } elsif (defined $version) { $checked_ver = "CHECKED"; } else { $checked_any = "CHECKED"; } print "\n"; print " \n"; print ""; print " \n"; if (defined $pkg) { my $v = html_escape($version) || ""; my $pkgsane = html_escape($pkg); print ""; print " \n"; } elsif (defined $src) { my $v = html_escape($version) || ""; my $srcsane = html_escape($src); print ""; print " \n"; } print "\n"; my $includetags = html_escape(join(" ", grep { !m/^subj:/i } map {split /[\s,]+/} ref($include)?@{$include}:$include)); my $excludetags = html_escape(join(" ", grep { !m/^subj:/i } map {split /[\s,]+/} ref($exclude)?@{$exclude}:$exclude)); my $includesubj = html_escape(join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } map {split /[\s,]+/} ref($include)?@{$include}:$include)); my $excludesubj = html_escape(join(" ", map { s/^subj://i; $_ } grep { m/^subj:/i } map {split /[\s,]+/} ref($exclude)?@{$exclude}:$exclude)); my $vismindays = ($mindays == 0 ? "" : $mindays); my $vismaxdays = ($maxdays == -1 ? "" : $maxdays); my $sel_rmy = ($param{repeatmerged} ? " selected" : ""); my $sel_rmn = ($param{repeatmerged} ? "" : " selected"); my $sel_ordraw = ($ordering eq "raw" ? " selected" : ""); my $sel_ordold = ($ordering eq "oldview" ? " selected" : ""); my $sel_ordnor = ($ordering eq "normal" ? " selected" : ""); my $sel_ordage = ($ordering eq "age" ? " selected" : ""); my $chk_bugrev = ($bug_rev ? " checked" : ""); my $chk_pendrev = ($pend_rev ? " checked" : ""); my $chk_sevrev = ($sev_rev ? " checked" : ""); print <\n"; printf "\n", pkg_htmlselectyesno("pend-rev", "outstanding bugs first", "done bugs first", $pend_rev); printf "\n", pkg_htmlselectyesno("sev-rev", "highest severity first", "lowest severity first", $sev_rev); printf "\n", pkg_htmlselectyesno("bug-rev", "oldest bugs first", "newest bugs first", $bug_rev); print < EOF print "
Show bugs applicable toanything
" . pkg_htmlselectsuite(1,2,1) . " for " . pkg_htmlselectarch(1,2,2) . "
$pkgsane version
$srcsane version
 
Only include bugs tagged with or that have in their subject
Exclude bugs tagged with or that have in their subject
Only show bugs older than days, and younger than days
 
Merged bugs should be
Categorise bugs by
Order bugs by%s
%s
%s
 
with new settings
\n"; print "
\n"; print "

$tail_html"; print "\n"; sub pkg_htmlindexentrystatus { my $s = shift; my %status = %{$s}; my $result = ""; my $showseverity; if ($status{severity} eq 'normal') { $showseverity = ''; } elsif (isstrongseverity($status{severity})) { $showseverity = "Severity: $status{severity};\n"; } else { $showseverity = "Severity: $status{severity};\n"; } $result .= pkg_htmlpackagelinks($status{"package"}, 1); my $showversions = ''; if (@{$status{found_versions}}) { my @found = @{$status{found_versions}}; $showversions .= join ', ', map {s{/}{ }; html_escape($_)} @found; } if (@{$status{fixed_versions}}) { $showversions .= '; ' if length $showversions; $showversions .= 'fixed: '; my @fixed = @{$status{fixed_versions}}; $showversions .= join ', ', map {s{/}{ }; html_escape($_)} @fixed; } $result .= ' ($showversions)} if length $showversions; $result .= ";\n"; $result .= $showseverity; $result .= pkg_htmladdresslinks("Reported by: ", \&submitterurl, $status{originator}); $result .= ";\nOwned by: " . html_escape($status{owner}) if length $status{owner}; $result .= ";\nTags: " . html_escape(join(", ", sort(split(/\s+/, $status{tags})))) . "" if (length($status{tags})); $result .= buglinklist(";\nMerged with ", ", ", split(/ /,$status{mergedwith})); $result .= buglinklist(";\nBlocked by ", ", ", split(/ /,$status{blockedby})); $result .= buglinklist(";\nBlocks ", ", ", split(/ /,$status{blocks})); if (length($status{done})) { $result .= "
Done: " . html_escape($status{done}); my $days = bug_archiveable(bug => $status{id}, status => \%status, days_until => 1, ); if ($days >= 0 and defined $status{location} and $status{location} ne 'archive') { $result .= ";\nCan be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . ""; } elsif (defined $status{location} and $status{location} eq 'archived') { $result .= ";\nArchived."; } } unless (length($status{done})) { if (length($status{forwarded})) { $result .= ";\nForwarded to " . join(', ', map {maybelink($_)} split /[,\s]+/,$status{forwarded} ); } # Check the age of the logfile my ($days_last,$eng_last) = secs_to_english(time - $status{log_modified}); my ($days,$eng) = secs_to_english(time - $status{date}); if ($days >= 7) { my $font = ""; my $efont = ""; $font = "em" if ($days > 30); $font = "strong" if ($days > 60); $efont = "" if ($font); $font = "<$font>" if ($font); $result .= ";\n ${font}$eng old$efont"; } if ($days_last > 7) { my $font = ""; my $efont = ""; $font = "em" if ($days_last > 30); $font = "strong" if ($days_last > 60); $efont = "" if ($font); $font = "<$font>" if ($font); $result .= ";\n ${font}Modified $eng_last ago$efont"; } } $result .= "."; return $result; } sub pkg_htmlizebugs { $b = $_[0]; my @bugs = @$b; my @status = (); my %count; my $header = ''; my $footer = "

Summary

\n"; my @dummy = ($gRemoveAge); #, @gSeverityList, @gSeverityDisplay); #, $gHTMLExpireNote); if (@bugs == 0) { return "

No reports found!

\n"; } if ( $bug_rev ) { @bugs = sort {$b<=>$a} @bugs; } else { @bugs = sort {$a<=>$b} @bugs; } my %seenmerged; my %common = ( 'show_list_header' => 1, 'show_list_footer' => 1, ); my %section = (); # Make the include/exclude map my %include; my %exclude; for my $include (make_list($param{include})) { next unless defined $include; my ($key,$value) = split /\s*:\s*/,$include,2; next unless defined $value; push @{$include{$key}}, split /\s*,\s*/, $value; } for my $exclude (make_list($param{exclude})) { next unless defined $exclude; my ($key,$value) = split /\s*:\s*/,$exclude,2; next unless defined $value; push @{$exclude{$key}}, split /\s*,\s*/, $value; } foreach my $bug (@bugs) { my %status = %{get_bug_status(bug=>$bug, (exists $param{dist}?(dist => $param{dist}):()), bugusertags => \%bugusertags, (exists $param{version}?(version => $param{version}):()), (exists $param{arch}?(arch => $param{arch}):()), )}; next unless %status; next if bug_filter(bug => $bug, status => \%status, (exists $param{repeatmerged}?(repeat_merged => $param{repeatmerged}):()), seen_merged => \%seenmerged, (keys %include ? (include => \%include):()), (keys %exclude ? (exclude => \%exclude):()), ); my $html = sprintf "
  • #%d: %s\n
    ", bug_url($bug), $bug, html_escape($status{subject}); $html .= pkg_htmlindexentrystatus(\%status) . "\n"; push @status, [ $bug, \%status, $html ]; } if ($bug_order eq 'age') { # MWHAHAHAHA @status = sort {$a->[1]{log_modified} <=> $b->[1]{log_modified}} @status; } elsif ($bug_order eq 'agerev') { @status = sort {$b->[1]{log_modified} <=> $a->[1]{log_modified}} @status; } for my $entry (@status) { my $key = ""; for my $i (0..$#prior) { my $v = get_bug_order_index($prior[$i], $entry->[1]); $count{"g_${i}_${v}"}++; $key .= "_$v"; } $section{$key} .= $entry->[2]; $count{"_$key"}++; } my $result = ""; if ($ordering eq "raw") { $result .= "
      \n" . join("", map( { $_->[ 2 ] } @status ) ) . "
    \n"; } else { $header .= "
      \n
      \n"; my @keys_in_order = (""); for my $o (@order) { push @keys_in_order, "X"; while ((my $k = shift @keys_in_order) ne "X") { for my $k2 (@{$o}) { $k2+=0; push @keys_in_order, "${k}_${k2}"; } } } for my $order (@keys_in_order) { next unless defined $section{$order}; my @ttl = split /_/, $order; shift @ttl; my $title = $title[0]->[$ttl[0]] . " bugs"; if ($#ttl > 0) { $title .= " -- "; $title .= join("; ", grep {($_ || "") ne ""} map { $title[$_]->[$ttl[$_]] } 1..$#ttl); } $title = html_escape($title); my $count = $count{"_$order"}; my $bugs = $count == 1 ? "bug" : "bugs"; $header .= "
    • $title ($count $bugs)
    • \n"; if ($common{show_list_header}) { my $count = $count{"_$order"}; my $bugs = $count == 1 ? "bug" : "bugs"; $result .= "

      $title ($count $bugs)

      \n"; } else { $result .= "

      $title

      \n"; } $result .= "
      \n
        \n"; $result .= "\n\n\n\n"; $result .= $section{$order}; $result .= "\n\n\n\n"; $result .= "
      \n
      \n"; } $header .= "
    \n"; $footer .= "
      \n
      "; for my $i (0..$#prior) { my $local_result = ''; foreach my $key ( @{$order[$i]} ) { my $count = $count{"g_${i}_$key"}; next if !$count or !$title[$i]->[$key]; $local_result .= "
    • $count $title[$i]->[$key]
    • \n"; } if ( $local_result ) { $footer .= "
    • $names[$i]
        \n$local_result
    • \n"; } } $footer .= "
    \n"; } $result = $header . $result if ( $common{show_list_header} ); $result .= $footer if ( $common{show_list_footer} ); return $result; } sub pkg_htmlpackagelinks { my $pkgs = shift; return unless defined $pkgs and $pkgs ne ''; my $strong = shift; my @pkglist = splitpackages($pkgs); $strong = 0; my $openstrong = $strong ? '' : ''; my $closestrong = $strong ? '' : ''; return 'Package' . (@pkglist > 1 ? 's' : '') . ': ' . join(', ', map { '' . $openstrong . html_escape($_) . $closestrong . '' } @pkglist ); } sub pkg_htmladdresslinks { htmlize_addresslinks(@_,'submitter'); } sub pkg_javascript { return < EOF } sub pkg_htmlselectyesno { my ($name, $n, $y, $default) = @_; return sprintf('', $name, ($default ? "" : " selected"), $n, ($default ? " selected" : ""), $y); } sub pkg_htmlselectsuite { my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2]; my @suites = ("stable", "testing", "unstable", "experimental"); my %suiteaka = ("stable", "etch", "testing", "lenny", "unstable", "sid"); my $defaultsuite = "unstable"; my $result = sprintf ''; return $result; } sub pkg_htmlselectarch { my $id = sprintf "b_%d_%d_%d", $_[0], $_[1], $_[2]; my @arches = qw(alpha amd64 arm hppa i386 ia64 m68k mips mipsel powerpc s390 sparc); my $result = sprintf ''; return $result; } sub myurl { return html_escape(pkg_url(map {exists $param{$_}?($_,$param{$_}):()} qw(archive repeatmerged mindays maxdays), qw(version dist arch pkg src tag maint submitter) ) ); } sub make_order_list { my $vfull = shift; my @x = (); if ($vfull =~ m/^([^:]+):(.*)$/) { my $v = $1; for my $vv (split /,/, $2) { push @x, "$v=$vv"; } } else { for my $v (split /,/, $vfull) { next unless $v =~ m/.=./; push @x, $v; } } push @x, ""; # catch all return @x; } sub get_bug_order_index { my $order = shift; my $status = shift; my $pos = -1; my %tags = (); %tags = map { $_, 1 } split / /, $status->{"tags"} if defined $status->{"tags"}; for my $el (@${order}) { $pos++; my $match = 1; for my $item (split /[+]/, $el) { my ($f, $v) = split /=/, $item, 2; next unless (defined $f and defined $v); my $isokay = 0; $isokay = 1 if (defined $status->{$f} and $v eq $status->{$f}); $isokay = 1 if ($f eq "tag" && defined $tags{$v}); unless ($isokay) { $match = 0; last; } } if ($match) { return $pos; last; } } return $pos + 1; } sub buglinklist { my ($prefix, $infix, @els) = @_; return '' if not @els; return $prefix . bug_linklist($infix,'submitter',@els); } # sets: my @names; my @prior; my @title; my @order; sub determine_ordering { $cats{status}[0]{ord} = [ reverse @{$cats{status}[0]{ord}} ] if ($pend_rev); $cats{severity}[0]{ord} = [ reverse @{$cats{severity}[0]{ord}} ] if ($sev_rev); my $i; if (defined $param{"pri0"}) { my @c = (); $i = 0; while (defined $param{"pri$i"}) { my $h = {}; my ($pri) = make_list($param{"pri$i"}); if ($pri =~ m/^([^:]*):(.*)$/) { $h->{"nam"} = $1; # overridden later if necesary $h->{"pri"} = [ map { "$1=$_" } (split /,/, $2) ]; } else { $h->{"pri"} = [ split /,/, $pri ]; } ($h->{"nam"}) = make_list($param{"nam$i"}) if (defined $param{"nam$i"}); $h->{"ord"} = [ split /\s*,\s*/, make_list($param{"ord$i"}) ] if (defined $param{"ord$i"}); $h->{"ttl"} = [ split /\s*,\s*/, make_list($param{"ttl$i"}) ] if (defined $param{"ttl$i"}); push @c, $h; $i++; } $cats{"_"} = [@c]; $ordering = "_"; } $ordering = "normal" unless defined $cats{$ordering}; sub get_ordering { my @res; my $cats = shift; my $o = shift; for my $c (@{$cats->{$o}}) { if (ref($c) eq "HASH") { push @res, $c; } else { push @res, get_ordering($cats, $c); } } return @res; } my @cats = get_ordering(\%cats, $ordering); sub toenglish { my $expr = shift; $expr =~ s/[+]/ and /g; $expr =~ s/[a-z]+=//g; return $expr; } $i = 0; for my $c (@cats) { $i++; push @prior, $c->{"pri"}; push @names, ($c->{"nam"} || "Bug attribute #" . $i); if (defined $c->{"ord"}) { push @order, $c->{"ord"}; } else { push @order, [ 0..$#{$prior[-1]} ]; } my @t = @{ $c->{"ttl"} } if defined $c->{ttl}; if (@t < $#{$prior[-1]}) { push @t, map { toenglish($prior[-1][$_]) } @t..($#{$prior[-1]}); } push @t, $c->{"def"} || ""; push @title, [@t]; } }