status.pl

   1 #!/usr/bin/perl -wT
   2
   3 # Produce a status page for all current and pending Fedora MinGW packages.
   4 # By Richard W.M. Jones <rjones@redhat.com>
   5 #
   6 # Requires:
   7 # . All Fedora MinGW packages have to be checked out
   8 #   under $HOME/d/fedora.
   9 # . All pending packages to be available in
  10 #   $HOME/d/fedora-mingw--devel.
  11 #
  12 # The output is normally placed here:
  13 # http://annexia.org/fedora_mingw
  14 #
  15 # Checks that the package build-requires mingw32-* in order to know if
  16 # it's an MinGW-related package.
  17 #
  18 # Only recognizes the Fedora/EPEL branches listed below and ignores
  19 # anything else.  There are no MinGW packages in RHEL at this time.
  20 #
  21 # XXX This script is a bit crap.  Instead of using lame specfile
  22 # parsing, this should be generated from the SRPMs.
  23
  24 use strict;
  25
  26 use POSIX qw(strftime);
  27 use CGI qw/:standard/;
  28
  29 my $home = $ENV{HOME};
  30 if ($home =~ m/(.*)/) { $home = $1; }
  31
  32 my $fedora = $home . "/d/fedora";
  33 my $pending = $home . "/d/fedora-mingw--devel";
  34
  35 chdir $pending or die "$pending: $!\n";
  36
  37 my %branches = (
  38     "EL-5" => {
  39         name => "EPEL 5",
  40         url => "http://fedoraproject.org/wiki/EPEL",
  41         title => "Packages for Red Hat Enterprise Linux 5",
  42         sortorder => 2,
  43         class => "epelbg",
  44     },
  45     "F-10" => {
  46         name => "Fedora 10",
  47         url => "http://fedoraproject.org/",
  48         sortorder => 10,
  49         class => "fedorabg",
  50     },
  51     "devel" => {
  52         name => "Devel",
  53         url => "http://fedoraproject.org/wiki/Releases/Rawhide",
  54         title => "Fedora 11 in development a.k.a. Rawhide",
  55         sortorder => 99,
  56         class => "develbg",
  57     },
  58     "pending" => {
  59         name => "Pending",
  60         url => "https://bugzilla.redhat.com/buglist.cgi?version=rawhide&component=Package+Review&target_milestone=&bug_status=NEW&bug_status=ASSIGNED&bug_status=NEEDINFO&bug_status=MODIFIED&short_desc_type=allwordssubstr&short_desc=mingw32&long_desc_type=allwordssubstr&long_desc=",
  61         sortorder => 100,
  62         class => "pendingbg",
  63     },
  64 );
  65
  66 # List of packages to ignore in pending.
  67 my %ignore_pending = ();
  68 open IGNORE, "IGNORE" or die "IGNORE: $!\n";
  69 while (<IGNORE>) {
  70     next if /^\#/ || /^$/;
  71     if (/^cross-(.*)/) {
  72         $ignore_pending{"mingw32-$1"} = 1;
  73     } else {
  74         m/(.*)/; # untaint
  75         $ignore_pending{"mingw32-$1"} = 1;
  76     }
  77 }
  78 close IGNORE;
  79
  80 # List of packages to ignore in Fedora checkout,
  81 # because they confuse this script.
  82 my %ignore_fedora = (
  83     "cyrus-sasl" => 1,
  84     "kernel" => 1,
  85     "msmtp" => 1,
  86     "openldap" => 1,
  87     "pixman" => 1,
  88     "python" => 1,
  89     "qt" => 1,
  90     "xenwatch" => 1,
  91 );
  92
  93 # List of packages.
  94 my %packages;
  95
  96 # Count of packages by branch.
  97 my %count;
  98
  99 # Collect the package names & status from the specfiles.
 100 sub collect {
 101     my $specfile;
 102
 103     # Fedora and EPEL packages.
 104     foreach $specfile (<$fedora/*/*/*.spec>) {
 105         if ($specfile =~ m{/([^/]+)/([^/]+)\.spec$}) {
 106             my $specfile_name = $2;
 107             my $branch = $1;
 108             if (exists $branches{$branch} &&
 109                 !exists $ignore_fedora{$specfile_name}) {
 110                 collect_specfile ($specfile, $branch);
 111             }
 112         }
 113     }
 114
 115     # Pending packages in review.
 116     foreach $specfile (<$pending/*/*.spec>) {
 117         collect_specfile ($specfile, "pending");
 118     }
 119 }
 120
 121 sub collect_specfile {
 122     my $specfile = shift;
 123     my $branch = shift;
 124
 125     # Read the specfile and parse the bits we understand.
 126     my ($name, $version, $summary, $description, $url, $is_mingw,
 127         @rpmdefines);
 128     @rpmdefines = (["nil", ""]);
 129
 130     open SPEC, "$specfile" or die "$specfile: $!";
 131     while (<SPEC>) {
 132         if (/^Name:\s*(\S+)/) {
 133             $name = $1;
 134             $name = rpmsubst ($name, 1, @rpmdefines) if $name =~ /%{/;
 135             $is_mingw = 1 if $name =~ /mingw32/;
 136         } elsif (/^Version:\s*(\S+)/) {
 137             $version = $1;
 138             $version = rpmsubst ($version, 1, @rpmdefines) if $version =~ /%{/;
 139         } elsif (!$url && /^URL:\s*(\S+)/) {
 140             $url = $1;
 141             $url = rpmsubst ($url, 1, @rpmdefines) if $url =~ /%{/;
 142         } elsif (!$summary && /^Summary:\s*(.*)/) {
 143             $summary = $1;
 144             #$is_mingw = 1 if $summary =~ /mingw32/i;
 145         } elsif (/^(Build)?Requires:.*mingw32/) {
 146             $is_mingw = 1
 147         } elsif (!$description && /^%description/) {
 148             $description = "";
 149             while (<SPEC>) {
 150                 last if /^%/;
 151                 $description .= $_;
 152             }
 153             $description = rpmsubst ($description, 1, @rpmdefines)
 154                 if $description =~ /%{/;
 155             #$is_mingw = 1 if $description =~ /mingw/i;
 156         }
 157
 158         # Handle simple RPM defines.
 159         elsif (/^%define\s+([A-Za-z_]+)\s+(.*)/) {
 160             my $name = $1;
 161             my $val = $2;
 162             if (only_simple_substs ($val)) {
 163                 $val = rpmsubst ($val, 0, @rpmdefines);
 164                 push @rpmdefines, [ $name, $val ];
 165             }
 166         }
 167     }
 168
 169     # Check it's a MinGW package.  If name/summary/description contains
 170     # 'mingw' or it Requires/BuildRequires some mingw32-* package then we
 171     # assume it's related.
 172     if (!$is_mingw) {
 173         warn "warning: $name ($branch) ignored, not a MinGW package\n";
 174         return;
 175     }
 176
 177     # Ignore certain packages appearing in pending branch.
 178     if ($branch eq "pending") {
 179         if (exists $ignore_pending{$name}) {
 180             return;
 181         }
 182
 183         # Also ignore packages marked NOT-FOR-FEDORA in pending.
 184         my $dirname = $specfile;
 185         $dirname =~ s{/[^/]+$}{};
 186         if (-f "$dirname/NOT-FOR-FEDORA") {
 187             return;
 188         }
 189     }
 190
 191     #print "$name $version $url\n";
 192
 193     # If the package is in "pending" then there shouldn't be a
 194     # Fedora package also.
 195     if ($branch eq "pending" && exists $packages{$name}) {
 196         die "error: pending $name is also in Fedora repo\n"
 197     }
 198
 199     # Add the package.
 200     $packages{$name} = {} unless exists $packages{$name};
 201     if (exists $packages{$name}{$branch}) {
 202         die "$name ($branch) package already seen\n";
 203     }
 204     $packages{$name}{$branch} = {
 205         name => $name,
 206         branch => $branch,
 207         version => $version,
 208         url => $url,
 209         summary => $summary,
 210         description => $description,
 211     }
 212 }
 213
 214 sub only_simple_substs {
 215     local $_ = shift;
 216
 217     s/%{[A-Za-z_]+}//g;
 218     s/%\([A-Za-z_]+\)//g;
 219     ! (m/%{/ || m/%\(/)
 220 }
 221
 222 # Simple RPM '%define' substitutions.
 223 sub rpmsubst {
 224     local $_ = shift;
 225     my $fail = shift;
 226
 227     my $pair;
 228     foreach $pair (@_) {
 229         my $var = $pair->[0];
 230         my $val = $pair->[1];
 231
 232         s/%{$var}/$val/ge;
 233         s/%\($var\)/$val/ge;
 234     }
 235
 236     if ($fail && (m/%{/ || m/%\(/)) {
 237         die "rpmsubst: string contains undefined substitutions: $_\n";
 238     }
 239
 240     $_;
 241 }
 242
 243 sub branchsortorder {
 244     $branches{$a}{sortorder} <=> $branches{$b}{sortorder}
 245 }
 246
 247 sub nbsp {
 248     local $_ = shift;
 249     s/\s+/&nbsp;/g;
 250     $_
 251 }
 252
 253 sub output_header {
 254     print "Status of packages in Fedora, EPEL and RHEL, last updated on ";
 255     print strftime("%Y-%m-%d",gmtime);
 256     print ".\n\n";
 257     print "<html>\n";
 258     print "<table class=\"top_table fedoratbl\">\n";
 259     print "<tr><th>Name</th>\n";
 260     foreach (sort branchsortorder (keys %branches)) {
 261         my $name = $branches{$_}{name};
 262         my $url = $branches{$_}{url};
 263         my $class = $branches{$_}{class};
 264
 265         print "<th class=\"$class\">";
 266         if (exists $branches{$_}{title}) {
 267             my $title = escapeHTML ($branches{$_}{title});
 268             print "<a title=\"$title\" href=\"$url\">",
 269               nbsp(escapeHTML($name)),
 270               "</a>";
 271         } else {
 272             print "<a href=\"$url\">",
 273               nbsp(escapeHTML($name)),
 274               "</a>";
 275         }
 276         print "</th>\n";
 277     }
 278     print "</tr>\n";
 279
 280     # Count the packages in each branch.
 281     %count = ();
 282     foreach (keys %branches) {
 283         $count{$_} = 0
 284     }
 285 }
 286
 287 sub output_package {
 288     my $name = shift;
 289
 290     # Get the URL, summary and description from devel
 291     # or pending (if possible).
 292     my ($url, $summary, $description);
 293     if (exists $packages{$name}{devel}) {
 294         $url = $packages{$name}{devel}{url};
 295         $summary = $packages{$name}{devel}{summary};
 296         $description = $packages{$name}{devel}{description};
 297     } elsif (exists $packages{$name}{pending}) {
 298         $url = $packages{$name}{pending}{url};
 299         $summary = $packages{$name}{pending}{summary};
 300         $description = $packages{$name}{pending}{description};
 301     }
 302
 303     print "<tr><td>";
 304     if (defined $url) {
 305         if (defined $summary && defined $description) {
 306             print "<a title=\"",
 307               escapeHTML($description),
 308               "\" href=\"$url\">",
 309               escapeHTML($name),
 310               "</a><br/><small>",
 311               escapeHTML($summary),
 312               "</small>";
 313         } else {
 314             print "<a href=\"$url\">", escapeHTML($name), "</a>";
 315         }
 316     } else {
 317         print (escapeHTML($name));
 318     }
 319     print "</td>\n";
 320
 321     my $branch;
 322     foreach $branch (sort branchsortorder (keys %branches)) {
 323         my $brclass = $branches{$branch}{class};
 324
 325         if (exists $packages{$name}{$branch}) {
 326             $count{$branch}++;
 327
 328             my %r = %{$packages{$name}{$branch}};
 329
 330             my $class = "released";
 331             $class = "pending" if $branch eq "pending";
 332             $class = "devel" if $branch eq "devel";
 333             $class = "filesystem" if $name eq "mingw32-filesystem";
 334
 335             print "<td class=\"$brclass $class\">$r{version}</td>\n";
 336         } else {
 337             # No package in this branch.
 338             print "<td class=\"$brclass\">&nbsp;</td>\n"
 339         }
 340     }
 341
 342     print "</tr>\n";
 343 }
 344
 345 sub output_trailer {
 346     # Summary of packages in each branch.
 347     print "<tr><td>Totals</td>";
 348     my $branch;
 349     foreach $branch (sort branchsortorder (keys %branches)) {
 350         print "<td>$count{$branch}</td>";
 351     }
 352     print "</tr>\n";
 353
 354     print "</table>\n";
 355     print "</html>\n";
 356 }
 357
 358 # Define a standard package name order.
 359 sub pkgnameorder {
 360     # "mingw32-*" packages always sort first.
 361     return -1 if $a =~ /^mingw32/ && $b !~ /^mingw32/;
 362     return 1 if $a !~ /^mingw32/ && $b =~ /^mingw32/;
 363
 364     return (lc($a) cmp lc($b))
 365 }
 366
 367 sub main {
 368     # Collect all the specfiles, into %packages hash.
 369     collect ();
 370
 371     # Get the package names.
 372     my @names = sort pkgnameorder (keys %packages);
 373
 374     # Generate the output.
 375     output_header ();
 376     foreach (@names) {
 377         output_package ($_);
 378     }
 379     output_trailer ();
 380 }
 381
 382 main ()