cgi/common.pl

   1 #!/usr/bin/perl -w
   2
   3 sub quit {
   4         my $msg = shift;
   5         print header . start_html("Error");
   6         print "An error occurred. Dammit.\n";
   7         print "Error was: $msg.\n";
   8         print end_html;
   9         exit 0;
  10 }
  11
  12 sub htmlindexentry {
  13     my $ref = shift;
  14
  15     my %status = getbugstatus($ref);
  16     my $result = "";
  17
  18     if  ($status{severity} eq 'normal') {
  19         $showseverity = '';
  20     } elsif (grep($status{severity} eq $_, @debbugs::gStrongSeverities)) {
  21         $showseverity = "<strong>Severity: $status{severity}</strong>;\n";
  22     } else {
  23         $showseverity = "Severity: <em>$status{severity}</em>;\n";
  24     }
  25
  26     $result .= "Package: <a href=\"" . pkgurl($status{package}) . "\"><strong>"
  27                . htmlsanit($status{package}) . "</strong></a>;\n"
  28                        if (length($status{package}));
  29     $result .= $showseverity;
  30     $result .= "Reported by: " . htmlsanit($status{originator});
  31     $result .= ";\nKeywords: " . htmlsanit($status{keywords})
  32                        if (length($status{keywords}));
  33
  34     my @merged= split(/ /,$status{mergedwith});
  35     if (@merged) {
  36         my $mseparator= ";\nmerged with ";
  37         for my $m (@merged) {
  38             $result .= $mseparator."<A href=\"" . bugurl($m) . "\">#$m</A>";
  39             $mseparator= ", ";
  40         }
  41     }
  42
  43     if (length($status{done})) {
  44         $result .= ";\n<strong>Done:</strong> " . htmlsanit($status{done});
  45     } elsif (length($status{forwarded})) {
  46         $result .= ";\n<strong>Forwarded</strong> to "
  47                    . htmlsanit($status{forwarded});
  48     } else {
  49         my $daysold = int((time - $status{date}) / 86400);   # seconds to days
  50         if ($daysold >= 7) {
  51             my $font = "";
  52             my $efont = "";
  53             $font = "em" if ($daysold > 30);
  54             $font = "strong" if ($daysold > 60);
  55             $efont = "</$font>" if ($font);
  56             $font = "<$font>" if ($font);
  57
  58             my $yearsold = int($daysold / 364);
  59             $daysold = $daysold - $yearsold * 364;
  60
  61             $result .= ";\n $font";
  62             $result .= "1 year and " if ($yearsold == 1);
  63             $result .= "$yearsold years and " if ($yearsold > 1);
  64             $result .= "1 day old" if ($daysold == 1);
  65             $result .= "$daysold days old" if ($daysold != 1);
  66             $result .= "$efont";
  67         }
  68     }
  69
  70     $result .= ".";
  71
  72     return $result;
  73 }
  74
  75 sub pkgurl {
  76     my $ref = shift;
  77     my $params = "pkg=$ref";
  78     foreach my $val (@_) { 1 }
  79
  80     return $debbugs::gCGIDomain . "pkgreport.cgi" . "?" . "$params";
  81 }
  82
  83 %saniarray= ('<','lt', '>','gt', '&','amp', '"','quot');
  84
  85 sub htmlsanit {
  86     my $in = shift;
  87     my $out;
  88     while ($in =~ m/[<>&"]/) {
  89         $out.= $`. '&'. $saniarray{$&}. ';';
  90         $in=$';
  91     }
  92     $out .= $in;
  93     return $out;
  94 }
  95
  96 sub bugurl {
  97     my $ref = shift;
  98     my $params = "bug=$ref";
  99     foreach my $val (@_) {
 100         $params .= "\&msg=$1" if ($val =~ /^msg=([0-9]+)$/);
 101     }
 102
 103     return $debbugs::gCGIDomain . "bugreport.cgi" . "?" . "$params";
 104 }
 105
 106 sub packageurl {
 107     my $ref = shift;
 108     return $debbugs::gCGIDomain . "package.cgi" . "?" . "package=$ref";
 109 }
 110
 111 sub allbugs {
 112     my @bugs = ();
 113
 114     opendir(D, $debbugs::gSpoolDir/db) || &quit("opendir db: $!");
 115     @bugs = sort { $a <=> $b }
 116                  grep s/\.status$//,
 117                  (grep m/^[0-9]+\.status$/,
 118                  (readdir(D)));
 119     closedir(D);
 120
 121     return @bugs;
 122 }
 123
 124 sub pkgbugs {
 125     my $pkg = shift;
 126     my @bugs = ();
 127     open I, "<$gAJIndex" || &quit("bugindex: $!");
 128     while(<I>) {
 129         push @bugs, $1 if (/^([0-9]+) $pkg$/);
 130     }
 131     @bugs = sort { $a <=> $b } @bugs;
 132     return @bugs;
 133 }
 134
 135 sub getmaintainers {
 136     my %maintainer;
 137
 138     open(MM,"$gMaintainerFile") || &quit("open $gMaintainerFile: $!");
 139     while(<MM>) {
 140         m/^(\S+)\s+(\S.*\S)\s*$/ || &quit("$gMaintainerFile: \`$_'");
 141         ($a,$b)=($1,$2);
 142         $a =~ y/A-Z/a-z/;
 143         $maintainer{$a}= $b;
 144     }
 145     close(MM);
 146
 147     return %maintainer;
 148 }
 149
 150 sub getbugstatus {
 151         my $bugnum = shift;
 152
 153         my %status;
 154
 155         open(S,"$gSpoolDir/db/$bugnum.status") || &quit("open $bugnum.status: $!");
 156         my @lines = qw(originator date subject msgid package keywords done
 157                         forwarded mergedwith severity);
 158         while(<S>) {
 159                 chomp;
 160                 $status{shift @lines} = $_;
 161         }
 162         close(S);
 163         $status{shift @lines} = '' while(@lines);
 164
 165         $status{package} =~ s/\s*$//;
 166         $status{package} = 'unknown' if ($status{package} eq '');
 167         $status{severity} = 'normal' if ($status{severity} eq '');
 168
 169         $status{pending} = 'pending';
 170         $status{pending} = 'forwarded' if (length($status{forwarded}));
 171         $status{pending} = 'done'      if (length($status{done}));
 172
 173         return %status;
 174 }
 175
 176 sub buglog {
 177         my $bugnum = shift;
 178         return "$gSpoolDir/db/$bugnum.log";
 179 }
 180
 181 1