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

pkg-get: change some function signatures

Browse Source 
pkg-repgen: avoid losing metadata in pkg_single()

update TODO and README
This commit is contained in:
John McQuah 2023-06-22 11:10:24 -04:00
parent 252c46d87e
commit 5d700a78e9
4 changed files with 114 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
README
View File

@ -67,8 +67,8 @@ repository and html index are sorted lexographically according to the
current setting for $LANG. When multiple versions of a package are found current setting for $LANG. When multiple versions of a package are found
within the active collections, pkg-get will install the latest version in within the active collections, pkg-get will install the latest version in
the first collection that contains any such package. This behaviour is akin the first collection that contains any such package. This behaviour is akin
to how prt-get handles dups, but with additional logic to account for dups to how prt-get handles dups, but with additional logic to account for
within the same collection. different versions of the built package within the same collection.
'pkg-get depends' and 'prt-get quickdep' do not handle more than one port, 'pkg-get depends' and 'prt-get quickdep' do not handle more than one port,
unlike the corresponding commands in prt-get. Therefore it is not as unlike the corresponding commands in prt-get. Therefore it is not as
@ -77,22 +77,21 @@ before running a 'depinst' operation with multiple targets.
The limitation above would have been mitigated by a --test switch. The limitation above would have been mitigated by a --test switch.
Alas, such a switch is also absent from the design of pkg-get. Use Alas, such a switch is also absent from the design of pkg-get. Use
the --test switch with prt-get itself, for the closest approximation the --test switch with prt-get itself, for the closest preview
of previewing the outcome from a 'pkg-get depinst' operation. of what would happen during a 'pkg-get depinst' operation.
'pkg-get dependent' does not support the --recursive option. Other 'pkg-get dependent' does not support the --recursive option. Other
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
provide these missing commands, consider the script written by user these missing commands, consider the script written by user farkuhar [1].
farkuhar [1].
pkg-get only makes use of the hard dependencies listed by the port pkg-get only makes use of the hard dependencies listed by the port
maintainer, not any of the eager linking that might have occurred on the maintainer, not any of the eager linking that might have occurred on the
build machine. As a result, 'pkg-get depinst foo' might omit some of the build machine. As a result, 'pkg-get depinst $foo' might omit some of the
packages needed by 'foo'. User ppetrov^ has contributed some helper scripts packages needed by $foo. User ppetrov^ has contributed some helper scripts
to facilitate the fixing of these broken binaries; visit the site [2] to to facilitate the fixing of these broken binaries; visit the site [2] to
download them. download them.
@ -104,23 +103,28 @@ operation). You can work around these omissions by avoiding 'depinst'
entirely, and manually performing the desired 'install' transactions (once entirely, and manually performing the desired 'install' transactions (once
you have a clear sense of what the actual runtime dependencies are). you have a clear sense of what the actual runtime dependencies are).
These gaps in pkg-get's design highlight an awkward fact about trying to erect These gaps in pkg-get's design highlight an awkward fact about trying to
an infrastructure for binary package management upon a foundation designed for erect an infrastructure for binary package management upon a foundation
compiling source code (the ports tree). Inheriting the Pkgfile's lack of designed for compiling source code (the ports tree). Inheriting the
separation between build-time and runtime dependencies, pkg-get will unwittingly Pkgfile's lack of separation between build-time and runtime dependencies,
recurse through all the dependencies (in a 'depinst' transaction) and install pkg-get will unwittingly recurse through all the dependencies (in a 'depinst'
packages that you might not really need. Hence the suggestion to consider transaction) and install packages that you might not really need. Hence the
avoiding 'depinst', running only 'install' and the helper script written suggestion to consider avoiding 'depinst'. But pairing 'install' with the
by ppetrov^ [2]. helper script written by ppetrov^ [2] might not be enough to ensure zero
breakage, since revdep does not detect every runtime dependency. In the
end, you might have to manually interpolate between the (maximal) footprint
recommended by 'pkg-get depinst' and the (minimal) footprint recommended by
'revlibpkg' [2].
In handling any new hard dependencies added by the maintainer since In handling any new hard dependencies added by the maintainer since
the previous version of a package, pkg-get performs a sysup in the same the previous version of a package, pkg-get performs a sysup in the same
manner as the original prt-get (i.e., new dependencies are not injected manner as the original prt-get (i.e., new dependencies are not injected
by default). With binary packages there's no need to carry out the by default). With binary packages there's no need to carry out the
installation in any particular order, so the lack of dependency injection is installation in any particular order, so the lack of dependency injection is
actually less of a problem for pkg-get than it was for prt-get. Running actually less of a problem for pkg-get than it was for prt-get. Combining
ppetrov^'s script [2] should help identify the packages you will need to 'pkg-get depends $foo | grep "\[ \]"' with the output of 'revlibpkg $foo'
install to fix any breakage. should help identify the packages you will need to install to fix any
breakage in $foo.
[1] https://git.sdf.org/jmq/Documentation/src/branch/master/scripts/prt-auf [1] https://git.sdf.org/jmq/Documentation/src/branch/master/scripts/prt-auf
[2] https://github.com/slackalaxy/depsck [2] https://github.com/slackalaxy/depsck

10
TODO
View File

@ -8,13 +8,13 @@ TODO file for pkg-get
- allow 'depends' and 'quickdep' to process multiple arguments - allow 'depends' and 'quickdep' to process multiple arguments
- allow 'sysup' to inject new dependencies
- add a --test switch (?)
- let the user control whether pkg-repgen prints the metadata only for the - let the user control whether pkg-repgen prints the metadata only for the
latest built package, or for all the versions in the directory latest built package, or for all the versions in the directory
- add support for aliases (?) - allow 'sysup' to inject new dependencies (?)
- add a --test switch (?)
- add an --ignore switch (?)
- switch from MD5 to a different hash function (?) - switch from MD5 to a different hash function (?)

124
scripts/pkg-get.pl
View File

@ -80,7 +80,7 @@ SWITCH: {
if ($command =~ /^(isinst|current)$/) { current(); last SWITCH; } if ($command =~ /^(isinst|current)$/) { current(); last SWITCH; }
if ($command =~ /^(diff|quickdiff|sysup)$/) { diff($1); last SWITCH; } if ($command =~ /^(diff|quickdiff|sysup)$/) { diff($1); last SWITCH; }
if ($command eq "dup") { dup(); last SWITCH; } if ($command eq "dup") { dup(); last SWITCH; }
if ($command =~ /^(depends|quickdep)$/) { depends(); last SWITCH; } if ($command =~ /^(depends|quickdep)$/) { depends($1); last SWITCH; }
if ($command =~ /^(install|update)$/) { upinst(@ARGV); last SWITCH; } if ($command =~ /^(install|update)$/) { upinst(@ARGV); last SWITCH; }
if ($command eq "dependent") { dependent(); last SWITCH; } if ($command eq "dependent") { dependent(); last SWITCH; }
if ($command eq "depinst") { depinst(); last SWITCH; } if ($command eq "depinst") { depinst(); last SWITCH; }
@ -150,20 +150,19 @@ sub readconfig {
# Populate a hash of locked packages # Populate a hash of locked packages
sub get_locked { sub get_locked {
open (my $fL, $LOCKFILE) or return; open (my $fL, $LOCKFILE) or return;
while (<$fL>) { $locked{$_} = 1; } while (<$fL>) { chomp; $locked{$_} = 1; }
close ($fL); close ($fL);
} }
# Parse a line describing a package # Parse a line describing a package
sub parsepackage { sub parsepackage {
my @p = split(/\:/, $_[0]); my $type=shift; 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 = ( 'name' => $p[0], 'version' => $p[0], 'release' => $p[0] ); my ($N, $V) = ($p[0] =~ m/(.*)\#(.*\.pkg\.tar.*)/) ? ($1, $2) : ("","");
$pkg{'name'} =~ s/\#.*//; ($type ne "light") or return ('name' => $N);
$pkg{'version'} =~ s/.*\#//; my $R = ($V =~ m/^.*-(\w*)\.pkg\.tar.*/) ? $1 : 0;
$pkg{'version'} =~ s/-\w*\.pkg\.tar.*//; $V =~ s/-\w*\.pkg\.tar.*//;
$pkg{'release'} =~ s/^.*-//; my %pkg = ( 'name' => $N, 'version' => $V, 'release' => $R);
$pkg{'release'} =~ s/\.pkg\.tar.*//;
if (not $_[2]) {$_[2] = $_[1]}; if (not $_[2]) {$_[2] = $_[1]};
$pkg{'path'} = $_[1]; $pkg{'path'} = $_[1];
$pkg{'url'} = $_[2]; $pkg{'url'} = $_[2];
@ -178,15 +177,6 @@ sub parsepackage {
return %pkg; return %pkg;
} }
# Parse a line describing a package (just the name)
sub parsepackagelight {
my @p = split(/\:/, $_[0]);
if ($#p < 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")};
my %pkg;
$pkg{'name'} = $1 if ($p[0] =~ m/^(.*)\#/);
return %pkg;
}
# Print info about the given package # Print info about the given package
sub printinfo { sub printinfo {
my %pkg = @_; my %pkg = @_;
@ -233,7 +223,7 @@ sub printreadme {
or exiterr("could not open $pkg{'path'}/PKGREAD"); or exiterr("could not open $pkg{'path'}/PKGREAD");
while (<READ>) { while (<READ>) {
chomp; chomp;
if (($found == 1) and ( /PKGREADME\:/ )) { if ( ($found == 1) and (/PKGREADME\:/) ) {
$finished = 1; $finished = 1;
} elsif ($found == 1) { } elsif ($found == 1) {
print "$_\n"; print "$_\n";
@ -252,11 +242,10 @@ sub printresults {
my $action; my $action;
my $pkg; my $pkg;
my @readme; my @readme;
my $goterror = 0;
if (@donetasks) { if (@donetasks) {
@readme = grep { ($readmetasks{$_}) } @donetasks;
print "\n-- Packages $okaction\n"; print "\n-- Packages $okaction\n";
foreach my $task(@donetasks) { foreach my $task(@donetasks) {
if ($readmetasks{$task}) {push(@readme, $task)}
print "$task" . $pptasks{$task}."\n"; print "$task" . $pptasks{$task}."\n";
} }
} }
@ -280,20 +269,17 @@ sub printresults {
} }
if (@readme) { if (@readme) {
print "\n-- $okaction packages with README file\n"; print "\n-- $okaction packages with README file\n";
foreach my $task(@readme) { print join(", ",@readme);
print "$task" . $pptasks{$task}."\n"; print "\n";
}
}
if(@donetasks and not @failtasks and not $_[0]) {
print "\npkg-get: $okaction successfully\n"
} }
(! @donetasks) or (@failtasks) or ($_[0]) or
print "\npkg-get: $okaction successfully\n";
} }
# Get the list of installed packages # Get the list of installed packages
sub getinstalled { sub getinstalled {
local $/ = ""; # read files paragraph-wise; see ``perldoc perlvar'' local $/ = ""; # read files paragraph-wise; see ``perldoc perlvar''
open(DB, $PKGDB) open(DB, $PKGDB) or exiterr("could not open ".$PKGDB);
or exiterr("could not open ".$PKGDB);
while (<DB>) { while (<DB>) {
my ($name, $version, @files) = split /\n/, $_; my ($name, $version, @files) = split /\n/, $_;
$installed{$name} = $version; $installed{$name} = $version;
@ -346,7 +332,7 @@ sub getpackage {
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 = parsepackage($_, $dir, $url); my %pkg = parsepackage("full",$_, $dir, $url);
next if ($pkg{'name'} ne $pkgname); next if ($pkg{'name'} ne $pkgname);
$found = 1; $found = 1;
push @maybe, join("^", $pkg{'path'}, $pkg{'url'}, push @maybe, join("^", $pkg{'path'}, $pkg{'url'},
@ -439,25 +425,20 @@ sub installpkg {
my $aa = $aargs." "; my $aa = $aargs." ";
if ($pkg{'readme'} eq "yes") {$readmetasks{$pkg{'name'}} = 1}; if ($pkg{'readme'} eq "yes") {$readmetasks{$pkg{'name'}} = 1};
$pptasks{$pkg{'name'}} = ""; $pptasks{$pkg{'name'}} = "";
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." "; if ($install_scripts or $pre_install) {doscript("pre",%pkg);}
(-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";
}
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";
print "pkg-get: /usr/bin/pkgadd $upgrade $aa$fullpath\n"; print "pkg-get: /usr/bin/pkgadd $upgrade $aa$fullpath\n";
system ("/usr/bin/pkgadd $upgrade $aa$fullpath") == 0 or return 0; system ("/usr/bin/pkgadd $upgrade $aa$fullpath") == 0 or return 0;
if ($pkg{'post_install'} eq "yes" and ($install_scripts or $post_install)) {doscript("post",%pkg);} if ($install_scripts or $post_install) {doscript("post",%pkg);}
return 1; return 1;
} }
# Execute pre- or post-install script # Execute pre- or post-install script
sub doscript { sub doscript {
my ($when, %pkg) = @_; my ($when, %pkg) = @_;
($pkg{$when . "_install"} eq "yes") or return;
my $cmd = ($root) ? "chroot $root " : ""; my $cmd = ($root) ? "chroot $root " : "";
$cmd .= "/bin/bash $pkg{'path'}/PKGINST $pkg{'name'} $when"; $cmd .= "/bin/bash $pkg{'path'}/PKGINST $pkg{'name'} $when";
if (system($cmd) == 0) { if (system($cmd) == 0) {
@ -473,8 +454,7 @@ sub doscript {
# No pun intended ########################################################## # No pun intended ##########################################################
sub version { sub version {
print "pkg-get $VERSION "; print "pkg-get $VERSION by Simone Rota <sip\@varlock.com>\n";
print "by Simone Rota <sip\@varlock.com>\n";
} }
# Show brief help ########################################################## # Show brief help ##########################################################
@ -534,7 +514,7 @@ sub info {
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 = parsepackage($_, $dir, $url); my %pkg = parsepackage("full",$_, $dir, $url);
if ($pkg{'name'} eq $arg) { if ($pkg{'name'} eq $arg) {
($type ne "info") or printinfo(%pkg); ($type ne "info") or printinfo(%pkg);
($type ne "readme") or printreadme(%pkg); ($type ne "readme") or printreadme(%pkg);
@ -550,19 +530,20 @@ sub info {
# List packages containing given string (name/description) ################# # List packages containing given string (name/description) #################
sub search { sub search {
my $arg = $ARGV[1]; my $arg = $ARGV[1];
my $type = ($ARGV[0] =~ /^d/) ? "desc" : "name"; my $parsetype = ($ARGV[0] =~ /^d/) ? "full" : "light";
my %found; my %found;
foreach my $repo(@repos) { foreach my $repo(@repos) {
my ($dir, $url) = split(/\|/, $repo); my ($dir, $url) = split(/\|/, $repo);
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 = parsepackage($_, $dir, $url); my %pkg = parsepackage($parsetype,$_, $dir, $url);
next if ($found{$pkg{'name'}}); next if ($found{$pkg{'name'}});
(index($pkg{'name'}, $arg) < 0) or $found{$pkg{'name'}} = 1; (index($pkg{'name'}, $arg) < 0) or $found{$pkg{'name'}} = 1;
(! $found{$pkg{'name'}}) or ($found{$pkg{'name'}}==1) (! $found{$pkg{'name'}}) or ($found{$pkg{'name'}}==1)
or ($type ne "desc") or (index($pkg{'description'}, $arg) < 0) or ($parsetype ne "full")
or $found{$pkg{'name'}} = 1; or (index($pkg{'description'}, $arg) < 0)
or $found{$pkg{'name'}} = 1;
} }
close(REPO); close(REPO);
} }
@ -579,7 +560,7 @@ sub list {
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 = parsepackage($_, $dir, $url); my %pkg = parsepackage("light",$_, $dir, $url);
$found{$pkg{'name'}} = 1; $found{$pkg{'name'}} = 1;
} }
close(REPO); close(REPO);
@ -638,7 +619,7 @@ sub dolock {
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 = parsepackagelight($_); my %pkg = parsepackage("light",$_);
if ($pkg{'name'} eq $arg) { if ($pkg{'name'} eq $arg) {
$found = 1; $found = 1;
open(LCK, ">> $LOCKFILE") open(LCK, ">> $LOCKFILE")
@ -684,7 +665,7 @@ 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 = parsepackage($_, $dir, $url); my %pkg = parsepackage("full",$_, $dir, $url);
next if ($found{$pkg{'name'}}); next if ($found{$pkg{'name'}});
(! $filter) or $filter =~ s/\*/\.\*/; (! $filter) or $filter =~ s/\*/\.\*/;
if (($filter) and ($pkg{'name'} !~ /^$filter$/)) { if (($filter) and ($pkg{'name'} !~ /^$filter$/)) {
@ -727,7 +708,7 @@ sub diff {
my @multip=(); my @multip=();
while (<REPO>) { while (<REPO>) {
chomp; chomp;
my %pkg = parsepackage($_, $dir, $url); my %pkg = parsepackage("full",$_, $dir, $url);
next if ( ($found{$pkg{'name'}}) or (! $installed{$pkg{'name'}}) ); next if ( ($found{$pkg{'name'}}) or (! $installed{$pkg{'name'}}) );
next if ( ($locked{$pkg{'name'}}) and (! $all) ); next if ( ($locked{$pkg{'name'}}) and (! $all) );
my $lastcol = ($locked{$pkg{'name'}}) ? "locked" : ""; my $lastcol = ($locked{$pkg{'name'}}) ? "locked" : "";
@ -740,7 +721,6 @@ sub diff {
while (my $mp = shift @multip) { while (my $mp = shift @multip) {
my ($mpname, $vinst, $mpinfo) = split /\^/, $mp; my ($mpname, $vinst, $mpinfo) = split /\^/, $mp;
next if ( (@multip) and ($multip[0] =~ m/^\Q$mpname\E\^/) ); next if ( (@multip) and ($multip[0] =~ m/^\Q$mpname\E\^/) );
$found{$mpname} = 1; $found{$mpname} = 1;
next if ($mpinfo eq "uptodate"); next if ($mpinfo eq "uptodate");
($format !~ /^(quick|sysup)/) or push @diff, $mpname; ($format !~ /^(quick|sysup)/) or push @diff, $mpname;
@ -769,20 +749,20 @@ sub dup {
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 = parsepackage($_, $dir, $url); my %pkg = parsepackage("full",$_, $dir, $url);
$found{$pkg{'name'}} .= "###" . $pkg{'path'}."/". $pkg{'name'}.$pkg{'version'}."-".$pkg{'release'}; $found{$pkg{'name'}} .= "###$pkg{'path'}/$pkg{'name'}#"
. "$pkg{'version'}-$pkg{'release'}"
. ".pkg.tar.$compress";
} }
close(REPO); close(REPO);
} }
foreach my $key (sort keys %found) { foreach my $key (sort keys %found) {
my $value = $found{$key}; my $value = $found{$key};
$value =~ s/^\#\#\#//; $value =~ s/^\#\#\#//;
if (rindex($value, "###") >=0){ (index($value, "###") > 0) or next;
print "* $key\n"; print "* $key\n";
my @d = split(/\#\#\#/, $value); foreach my $dup(split(/\#\#\#/, $value)) { print " $dup\n"; }
foreach my $dup(@d){ print " $dup\n"; } }
}
}
} }
# Show list of dependencies for package #################################### # Show list of dependencies for package ####################################
@ -790,7 +770,7 @@ sub depends {
my ($j, $checkver) = ($ARGV[0] =~ /^quick/) ? (" ",0) : ("\n",1); my ($j, $checkver) = ($ARGV[0] =~ /^quick/) ? (" ",0) : ("\n",1);
($checkver == 0) or (%installed) or getinstalled(); ($checkver == 0) or (%installed) or getinstalled();
getdependencies($ARGV[1], $checkver, "") or exiterr("package '$ARGV[1]' not found"); getdependencies($ARGV[1], $checkver, "") or exiterr("package '$ARGV[1]' not found");
if ((@dependencies) and ($checkver)) {print "-- dependencies ([i] = installed, [u] = updatable)\n"} (! @dependencies) or (! $checkver) or print "-- dependencies ([i] = installed, [u] = updatable)\n";
print join($j, @dependencies); print join($j, @dependencies);
if ((%missingdeps) and ($j ne " ")) { if ((%missingdeps) and ($j ne " ")) {
print "\n-- missing packages\n"; print "\n-- missing packages\n";
@ -803,8 +783,7 @@ sub depends {
# Show packages directly depending from given package ###################### # Show packages directly depending from given package ######################
sub dependent { sub dependent {
my $arg = $ARGV[1]; my $arg = $ARGV[1]; my %dp;
my %dp;
getinstalled() unless (($all) or (%installed)); getinstalled() unless (($all) or (%installed));
foreach my $repo(@repos) { foreach my $repo(@repos) {
my ($dir, $url) = split(/\|/, $repo); my ($dir, $url) = split(/\|/, $repo);
@ -832,18 +811,31 @@ 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","");
if ($root) {
foreach my $repo(@repos) {
my ($dir, $url) = split(/\|/, $repo);
open(my $host, "$dir/PKGINST") or next;
open(my $mount, ">$root$dir/PKGINST");
while (<$host>) { print $mount $_; }
close($mount);
close($host);
}
}
getinstalled() if (! %installed); getinstalled() if (! %installed);
foreach my $pkgname(@args) { foreach my $pkgname(@args) {
my %pkg = getpackage($pkgname); my %pkg = getpackage($pkgname); my $failed=0;
if (not %pkg) { if (not %pkg) {
push(@failtasks, "not found,$pkgname"); push(@failtasks, "not found,$pkgname");
} elsif ( ($cmd . getshortstatus(%pkg)) } elsif ( ($cmd . getshortstatus(%pkg))
=~ /^(update.i|update. |install.u|install.i)/ ) { =~ /^(update.i|update. |install.u|install.i)/ ) {
push(@prevtasks, "$pkgname"); push(@prevtasks, "$pkgname");
} elsif (downloadpkg(%pkg) and installpkg($aa, %pkg)) { } elsif (downloadpkg(%pkg)) {
push(@donetasks, $pkgname); ($download_only) or installpkg($aa, %pkg) or $failed=1;
($failed == 1) ? push(@failtasks, "where $cmd failed,$pkgname")
: push(@donetasks, $pkgname);
} else { } else {
push(@failtasks, "where $cmd failed,$pkgname"); push(@failtasks, "where download failed,$pkgname");
} }
} }
printresults(); printresults();

36
scripts/pkg-repgen.pl
View File

@ -36,7 +36,6 @@ if ($#ARGV >= 0) { # single packages
foreach my $name (sort @ARGV) { foreach my $name (sort @ARGV) {
my @hits = glob("$name#*.pkg.tar.$compress"); my @hits = glob("$name#*.pkg.tar.$compress");
push(@packages,@hits); push(@packages,@hits);
$isDup{$name} = 1 if ($#hits > 0);
} }
} else { } else {
@packages = @dirlist; @packages = @dirlist;
@ -48,7 +47,7 @@ our %pname = map { $_ => $_ } @packages;
foreach my $p (@packages) { $pname{$p} =~ s/\#.*//; } foreach my $p (@packages) { $pname{$p} =~ s/\#.*//; }
# ... or to look up the successor when merging old metadata files # ... or to look up the successor when merging old metadata files
my %followR; my %followH; my @queue = @packages; my %followR; my %followH; my %followD; my @queue = @packages;
while (my $q = shift @queue) { while (my $q = shift @queue) {
($#queue < 0) or ($pname{$q} ne $pname{$queue[0]}) or $isDup{$q} = 1; ($#queue < 0) or ($pname{$q} ne $pname{$queue[0]}) or $isDup{$q} = 1;
} }
@ -99,17 +98,18 @@ sub pkg_single {
print "+ Updating specified entries in $mf\n"; print "+ Updating specified entries in $mf\n";
} }
while (my $p =shift @packages) { PACKAGE: while (my $p =shift @packages) {
my ($pver, $url, $du, $md5, $desc, $ppr, $pdeps, $date) = metadata($p); my ($pver, $url, $du, $md5, $desc, $ppr, $pdeps, $date) = metadata($p);
($firstrun{"PKGREPO"}==0) or printf $nR "%-s:%-s:%-s:%-s:%-s\n", ($firstrun{"PKGREPO"}==0) or printf $nR "%-s:%-s:%-s:%-s:%-s\n",
$p, $du, $md5, $desc, $ppr; $p, $du, $md5, $desc, $ppr;
($firstrun{"PKGDEPS"}==0) or ($pdeps eq "") ($firstrun{"PKGDEPS"}==0) or ($pdeps eq "") or ($isDup{$p})
or printf $nD "%-30s : %-s\n", $pname{$p}, $pdeps; or printf $nD "%-30s : %-s\n", $pname{$p}, $pdeps;
if ($firstrun{"index.html"} == 1) { if ($firstrun{"index.html"} == 1) {
$count++; $count++;
htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date); 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 # Pop entries from the old repository until we reach an entry
# that would come after the current package. # that would come after the current package.
@ -131,6 +131,10 @@ sub pkg_single {
last if ($oname ge $pname{$p}); 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 # Likewise for the html index
while ( ($firstrun{"index.html"}==0) and $oline=<$oH> ) { while ( ($firstrun{"index.html"}==0) and $oline=<$oH> ) {
chomp($oline); chomp($oline);
@ -149,8 +153,13 @@ sub pkg_single {
last if ($oname ge $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 # Likewise for the dependency map, but avoid creating duplicate entries
while ($firstrun{"PKGDEPS"}==0 and $oline = <$oD>) { while ( ($firstrun{"PKGDEPS"}==0) and $oline = <$oD> ) {
chomp($oline); $oname = $oline; chomp($oline); $oname = $oline;
$oname =~ s/\s*\:.*//; $oname =~ s/\s*\:.*//;
if ($oname lt $pname{$p}) { if ($oname lt $pname{$p}) {
@ -158,19 +167,26 @@ sub pkg_single {
} elsif ( ($pdeps ne "") and (! $isDup{$p}) ) { } elsif ( ($pdeps ne "") and (! $isDup{$p}) ) {
printf $nD "%-30s : %-s\n", $pname{$p}, $pdeps; printf $nD "%-30s : %-s\n", $pname{$p}, $pdeps;
} }
printf $nD "$oline\n" if ($oname gt $pname{$p}); if ($oname gt $pname{$p}) {
$followD{$pname{$p}} = $oline;
print $nD "$oline\n";
}
last if ($oname ge $pname{$p}); 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 # after reaching the last in a sequence of dups, copy the
# successor line from the old {html index, repository} # successor line from the old {html index, repository}
if ( (! $isDup{$p}) and ($isDup{$pname{$p}}) and ($followH{$pname{$p}}) ) { if ( (! $isDup{$p}) and ($followH{$pname{$p}}) ) {
$count++; $count++;
$followH{$pname{$p}} =~ s/class="(even|odd)"/class="$parity{($count %2)}"/; $followH{$pname{$p}} =~ s/class="(even|odd)"/class="$parity{($count %2)}"/;
print $nH $followH{$pname{$p}}; print $nH $followH{$pname{$p}};
} }
($isDup{$p}) or (! $isDup{$pname{$p}}) or (! $followR{$pname{$p}}) ($isDup{$p}) or (! $followR{$pname{$p}}) or print $nR $followR{$pname{$p}};
or print $nR $followR{$pname{$p}};
# Restart the loop with the next package in the queue # Restart the loop with the next package in the queue
} }
@ -238,7 +254,7 @@ run_script() {
my %seen; my %seen;
foreach my $name (@dirlist) { foreach my $name (@dirlist) {
$name =~ s/\#.*//; next if ($seen{$name}); $name =~ s/\#.*//; next if ($seen{$name});
$seen{$name} = 1; $seen{$name} = 1;
if (-f "$path{$name}/README"){ if (-f "$path{$name}/README"){
print $fR "##### PKGREADME: $name\n"; print $fR "##### PKGREADME: $name\n";
open(my $readme, "$path{$name}/README"); open(my $readme, "$path{$name}/README");