pkg-get/scripts/pkg-repgen.pl

417 lines
13 KiB
Perl
Executable File

#!/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; my %isDup;
sub pkg_mtime {
my $aName = $a; my $bName = $b;
my $aTime; my $bTime;
$aName =~ s/#.*//;
$bName =~ s/#.*//;
if ($aName lt $bName) { return -1; }
elsif ($aName gt $bName) { return 1; }
else {
$aTime = (stat $a)[9];
$bTime = (stat $b)[9];
}
if ($aTime le $bTime) { return -1; }
else { return 1; }
}
if ($#ARGV >= 0) { # single packages
foreach my $name (sort @ARGV) {
my @hits = glob("$name#*.pkg.tar.$compress");
push(@packages,@hits);
}
} else {
@packages = sort pkg_mtime @dirlist;
%isDup = map { $_ => 0 } @packages;
}
# hashes to determine the package name ...
our %pname = map { $_ => $_ } @packages;
foreach my $p (@packages) { $pname{$p} =~ s/\#.*//; }
# ... or to look up the successor when merging old metadata files
my %followR; my %followH; my %followD; my @queue = @packages;
while (my $q = shift @queue) {
($#queue < 0) or ($pname{$q} ne $pname{$queue[0]}) or $isDup{$q} = 1;
}
# Populate some other hashes using a single run of prt-get
our %path; our %depends; our %descrip; our %flags;
my @validkeys = @dirlist;
map { s/\#.*// } @validkeys;
my %printme = map { $_ => 1 } @validkeys;
open (my $ppf, "$prtget printf '%n^%p^%e^%d^%E:%O:%R\n' |");
while (<$ppf>) {
chomp;
my ($name,$repo,$deps,$desc,$prepostread) = split /\^/;
next if (! $printme{$name});
$path{$name} = $repo . "/" . $name;
$depends{$name} = $deps;
$desc =~ s/\:/ /g;
$descrip{$name} = $desc;
$flags{$name} = $prepostread;
}
close ($ppf);
# Needed for alternating colors in the html index
my %parity = ( 0 => "even", 1 => "odd" );
# Generate the metadata files
($#ARGV >= 0) ? pkg_single() : pkg_dir();
# Generate README and PKGINST
pkgreadscripts();
###################### individual packages ##########################
sub pkg_single {
my ($oR, $oD, $oH, $nR, $nD, $nH, $oline, $oname);
my $count = 0; # needed for the html index
my %firstrun = map { $_ => 0 } ("PKGREPO", "PKGDEPS", "index.html");
open ($oR, "PKGREPO") or $firstrun{"PKGREPO"} = 1;
open ($oD, "PKGDEPS") or $firstrun{"PKGDEPS"} = 1;
open ($oH, "index.html") or $firstrun{"index.html"} = 1;
open ($nR, ">PKGREPO.new");
open ($nD, ">PKGDEPS.new");
printheader(1);
open ($nH, ">>index.html.new");
foreach my $mf ("repository", "dependency map", "html index") {
print "+ Updating specified entries in $mf\n";
}
PACKAGE: while (my $p =shift @packages) {
my ($pver, $url, $du, $md5, $desc, $ppr, $pdeps, $date) = metadata($p);
($firstrun{"PKGREPO"}==0) or printf $nR "%-s:%-s:%-s:%-s:%-s\n",
$p, $du, $md5, $desc, $ppr;
($firstrun{"PKGDEPS"}==0) or ($pdeps eq "") or ($isDup{$p})
or printf $nD "%-30s : %-s\n", $pname{$p}, $pdeps;
if ($firstrun{"index.html"} == 1) {
$count++;
htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date);
}
($firstrun{"PKGREPO"}*$firstrun{"PKGDEPS"}*$firstrun{"index.html"}==0) or next PACKAGE;
# Pop entries from the old repository until we reach an entry
# that would come after the current package.
while ( ($firstrun{"PKGREPO"}==0) and $oline = <$oR> ) {
chomp($oline); $oname = $oline;
$oname =~ s/\#.*//;
print $nR "$oline\n" if ($oname lt $pname{$p});
# before breaking out of the loop, either overwrite the old
# entry in the repository, or insert the requested package
# where it should appear.
printf $nR "%-s:%-s:%-s:%-s:%-s\n", $p, $du, $md5, $desc, $ppr
if ($oname ge $pname{$p});
# save what got popped from the repository, in case of dups
$followR{$pname{$p}} = $oline if ($oname gt $pname{$p});
# stop reading the repository, at least until the next package
last if ($oname ge $pname{$p});
}
# if the current package comes after everything in the old repository,
# just append its metadata
($followR{$pname{$p}}) or printf $nR "%-s:%-s:%-s:%-s:%-s\n", $p, $du, $md5, $desc, $ppr;
# Likewise for the html index
while ( ($firstrun{"index.html"}==0) and $oline=<$oH> ) {
chomp($oline);
# no need to copy the header, it should already be there
next if ($oline !~ m/^<tr class="(odd|even)"/);
$count++;
$oname = $oline;
$oname =~ s/.*a href="(.*)"/$1/;
$oname =~ s/\%23.*//;
print $nH "$oline\n" if ($oname lt $pname{$p});
htmlrow($nH,$count,$pname{$p},$url,
$pver,$desc,$date) if ($oname ge $pname{$p});
$followH{$pname{$p}} = $oline if ($oname gt $pname{$p});
last if ($oname ge $pname{$p});
}
if (! $followH{$pname{$p}}) {
$count++;
htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date);
}
# Likewise for the dependency map, but avoid creating duplicate entries
while ( ($firstrun{"PKGDEPS"}==0) and $oline = <$oD> ) {
chomp($oline); $oname = $oline;
$oname =~ s/\s*\:.*//;
if ($oname lt $pname{$p}) {
print $nD "$oline\n";
} elsif ( ($pdeps ne "") and (! $isDup{$p}) ) {
printf $nD "%-30s : %-s\n", $pname{$p}, $pdeps;
}
if ($oname gt $pname{$p}) {
$followD{$pname{$p}} = $oline;
print $nD "$oline\n";
}
last if ($oname ge $pname{$p});
}
# if the current package comes after everything in the old depmap,
# just append its metadata
($followD{$pname{$p}}) or ($isDup{$p}) or ($pdeps eq "")
or printf $nD "%-30s : %-s\n", $pname{$p}, $pdeps;
# after reaching the last in a sequence of dups, copy the
# successor line from the old {html index, repository}
if ( (! $isDup{$p}) and ($followH{$pname{$p}}) ) {
$count++;
$followH{$pname{$p}} =~ s/class="(even|odd)"/class="$parity{($count %2)}"/;
print $nH $followH{$pname{$p}};
}
($isDup{$p}) or (! $followR{$pname{$p}}) or print $nR $followR{$pname{$p}};
# Restart the loop with the next package in the queue
}
# Done with all the packages that match command-line arguments.
# Now append the tails of the old metadata files to their new counterparts.
while ($firstrun{"index.html"}==0 and $oline = <$oH>) {
$count++;
$oline =~ s/class="(even|odd)"/class="$parity{($count % 2)}"/;
print $nH $oline;
}
while ($firstrun{"PKGDEPS"}==0 and $oline = <$oD>) { print $nD $oline; }
while ($firstrun{"PKGREPO"}==0 and $oline = <$oR>) { print $nR $oline; }
close($nH);
close($nD);
close($nR);
($firstrun{"PKGREPO"}==1) or close($oR);
($firstrun{"PKGDEPS"}==1) or close($oD);
($firstrun{"index.html"}==1) or close($oH);
foreach my $db (keys %firstrun) { rename("$db.new", "$db"); }
printfooter($count) if ($firstrun{"index.html"} == 1);
}
######################## full repository ########################
sub pkg_dir {
print "+ Generating dependencies\n";
open (my $iD, ">PKGDEPS");
print "+ Generating repository\n";
open (my $iR, ">PKGREPO");
printheader(0);
my $count = 0;
open (my $ih, '>>index.html');
foreach my $p (@packages) {
my ($pver, $url, $du, $md5, $desc, $ppr, $pdeps, $date) = metadata($p);
($pdeps eq "") or ($isDup{$p})
or printf $iD "%-30s : %-s\n", $pname{$p}, $pdeps;
printf $iR "%-s:%-s:%-s:%-s:%-s\n", $p,$du,$md5,$desc,$ppr;
$count++;
htmlrow($ih,$count,$pname{$p},$url,$pver,$desc,$date);
}
close($ih);
printfooter($count);
close($iR);
close($iD);
}
# consolidate all the README and install scripts for the available packages
sub pkgreadscripts {
print "+ Generating README\n";
open (my $fR, '>PKGREAD');
print $fR "# README files for repository. Do NOT remove this line.\n";
print "+ Generating scripts\n";
open (my $fS, '>PKGINST');
print $fS '#!/usr/bin/env bash
#
# PKGINST: pre- and post-install scripts for CRUX packages
#
run_script() {
case "$1" in
';
my %seen;
foreach my $name (@dirlist) {
$name =~ s/\#.*//; next if ($seen{$name});
$seen{$name} = 1;
next if (! $path{$name});
if (-f "$path{$name}/README"){
print $fR "##### PKGREADME: $name\n";
open(my $readme, "$path{$name}/README");
while (<$readme>){ print $fR $_; }
close($readme);
}
foreach my $when ("pre", "post") {
if (-f "$path{$name}/${when}-install"){
print $fS " $name.$when)\n";
open(my $rs, "$path{$name}/${when}-install");
while (<$rs>){
chomp;
(m/^\#(!.*sh|\s*EOF|\s*End)/) or print $fS " $_\n";
}
close($rs);
print $fS " ;;\n";
}
}
}
print $fS " esac\n}\n\n";
print $fS '[ "$1" ] && [[ "$2" == @(pre|post) ]] && run_script "$1.$2"';
print $fS "\n";
close $fS;
close $fR;
}
######################## html index subs ########################
sub printheader {
my $isTemp = shift; my $ih;
($isTemp == 0) ? open ($ih, '>index.html') : open ($ih, '>index.html.new');
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 htmlrow {
my ($ih, $count, $name, $url, $version, $desc, $date) = @_;
print $ih "<tr class=\"$parity{($count % 2)}\"><td>$name</td>";
print $ih "<td><a href=\"$url\">$version</a></td>";
print $ih "<td>$desc</td><td>$date</td></tr>\n";
}
sub printfooter {
my $count = shift;
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 metadata {
my $p = shift;
my ($pver, $url) = ($p, $p);
$pver =~ s/.*\#//; $pver =~ s/\.pkg\.tar.*//;
$url =~ s/\#/\%23/;
my $du = (-s $p);
my $md5 = digest_file_hex($p,"MD5");
my $desc = (! $descrip{$pname{$p}}) ? "N.A." : $descrip{$pname{$p}};
my $ppr = (! $flags{$pname{$p}}) ? "no:no:no" : $flags{$pname{$p}};
my $pdeps = (! $depends{$pname{$p}}) ? "" : $depends{$pname{$p}};
my $date = isotime( (stat($p))[9], 1);
return $pver, $url, $du, $md5, $desc, $ppr, $pdeps, $date;
}
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]);
}