#!/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 [options] [directory [pkgname1..pkgnameN]]
#

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

our $prtget = "/usr/bin/prt-get"; our $prtdir; our $compress; our $VERSION="0.5.1";
our $title = "CRUX Packages"; our $header; our $footer; our @HowMuchHelp; our $noconf;
GetOptions("prtdir=s"=>\$prtdir, "title=s"=>\$title, "header=s"=>\$header, "footer=s"=>\$footer,
      "h"=>sub{ push(@HowMuchHelp,"help") }, "help"=>sub{ push(@HowMuchHelp,"help") }, 
      "version"=>sub{ push(@HowMuchHelp,"version") }, "no-pkgmk-conf"=>\$noconf)
      or die("Error processing options! Try pkg-repgen --help.\n");

if (@HowMuchHelp) {
    print_usage(@HowMuchHelp);
}

if ($noconf) { 
    $compress = "{gz,lz,xz,bz2,zst}";
} else { # Use compression-mode defined in pkgmk-conf
    $compress = "xz";
    open CONFIG, "/etc/pkgmk.conf" or die "Could not open /etc/pkgmk.conf";
    while (<CONFIG>) {
        if (m/^\s*PKGMK_COMPRESSION_MODE=(.*?)\s*(?:#.*)?$/) { (my $c = $1) =~ s/\s+$//; $compress = $c; }
    }
    close CONFIG;
    $compress =~ s/["' ]//g;
}

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

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 ($bTime le $aTime) { return -1; }
    else { return 1; }
}

sub print_usage {
    my $status=0;
    foreach my $h (@_) {
        if ($h eq "version") {
            print "pkg-get $VERSION by Simone Rota <sip\@varlock.com>\n";
        } else {
    	    print "usage: pkg-repgen [options] [directory [pkgname1..pkgnameN]]\n";
    	    print "             toggle option: --no-pkgmk-conf\n";
    	    print "             string option: --title=\n";
    	    print "         file/path options: --header=, --footer=, --prtdir=\n";
    	    $status=1 if ($h ne "help");
        }
    }
    exit $status;
}

my $pkgdir = shift @ARGV; my $quickMode=0;
(! $pkgdir) or (-d $pkgdir) or print_usage("wrong argument");

$pkgdir = "." if (! $pkgdir);
my @dirlist = glob("$pkgdir/*.pkg.tar.$compress");
@dirlist = sort pkg_mtime @dirlist;
%isDup = map { $_ => 0 } @dirlist;

if (@ARGV) { # individual packages
    $quickMode=1;
    my @updates = sort @ARGV;
    while (my $name = shift @updates) {
        push @packages, grep { m/$name#.*\.pkg\.tar\./ } @dirlist;
    }
} else { # the entire directory
    @packages = @dirlist;
}

# hashes to determine the package name ...
our %pname = map { $_ => (split /\//, $_)[-1] } @dirlist;
foreach my $p (@dirlist) { $pname{$p} =~ s/\#.*//; }

# ... or to look up the successor when merging old metadata files
my %followR; my %followH; my %followD; my @queue = @dirlist;
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 = map { (split /\//, $_)[-1] } @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;
    $depends{$name} =~ s/,/ /g;
    $descrip{$name} = $desc;
    $desc =~ s/:/ /g;
    $flags{$name} = $prepostread;
}
close ($ppf);

# Needed for alternating colors in the html index
my %parity = ( 0 => "even", 1 => "odd" );

# Generate the metadata files
($quickMode) ? 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 @dep_packages = @packages;
  my @idx_packages = @packages;

  my %firstrun = map { $_ => 0 } ("PKGREPO", "PKGDEPS", "index.html");
  open ($oR, "$pkgdir/PKGREPO")    or $firstrun{"PKGREPO"} = 1;
  open ($oD, "$pkgdir/PKGDEPS")    or $firstrun{"PKGDEPS"} = 1;
  open ($oH, "$pkgdir/index.html") or $firstrun{"index.html"} = 1;

  open ($nR, ">$pkgdir/PKGREPO.new");
  print "+ Updating specified entries in repository\n";
  RPKG: while (my $p =shift @packages) {
    my ($basename, $du, $md5, $ppr) = repodata($p);
    my $desc = (! $descrip{$pname{$p}}) ? "N.A." : $descrip{$pname{$p}};
    if ($firstrun{"PKGREPO"}==1) {
      printf $nR "%-s:%-s:%-s:%-s:%-s\n",$basename, $du, $md5, $desc, $ppr;
      next RPKG;
    }

    # Shift entries from the old repository until we find
    # a successor to the current package.
    while ( (! $followR{$pname{$p}}) and $oline = <$oR> ) {
      chomp($oline); $oname = $oline;
      $oname =~ s/\#.*//;
      print $nR "$oline\n" if ($oname lt $pname{$p});

      # before breaking out of the loop, append all the packages 
      # from the globbed queue that are lexographically earlier
      # than the current entry in the old repository.
      while ($pname{$p} le $oname) {
        printf $nR "%-s:%-s:%-s:%-s:%-s\n", $basename, $du, $md5, $desc, $ppr;
        next RPKG if (! $isDup{$p});
        $p = shift @packages;
        ($basename, $du, $md5, $ppr) = repodata($p);
        $desc = (! $descrip{$pname{$p}}) ? "N.A." : $descrip{$pname{$p}};

        # save what got shifted from the repository if we're not going to
        # print it now, but don't save packages that match the same glob.
        $followR{$pname{$p}} = "$oline\n" if ($pname{$p} lt $oname);
      }
    }

    # 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", $basename, $du, $md5, $desc, $ppr;

    next RPKG if (($isDup{$p}) or (! $followR{$pname{$p}}));

    # Arriving here means the current package is not a dup, and 
    # definitely has a successor in the old repository. But the 
    # next globbed package might be a more immediate successor. 
    # Decide which of the two possible successors comes first.
    # By defining a successor for the next package in the queue, 
    # we delay shifting entries off the old repo.
    if ((@packages) and ($pname{$packages[0]} le $followR{$pname{$p}})) {
       $followR{$pname{$packages[0]}} = $followR{$pname{$p}};
       next RPKG;
    } else {
       print $nR $followR{$pname{$p}};
    }

  # Shift another package from the queue
  }

  # Likewise for the html index
  printheader(1);
  open ($nH, ">>$pkgdir/index.html.new");

  print "+ Updating specified entries in the html index\n";
  HPKG: while (my $p =shift @idx_packages) {
    my ($pver, $desc, $date) = htmldata($p);
    my $url = $p;
    $url =~ s/#/%23/;

    if ($firstrun{"index.html"} == 1) {
        $count++;
        htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date);
        next HPKG;
    }
    # Shift entries from the old html index until we find
    # a successor to the current package.
    while ( (! $followH{$pname{$p}}) and $oline=<$oH> ) {
        chomp($oline);
        # no need to copy the header, it should already be there
        next if ($oline !~ m/^<tr class="(odd|even)"/);
          
        $oname = $oline;
        $oname =~ s/.*a href="(.*)"/$1/; $oname =~ s/\%23.*//;
        if ($oname lt $pname{$p}) { $count++; print $nH "$oline\n"; }

        # before breaking out of the loop, append all the packages 
        # from the globbed queue that are lexographically earlier
        # than the current entry in the old html index.
        while ($pname{$p} le $oname) {
          $count++;
          htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date);
          next HPKG if (! $isDup{$p});
          $p = shift @idx_packages;
          ($pver, $desc, $date) = htmldata($p);
          $url = $p;
          $url =~ s/#/%23/;

          # save what got shifted from the index if we're not going to print
          # it now, but ignore packages that match the same glob.
          $followH{$pname{$p}} = "$oline\n" if ($pname{$p} lt $oname);
        }
    }

    # if the current package comes after everything in the old html index,
    # just append its metadata
    if (! $followH{$pname{$p}}) {
        $count++;
        htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date);
    }

    next HPKG if (($isDup{$p}) or (! $followH{$pname{$p}}));

    # Arriving here means the current package is not a dup, and 
    # definitely has a successor in the old html index. But the 
    # next globbed package might be a more immediate successor.
    # Decide which of the two possible successors comes first. If the 
    # globbed package is the more immediate successor, use its name
    # as a key to retain the most recent entry from the html index.
    if ((@packages) and ($pname{$packages[0]} le $followH{$pname{$p}})) {
         $followH{$pname{$packages[0]}} = $followH{$pname{$p}};
         next HPKG;
    } else {
         $count++;
         $followH{$pname{$p}} =~ s/class="(even|odd)"/class="$parity{($count %2)}"/;
         print $nH $followH{$pname{$p}};
    }

  # Shift another package from the queue
  }

  # Likewise for the dependency map, but avoid creating duplicate entries
  open ($nD, ">$pkgdir/PKGDEPS.new");

  print "+ Updating specified entries in the depmap\n";
  DPKG: while (my $p =shift @dep_packages) {
    if ($firstrun{"PKGDEPS"}==1) {
       (! $depends{$pname{$p}}) or ($isDup{$p})
        or printf $nD "%-30s : %-s\n", $pname{$p}, $depends{$pname{$p}};
       next DPKG;
    }
    # Shift entries from the old depmap until we find a successor
    # to the current package
    while ( (! $followD{$pname{$p}}) and $oline = <$oD> ) {
        chomp($oline); $oname = $oline;
        $oname =~ s/\s*\:.*//;
        print $nD "$oline\n" if ($oname lt $pname{$p});
        while ($pname{$p} le $oname) {
          if (! $isDup{$p}) {
            printf $nD "%-30s : %-s\n", $pname{$p}, $depends{$pname{$p}};
            next DPKG;
          } else {
            $p = shift @dep_packages;
          }
          # save what got shifted from the depmap if we're not going to print
          # it now, but ignore packages that match the same glob.
          $followD{$pname{$p}} = $oline if ($pname{$p} lt $oname);
        }
    }

    # if the current package comes after everything in the old depmap
    # and is not a dup, just append its metadata
    ($followD{$pname{$p}}) or ($isDup{$p}) or (! $depends{$pname{$p}})
    or printf $nD "%-30s : %-s\n", $pname{$p}, $depends{$pname{$p}};

    next DPKG if (($isDup{$p}) or (! $followD{$pname{$p}}));

    # Arriving here means the current package is not a dup, and 
    # definitely has a successor entry in the old depmap.
    # But the next globbed package might be a more immediate successor.
    # Decide which of the two possible successors comes first. If it's the
    # globbed package that comes next, save the old depmap entry.
    if ((@packages) and ($pname{$packages[0]} le $followD{$pname{$p}})) {
       $followD{$pname{$packages[0]}} = $followD{$pname{$p}};
       next DPKG;
    } else {
       printf $nD $followD{$pname{$p}};
    }

  # Shift another package from 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.
  # Remember to update the count, in case new packages were inserted.
  while ($firstrun{"index.html"}==0 and $oline = <$oH>) {
      if ($oline =~ m/class="(even|odd)"/) {
          $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("$pkgdir/$db.new", "$pkgdir/$db"); }
  printfooter($count);
}

######################## full repository ########################
sub pkg_dir {
    print "+ Generating dependencies\n";
    open (my $iD, ">$pkgdir/PKGDEPS");
    print "+ Generating repository\n";
    open (my $iR, ">$pkgdir/PKGREPO");
    printheader(0);
    my $count = 0;
    open (my $ih, ">>$pkgdir/index.html");
    foreach my $p (@packages) {
        my ($basename, $du, $md5, $ppr) = repodata($p);
        my ($pver, $desc, $date) = htmldata($p);
        my $url = $basename;
        $url =~ s/#/%23/;
        (! $depends{$pname{$p}}) or ($isDup{$p}) 
                or printf $iD "%-30s : %-s\n", $pname{$p}, $depends{$pname{$p}};
        printf $iR "%-s:%-s:%-s:%-s:%-s\n", $basename,$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, ">$pkgdir/PKGREAD");
    print $fR "# README files for repository. Do NOT remove this line.\n";

    print "+ Generating scripts\n";
    open (my $fS, ">$pkgdir/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/\#.*//; $name = (split /\//, $name)[-1];
        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" -o "$2" = "post" ] && run_script "$1.$2"';
    print $fS "\n";
    close $fS;
    close $fR;
}

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

sub printheader {
    my $isTemp = shift; my $ih; my $fS;
    my $stylePage = "/usr/share/pkg-get/style.html";
    ($isTemp == 0) ? open ($ih, ">$pkgdir/index.html") : open ($ih, ">$pkgdir/index.html.new");
    open ($fS, $stylePage) or die "cannot find html template. Please install $stylePage and try again.";
    while (my $sline = <$fS>) {
        if ($sline =~ m/<(title|h[1-3])>/) {
            $sline =~ s/(title|h[1-3])>[^<]*</$1>$title</;
        }
        print $ih $sline;
    }

    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, ">>$pkgdir/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><em>Generated by <a href=\"http://www.varlock.com\">pkg-repgen</a> on " . isotime() . ".</em></p>\n";
    print $ih <<EOH;
 </body>
</html>
EOH
    close($ih);
}

sub htmldata {
    my $p = shift;
    my $pver = $1 if ($p =~ m/.*\#(.*)\.pkg\.tar\.*/);
    my $date = isotime( (stat($p))[9] );
    my $desc = (! $descrip{$pname{$p}}) ? "N.A." : $descrip{$pname{$p}};
    return $pver, $desc, $date;
}

sub repodata {
    my $p = shift;
    my $basename = (split /\//, $p)[-1];
    my $du = (-s $p);
    my $md5 = digest_file_hex($p,"MD5");
    my $ppr = (! $flags{$pname{$p}}) ? "no:no:no" : $flags{$pname{$p}};
    return $basename, $du, $md5, $ppr;
}

sub isotime {
    my $time = (shift or time);
    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";
}
