pkg-get/scripts/pkg-repgen.pl

#!/usr/bin/env perl
#
# pkg-repgen: generates a binary repository for pkg-get
#
# requires prt-get
#
# html index generation code adapted from Jukka Heino's portspage
#
# usage: pkg-repgen [<pkgname1>..<pkgnameN>]
#

use warnings;
use strict;
use Getopt::Long;
use Digest::file qw(digest_file_hex);

our $prtget = "/usr/bin/prt-get"; our $prtdir;
our $title = "CRUX Packages"; our $header; our $footer;
GetOptions("prtdir=s"=>\$prtdir, "title=s"=>\$title, "header=s"=>\$header, "footer=s"=>\$footer);

# Use compression-mode defined in pkgmk-conf
our $compress = "gz";
open CONFIG, "/etc/pkgmk.conf" or die "Could not open /etc/pkgmk.conf";
while (<CONFIG>) {
    $compress = $1 if m/^PKGMK_COMPRESSION_MODE=(.*)(#|$)/;
}
close CONFIG;
$compress =~ s/["' ]//g;

$prtget .= " --no-std-config --config-set=\"prtdir $prtdir\"" if ($prtdir);

my @dirlist = glob("*#*.pkg.tar.$compress"); my @packages;
if ($#ARGV >= 0) { # single packages
    foreach my $pkgname (@ARGV) {
        my @hits = grep /^$pkgname#/ @dirlist;
	push(@packages,@hits) if (@hits);
    }
} else {
    @packages = @dirlist;
}

# Populate some hashes with a single run of prt-get
our %path; our %depends; our %descrip; our %flags;
our %oldDeps; our %oldFlags; our %du; our %md5sums;
fill_hashes_from_prtget();

if ($#ARGV >= 0) {
    pkg_single("REPO"); pkg_single("DEPS");
} else {
    pkg_dir("REPO"); pkg_dir("DEPS");
}

# Generate README and PKGINST
pkgread();
pkginst();

sub fill_hashes_from_prtget {
    my @validkeys = @packages;
    map { s/#.*// } @validkeys;
    open (my $ppf, "$prtget printf '%n^%p^%e^%d^%E^%O^%R\n' |");
    while (<$ppf>) {
        my ($name,$repo,$deps,$desc,$haspre,$haspost,$hasreadme) = split /\^/;
        next if (! grep { ($_ eq $name) } @validkeys);
        $path{$name} = $repo . "/" . $name;
        $depends{$name} = $deps;
        $desc =~ s/\:/ /g;
        $descrip{$name} = $desc;
        chomp($hasreadme);
        $flags{$name} = join(":", $haspre, $haspost, $hasreadme);
    }
    close ($ppf);
}

sub fill_hashes_from_prevrun {
    my $oldRepo = shift;
    open (my $fh, $oldRepo) or return;
    while (<$fh>) {
        chomp;
        if ($oldRepo eq "PKGDEPS") {
            my ($iPkg, $iDep) = split /:/;
            $iPkg =~ s/\s+//g;
            $iDep =~ s/,/ /g;
            $oldDeps{$iPkg} = $iDep;
        } elsif ($oldRepo eq "PKGREPO") {
            my ($iPkg, $iSize, $iMD5, $iDesc, $iPre, $iPost, $iReadme) = split /:/;
            $iPkg =~ s/\s+//g;
            $oldFlags{$iPkg} = join (":", $iPre, $iPost, $iReadme);
        }
    }
    close ($fh);
}

# generate dependency map or repository for individual packages
sub pkg_single {
    my $db = shift; my $name;
    my $status = "+ Generating ";
    $status .= ($db eq "REPO") ? "repository\n" : "dependencies\n";
    print $status;
    
    fill_hashes_from_prevrun("PKG$db");
    my $hasnew = 0;
    foreach my $p (@ARGV) {
        my @matches = grep /^$p#/, @packages;
        if ($#matches != 0) {
            print "Package '$p' not found or duplicate\n"; next;
        }
        my $match = $matches[0];
        $name = $match;
        $name =~ s/#.*//;
        if ( ($db eq "DEPS") and 
         ((! $oldDeps{$name}) or ($oldDeps{$name} ne $depends{$name})) ) {
             $hasnew = 1;
        } elsif ($db eq "REPO") {
            $du{$match} = (-s $match);
            $md5sums{$match} = digest_file_hex($match,"MD5");
            if (! $descrip{$name}) {$descrip{$name} = "N.A."};
            if (! $flags{$name}) {$flags{$name} = "no:no:no"};
            if (! $oldFlags{$name}) { $hasnew = 1; }
        }
    }
    return unless ($hasnew == 1);

    my $dict = ($db eq "DEPS") ? "depends" : "flags";
    open (my $fh, ">PKG$db.new");
    foreach my $mp (sort keys %$dict) {
        $name = $mp; $name =~ s/#.*//;
        if ($db eq "REPO") {
                printf $fh "%-s:%-s:%-s:%-s:%-s\n", $name, $du{$mp}, 
                $md5sums{$mp}, $descrip{$name}, $flags{$name};
        } elsif ($db eq "DEPS") {
                printf $fh "%-30s:%s\n", $name, $depends{$name};
        }
    }
    close ($fh);
    rename("PKG$db.new", "PKG$db");
}

######################## full repository ########################

# generate dependency map or the repository/index page
sub pkg_dir {
    my $db = shift; my %seen;
    my $status = "+ Generating ";
    $status .= ($db eq "DEPS") ? "dependencies\n" : "repository\n";
    print $status;

    open (my $fh, ">PKG$db");
    if ($db eq "DEPS") {
        foreach my $name (@packages) {
            $name =~ s/#.*//; next if ($seen{$name});
            if (($depends{$name}) and ($depends{$name} ne "")) {
                printf $fh "%-30s : %-s\n", $name, $depends{$name};
            }
            $seen{$name} = 1;
        }
    } elsif ($db eq "REPO") {
        our $parity = "odd";
        my $count = 0;
        printheader();
        open (my $ih, '>>index.html');
        foreach my $p (@packages) {
            chomp($p);
            my $date = (stat($p))[9];
            $count++;
            my ($name, $version, $url) = ($p, $p, $p);
            $name =~ s/#.*//;
            $version =~ s/^.*\#//;
            $version =~ s/\.pkg\.tar\.[gbx]z*//;
            $url =~ s/\#/\%23/;
            my $du = (-s $p);
            my $md5 = digest_file_hex($p,"MD5");
            $md5 =~ s/  .*$|\n//g;
            if (! $descrip{$name}) {$descrip{$name} = "N.A.";}
            if (! $flags{$name}) { $flags{$name} = "no:no:no"; }
            printf $fh "%-s:%-s:%-s:%-s:%-s\n", $p,$du,$md5,$descrip{$name},$flags{$name};
            print $ih "<tr class=\"$parity\">";
            print $ih "<td>$name</td>";
            print $ih "<td><a href=\"$url\">$version</a></td>";
            print $ih "<td>$descrip{$name}</td>";
            print $ih "<td>" . isotime($date, 1) . "</td>";
            print $ih "</tr>\n";

            if ($parity eq "odd") { $parity = "even"; }
            else { $parity = "odd"; }
        }
        close $ih;
        printfooter($count);
    }
    close $fh;
}

# generate README file
sub pkgread {
    print "+ Generating README\n";
    open (my $fh, '>PKGREAD');
    print $fh "# README files for repository. Do NOT remove this line.\n";
    foreach my $name (@packages) {
        $name =~ s/#.*//;
        if (-f "$path{$name}/README"){
            print $fh "##### PKGREADME: $name\n";
            open(my $readme, "$path{$name}/README");
            while (<$readme>){ print $fh $_; }
            close($readme);
        }
    }
    close $fh;
}

# generate pre-install scripts file
sub pkginst {
    print "+ Generating scripts\n";
    open (my $fh, '>PKGINST');
    print $fh '#!/usr/bin/env bash
#
# PKGINST: pre- and post-install scripts for CRUX packages
#
run_script() {
    case "$1" in
';
    foreach my $name (@packages) {
        $name =~ s/#.*//;
        foreach my $when ("pre", "post") {
        if (-f "$path{$name}/${when}-install"){
            print $fh "$name.$when)\n";
            open(my $rs, "$path{$name}/${when}-install");
            while (<$rs>){
            chomp;
            if (! m/^#!.*sh/) { print $fh "    $_\n"; }
        }
            close($rs);
            print $fh "    ;;\n";
        }
        }
    }
    print $fh "esac\n}\n\n";
    print $fh '[ "$1" ] && [[ "$2" == @(pre|post) ]] && run_script "$1.$2"';
    print $fh "\n";
    close $fh;
}


######################## html index subs ########################

sub printheader {
    open (my $ih, '>index.html');
    print $ih <<EOH;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
    "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
 <head>
EOH

    print $ih "  <title>$title</title>\n";

    print $ih <<EOH;
  <style type="text/css">
   body
   {
    font-family: Verdana, sans-serif;
    font-size: 85%;
    padding: 2em;
   }
   a
   {
    color: #67550d;
   }
   table
   {
    border: solid #e5dccf 1px;
    font-size: 85%;
   }
   td
   {
    padding: 6px;
   }
   tr.header
   {
    background-color: #e5dccf;
   }
   tr.odd
   {
    background-color: #f7f3ed;
   }
   tr.even
   {
    background-color: #fcf9f8;
   }
  </style>
  <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />
 </head>
 <body>
EOH

    print $ih "  <h2>$title</h2>\n";
    if ($header) {
        open(FILE, $header) or die "Couldn't open header file";
        while (<FILE>) {
            print $ih "  " . $_;
        }
        close(FILE);
    }

    print $ih "  <table width=\"100%\" cellspacing=\"0\">\n";
    print $ih "   <tr class=\"header\"><td><b>Port</b></td><td><b>Version</b></td><td><b>Description</b></td>";
    print $ih "<td><b>Last modified</b></td>";
    print $ih "</tr>\n";
    close($ih);
}

sub printfooter {
    my $count = $_[0];
    open (my $ih, '>>index.html');
    print $ih "  </table>\n";
    print $ih "  <p><b>$count packages</b></p>\n";
    if ($footer) {
        open(FILE, $footer) or die "Couldn't open footer file";
        while (<FILE>) {
            print $ih "  " . $_;
        }
        close(FILE);
    }
    print $ih "  <p><i>Generated by <a href=\"http://www.varlock.com\">pkg-repgen</a> on " . isotime() . ".</i></p>\n";
    print $ih <<EOH;
 </body>
</html>
EOH
    close($ih);
}

sub isotime {
    my $time = (shift or time);
    my $accuracy = (shift or 2);
    my @t = gmtime ($time);
    my $year = $t[5] + 1900;
    my $month = sprintf("%02d", $t[4] + 1);
    my $day = sprintf("%02d", $t[3]);

    return "$year-$month-$day" if ($accuracy == 1);
    return "$year-$month-$day " . sprintf("%02d:%02d:%02d UTC", $t[2], $t[1], $t[0]);
}