pkg-repgen: handle dups more efficiently
This commit is contained in:
parent
57f3b29e2e
commit
9ed253de71
4
README
4
README
@ -77,8 +77,8 @@ of previewing the outcome from a 'pkg-get depinst' operation.
|
||||
useful prt-get commands (grpinst, fsearch, deptree, listorphans, ls,
|
||||
cat, edit, cache) have no counterpart in pkg-get. Of these omissions,
|
||||
only the 'grpinst' command is of possible interest for binary package
|
||||
management; the unimplemented commands and options are just as easily
|
||||
delegated to prt-get itself. If you want a Perl implementation that does
|
||||
management; the unimplemented commands and options are better handled
|
||||
by prt-get itself. If you want a Perl implementation that does
|
||||
provide these missing commands, consider the script written by user
|
||||
farkuhar [1].
|
||||
|
||||
|
||||
@ -59,9 +59,10 @@ if (index($command,"Error: ") eq 0 ) {
|
||||
$command =~ s/Error\: //;
|
||||
exiterr($command);
|
||||
}
|
||||
|
||||
readconfig();
|
||||
get_locked() unless ($command =~
|
||||
/^(info|help|readme|search|dsearch|list|path|depend|current|isinst)$/);
|
||||
get_locked() unless ($command =~
|
||||
/^(info|help|readme|search|dsearch|list|path|depend|current|isinst)$/);
|
||||
|
||||
SWITCH: {
|
||||
if ($command eq "version") { version(); last SWITCH; }
|
||||
@ -161,20 +162,17 @@ sub parsepackage {
|
||||
my @p = split(/\:/, $_[0]);
|
||||
if ($#p != 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")};
|
||||
my %pkg;
|
||||
my $name = $p[0];
|
||||
$name =~ s/\#.*$//;
|
||||
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]};
|
||||
my ($name, $verrel) = ($p[0] =~ m/(.*)\#(.*)\.pkg\.tar\.[gbx]z.*/) ?
|
||||
($1,$2) : ("unnamed","1-1");
|
||||
$pkg{'name'} = $name;
|
||||
$pkg{'version'} = $version;
|
||||
$pkg{'release'} = $release;
|
||||
($pkg{'version'}, $pkg{'release'}) = ($verrel, $verrel);
|
||||
$pkg{'version'} =~ s/-\w*//;
|
||||
$pkg{'release'} =~ s/^.*-//;
|
||||
if (not $_[2]) {$_[2] = $_[1]};
|
||||
$pkg{'path'} = $_[1];
|
||||
$pkg{'url'} = $_[2] . "/$p[0]";
|
||||
$pkg{'url'} = $_[2];
|
||||
$pkg{'url'} =~ s/\/$//;
|
||||
$pkg{'url'} .= "/$p[0]";
|
||||
$pkg{'size'} = $p[1];
|
||||
$pkg{'md5sum'} = $p[2];
|
||||
$pkg{'description'} = $p[3];
|
||||
@ -193,9 +191,7 @@ sub parsepackagelight {
|
||||
my @p = split(/\:/, $_[0]);
|
||||
if ($#p != 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")};
|
||||
my %pkg;
|
||||
my $name = $p[0];
|
||||
$name =~ s/\#.*$//;
|
||||
$pkg{'name'} = $name;
|
||||
$pkg{'name'} = $1 if ($p[0] =~ m/^(.*)\#/);
|
||||
return %pkg;
|
||||
}
|
||||
|
||||
@ -244,13 +240,13 @@ sub printreadme {
|
||||
open(READ, "$pkg{'path'}/PKGREAD")
|
||||
or exiterr("could not open $pkg{'path'}/PKGREAD");
|
||||
while (<READ>) {
|
||||
if ($finished eq 1) {return;};
|
||||
if ($finished == 1) {return;};
|
||||
chomp;
|
||||
if (($found eq 1) and ( /PKGREADME\:/ )) {
|
||||
if (($found == 1) and ( /PKGREADME\:/ )) {
|
||||
$finished = 1;
|
||||
close(READ);
|
||||
return;
|
||||
} elsif ($found eq 1) {
|
||||
} elsif ($found == 1) {
|
||||
print "$_\n";
|
||||
} elsif ( /PKGREADME: $pkg{'name'}$/ ) {
|
||||
$found = 1;
|
||||
@ -263,7 +259,8 @@ sub printreadme {
|
||||
sub printresults {
|
||||
my $okaction = $curraction;
|
||||
my $curr = "";
|
||||
my $action; my $pkg;
|
||||
my $action;
|
||||
my $pkg;
|
||||
my @readme;
|
||||
my $goterror = 0;
|
||||
if (@donetasks) {
|
||||
@ -382,22 +379,24 @@ sub getshortstatus {
|
||||
sub getdependencies {
|
||||
my ($pkgname, $checkver, $pkgparent) = @_;
|
||||
my $depstring = "";
|
||||
if (not $deps{$pkgname}) {
|
||||
my %pkg = getpackage($pkgname, 1);
|
||||
if (%pkg) {
|
||||
my $ddeps = getdirectdeps($pkg{'name'}, $pkg{'path'});
|
||||
my @d = split(/,/, $ddeps);
|
||||
foreach my $dep(@d) {
|
||||
getdependencies($dep, $checkver, $pkgname);
|
||||
}
|
||||
$depstring = getshortstatus(%pkg)." " if ($checkver);
|
||||
$depstring .= $pkgname;
|
||||
$deps{$pkgname} = $depstring;
|
||||
push(@dependencies, $depstring);
|
||||
} else {
|
||||
return 0 if ($pkgparent eq "");
|
||||
$missingdeps{$pkgname} = $pkgparent;
|
||||
|
||||
# no need to continue if there's already a value for this key
|
||||
return if ($deps{$pkgname});
|
||||
|
||||
my %pkg = getpackage($pkgname, 1);
|
||||
if (%pkg) {
|
||||
my $ddeps = getdirectdeps($pkg{'name'}, $pkg{'path'});
|
||||
my @d = split(/,/, $ddeps);
|
||||
foreach my $dep(@d) {
|
||||
getdependencies($dep, $checkver, $pkgname);
|
||||
}
|
||||
$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;
|
||||
} 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'};
|
||||
$url =~ s/\#/\%23/;
|
||||
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 ($force){$aa = $aa."-f ";}
|
||||
if ($root) {
|
||||
$aa = $aa."-r ".$root." ";
|
||||
$aa = $aa."-r ".$root." ";
|
||||
(-f "$root/$pkg{'path'}/PKGINST") or
|
||||
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);}
|
||||
my $fullpath = $pkg{'path'}."/".$pkg{'name'}."#".$pkg{'version'}."-".$pkg{'release'}.".pkg.tar.$compress";
|
||||
@ -533,10 +532,9 @@ sub info {
|
||||
chomp;
|
||||
my %pkg = parsepackage($_, $dir, $url, 0);
|
||||
if ($pkg{'name'} eq $arg) {
|
||||
if ($type eq "info") { printinfo(%pkg);
|
||||
} elsif ($type eq "readme") { printreadme(%pkg);
|
||||
} elsif ($type eq "path") { print $pkg{'path'} . "\n";
|
||||
}
|
||||
($type ne "info") or printinfo(%pkg);
|
||||
($type ne "readme") or printreadme(%pkg);
|
||||
($type ne "path") or print $pkg{'path'} . "\n";
|
||||
close(REPO); return;
|
||||
}
|
||||
}
|
||||
@ -557,9 +555,10 @@ sub search {
|
||||
chomp;
|
||||
my %pkg = parsepackage($_, $dir, $url, 0);
|
||||
next if ($found{$pkg{'name'}});
|
||||
if ( (index($pkg{'name'}, $arg) >= 0) or
|
||||
(($type eq "desc") and (index($pkg{'description'}, $arg) >= 0)) )
|
||||
{$found{$pkg{'name'}} = 1;}
|
||||
(index($pkg{'name'}, $arg) < 0) or $found{$pkg{'name'}} = 1;
|
||||
($found{$pkg{'name'}}==1) or ($type ne "desc")
|
||||
or (index($pkg{'description'}, $arg) < 0)
|
||||
or $found{$pkg{'name'}} = 1;
|
||||
}
|
||||
close(REPO);
|
||||
}
|
||||
@ -627,7 +626,7 @@ sub dolock {
|
||||
shift(@ARGV);
|
||||
foreach my $arg(@ARGV) {
|
||||
if ($locked{$arg}) {
|
||||
print "Already locked: $arg\n"; next;
|
||||
print "Already locked: $arg\n"; next;
|
||||
}
|
||||
my $found = 0;
|
||||
foreach my $repo(@repos) {
|
||||
@ -639,7 +638,7 @@ sub dolock {
|
||||
if ($pkg{'name'} eq $arg) {
|
||||
$found = 1;
|
||||
open(LCK, ">> $LOCKFILE")
|
||||
or exiterr("could not write to lock file");
|
||||
or exiterr("could not write to lock file");
|
||||
print LCK "$arg\n";
|
||||
close(LCK);
|
||||
}
|
||||
@ -680,27 +679,22 @@ sub doprintf {
|
||||
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
|
||||
while (<REPO>) {
|
||||
chomp;
|
||||
my %pkg;
|
||||
if (index($ARGV[1], "%i") >=0 ) {
|
||||
%pkg = parsepackage($_, $dir, $url, 1);
|
||||
} else {
|
||||
%pkg = parsepackage($_, $dir, $url, 0);
|
||||
}
|
||||
if (not $found{$pkg{'name'}}) {
|
||||
if ($filter ne "") {
|
||||
my %pkg = (index($ARGV[1], "%i") >=0 ) ?
|
||||
parsepackage($_, $dir, $url, 1) :
|
||||
parsepackage($_, $dir, $url, 0) ;
|
||||
if (($filter) and not $found{$pkg{'name'}}) {
|
||||
my $match = $pkg{'name'};
|
||||
my $cfilter = $filter;
|
||||
$cfilter =~ s/\*/\.\*/;
|
||||
if ($match =~ /^$cfilter$/) {
|
||||
my $refilter = $filter;
|
||||
$refilter =~ s/\*/\.\*/;
|
||||
if ($match =~ /^$refilter$/) {
|
||||
formattedprint(%pkg);
|
||||
$found{$pkg{'name'}} = 1;
|
||||
}
|
||||
} else {
|
||||
} elsif (not $found{$pkg{'name'}}) {
|
||||
formattedprint(%pkg);
|
||||
$found{$pkg{'name'}} = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
close(REPO);
|
||||
}
|
||||
}
|
||||
@ -724,7 +718,7 @@ sub diff {
|
||||
printf("%-19s %-19s %-19s\n\n","Package","Installed","Available in the repositories");
|
||||
}
|
||||
my $lastcol = ($locked{$pkg{'name'}}) ? "locked" : $pkg{'version'}."-".$pkg{'release'};
|
||||
push @diff, $pkg{'name'};
|
||||
push @diff, $pkg{'name'};
|
||||
print "$pkg{'name'} " if ($format =~ /^quick/);
|
||||
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;
|
||||
($curraction, $aa) = ($cmd =~ /^up/) ? ("updated","-u") : ("installed","");
|
||||
|
||||
|
||||
getinstalled() if (! %installed);
|
||||
foreach my $pkgname(@args) {
|
||||
my %pkg = getpackage($pkgname, 1);
|
||||
|
||||
@ -31,15 +31,19 @@ $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 = sort grep { /^$pkgname\#/ } @dirlist;
|
||||
push(@packages,$hits[-1]) if (@hits);
|
||||
foreach my $name (sort @ARGV) {
|
||||
my @hits = glob("$name#*.pkg.tar.$compress");
|
||||
push(@packages,@hits);
|
||||
}
|
||||
} else {
|
||||
@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;
|
||||
my @validkeys = @dirlist;
|
||||
map { s/\#.*// } @validkeys;
|
||||
@ -68,98 +72,116 @@ pkgreadscripts();
|
||||
|
||||
######################## individual packages ########################
|
||||
sub pkg_single {
|
||||
my ($pname, $dbO, $oname, $pdeps, $desc, $du, $md5, $ppr);
|
||||
my $count = 0; my ($pver, $url, $date); # needed for the html index
|
||||
my ($oR, $oD, $oH, $nR, $nD, $nH, $oline, $oname);
|
||||
my $count = 0; # needed for the html index
|
||||
|
||||
foreach my $db ("PKGREPO", "PKGDEPS", "index.html") {
|
||||
my $firstrun = 0; my $dbNew;
|
||||
my $status = "+ Generating ";
|
||||
if ($db eq "PKGREPO") {
|
||||
$status .= "repository\n";
|
||||
} elsif ($db eq "PKGDEPS") {
|
||||
$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");
|
||||
}
|
||||
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");
|
||||
|
||||
PACKAGE: foreach my $p (sort @packages) {
|
||||
$count++ if ($db eq "index.html");
|
||||
$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");
|
||||
}
|
||||
printheader(1);
|
||||
open ($nH, ">>index.html.new");
|
||||
|
||||
if ($oname lt $pname) {
|
||||
print $dbNew "$dbO\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"));
|
||||
foreach my $mf ("repository", "dependency map", "html index") {
|
||||
print "+ Updating specified entries in $mf\n";
|
||||
}
|
||||
|
||||
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 ########################
|
||||
@ -168,27 +190,18 @@ sub pkg_dir {
|
||||
open (my $iD, ">PKGDEPS");
|
||||
print "+ Generating repository\n";
|
||||
open (my $iR, ">PKGREPO");
|
||||
printheader();
|
||||
printheader(0);
|
||||
my $count = 0;
|
||||
open (my $ih, '>>index.html');
|
||||
foreach my $p (@packages) {
|
||||
while (my $p =shift @packages) {
|
||||
chomp($p);
|
||||
my $date = isotime( (stat($p))[9], 1);
|
||||
$count++;
|
||||
my ($name, $version, $url) = ($p, $p, $p);
|
||||
$name =~ s/\#.*//;
|
||||
$version =~ s/^.*\#//;
|
||||
$version =~ s/\.pkg\.tar\.[gbx]z*//;
|
||||
$url =~ s/\#/\%23/;
|
||||
if (($depends{$name}) and ($depends{$name} ne "")) {
|
||||
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);
|
||||
my ($pver, $url, $du, $md5, $desc, $ppr, $pdeps, $date) = metadata($p);
|
||||
($pdeps eq "") or
|
||||
( (@packages) and ($pname{$p} eq $pname{$packages[0]}) )
|
||||
or printf $iD "%-30s : %-s\n", $pname{$p}, $pdeps;
|
||||
printf $iR "%-s:%-s:%-s:%-s:%-s\n", $p,$du,$md5,$desc,$ppr;
|
||||
htmlrow($ih,$parity{($count % 2)},$pname{$p},$url,$pver,$desc,$date);
|
||||
}
|
||||
close($ih);
|
||||
printfooter($count);
|
||||
@ -212,7 +225,7 @@ run_script() {
|
||||
case "$1" in
|
||||
';
|
||||
|
||||
foreach my $name (sort @dirlist) {
|
||||
foreach my $name (@dirlist) {
|
||||
$name =~ s/\#.*//;
|
||||
if (-f "$path{$name}/README"){
|
||||
print $fR "##### PKGREADME: $name\n";
|
||||
@ -226,8 +239,7 @@ run_script() {
|
||||
open(my $rs, "$path{$name}/${when}-install");
|
||||
while (<$rs>){
|
||||
chomp;
|
||||
print $fS " $_\n"
|
||||
unless (m/^\#(!.*sh|\s*EOF|\s*End)/);
|
||||
(m/^\#(!.*sh|\s*EOF|\s*End)/) or print $fS " $_\n";
|
||||
}
|
||||
close($rs);
|
||||
print $fS " ;;\n";
|
||||
@ -244,7 +256,8 @@ run_script() {
|
||||
######################## html index subs ########################
|
||||
|
||||
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;
|
||||
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN"
|
||||
"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">
|
||||
@ -315,7 +328,7 @@ sub htmlrow {
|
||||
}
|
||||
|
||||
sub printfooter {
|
||||
my $count = $_[0];
|
||||
my $count = shift;
|
||||
open (my $ih, '>>index.html');
|
||||
print $ih " </table>\n";
|
||||
print $ih " <p><b>$count packages</b></p>\n";
|
||||
@ -332,6 +345,20 @@ 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);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user