ocaml-status.pl

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