X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=cgi%2Fpkgreport.cgi;h=7f16855b704c739b1cfabac536a6f02f45897f36;hb=adf6539386c22827b4652dae96b4b634f6f4b4f2;hp=0031cc472456ef40015ebf8bc30b342d574ef297;hpb=bb609b8db53b6f99c4157beed88eac72c386f705;p=debbugs.git diff --git a/cgi/pkgreport.cgi b/cgi/pkgreport.cgi index 0031cc4..7f16855 100755 --- a/cgi/pkgreport.cgi +++ b/cgi/pkgreport.cgi @@ -3,30 +3,44 @@ package debbugs; use strict; -use POSIX qw(strftime tzset nice); +use POSIX qw(strftime nice); -#require '/usr/lib/debbugs/errorlib'; require './common.pl'; -require '/etc/debbugs/config'; -require '/etc/debbugs/text'; +use Debbugs::Config qw(:globals :text); +use Debbugs::User; +use Debbugs::CGI qw(version_url); +use Debbugs::Common qw(getparsedaddrs); +use Debbugs::Bugs qw(get_bugs); -use vars qw($gPackagePages $gWebDomain); +use vars qw($gPackagePages $gWebDomain %gSeverityDisplay @gSeverityList); -if ($ENV{REQUEST_METHOD} eq 'HEAD') { - print "Content-Type: text/html\n\n"; +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); +my $userAgent = detect_user_agent(); my %param = readparse(); my $repeatmerged = ($param{'repeatmerged'} || "yes") eq "yes"; my $archive = ($param{'archive'} || "no") eq "yes"; -my $include = $param{'include'} || ""; -my $exclude = $param{'exclude'} || ""; +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"; +unless (defined $ordering) { + $ordering = "normal"; + $ordering = "oldview" if $old_view; + $ordering = "raw" if $raw_sort; +} + 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"; @@ -34,48 +48,134 @@ my $pend_exc = $param{'&pend-exc'} || $param{'pend-exc'} || ""; my $pend_inc = $param{'&pend-inc'} || $param{'pend-inc'} || ""; my $sev_exc = $param{'&sev-exc'} || $param{'sev-exc'} || ""; my $sev_inc = $param{'&sev-inc'} || $param{'sev-inc'} || ""; +my $maxdays = ($param{'maxdays'} || -1); +my $mindays = ($param{'mindays'} || 0); +my $version = $param{'version'} || undef; +my $dist = $param{'dist'} || undef; +my $arch = $param{'arch'} || undef; +my $show_list_header = ($param{'show_list_header'} || $userAgent->{'show_list_header'} || "yes" ) eq "yes"; +my $show_list_footer = ($param{'show_list_footer'} || $userAgent->{'show_list_footer'} || "yes" ) eq "yes"; + +{ + if (defined $param{'vt'}) { + my $vt = $param{'vt'}; + if ($vt eq "none") { $dist = undef; $arch = undef; $version = undef; } + if ($vt eq "bysuite") { + $version = undef; + $arch = undef if ($arch eq "any"); + } + if ($vt eq "bypkg" || $vt eq "bysrc") { $dist = undef; $arch = undef; } + } + if (defined $param{'includesubj'}) { + my $is = $param{'includesubj'}; + $include .= "," . join(",", map { "subj:$_" } (split /[\s,]+/, $is)); + } + if (defined $param{'excludesubj'}) { + my $es = $param{'excludesubj'}; + $exclude .= "," . join(",", map { "subj:$_" } (split /[\s,]+/, $es)); + } +} -my ($pkg, $src, $maint, $maintenc, $submitter, $severity, $status); + +my %hidden = map { $_, 1 } qw(status severity classification); +my %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 ($pkg, $src, $maint, $maintenc, $submitter, $severity, $status, $tag, $usertag, + $owner, + ); my %which = ( - 'pkg' => \$pkg, - 'src' => \$src, - 'maint' => \$maint, - 'maintenc' => \$maintenc, - 'submitter' => \$submitter, - 'severity' => \$severity, - ); + 'pkg' => \$pkg, + 'src' => \$src, + 'maint' => \$maint, + 'maintenc' => \$maintenc, + 'submitter' => \$submitter, + 'severity' => \$severity, + 'tag' => \$tag, + 'usertag' => \$usertag, + 'owner' => \$owner, + ); my @allowedEmpty = ( 'maint' ); my $found; foreach ( keys %which ) { - $status = $param{'status'} || 'open' if /^severity$/; - if (($found = $param{$_})) { - ${ $which{$_} } = $found; - last; - } + $status = $param{'status'} || 'open' if /^severity$/; + if (($found = $param{$_})) { + ${ $which{$_} } = $found; + last; + } } if (!$found && !$archive) { - foreach ( @allowedEmpty ) { - if (exists($param{$_})) { - ${ $which{$_} } = ''; - $found = 1; - last; - } - } + foreach ( @allowedEmpty ) { + if (exists($param{$_})) { + ${ $which{$_} } = ''; + $found = 1; + last; + } + } } if (!$found) { - my $which; - if (($which = $param{'which'})) { - if (grep( /^\Q$which\E$/, @allowedEmpty)) { - ${ $which{$which} } = $param{'data'}; - $found = 1; - } elsif (($found = $param{'data'})) { - ${ $which{$which} } = $found if (exists($which{$which})); - } - } + my $which; + if (($which = $param{'which'})) { + if (grep( /^\Q$which\E$/, @allowedEmpty)) { + ${ $which{$which} } = $param{'data'}; + $found = 1; + } elsif (($found = $param{'data'})) { + ${ $which{$which} } = $found if (exists($which{$which})); + } + } +} +quitcgi("You have to choose something to select by") if (!$found); + +my %bugusertags; +my %ut; +for my $user (split /[\s*,]+/, $users) { + next unless length($user) >= 4; + add_user($user); +} + +if (defined $usertag) { + my %select_ut = (); + my ($u, $t) = split /:/, $usertag, 2; + Debbugs::User::read_usertags(\%select_ut, $u); + unless (defined $t && $t ne "") { + $t = join(",", keys(%select_ut)); + } + + add_user($u); + $tag = $t; } -quit("You have to choose something to select by") if (!$found); my $Archived = $archive ? " Archived" : ""; @@ -84,161 +184,261 @@ my $this = ""; my %indexentry; my %strings = (); -$ENV{"TZ"} = 'UTC'; -tzset(); - -my $dtime = strftime "%a, %e %b %Y %T UTC", localtime; +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/; set_option("repeatmerged", $repeatmerged); set_option("archive", $archive); -set_option("include", { map {if (m/^(.*):(.*)$/) { ($1,$2) } else { ($_,1) }} (split /[\s,]+/, $include) }) - if ($include); -set_option("exclude", { map {if (m/^(.*):(.*)$/) { ($1,$2) } else { ($_,1) }} (split /[\s,]+/, $exclude) }) - if ($exclude); -set_option("raw", $raw_sort); -set_option("bug-rev", $bug_rev); -set_option("pend-rev", $pend_rev); -set_option("sev-rev", $sev_rev); +set_option("include", $include); +set_option("exclude", $exclude); set_option("pend-exc", $pend_exc); set_option("pend-inc", $pend_inc); set_option("sev-exc", $sev_exc); set_option("sev-inc", $sev_inc); +set_option("maxdays", $maxdays); +set_option("mindays", $mindays); +set_option("version", $version); +set_option("dist", $dist); +set_option("arch", $arch); +set_option("use-bug-idx", defined($param{'use-bug-idx'}) ? $param{'use-bug-idx'} : 0); +set_option("show_list_header", $show_list_header); +set_option("show_list_footer", $show_list_footer); + +our %seen_users; +sub add_user { + my $ut = \%ut; + my $u = shift; -my $tag; + 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 $pseudodesc = getpseudodesc(); +if (defined $pseudodesc and defined $pkg and exists $pseudodesc->{$pkg}) { + undef $dist; + set_option('dist',$dist) +} +my $title; my @bugs; if (defined $pkg) { - $tag = "package $pkg"; - @bugs = @{getbugs(sub {my %d=@_; return $pkg eq $d{"pkg"}}, 'package', $pkg)}; + $title = "package $pkg"; + add_user("$pkg\@packages.debian.org"); + # figure out the source package + my $pkgsrc = getpkgsrc(); + add_user($pkgsrc->{$pkg}.'@packages.debian.org') + if defined $pkgsrc->{$pkg}; + if (defined $version) { + $title .= " (version $version)"; + } elsif (defined $dist) { + $title .= " in $dist"; + my $verdesc = getversiondesc($pkg); + $title .= " ($verdesc)" if defined $verdesc; + } + my @pkgs = split /,/, $pkg; + @bugs = get_bugs(package=>\@pkgs); } elsif (defined $src) { - $tag = "source $src"; - my @pkgs = getsrcpkgs($src); - push @pkgs, $src if ( !grep(/^\Q$src\E$/, @pkgs) ); - @bugs = @{getbugs(sub {my %d=@_; return grep($d{"pkg"} eq $_, @pkgs)}, 'package', @pkgs)}; -} elsif (defined $maint) { - my %maintainers = %{getmaintainers()}; - $tag = "maintainer $maint"; - my @pkgs = (); - foreach my $p (keys %maintainers) { - my $me = $maintainers{$p}; - $me =~ s/\s*\(.*\)\s*//; - $me = $1 if ($me =~ m/<(.*)>/); - push @pkgs, $p if ($me eq $maint); + add_user("$src\@packages.debian.org"); + $title = "source $src"; + set_option('arch', 'source'); + if (defined $version) { + $title .= " (version $version)"; + } elsif (defined $dist) { + $title .= " in $dist"; + my $verdesc = getversiondesc($src); + $title .= " ($verdesc)" if defined $verdesc; } + @bugs = get_bugs(src=>[split /,/, $src]); +} elsif (defined $maint) { + add_user($maint); + $title = "maintainer $maint"; + $title .= " in $dist" if defined $dist; if ($maint eq "") { - @bugs = @{getbugs(sub {my %d=@_; my $me; - ($me = $maintainers{$d{"pkg"}}||"") =~ s/\s*\(.*\)\s*//; - $me = $1 if ($me =~ m/<(.*)>/); - return $me eq $maint; - })}; + my %maintainers = %{getmaintainers()}; + @bugs = @{getbugs(sub {my %d=@_; + foreach my $try (splitpackages($d{"pkg"})) { + return 1 if !getparsedaddrs($maintainers{$try}); + } + return 0; + })}; } else { - @bugs = @{getbugs(sub {my %d=@_; my $me; - ($me = $maintainers{$d{"pkg"}}||"") =~ s/\s*\(.*\)\s*//; - $me = $1 if ($me =~ m/<(.*)>/); - return $me eq $maint; - }, 'package', @pkgs)}; + @bugs = get_bugs(maint=>[map {lc ($_)} split /,/,$maint]); } } elsif (defined $maintenc) { my %maintainers = %{getmaintainers()}; - $tag = "encoded maintainer $maintenc"; + $title = "encoded maintainer $maintenc"; + $title .= " in $dist" if defined $dist; @bugs = @{getbugs(sub {my %d=@_; - return maintencoded($maintainers{$d{"pkg"}} || "") - eq $maintenc - })}; + foreach my $try (splitpackages($d{"pkg"})) { + my @me = getparsedaddrs($maintainers{$try}); + return 1 if grep { + maintencoded($_->address) eq $maintenc + } @me; + } + return 0; + })}; } elsif (defined $submitter) { - $tag = "submitter $submitter"; - @bugs = @{getbugs(sub {my %d=@_; my $se; - ($se = $d{"submitter"} || "") =~ s/\s*\(.*\)\s*//; - $se = $1 if ($se =~ m/<(.*)>/); - return $se eq $submitter; - }, 'submitter-email', $submitter)}; + add_user($submitter); + $title = "submitter $submitter"; + $title .= " in $dist" if defined $dist; + my @submitters = map {lc ($_)} split /,/, $submitter; + @bugs = get_bugs(submitter => \@submitters); } elsif (defined($severity) && defined($status)) { - $tag = "$status $severity bugs"; + $title = "$status $severity bugs"; + $title .= " in $dist" if defined $dist; + my @severities = split /,/, $severity; + my @statuses = split /,/, $status; @bugs = @{getbugs(sub {my %d=@_; - return ($d{"severity"} eq $severity) - && ($d{"status"} eq $status); - })}; + return (grep($d{"severity"} eq $_, @severities)) + && (grep($d{"status"} eq $_, @statuses)); + })}; } elsif (defined($severity)) { - $tag = "$severity bugs"; + $title = "$severity bugs"; + $title .= " in $dist" if defined $dist; + my @severities = split /,/, $severity; @bugs = @{getbugs(sub {my %d=@_; - return ($d{"severity"} eq $severity); - }, 'severity', $severity)}; + return (grep($d{"severity"} eq $_, @severities)); + }, 'severity', @severities)}; +} elsif (defined($tag)) { + $title = "bugs tagged $tag"; + $title .= " in $dist" if defined $dist; + my @tags = split /,/, $tag; + my %bugs = (); + for my $t (@tags) { + for my $b (@{$ut{$t}}) { + $bugs{$b} = 1; + } + } + @bugs = @{getbugs(sub {my %d = @_; + return 1 if $bugs{$d{"bug"}}; + my %tags = map { $_ => 1 } split ' ', $d{"tags"}; + return grep(exists $tags{$_}, @tags); + })}; } +elsif (defined $owner) { + $title = "bugs owned by $owner"; + $title .= " in $dist" if defined $dist; + my @owners = map {lc ($_)} split /,/, $owner; + my %bugs = (); + @bugs = get_bugs(owner=>\@owners); + +} +$title = htmlsanit($title); + +my @names; my @prior; my @title; my @order; +determine_ordering(); -my $result = htmlizebugs(\@bugs); +# strip out duplicate bugs +my %bugs; +@bugs{@bugs} = @bugs; +@bugs = keys %bugs; -print "Content-Type: text/html\n\n"; +my $result = pkg_htmlizebugs(\@bugs); + +print "Content-Type: text/html; charset=utf-8\n\n"; print "\n"; print "
\n" . - "Maintainer for " . ( defined($pkg) ? $pkg : "source package $src" ) . " is " - . htmlsanit($maint) . ".
\n"; + print ''; + print htmlmaintlinks(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"; } if (defined $maint or @bugs) { - my %pkgsrc = %{getpkgsrc()}; - my $srcforpkg; - if (defined $pkg) { - $srcforpkg = $pkgsrc{$pkg}; - defined $srcforpkg or $srcforpkg = $pkg; - } - my @pkgs = getsrcpkgs($pkg ? $srcforpkg : $src); - undef $srcforpkg unless @pkgs; - @pkgs = grep( !/^\Q$pkg\E$/, @pkgs ) if ( $pkg ); - if ( @pkgs ) { - @pkgs = sort @pkgs; - if ($pkg) { - print "You may want to refer to the following packages that are part of the same source:You might like to refer ", join(", ", @references), ".
\n"; - } + my %pkgsrc = %{getpkgsrc()}; + my $srcforpkg; + if (defined $pkg) { + $srcforpkg = $pkgsrc{$pkg}; + defined $srcforpkg or $srcforpkg = $pkg; + } + my @pkgs = getsrcpkgs($pkg ? $srcforpkg : $src); + undef $srcforpkg unless @pkgs; + @pkgs = grep( !/^\Q$pkg\E$/, @pkgs ) if ( $pkg ); + if ( @pkgs ) { + @pkgs = sort @pkgs; + if ($pkg) { + 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( "$_", @pkgs ) ); + print ".\n"; + } + my @references; + my $pseudodesc = getpseudodesc(); + if ($pkg and defined($pseudodesc) and exists($pseudodesc->{$pkg})) { + push @references, "to the list of other pseudo-packages"; + } else { + if ($pkg and defined $gPackagePages) { + push @references, sprintf "to the %s package page", urlsanit("http://${debbugs::gPackagePages}/$pkg"), htmlsanit("$pkg"); + } + if (defined $gSubscriptionDomain) { + my $ptslink = $pkg ? $srcforpkg : $src; + push @references, "to the Package Tracking System"; + } + # Only output this if the source listing is non-trivial. + if ($pkg and $srcforpkg and (@pkgs or $pkg ne $srcforpkg)) { + push @references, sprintf "to the source package %s's bug page", srcurl($srcforpkg), htmlsanit($srcforpkg); + } + } + if (@references) { + $references[$#references] = "or $references[$#references]" if @references > 1; + print "
You might like to refer ", join(", ", @references), ".
\n"; + } + if (defined $maint || defined $maintenc) { + print "If you find a bug not listed here, please\n"; + printf "report it.
\n", + urlsanit("http://${debbugs::gWebDomain}/Reporting${debbugs::gHTMLSuffix}"); } - print "If you find a bug not listed here, please\n"; - printf "report it.
\n", - urlsanit("http://${debbugs::gWebDomain}/Reporting${debbugs::gHTMLSuffix}"); } else { - print "There is no record of the " . - (defined($pkg) ? htmlsanit($pkg) . " package" - : htmlsanit($src) . " source package") . - ", and no bugs have been filed against it.
"; - $showresult = 0; + print "There is no record of the " . + (defined($pkg) ? htmlsanit($pkg) . " package" + : htmlsanit($src) . " source package") . + ", and no bugs have been filed against it.
"; + $showresult = 0; } } elsif (defined $maint || defined $maintenc) { print "Note that maintainers may use different Maintainer fields for\n"; @@ -250,9 +450,630 @@ if (defined $pkg || defined $src) { print "different addresses.\n"; } +set_option("archive", !$archive); +printf "
See the %s reports
", + urlsanit(pkg_url(( + map { + $_ eq 'archive'?():($_,$param{$_}) + } keys %param + ), + ('archive',($archive?"no":"yes")) + ) + ), ($archive ? "active" : "archived"); +set_option("archive", $archive); + print $result if $showresult; +print pkg_javascript() . "\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{/}{ }; htmlsanit($_)} @found;
+ }
+ if (@{$status{fixed_versions}}) {
+ $showversions .= '; ' if length $showversions;
+ $showversions .= 'fixed: ';
+ my @fixed = @{$status{fixed_versions}};
+ $showversions .= join ', ', map {s{/}{ }; htmlsanit($_)} @fixed;
+ }
+ $result .= ' ($showversions)} if length $showversions;
+ $result .= ";\n";
+
+ $result .= $showseverity;
+ $result .= pkg_htmladdresslinks("Reported by: ", \&submitterurl,
+ $status{originator});
+ $result .= ";\nOwned by: " . htmlsanit($status{owner})
+ if length $status{owner};
+ $result .= ";\nTags: "
+ . htmlsanit(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: " . htmlsanit($status{done});
+ my $days = bug_archiveable(bug => $status{id},
+ status => \%status,
+ days_until => 1,
+ );
+ if ($days >= 0) {
+ $result .= ";\nWill be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . "";
+ }
+ }
+
+ unless (length($status{done})) {
+ if (length($status{forwarded})) {
+ $result .= ";\nForwarded to "
+ . join(', ',
+ map {maybelink($_)}
+ split /[,\s]+/,$status{forwarded}
+ );
+ }
+ my $daysold = int((time - $status{date}) / 86400); # seconds to days
+ if ($daysold >= 7) {
+ my $font = "";
+ my $efont = "";
+ $font = "em" if ($daysold > 30);
+ $font = "strong" if ($daysold > 60);
+ $efont = "$font>" if ($font);
+ $font = "<$font>" if ($font);
+
+ my $yearsold = int($daysold / 365);
+ $daysold -= $yearsold * 365;
+
+ $result .= ";\n $font";
+ my @age;
+ push @age, "1 year" if ($yearsold == 1);
+ push @age, "$yearsold years" if ($yearsold > 1);
+ push @age, "1 day" if ($daysold == 1);
+ push @age, "$daysold days" if ($daysold > 1);
+ $result .= join(" and ", @age);
+ $result .= " old$efont";
+ }
+ }
+
+ $result .= ".";
+
+ return $result;
+}
+
+
+sub pkg_htmlizebugs {
+ $b = $_[0];
+ my @bugs = @$b;
+
+ my @status = ();
+ my %count;
+ my $header = '';
+ my $footer = "