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