diff --git a/README b/README index 2b2cfdf..677b098 100644 --- a/README +++ b/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]. diff --git a/scripts/pkg-get.pl b/scripts/pkg-get.pl index 90ac9e9..bdcc9fe 100755 --- a/scripts/pkg-get.pl +++ b/scripts/pkg-get.pl @@ -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 () { - 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 () { 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); diff --git a/scripts/pkg-repgen.pl b/scripts/pkg-repgen.pl index 6b90b6a..858fcf8 100755 --- a/scripts/pkg-repgen.pl +++ b/scripts/pkg-repgen.pl @@ -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/^>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/^) { + 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 < @@ -315,7 +328,7 @@ sub htmlrow { } sub printfooter { - my $count = $_[0]; + my $count = shift; open (my $ih, '>>index.html'); print $ih " \n"; print $ih "

$count packages

\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);