jmq/pkg-get
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

pkg-repgen: handle dups more efficiently

Browse Source
This commit is contained in:
John McQuah 2023-06-19 14:25:42 -04:00
parent 57f3b29e2e
commit 9ed253de71
3 changed files with 199 additions and 179 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
README
View File

@ -77,8 +77,8 @@ of previewing the outcome from a 'pkg-get depinst' operation.
useful prt-get commands (grpinst, fsearch, deptree, listorphans, ls, useful prt-get commands (grpinst, fsearch, deptree, listorphans, ls,
cat, edit, cache) have no counterpart in pkg-get. Of these omissions, cat, edit, cache) have no counterpart in pkg-get. Of these omissions,
only the 'grpinst' command is of possible interest for binary package only the 'grpinst' command is of possible interest for binary package
management; the unimplemented commands and options are just as easily management; the unimplemented commands and options are better handled
delegated to prt-get itself. If you want a Perl implementation that does by prt-get itself. If you want a Perl implementation that does
provide these missing commands, consider the script written by user provide these missing commands, consider the script written by user
farkuhar [1]. farkuhar [1].

119
scripts/pkg-get.pl
View File

@ -59,9 +59,10 @@ if (index($command,"Error: ") eq 0 ) {
$command =~ s/Error\: //; $command =~ s/Error\: //;
exiterr($command); exiterr($command);
} }
readconfig(); readconfig();
get_locked() unless ($command =~ get_locked() unless ($command =~
/^(info|help|readme|search|dsearch|list|path|depend|current|isinst)$/); /^(info|help|readme|search|dsearch|list|path|depend|current|isinst)$/);
SWITCH: { SWITCH: {
if ($command eq "version") { version(); last SWITCH; } if ($command eq "version") { version(); last SWITCH; }
@ -161,20 +162,17 @@ sub parsepackage {
my @p = split(/\:/, $_[0]); my @p = split(/\:/, $_[0]);
if ($#p != 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")}; if ($#p != 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")};
my %pkg; my %pkg;
my $name = $p[0]; my ($name, $verrel) = ($p[0] =~ m/(.*)\#(.*)\.pkg\.tar\.[gbx]z.*/) ?
$name =~ s/\#.*$//; ($1,$2) : ("unnamed","1-1");
my $version = $p[0];
$version =~ s/^.*\#//;
$version =~ s/-\w*\.pkg\.tar\.[gbx]z*//;
my $release = $p[0];
$release =~ s/^.*-//;
$release =~ s/\.pkg\.tar\.[gbx]z*//;
if (not $_[2]) {$_[2] = $_[1]};
$pkg{'name'} = $name; $pkg{'name'} = $name;
$pkg{'version'} = $version; ($pkg{'version'}, $pkg{'release'}) = ($verrel, $verrel);
$pkg{'release'} = $release; $pkg{'version'} =~ s/-\w*//;
$pkg{'release'} =~ s/^.*-//;
if (not $_[2]) {$_[2] = $_[1]};
$pkg{'path'} = $_[1]; $pkg{'path'} = $_[1];
$pkg{'url'} = $_[2] . "/$p[0]"; $pkg{'url'} = $_[2];
$pkg{'url'} =~ s/\/$//;
$pkg{'url'} .= "/$p[0]";
$pkg{'size'} = $p[1]; $pkg{'size'} = $p[1];
$pkg{'md5sum'} = $p[2]; $pkg{'md5sum'} = $p[2];
$pkg{'description'} = $p[3]; $pkg{'description'} = $p[3];
@ -193,9 +191,7 @@ sub parsepackagelight {
my @p = split(/\:/, $_[0]); my @p = split(/\:/, $_[0]);
if ($#p != 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")}; if ($#p != 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")};
my %pkg; my %pkg;
my $name = $p[0]; $pkg{'name'} = $1 if ($p[0] =~ m/^(.*)\#/);
$name =~ s/\#.*$//;
$pkg{'name'} = $name;
return %pkg; return %pkg;
} }
@ -244,13 +240,13 @@ sub printreadme {
open(READ, "$pkg{'path'}/PKGREAD") open(READ, "$pkg{'path'}/PKGREAD")
or exiterr("could not open $pkg{'path'}/PKGREAD"); or exiterr("could not open $pkg{'path'}/PKGREAD");
while (<READ>) { while (<READ>) {
if ($finished eq 1) {return;}; if ($finished == 1) {return;};
chomp; chomp;
if (($found eq 1) and ( /PKGREADME\:/ )) { if (($found == 1) and ( /PKGREADME\:/ )) {
$finished = 1; $finished = 1;
close(READ); close(READ);
return; return;
} elsif ($found eq 1) { } elsif ($found == 1) {
print "$_\n"; print "$_\n";
} elsif ( /PKGREADME: $pkg{'name'}$/ ) { } elsif ( /PKGREADME: $pkg{'name'}$/ ) {
$found = 1; $found = 1;
@ -263,7 +259,8 @@ sub printreadme {
sub printresults { sub printresults {
my $okaction = $curraction; my $okaction = $curraction;
my $curr = ""; my $curr = "";
my $action; my $pkg; my $action;
my $pkg;
my @readme; my @readme;
my $goterror = 0; my $goterror = 0;
if (@donetasks) { if (@donetasks) {
@ -382,22 +379,24 @@ sub getshortstatus {
sub getdependencies { sub getdependencies {
my ($pkgname, $checkver, $pkgparent) = @_; my ($pkgname, $checkver, $pkgparent) = @_;
my $depstring = ""; my $depstring = "";
if (not $deps{$pkgname}) {
my %pkg = getpackage($pkgname, 1); # no need to continue if there's already a value for this key
if (%pkg) { return if ($deps{$pkgname});
my $ddeps = getdirectdeps($pkg{'name'}, $pkg{'path'});
my @d = split(/,/, $ddeps); my %pkg = getpackage($pkgname, 1);
foreach my $dep(@d) { if (%pkg) {
getdependencies($dep, $checkver, $pkgname); my $ddeps = getdirectdeps($pkg{'name'}, $pkg{'path'});
} my @d = split(/,/, $ddeps);
$depstring = getshortstatus(%pkg)." " if ($checkver); foreach my $dep(@d) {
$depstring .= $pkgname; getdependencies($dep, $checkver, $pkgname);
$deps{$pkgname} = $depstring;
push(@dependencies, $depstring);
} else {
return 0 if ($pkgparent eq "");
$missingdeps{$pkgname} = $pkgparent;
} }
$depstring = getshortstatus(%pkg)." " if ($checkver);
$depstring .= $pkgname;
$deps{$pkgname} = $depstring;
push(@dependencies, $depstring);
} else {
return 0 if ($pkgparent eq "");
$missingdeps{$pkgname} = $pkgparent;
} }
} }
@ -415,7 +414,7 @@ sub downloadpkg {
} }
return 1; return 1;
} else { } else {
return 1 if ($pkg{'url'} eq ""); # repo is local and pkg does not exist. return 1 if ($pkg{'url'} eq ""); # repo is local and pkg does not exist
my $url = $pkg{'url'}; my $url = $pkg{'url'};
$url =~ s/\#/\%23/; $url =~ s/\#/\%23/;
system ("curl --retry 3 --retry-delay 3 -o $fullpath $url") == 0 or return 0; system ("curl --retry 3 --retry-delay 3 -o $fullpath $url") == 0 or return 0;
@ -439,10 +438,10 @@ sub installpkg {
if ($download_only) {return 1;} if ($download_only) {return 1;}
if ($force){$aa = $aa."-f ";} if ($force){$aa = $aa."-f ";}
if ($root) { if ($root) {
$aa = $aa."-r ".$root." "; $aa = $aa."-r ".$root." ";
(-f "$root/$pkg{'path'}/PKGINST") or (-f "$root/$pkg{'path'}/PKGINST") or
system("install -D $pkg{'path'}/PKGINST $root/$pkg{'path'}/PKGINST") system("install -D $pkg{'path'}/PKGINST $root/$pkg{'path'}/PKGINST")
or die "Failed to copy PKGINST to $root, aborting.\n"; or die "Failed to copy PKGINST to $root, aborting.\n";
} }
if ($pkg{'pre_install'} eq "yes" and ($install_scripts or $pre_install)) {doscript("pre",%pkg);} if ($pkg{'pre_install'} eq "yes" and ($install_scripts or $pre_install)) {doscript("pre",%pkg);}
my $fullpath = $pkg{'path'}."/".$pkg{'name'}."#".$pkg{'version'}."-".$pkg{'release'}.".pkg.tar.$compress"; my $fullpath = $pkg{'path'}."/".$pkg{'name'}."#".$pkg{'version'}."-".$pkg{'release'}.".pkg.tar.$compress";
@ -533,10 +532,9 @@ sub info {
chomp; chomp;
my %pkg = parsepackage($_, $dir, $url, 0); my %pkg = parsepackage($_, $dir, $url, 0);
if ($pkg{'name'} eq $arg) { if ($pkg{'name'} eq $arg) {
if ($type eq "info") { printinfo(%pkg); ($type ne "info") or printinfo(%pkg);
} elsif ($type eq "readme") { printreadme(%pkg); ($type ne "readme") or printreadme(%pkg);
} elsif ($type eq "path") { print $pkg{'path'} . "\n"; ($type ne "path") or print $pkg{'path'} . "\n";
}
close(REPO); return; close(REPO); return;
} }
} }
@ -557,9 +555,10 @@ sub search {
chomp; chomp;
my %pkg = parsepackage($_, $dir, $url, 0); my %pkg = parsepackage($_, $dir, $url, 0);
next if ($found{$pkg{'name'}}); next if ($found{$pkg{'name'}});
if ( (index($pkg{'name'}, $arg) >= 0) or (index($pkg{'name'}, $arg) < 0) or $found{$pkg{'name'}} = 1;
(($type eq "desc") and (index($pkg{'description'}, $arg) >= 0)) ) ($found{$pkg{'name'}}==1) or ($type ne "desc")
{$found{$pkg{'name'}} = 1;} or (index($pkg{'description'}, $arg) < 0)
or $found{$pkg{'name'}} = 1;
} }
close(REPO); close(REPO);
} }
@ -627,7 +626,7 @@ sub dolock {
shift(@ARGV); shift(@ARGV);
foreach my $arg(@ARGV) { foreach my $arg(@ARGV) {
if ($locked{$arg}) { if ($locked{$arg}) {
print "Already locked: $arg\n"; next; print "Already locked: $arg\n"; next;
} }
my $found = 0; my $found = 0;
foreach my $repo(@repos) { foreach my $repo(@repos) {
@ -639,7 +638,7 @@ sub dolock {
if ($pkg{'name'} eq $arg) { if ($pkg{'name'} eq $arg) {
$found = 1; $found = 1;
open(LCK, ">> $LOCKFILE") open(LCK, ">> $LOCKFILE")
or exiterr("could not write to lock file"); or exiterr("could not write to lock file");
print LCK "$arg\n"; print LCK "$arg\n";
close(LCK); close(LCK);
} }
@ -680,27 +679,22 @@ sub doprintf {
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO"); open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) { while (<REPO>) {
chomp; chomp;
my %pkg; my %pkg = (index($ARGV[1], "%i") >=0 ) ?
if (index($ARGV[1], "%i") >=0 ) { parsepackage($_, $dir, $url, 1) :
%pkg = parsepackage($_, $dir, $url, 1); parsepackage($_, $dir, $url, 0) ;
} else { if (($filter) and not $found{$pkg{'name'}}) {
%pkg = parsepackage($_, $dir, $url, 0);
}
if (not $found{$pkg{'name'}}) {
if ($filter ne "") {
my $match = $pkg{'name'}; my $match = $pkg{'name'};
my $cfilter = $filter; my $refilter = $filter;
$cfilter =~ s/\*/\.\*/; $refilter =~ s/\*/\.\*/;
if ($match =~ /^$cfilter$/) { if ($match =~ /^$refilter$/) {
formattedprint(%pkg); formattedprint(%pkg);
$found{$pkg{'name'}} = 1; $found{$pkg{'name'}} = 1;
} }
} else { } elsif (not $found{$pkg{'name'}}) {
formattedprint(%pkg); formattedprint(%pkg);
$found{$pkg{'name'}} = 1; $found{$pkg{'name'}} = 1;
} }
} }
}
close(REPO); close(REPO);
} }
} }
@ -724,7 +718,7 @@ sub diff {
printf("%-19s %-19s %-19s\n\n","Package","Installed","Available in the repositories"); printf("%-19s %-19s %-19s\n\n","Package","Installed","Available in the repositories");
} }
my $lastcol = ($locked{$pkg{'name'}}) ? "locked" : $pkg{'version'}."-".$pkg{'release'}; my $lastcol = ($locked{$pkg{'name'}}) ? "locked" : $pkg{'version'}."-".$pkg{'release'};
push @diff, $pkg{'name'}; push @diff, $pkg{'name'};
print "$pkg{'name'} " if ($format =~ /^quick/); print "$pkg{'name'} " if ($format =~ /^quick/);
printf("%-19s %-19s %-19s\n", $pkg{'name'}, $pkg{'instversion'}, $lastcol) if ($format !~ /^(quick|sysup)/); printf("%-19s %-19s %-19s\n", $pkg{'name'}, $pkg{'instversion'}, $lastcol) if ($format !~ /^(quick|sysup)/);
} }
@ -808,7 +802,6 @@ sub upinst {
my ($cmd, @args) = @_; my $aa; my ($cmd, @args) = @_; my $aa;
($curraction, $aa) = ($cmd =~ /^up/) ? ("updated","-u") : ("installed",""); ($curraction, $aa) = ($cmd =~ /^up/) ? ("updated","-u") : ("installed","");
getinstalled() if (! %installed); getinstalled() if (! %installed);
foreach my $pkgname(@args) { foreach my $pkgname(@args) {
my %pkg = getpackage($pkgname, 1); my %pkg = getpackage($pkgname, 1);

255
scripts/pkg-repgen.pl
View File

@ -31,15 +31,19 @@ $prtget .= " --no-std-config --config-set=\"prtdir $prtdir\"" if ($prtdir);
my @dirlist = glob("*#*.pkg.tar.$compress"); my @packages; my @dirlist = glob("*#*.pkg.tar.$compress"); my @packages;
if ($#ARGV >= 0) { # single packages if ($#ARGV >= 0) { # single packages
foreach my $pkgname (@ARGV) { foreach my $name (sort @ARGV) {
my @hits = sort grep { /^$pkgname\#/ } @dirlist; my @hits = glob("$name#*.pkg.tar.$compress");
push(@packages,$hits[-1]) if (@hits); push(@packages,@hits);
} }
} else { } else {
@packages = @dirlist; @packages = @dirlist;
} }
# Populate hashes using a single run of prt-get # A hash to determine quickly whether a package is a dup
our %pname = map { $_ => $_ } @packages;
foreach my $p (@packages) { $pname{$p} =~ s/\#.*//; }
# Populate some other hashes using a single run of prt-get
our %path; our %depends; our %descrip; our %flags; our %path; our %depends; our %descrip; our %flags;
my @validkeys = @dirlist; my @validkeys = @dirlist;
map { s/\#.*// } @validkeys; map { s/\#.*// } @validkeys;
@ -68,98 +72,116 @@ pkgreadscripts();
######################## individual packages ######################## ######################## individual packages ########################
sub pkg_single { sub pkg_single {
my ($pname, $dbO, $oname, $pdeps, $desc, $du, $md5, $ppr); my ($oR, $oD, $oH, $nR, $nD, $nH, $oline, $oname);
my $count = 0; my ($pver, $url, $date); # needed for the html index my $count = 0; # needed for the html index
foreach my $db ("PKGREPO", "PKGDEPS", "index.html") { my %firstrun = map { $_ => 0 } ("PKGREPO", "PKGDEPS", "index.html");
my $firstrun = 0; my $dbNew; open ($oR, "PKGREPO") or $firstrun{"PKGREPO"} = 1;
my $status = "+ Generating "; open ($oD, "PKGDEPS") or $firstrun{"PKGDEPS"} = 1;
if ($db eq "PKGREPO") { open ($oH, "index.html") or $firstrun{"index.html"} = 1;
$status .= "repository\n"; open ($nR, ">PKGREPO.new");
} elsif ($db eq "PKGDEPS") { open ($nD, ">PKGDEPS.new");
$status .= "dependencies\n";
} else {
$status .= "html index\n";
}
print $status;
open (my $dbOld, "$db") or $firstrun=1;
if ( ($firstrun == 1) and ($db eq "index.html") ) {
printheader();
rename($db, "$db.new");
open ($dbNew, ">>$db.new");
} else {
open ($dbNew, ">$db.new");
}
PACKAGE: foreach my $p (sort @packages) { printheader(1);
$count++ if ($db eq "index.html"); open ($nH, ">>index.html.new");
$pname = $p; $pver = $p;
$pname =~ s/#.*//; $pver =~ s/.*#(.*)\.pkg\.tar\.*/$1/;
if ($db eq "PKGREPO") {
$du = (-s $p);
$md5 = digest_file_hex($p,"MD5");
$desc = (! $descrip{$pname}) ? "N.A." : $descrip{$pname};
$ppr = (! $flags{$pname}) ? "no:no:no" : $flags{$pname};
printf $dbNew "%-s:%-s:%-s:%-s:%-s\n",
$p, $du, $md5, $desc, $ppr if ($firstrun == 1);
} elsif ($db eq "PKGDEPS") {
$pdeps = (! $depends{$pname}) ? "" : $depends{$pname};
printf $dbNew "%-30s:%s\n", $pname, $pdeps if ($firstrun == 1);
} else {
$date = isotime( (stat($p))[9], 1);
$url = $p;
$url =~ s/\#/\%23/;
htmlrow($dbNew,$parity{($count % 2)},$pname,$url,$pver,
$descrip{$pname},$date) if ($firstrun == 1);
}
next PACKAGE if ($firstrun == 1);
while ($dbO = <$dbOld>) {
chomp($dbO);
if (($db eq "index.html") and ($dbO !~ m/^<tr class/)) {
# Try to ensure that header lines are copied verbatim,
# by exploiting the alphabetical sorting below.
# Not guaranteed to work with every locale!
$oname = " 0";
} else {
# should be able to extract the old pkg name from this line
$oname = $dbO;
$oname =~ s/\s*\:.*// if ($db eq "PKGDEPS");
$oname =~ s/(.*)\#.*pkg\.tar.*/$1/ if ($db eq "PKGREPO");
$oname =~ s/.*a href="(.*)\%23.*/$1/ if ($db eq "index.html");
$count++ if ($db eq "index.html");
}
if ($oname lt $pname) { foreach my $mf ("repository", "dependency map", "html index") {
print $dbNew "$dbO\n"; print "+ Updating specified entries in $mf\n";
} elsif (($oname ge $pname) and ($db eq "PKGREPO")) {
printf $dbNew "%-s:%-s:%-s:%-s:%-s\n", $p, $du, $md5, $desc, $ppr;
} elsif (($oname ge $pname) and ($db eq "PKGDEPS")) {
printf $dbNew "%-30s:%s\n", $pname, $pdeps
} else {
# either overwrite the old entry in the html index,
# or insert this entry before the first line that
# would come after $p when sorted alphabetically.
htmlrow($dbNew,$parity{($count % 2)},$pname,$url,$pver,
$descrip{$pname},$date);
}
print $dbNew "$dbO\n" if ($oname gt $pname);
last if ($oname ge $pname);
}
}
while ( ($firstrun != 1) and ($dbO = <$dbOld>) ) {
if ($db eq "index.html") {
$count++;
$dbO =~ s/class="(even|odd)"/class="$parity{($count % 2)}"/;
}
print $dbNew $dbO;
}
close($dbNew);
($firstrun == 1) or close($dbOld);
rename("$db.new", "$db");
printfooter($count) if (($firstrun == 1) and ($db eq "index.html"));
} }
while (my $p =shift @packages) {
my ($pver, $url, $du, $md5, $desc, $ppr, $pdeps, $date) = metadata($p);
my $isDup = ((@packages) and ($pname{$packages[0]} eq $pname{$p})) ? 1 : 0;
($firstrun{"PKGREPO"}==0) or printf $nR "%-s:%-s:%-s:%-s:%-s\n",
$p, $du, $md5, $desc, $ppr;
($firstrun{"PKGDEPS"}==0) or ($pdeps eq "")
or printf $nD "%-30s : %-s\n", $pname{$p}, $pdeps;
if ($firstrun{"index.html"} == 1) {
$count++;
htmlrow($nH,$parity{($count % 2)},$pname{$p},$url,$pver,$desc,$date);
}
# 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});
# in case the current package is the last in a sequence of dups, or
# the last in the queue, make sure we don't lose what got popped
# from the repository
print $nR $oline if (($oname gt $pname{$p}) and (! $isDup));
# stop reading the repository, at least until the next package
last if ($oname ge $pname{$p});
}
# 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,$parity{($count % 2)},$pname{$p},$url,$pver,$desc,$date)
if ($oname ge $pname{$p});
if ( ($oname gt $pname{$p}) and (! $isDup) ) {
$count++;
$oline =~ s/class="(even|odd)"/class="$parity{($count %2)}"/;
print $nH "$oline\n";
}
last if ($oname ge $pname{$p});
}
# 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) ) {
printf $nD "%-30s : %-s\n", $pname{$p}, $pdeps;
}
printf $nD "$oline\n" if ($oname gt $pname{$p});
last if ($oname ge $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 ######################## ######################## full repository ########################
@ -168,27 +190,18 @@ sub pkg_dir {
open (my $iD, ">PKGDEPS"); open (my $iD, ">PKGDEPS");
print "+ Generating repository\n"; print "+ Generating repository\n";
open (my $iR, ">PKGREPO"); open (my $iR, ">PKGREPO");
printheader(); printheader(0);
my $count = 0; my $count = 0;
open (my $ih, '>>index.html'); open (my $ih, '>>index.html');
foreach my $p (@packages) { while (my $p =shift @packages) {
chomp($p); chomp($p);
my $date = isotime( (stat($p))[9], 1);
$count++; $count++;
my ($name, $version, $url) = ($p, $p, $p); my ($pver, $url, $du, $md5, $desc, $ppr, $pdeps, $date) = metadata($p);
$name =~ s/\#.*//; ($pdeps eq "") or
$version =~ s/^.*\#//; ( (@packages) and ($pname{$p} eq $pname{$packages[0]}) )
$version =~ s/\.pkg\.tar\.[gbx]z*//; or printf $iD "%-30s : %-s\n", $pname{$p}, $pdeps;
$url =~ s/\#/\%23/; printf $iR "%-s:%-s:%-s:%-s:%-s\n", $p,$du,$md5,$desc,$ppr;
if (($depends{$name}) and ($depends{$name} ne "")) { htmlrow($ih,$parity{($count % 2)},$pname{$p},$url,$pver,$desc,$date);
printf $iD "%-30s : %-s\n", $name, $depends{$name};
}
my $du = (-s $p);
my $md5 = digest_file_hex($p,"MD5");
if (! $descrip{$name}) {$descrip{$name} = "N.A.";}
if (! $flags{$name}) { $flags{$name} = "no:no:no"; }
printf $iR "%-s:%-s:%-s:%-s:%-s\n", $p,$du,$md5,$descrip{$name},$flags{$name};
htmlrow($ih,$parity{($count % 2)},$name,$url, $version,$descrip{$name},$date);
} }
close($ih); close($ih);
printfooter($count); printfooter($count);
@ -212,7 +225,7 @@ run_script() {
case "$1" in case "$1" in
'; ';
foreach my $name (sort @dirlist) { foreach my $name (@dirlist) {
$name =~ s/\#.*//; $name =~ s/\#.*//;
if (-f "$path{$name}/README"){ if (-f "$path{$name}/README"){
print $fR "##### PKGREADME: $name\n"; print $fR "##### PKGREADME: $name\n";
@ -226,8 +239,7 @@ run_script() {
open(my $rs, "$path{$name}/${when}-install"); open(my $rs, "$path{$name}/${when}-install");
while (<$rs>){ while (<$rs>){
chomp; chomp;
print $fS " $_\n" (m/^\#(!.*sh|\s*EOF|\s*End)/) or print $fS " $_\n";
unless (m/^\#(!.*sh|\s*EOF|\s*End)/);
} }
close($rs); close($rs);
print $fS " ;;\n"; print $fS " ;;\n";
@ -244,7 +256,8 @@ run_script() {
######################## html index subs ######################## ######################## html index subs ########################
sub printheader { sub printheader {
open (my $ih, '>index.html'); my $isTemp = shift; my $ih;
($isTemp == 0) ? open ($ih, '>index.html') : open ($ih, '>index.html.new');
print $ih <<EOH; print $ih <<EOH;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"> "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
@ -315,7 +328,7 @@ sub htmlrow {
} }
sub printfooter { sub printfooter {
my $count = $_[0]; my $count = shift;
open (my $ih, '>>index.html'); open (my $ih, '>>index.html');
print $ih " </table>\n"; print $ih " </table>\n";
print $ih " <p><b>$count packages</b></p>\n"; print $ih " <p><b>$count packages</b></p>\n";
@ -332,6 +345,20 @@ EOH
close($ih); 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 { sub isotime {
my $time = (shift or time); my $time = (shift or time);
my $accuracy = (shift or 2); my $accuracy = (shift or 2);