prt-auf: clean up whitespace; improve documentation

This commit is contained in:
John McQuah 2023-06-15 18:37:53 -04:00
parent b690906b27
commit c2583c3642
2 changed files with 359 additions and 340 deletions

View File

@ -473,11 +473,21 @@ note that \-d is already passed to pkgmk anyway.
Pass these additional arguments to pkgadd
.TP
.B \-\-install\-root="...", e.g. \-\-install\-root="/mnt"
.B \-\-install\-root=<dir>, e.g. \-\-install\-root="/mnt"
Specify a mountpoint other than "/", where the built packages are to be
installed. This setting affects the package database that is subject to
read/write operations, but not the ports tree (which remains governed by
the prtdir directives in \fBprt-get.conf(5)\fP).
.TP
Beware of combining this option with the directive 'runscripts yes' in
the configuration file. One side-effect of the naive attempt to reconcile
this combination is that \fBprt\-auf\fP copies the pre- or
post-install scripts into the ports tree under <dir>, before running
a \fBchroot(1)\fP command to launch the scripts. This workaround might
inadvertently pollute <dir> with unwanted files, if the mountpoint did not
already contain a copy of the ports tree. It is safer to set 'runscripts
no' in the configuration file, whenever you plan to use an alternate root
for installations.
.TP
.B \-\-cache

View File

@ -41,16 +41,16 @@ my @basedirs = @{$bldirs[0]}; my @localports = @{$bldirs[1]};
get_locked_and_aliased();
if (($action !~ /^(fsearch|isinst|current)$/) and ($osearch{cache}==0)) {
@allports = list_ports();
fill_hashes_from_pkgfiles();
@allports = list_ports();
fill_hashes_from_pkgfiles();
}
if ($osearch{cache}==1) { fill_hashes_from_cache(); }
if ($action !~ /^(search|dsearch|fsearch|info|dup|ls|readme|cat)$/) {
open (DB, "$altroot$pkgdb") or die "Could not open package database!\n";
local $/="";
while (<DB>) { $V_INST{$1} = $2 if m/^(.*)\n(.*)\n/; }
close (DB);
open (DB, "$altroot$pkgdb") or die "Could not open package database!\n";
local $/="";
while (<DB>) { $V_INST{$1} = $2 if m/^(.*)\n(.*)\n/; }
close (DB);
}
############## Branch based on the requested action #################
@ -60,11 +60,11 @@ if ($action eq "path") { @results = find_port_by_name($query[0],1,1,0);
} elsif ($action eq "fsearch") { $hh = find_port_by_file(".footprint", @query);
} elsif ($action eq "dsearch") { @results = find_port_by_desc(@query);
} elsif ($action eq "info") { $portpath = find_port_by_name(@query,1,1,0);
@results = get_pkgfile_fields($portpath,"all") if ($portpath);
@results = get_pkgfile_fields($portpath,"all") if ($portpath);
} elsif ($action eq "cache") { printf_ports("CACHE",@allports);
} elsif ($action eq "printf") { @results = ($osearch{filter}) ?
find_port_by_name($osearch{filter},0,1,1) : @allports;
printf_ports($query[0],@results);
find_port_by_name($osearch{filter},0,1,1) : @allports;
printf_ports($query[0],@results);
} elsif ($action eq "lock") { port_lock(@query);
} elsif ($action eq "unlock") { port_unlock(@query);
} elsif ($action eq "ls") { port_ls(@query);
@ -83,192 +83,200 @@ if ($action eq "path") { @results = find_port_by_name($query[0],1,1,0);
#################### Post-transaction reports #######################
$strf = "%s\n";
if (($action =~ /^(listinst|listorphans|dependent)/) and
($odepends{tree}==0)) {
foreach my $result (sort @results) {
$result = ($osearch{verbose}==1) ? " $result: $V_INST{$result}" : " $result";
$result = ($osearch{verbose}>1) ? " $result: $V_INST{$result}\n$DESC{$result}\n" : $result;
printf $strf, $result;
}
if (($action =~ /^(listinst|listorphans|dependent)/)
and ($odepends{tree}==0)) {
foreach my $result (sort @results) {
$result = ($osearch{verbose}==1) ? " $result: $V_INST{$result}" : " $result";
$result = ($osearch{verbose}>1) ? " $result: $V_INST{$result}\n$DESC{$result}\n" : $result;
printf $strf, $result;
}
} elsif ($action =~ /^(list|search|dsearch|path)/) {
foreach my $result (@results) {
next if ((! $result) or ($result =~ /^\s*$/));
$result =~ s/.*\/(.*)$/$1/ if (($action ne "path") and ($osearch{path}==0));
$result .= " $V_REPO{$result}" if (($osearch{verbose}==1) and ($action ne "path"));
$result .= " $V_REPO{$result}\n$DESC{$result}\n" if (($osearch{verbose}>1) and ($action ne "path"));
printf $strf, $result;
}
foreach my $result (@results) {
next if ((! $result) or ($result =~ /^\s*$/));
$result =~ s/.*\/(.*)$/$1/ if (($action ne "path") and ($osearch{path}==0));
$result .= " $V_REPO{$result}" if (($osearch{verbose}==1) and ($action ne "path"));
$result .= " $V_REPO{$result}\n$DESC{$result}\n" if (($osearch{verbose}>1) and ($action ne "path"));
printf $strf, $result;
}
} elsif ($action =~ /^(fsearch)/) {
my %hits = %{$hh}; $strf = "%20s %s\n"; my @fmatch;
printf $strf, "Found in", "Matching File";
foreach my $fh (keys %hits) {
chomp($hits{$fh});
@fmatch = split /\s/, $hits{$fh};
foreach my $fileN (@fmatch) { printf $strf, $fh, $fileN; }
}
my %hits = %{$hh}; $strf = "%20s %s\n"; my @fmatch;
printf $strf, "Found in", "Matching File";
foreach my $fh (keys %hits) {
chomp($hits{$fh});
@fmatch = split /\s/, $hits{$fh};
foreach my $fileN (@fmatch) { printf $strf, $fh, $fileN; }
}
} elsif ($action =~ /^(current|isinst|dup|diff|quickdiff)$/) {
my $format = "%20s %15s %20s\n"; my $ind = shift(@results);
if ($action eq "diff") {
if ($#results > 0) {
printf $format, "Port", "Installed", "Available in Repo"
} else { print "No differences found\n" }
}
foreach (@results) {
if ($action =~ /^(current|isinst)$/) { print "$_\n"; next; }
my ($diffN, $diffI, $diffR) = split / /;
next if (($osearch{filter}) and ($diffN !~ /$osearch{filter}/));
next if (($LOCKED{$diffN}) and ($odepends{all}==0));
$diffR = ($LOCKED{$diffN}) ? "LOCKED" : $diffR;
printf "$format", $diffN, $diffI, $diffR if ($action eq "diff");
printf "%s ", $diffN if ($action eq "quickdiff");
}
print "\n" if ($action eq "quickdiff");
exit $ind;
my $format = "%20s %15s %20s\n"; my $ind = shift(@results);
if ($action eq "diff") {
if ($#results > 0) {
printf $format, "Port", "Installed", "Available in Repo"
} else { print "No differences found\n" }
}
foreach (@results) {
if ($action =~ /^(current|isinst)$/) { print "$_\n"; next; }
my ($diffN, $diffI, $diffR) = split / /;
next if (($osearch{filter}) and ($diffN !~ /$osearch{filter}/));
next if (($LOCKED{$diffN}) and ($odepends{all}==0));
$diffR = ($LOCKED{$diffN}) ? "LOCKED" : $diffR;
printf "$format", $diffN, $diffI, $diffR if ($action eq "diff");
printf "%s ", $diffN if ($action eq "quickdiff");
}
print "\n" if ($action eq "quickdiff");
exit $ind;
} elsif ($action =~ /^(depends|quickdep)$/) {
print "-- dependency list ([i] = installed)\n" if ($action =~ /^dep/);
my $strf="%3s %s\n"; my $dep; my $missing=0;
foreach $dep (@results) {
if ($dep =~ /MISSING/) { $missing=1; print "-- missing packages\n"; next; }
if (! $dep) { next; }
if ($action ne "quickdep") {
$ind = (grep { $_ eq $dep } keys %V_INST) ? "[i]" : "[ ]";
$dep .= " $V_REPO{$dep}" if ($osearch{verbose}==1);
$dep .= " $V_REPO{$dep}\n$DESC{$dep}" if ($osearch{verbose}>1);
}
printf $strf, $ind, $dep unless ($action eq "quickdep");
printf "%s ", $dep if ($action eq "quickdep");
}
print "\n" if ($action eq "quickdep");
print "-- dependency list ([i] = installed)\n" if ($action =~ /^dep/);
my $strf="%3s %s\n"; my $dep; my $missing=0;
foreach $dep (@results) {
if ($dep =~ /MISSING/) {
$missing=1; print "-- missing packages\n"; next;
}
next if (! $dep);
if ($action ne "quickdep") {
$ind = (grep { $_ eq $dep } keys %V_INST) ? "[i]" : "[ ]";
$dep .= " $V_REPO{$dep}" if ($osearch{verbose}==1);
$dep .= " $V_REPO{$dep}\n$DESC{$dep}" if ($osearch{verbose}>1);
}
printf $strf, $ind, $dep unless ($action eq "quickdep");
printf "%s ", $dep if ($action eq "quickdep");
}
print "\n" if ($action eq "quickdep");
} elsif ($action eq "info") {
$strf = "%14s: %-s\n";
exit 1 if ($#results < 0);
my @fields = ("Name", "Repository", "Version", "Release", "Description",
"Dependencies", "URL", "Optional Deps", "Maintainer",
"Readme", "PreInstall", "PostInstall");
for (my $i=0; $i<9; $i++) { printf $strf, $fields[$i], $results[$i] unless ($results[$i] =~ /^\s*$/); }
$strf = "%14s: %-s\n";
exit 1 if ($#results < 0);
my @fields = ("Name", "Repository", "Version", "Release", "Description",
"Dependencies", "URL", "Optional Deps", "Maintainer",
"Readme", "PreInstall", "PostInstall");
for (my $i=0; $i<9; $i++) {
printf $strf, $fields[$i], $results[$i]
unless ($results[$i] =~ /^\s*$/);
}
} elsif ($action eq "remove") {
my @removed = @$ind;
print "Ports removed:\n" if (@removed);
foreach my $p (@removed) { print "$p\n"; }
my @removed = @$ind;
print "Ports removed:\n" if (@removed);
foreach my $p (@removed) { print "$p\n"; }
} elsif ($action =~ /^(install|sysup)$/) {
my @ok = @{$results[0]}; my %ok_pre = %{$results[1]}; my %ok_post = %{$results[2]};
my @ok_readme = @{$results[3]}; my @not_ok = @{$results[4]}; my $note;
if ($opkg{test} eq "yes") { print "\n$action successful.\n";
print "*** prt-auf: test mode end\n\n"; }
if (($opkg{test} eq "no") and (@ok)) {
print "Successful ports:\n";
foreach my $k (@ok) {
$note = ($ok_pre{$k}) ? " pre: ok. " : "";
$note .= ($ok_post{$k}) ? " post: ok. " : "";
$note = ( grep /(pre|post):/, $note ) ? "($note)" : "";
print " $k $note\n";
}
print "\n";
}
if (@ok_readme) {
print "Ports with README files:\n";
foreach (@ok_readme) { print " $_\n"; }
print "\n";
}
if (@not_ok) {
print "Ports with pkgmk/pkgadd failures:\n";
foreach (@not_ok) { print " $_\n"; }
print "\n";
}
} else {}
my @ok = @{$results[0]}; my %ok_pre = %{$results[1]};
my %ok_post = %{$results[2]}; my @ok_readme = @{$results[3]};
my @not_ok = @{$results[4]}; my $note;
if ($opkg{test} eq "yes") {
print "\n$action successful.\n";
print "*** prt-auf: test mode end\n\n";
}
if (($opkg{test} eq "no") and (@ok)) {
print "Successful ports:\n";
foreach my $k (@ok) {
$note = ($ok_pre{$k}) ? " pre: ok. " : "";
$note .= ($ok_post{$k}) ? " post: ok. " : "";
$note = ( grep /(pre|post):/, $note ) ? "($note)" : "";
print " $k $note\n";
}
print "\n";
}
if (@ok_readme) {
print "Ports with README files:\n";
foreach (@ok_readme) { print " $_\n"; }
print "\n";
}
if (@not_ok) {
print "Ports with pkgmk/pkgadd failures:\n";
foreach (@not_ok) { print " $_\n"; }
print "\n";
}
}
# Done!
#################### Begin Subroutines #######################
sub parse_args {
my @query;
while (my $arg = shift) {
if ($arg =~ /^(search|dsearch|fsearch|path|info|list|remove)$/) { $action = $1;
} elsif ($arg =~ /^(install|update|depinst)$/) { $action = "install";
} elsif ($arg eq "sysup") { $action = "sysup"; $opkg{nolock}=0;
} elsif ($arg eq "grpinst") { $action = "install"; $opkg{group} = "yes";
print "Warning: grpinst is obsolescent, using install --group\n";
} elsif ($arg =~ /^(lock|unlock|listlocked|current|isinst)$/) { $action = $1;
} elsif ($arg =~ /^(diff|quickdiff|printf|listinst|listorphans)$/) {
$action = $1; $odepends{tree} = 0;
} elsif ($arg =~ /^(depends|quickdep|dup|dependent)$/) { $action = $1;
} elsif ($arg eq "deptree") { $action = $arg; $odepends{tree} = 1;
} elsif ($arg =~ /^(readme|cat|edit|ls|help|version|cache)$/) { $action = $1;
} elsif ($arg eq "--tree") { $odepends{tree} = 1;
} elsif ($arg eq "--all") { $odepends{all} = 1;
} elsif ($arg eq "--nodeps") { $odepends{inject} = 0;
} elsif ($arg eq "--depsort") { $odepends{inject} = 1;
} elsif ($arg eq "--softdeps") { $odepends{soft} = 1;
} elsif ($arg eq "--recursive") { $odepends{recursive} = 1;
} elsif ($arg eq "--cache") { $osearch{cache} = 1;
} elsif ($arg =~ /^--config=(.+)$/) { $prtconf = $1;
} elsif ($arg eq "--path") { $osearch{path} = 1;
} elsif ($arg eq "--regex") { $osearch{regex} = 1;
} elsif ($arg =~ /^--filter=(.+)/) { $osearch{filter} = $1;
} elsif ($arg eq "-v") { $osearch{verbose} += 1;
} elsif ($arg eq "-vv") { $osearch{verbose} += 2;
} elsif ($arg eq "--test") { $opkg{test} = "yes";
} elsif ($arg eq "--group") { $opkg{group} = "yes";
} elsif ($arg eq "-fr") { $opkg{margs} .= " -f"; $odepends{inject} = 0;
} elsif ($arg eq "-fi") { $opkg{aargs} .= " -f";
} elsif ($arg =~ /^(-uf|-if|-us|-is|-ns|-kw)$/) { $opkg{margs} .= " $1";
} elsif ($arg =~ /^--margs=(.+)/) { $opkg{margs} .= $1;
} elsif ($arg =~ /^--install-root=(.+)$/) { $altroot=$1;
} elsif ($arg =~ /^--aargs=(-r|--root)=(.+)/) { $altroot=$2;
} elsif ($arg =~ /^--rargs=(-r|--root)=(.+)/) { $altroot=$2;
} elsif ($arg =~ /^--aargs=(.+)/) { $opkg{aargs} .= " $1";
} elsif ($arg =~ /^--rargs=(.+)/) { $opkg{rargs} .= " $1";
} elsif ($arg =~ /^-/) {
print "'$arg' is not a recognized option.\n";
} else { push (@query, $arg); }
}
if (! $action) { print_help(); }
if (($#query > -1) and
($action =~ /^(diff|quickdiff|cache|list|sysup)/)) {
print "warning: $1 takes no arguments; ignoring those given.\n";
}
if (($#query > 0) and
($action =~ /^(search|dsearch|fsearch|info|readme|path|ls)$/)) {
print "warning: $1 takes only one argument; ignoring all but the first.\n";
}
if ((! @query) and
($action =~ /^(search|dsearch|fsearch|info|readme|path|ls)$/)) {
print "$1 requires an argument.\n"; exit 1;
}
if (($#query != 0) and
($action =~ /^(deptree|dependent)$/)) {
print "$1 requires exactly one argument.\n"; exit 1;
}
if (($#query < 0) and
($action =~ /^(install|update|depinst|remove)$/)) {
print "$1 requires at least one argument.\n"; exit 1;
}
return $action, @query;
my @query;
while (my $arg = shift) {
if ($arg =~ /^(search|dsearch|fsearch|path|info|list|remove)$/) { $action = $1;
} elsif ($arg =~ /^(install|update|depinst)$/) { $action = "install";
} elsif ($arg eq "sysup") { $action = "sysup"; $opkg{nolock}=0;
} elsif ($arg eq "grpinst") { $action = "install"; $opkg{group} = "yes";
print "Warning: grpinst is obsolescent, using install --group\n";
} elsif ($arg =~ /^(lock|unlock|listlocked|current|isinst)$/) { $action = $1;
} elsif ($arg =~ /^(diff|quickdiff|printf|listinst|listorphans)$/) {
$action = $1; $odepends{tree} = 0;
} elsif ($arg =~ /^(depends|quickdep|dup|dependent)$/) { $action = $1;
} elsif ($arg eq "deptree") { $action = $arg; $odepends{tree} = 1;
} elsif ($arg =~ /^(readme|cat|edit|ls|help|version|cache)$/) { $action = $1;
} elsif ($arg eq "--tree") { $odepends{tree} = 1;
} elsif ($arg eq "--all") { $odepends{all} = 1;
} elsif ($arg eq "--nodeps") { $odepends{inject} = 0;
} elsif ($arg eq "--depsort") { $odepends{inject} = 1;
} elsif ($arg eq "--softdeps") { $odepends{soft} = 1;
} elsif ($arg eq "--recursive") { $odepends{recursive} = 1;
} elsif ($arg eq "--cache") { $osearch{cache} = 1;
} elsif ($arg =~ /^--config=(.+)$/) { $prtconf = $1;
} elsif ($arg eq "--path") { $osearch{path} = 1;
} elsif ($arg eq "--regex") { $osearch{regex} = 1;
} elsif ($arg =~ /^--filter=(.+)/) { $osearch{filter} = $1;
} elsif ($arg eq "-v") { $osearch{verbose} += 1;
} elsif ($arg eq "-vv") { $osearch{verbose} += 2;
} elsif ($arg eq "--test") { $opkg{test} = "yes";
} elsif ($arg eq "--group") { $opkg{group} = "yes";
} elsif ($arg eq "-fr") { $opkg{margs} .= " -f"; $odepends{inject} = 0;
} elsif ($arg eq "-fi") { $opkg{aargs} .= " -f";
} elsif ($arg =~ /^(-uf|-if|-us|-is|-ns|-kw)$/) { $opkg{margs} .= " $1";
} elsif ($arg =~ /^--margs=(.+)/) { $opkg{margs} .= $1;
} elsif ($arg =~ /^--install-root=(.+)$/) { $altroot=$1;
} elsif ($arg =~ /^--aargs=(-r|--root)=(.+)/) { $altroot=$2;
} elsif ($arg =~ /^--rargs=(-r|--root)=(.+)/) { $altroot=$2;
} elsif ($arg =~ /^--aargs=(.+)/) { $opkg{aargs} .= " $1";
} elsif ($arg =~ /^--rargs=(.+)/) { $opkg{rargs} .= " $1";
} elsif ($arg =~ /^-/) {
print "'$arg' is not a recognized option.\n";
} else { push (@query, $arg); }
}
if (! $action) { print_help(); }
if (($#query > -1) and
($action =~ /^(diff|quickdiff|cache|list|sysup)/)) {
print "warning: $1 takes no arguments; ignoring those given.\n";
}
if (($#query > 0) and
($action =~ /^(search|dsearch|fsearch|info|readme|path|ls)$/)) {
print "warning: $1 takes only one argument; ignoring all but the first.\n";
}
if ((! @query) and
($action =~ /^(search|dsearch|fsearch|info|readme|path|ls)$/)) {
print "$1 requires an argument.\n"; exit 1;
}
if (($#query != 0) and
($action =~ /^(deptree|dependent)$/)) {
print "$1 requires exactly one argument.\n"; exit 1;
}
if (($#query < 0) and
($action =~ /^(install|update|depinst|remove)$/)) {
print "$1 requires at least one argument.\n"; exit 1;
}
return $action, @query;
}
sub parse_prt_conf {
my @basedirs; my @localports; my $conf = shift;
my @basedirs; my @localports; my $conf = shift;
open(PORTS, $conf) or die "could not open $conf";
while (<PORTS>) { chomp;
if ( /^prtdir\s+/ ) {
my $line = $_;
$line =~ s/^prtdir\s+//; #remove the leading directive
$line =~ s/#.*$//; #strip inline comments like this one
$line =~ s/\s+//g; #collapse all whitespace, even if in a path!
if ( $line !~ /:/ ) {
push @basedirs, $line if (-d $line);
} else {
my @a = split(/:/, $line);
my @b = split(/,/, $a[1]);
while ( my $c = pop @b ) {
my $port = $a[0] . "/" . $c;
push @localports, $port if (-d $port);
}
}
}
$opkg{runscripts} = $1 if /^runscripts\s+(yes|no)/;
$opkg{makecommand} = $1 if /^makecommand\s+(.*)(#|$)/;
open(PORTS, $conf) or die "could not open $conf";
while (<PORTS>) { chomp;
if ( /^prtdir\s+/ ) {
my $line = $_;
$line =~ s/^prtdir\s+//; #remove the leading directive
$line =~ s/#.*$//; #strip inline comments like this one
$line =~ s/\s+//g; #collapse all whitespace, even if in a path!
if ( $line !~ /:/ ) {
push @basedirs, $line if (-d $line);
} else {
my @a = split(/:/, $line);
my @b = split(/,/, $a[1]);
while ( my $c = pop @b ) {
my $port = $a[0] . "/" . $c;
push @localports, $port if (-d $port);
}
}
}
$opkg{runscripts} = $1 if /^runscripts\s+(yes|no)/;
$opkg{makecommand} = $1 if /^makecommand\s+(.*)(#|$)/;
$opkg{addcommand} = $1 if /^addcommand\s+(.*)(#|$)/;
$opkg{removecommand} = $1 if /^removecommand\s+(.*)(#|$)/;
$olog{write} = $1 if /^writelog\s+(enabled|disabled)/;
@ -286,7 +294,7 @@ sub find_dups {
foreach my $pp (@allports) { my $pn = (split /\//, $pp)[-1]; $seen{$pn}++; }
my @dups = grep { $seen{$_} > 1 } keys %seen;
my %subscripts = ( "%n"=>0, "%p1"=>1, "%v1"=>2, "%u1"=>3, "%M1"=>4,
"%p2"=>5, "%v2"=>6, "%u2"=>7, "%M2"=>8 );
"%p2"=>5, "%v2"=>6, "%u2"=>7, "%M2"=>8 );
if (($osearch{verbose}==0) and (! $format)) {
foreach my $dup (@dups) { print "$dup\n"; }
} elsif (($osearch{verbose}>0) and (! $format)) {
@ -298,12 +306,13 @@ sub find_dups {
} else { # the user has given us a format string; let's respect it
foreach my $dup (@dups) {
@hits = grep /\/$dup$/, @allports;
@dupinfo = (get_pkgfile_fields($hits[0],"all"))[1,2,6,8];
@info1 = (get_pkgfile_fields($hits[1],"all"))[1,2,6,8];
push(@dupinfo,@info1); unshift(@dupinfo,$dup);
$dupstr = "$format\n";
$dupstr =~ s/(%n|%p1|%v1|%u1|%M1|%p2|%v2|%u2|%M2)/$dupinfo[$subscripts{$1}]/g;
print $dupstr;
@dupinfo = (get_pkgfile_fields($hits[0],"all"))[1,2,6,8];
@info1 = (get_pkgfile_fields($hits[1],"all"))[1,2,6,8];
push(@dupinfo,@info1); unshift(@dupinfo,$dup);
$dupstr = "$format\n";
$dupstr =~
s/(%n|%p1|%v1|%u1|%M1|%p2|%v2|%u2|%M2)/$dupinfo[$subscripts{$1}]/g;
print $dupstr;
}
}
return 1+$#dups;
@ -331,9 +340,9 @@ sub who_aliased_to {
}
sub printf_ports {
my $FS; my @pstats; my $p; my $inputf=shift; my @targets=@_;
my @pstats; my $p; my $inputf=shift; my @targets=@_;
my @pos; my @outfields; my $outputf; my %FS = ( "t"=>"\t", "n"=>"\n" );
my %subscripts = ( "n"=>0, "p"=>1, "v"=>2, "r"=>3, "d"=>4, "u"=>5,
my %subscripts = ( "n"=>0, "p"=>1, "v"=>2, "r"=>3, "d"=>4, "e"=>5, "u"=>6,
"P"=>7, "M"=>8, "R"=>9, "E"=>10, "O"=>11, "l"=>12, "i"=>13);
if ($inputf eq "CACHE") {
open (CACHE,'>',$prtcache) or die "cannot create a new cache file";
@ -343,7 +352,7 @@ sub printf_ports {
$p = (split /\//, $pp)[-1]; next if ($cached{$p});
@pstats = get_pkgfile_fields($pp,"all");
printf CACHE "%s\n"x($#pstats+1), @pstats;
printf CACHE "\n"; $cached{$p}=1;
printf CACHE "\n"; $cached{$p}=1;
} close (CACHE);
print "cache created.\n";
} else {
@ -352,20 +361,20 @@ sub printf_ports {
foreach (@outfields) {
if (m/\\(t|n)/) { $outputf .= $FS{$1}; next; }
$strf = $_;
s/%(p|n|v|r|d|u|P|M|R|E|O|l|i)/_Z_$subscripts{$1}/g;
push @pos, grep { s/([0-9]+)(.*)/$1/ } (split /_Z_/, $_);
$strf =~ s/%(p|n|v|r|d|u|P|M|R|E|O|l|i)/%s/g;
$outputf .= $strf;
}
s/%(p|n|v|r|d|e|u|P|M|R|E|O|l|i)/_Z_$subscripts{$1}/g;
push @pos, grep { s/([0-9]+)(.*)/$1/ } (split /_Z_/, $_);
$strf =~ s/%(p|n|v|r|d|e|u|P|M|R|E|O|l|i)/%s/g;
$outputf .= $strf;
}
foreach my $pp (@targets) {
$p = (split /\//, $pp)[-1];
@pstats = get_pkgfile_fields($pp,"all");
$pstats[12] = ($LOCKED{$p}) ? "yes" : "no";
$pstats[13] = (grep /^$p$/, keys %V_INST) ? "yes" : "no";
if (($pstats[13] eq "yes") and ($V_INST{$p} ne $V_REPO{$p})) {
$pstats[13] = "diff" }
printf STDOUT $outputf, @pstats[@pos];
@pstats = get_pkgfile_fields($pp,"all");
$pstats[12] = ($LOCKED{$p}) ? "yes" : "no";
$pstats[13] = (grep /^$p$/, keys %V_INST) ? "yes" : "no";
$pstats[13] = "diff"
if (($pstats[13] eq "yes") and ($V_INST{$p} ne $V_REPO{$p}));
printf STDOUT $outputf, @pstats[@pos];
}
}
}
@ -375,7 +384,7 @@ sub fill_hashes_from_cache {
my $p; my $parent; my $deps; my $softDeps;
my $ignored=<$cf>; chomp($ignored);
if ($ignored ne "$cache_ver") {
die "incompatible cache format; regenerate by running $0 cache";
die "incompatible cache format; regenerate by running $0 cache";
}
while (1) {
@ -401,7 +410,7 @@ sub fill_hashes_from_pkgfiles {
$V_REPO{$p} = $rver;
$V_REPO{$p} .= "-$rrel";
$DEPENDS{$p} = $rdeps;
$SOFTDEPS{$p} = $rsoftdeps;
$SOFTDEPS{$p} = $rsoftdeps;
$DESC{$p} = $rdesc;
}
}
@ -432,9 +441,9 @@ sub get_pkgfile_fields {
} close(PF);
if (($Version =~ m/\$\(.*\)/) or ($Version =~ m/`.*`/)) {
open(ECHO,"-|","bash -c \'source $pkgfile; echo \$version\'");
while(<ECHO>) { chomp; $Version = $_; }
close(ECHO);
open(ECHO,"-|","bash -c \'source $pkgfile; echo \$version\'");
while(<ECHO>) { chomp; $Version = $_; }
close(ECHO);
}
$Dependencies =~ s/, / /g; $Dependencies =~ s/,/ /g;
@ -494,7 +503,7 @@ sub uninstall {
foreach my $r (@rubbish) { print "$r not installed; ignoring.\n"; }
my %removed = map { $_ => 0 } @targets;
if (($altroot ne "") and ($opkg{rargs} !~ m/(-r|--root)/)) {
$opkg{rargs} .= " -r $altroot";
$opkg{rargs} .= " -r $altroot";
}
foreach my $t (@targets) {
($opkg{test} eq "no") ? system($PKGRM,$opkg{rargs},$t) : print "$PKGRM $opkg{rargs} $t\n";
@ -511,8 +520,8 @@ sub port_lock {
if (@newlocks) {
open (LK,'>>',$prtlocker) or die "cannot open $prtlocker for writing.\n";
foreach my $lp (@newlocks) {
print LK "$lp\n";
print STDOUT "$lp locked.\n";
print LK "$lp\n";
print STDOUT "$lp locked.\n";
} close (LK);
}
}
@ -534,7 +543,7 @@ sub list_ports {
opendir (DIR, $collection) or next;
foreach my $port (sort(readdir DIR)) {
next if (! -f "$collection/$port/Pkgfile");
push (@found, "$collection/$port");
push (@found, "$collection/$port");
} closedir (DIR);
}
foreach my $lp (@localports) {
@ -549,92 +558,91 @@ sub list_ports {
@searchspace = grep { defined $DEPENDS{$_} } @searchspace;
if ($subset =~ /^dep/) {
$seed=shift; $sseed = $seed;
if (! find_port_by_name($seed,1,1,0)) {
print "$seed not found in the ports tree.\n"; return;
}
# workaround for any port with a plus sign in its name
$sseed =~ s/\+/\\\+/g
$seed=shift; $sseed = $seed;
if (! find_port_by_name($seed,1,1,0)) {
print "$seed not found in the ports tree.\n"; return;
}
# workaround for any port with a plus sign in its name
$sseed =~ s/\+/\\\+/g
}
if ($subset eq "orphans") {
my %not_orphans = map { $_ => 0 } @searchspace;
foreach my $port (@searchspace) {
map { $not_orphans{$_} = 1 } split(/[ ,]/, $DEPENDS{$port});
if ($odepends{soft} == 1) {
map { $not_orphans{$_} = 1 } split(/[ ,]/, $SOFTDEPS{$port});
}
map { $not_orphans{$_} = 1 } split(/[ ,]/, $DEPENDS{$port});
if ($odepends{soft} == 1) {
map { $not_orphans{$_} = 1 } split(/[ ,]/, $SOFTDEPS{$port});
}
}
@found = grep { $not_orphans{$_} eq 0 } keys %V_INST;
@found = grep { $not_orphans{$_} eq 0 } keys %V_INST;
} elsif (($subset eq "dependent") and ($odepends{recursive}==0)) {
@found = grep { " $DEPENDS{$_} " =~ / $sseed / } @searchspace;
if ($odepends{soft}==1) { push (@found,
grep{ " $SOFTDEPS{$_} " =~ / $sseed / } @searchspace);
}
if ($odepends{tree}==1) { unshift (@found, "$seed"); }
@found = grep { " $DEPENDS{$_} " =~ / $sseed / } @searchspace;
if ($odepends{soft}==1) {
push (@found, grep
{ " $SOFTDEPS{$_} " =~ / $sseed / } @searchspace);
}
if ($odepends{tree}==1) { unshift (@found, "$seed"); }
} elsif ($subset =~ /^dep(endent|tree)/) {
our $direction = ($subset eq "deptree") ? "fwd" : "rev";
my $header = (($subset eq "deptree") and ($odepends{tree} == 1)) ?
"-- dependencies ([i] = installed, '-->' = already shown)\n":
"-- reverse dependencies ('-->' = already shown)\n";
if (($direction eq "fwd") and ($odepends{soft} == 1)) {
$header =~ s/installed,/installed, [s] = installed softdep,/;
}
print $header unless ($odepends{tree} == 0);
"-- dependencies ([i] = installed, '-->' = already shown)\n":
"-- reverse dependencies ('-->' = already shown)\n";
if (($direction eq "fwd") and ($odepends{soft} == 1)) {
$header =~ s/installed,/installed, [s] = installed softdep,/;
}
print $header unless ($odepends{tree} == 0);
our $indent=" "; our $height=0;
our $ind; our %seen; our @lineage; my @fosters=();
$ind = ($V_INST{$seed}) ? "[i]" : "[ ]";
our $indent=" "; our $height=0;
our $ind; our %seen; our @lineage; my @fosters=();
$ind = ($V_INST{$seed}) ? "[i]" : "[ ]";
print "$ind $seed\n" if ($odepends{tree}==1);
$seen{$seed} = 1;
$seen{$seed} = 1;
my @children = ($direction eq "fwd") ? split /[ ,]/, $DEPENDS{$sseed}:
grep { " $DEPENDS{$_} " =~ / $sseed / } @searchspace;
if ($odepends{soft}==1) {
@fosters = ($direction eq "fwd") ?
grep { ($V_INST{$_}) } split /[ ,]/, $SOFTDEPS{$sseed}:
grep { " $SOFTDEPS{$_} " =~ / $sseed / } @searchspace;
grep { " $DEPENDS{$_} " =~ / $sseed / } @searchspace;
if ($odepends{soft}==1) {
@fosters = ($direction eq "fwd") ?
grep { ($V_INST{$_}) } split /[ ,]/, $SOFTDEPS{$sseed}:
grep { " $SOFTDEPS{$_} " =~ / $sseed / } @searchspace;
}
foreach my $sd (@children) { recurse_tree(0,$sd,$direction); }
foreach my $sd (@fosters) { recurse_tree(1,$sd,$direction); }
foreach my $sd (@fosters) { recurse_tree(1,$sd,$direction); }
sub recurse_tree {
my $greedy = shift; my $s = shift; my $direction=shift;
my $ps = (($seen{$s}) and ($odepends{all} !=1)) ? "-->\n" : "\n";
$ind = ($V_INST{$s}) ? "[i]" : "[ ]";
$ind = (($ind eq "[i]") and ($greedy)) ? "[s]" : $ind;
print $ind.(${indent}x(1+$height))."$s".$ps if ($odepends{tree}==1);
return if (($seen{$s}) and ($odepends{all} !=1));
$seen{$s} = 1;
my $ps = (($seen{$s}) and ($odepends{all} !=1)) ? "-->\n" : "\n";
$ind = ($V_INST{$s}) ? "[i]" : "[ ]";
$ind = (($ind eq "[i]") and ($greedy)) ? "[s]" : $ind;
print $ind.(${indent}x(1+$height))."$s".$ps if ($odepends{tree}==1);
return if (($seen{$s}) and ($odepends{all} !=1));
$seen{$s} = 1;
my %curdeps = ($direction eq "fwd") ?
map {$_ => 0} split /[ ,]/, $DEPENDS{$s} :
map {$_ => 0} grep { " $DEPENDS{$_} " =~ / $s / } @searchspace;
map {$_ => 0} split /[ ,]/, $DEPENDS{$s} :
map {$_ => 0} grep { " $DEPENDS{$_} " =~ / $s / } @searchspace;
if ($odepends{soft} == 1) {
my @optionals = ($direction eq "fwd") ?
grep { ($V_INST{$_}) } split /[ ,]/, $SOFTDEPS{$s} :
grep { " $SOFTDEPS{$_} " =~ / $s / } @searchspace;
grep { ($V_INST{$_}) } split /[ ,]/, $SOFTDEPS{$s} :
grep { " $SOFTDEPS{$_} " =~ / $s / } @searchspace;
map {$curdeps{$_} = 1} @optionals;
}
foreach my $dc (keys %curdeps) {
if (grep /^$dc$/, @lineage) {
print "Warning: dependency cycle => ".$dc."\n" unless ($greedy|$curdeps{$dc});
if (grep /^$dc$/, @lineage) {
print "Warning: dependency cycle => "
.$dc."\n" unless ($greedy|$curdeps{$dc});
return;
}
push (@lineage, $dc);
$height = $#lineage+1;
recurse_tree($greedy|$curdeps{$dc},$dc,$direction);
pop(@lineage);
$height = $#lineage+1;
}
push (@lineage, $dc);
$height = $#lineage+1;
recurse_tree($greedy|$curdeps{$dc},$dc,$direction);
pop(@lineage);
$height = $#lineage+1;
}
}
delete $seen{$seed} if ($odepends{tree} == 0);
@found = sort(keys %seen);
}
# possibilities for the recursive switch have been exhausted
else { }
delete $seen{$seed} if ($odepends{tree} == 0);
@found = sort(keys %seen);
} # possibilities for the recursive switch have been exhausted
} # possibilities for the filter have been exhausted
else { }
return @found if ((! $subset) or ($subset =~ /^(orphans|locked)$/));
if (! $osearch{filter}) { return @found; }
else { return grep {$_ !~ /$osearch{filter}/} @found; }
@ -645,30 +653,31 @@ sub port_diff { # find differences between the pkgdb and the repo
if ($dtype !~ /^(current|isinst|utd)/) {
foreach my $p (sort(keys %V_INST)) {
if (($V_REPO{$p}) and ($V_REPO{$p} ne $V_INST{$p})) {
($dtype =~ /^(quick|sysup)/) ? push @outfile, "$p" :
push @outfile, "$p $V_INST{$p} $V_REPO{$p}";
} elsif ((! $V_REPO{$p}) and ($dtype !~ /^(quick|sysup)/)) {
push @outfile, "$p $V_INST{$p} MISSING";
if (($V_REPO{$p}) and ($V_REPO{$p} ne $V_INST{$p})) {
($dtype =~ /^(quick|sysup)/) ? push @outfile, "$p" :
push @outfile, "$p $V_INST{$p} $V_REPO{$p}";
} elsif ((! $V_REPO{$p}) and ($dtype !~ /^(quick|sysup)/)) {
push @outfile, "$p $V_INST{$p} MISSING";
}
}
} elsif ($dtype eq "utd") { my $q=shift(@argq);
if (! $V_INST{$q}) { $retval--;
} elsif (($V_REPO{$q}) and ($V_INST{$q} ne $V_REPO{$q})) { $retval++;
} else {}
if (! $V_INST{$q}) { $retval--;
} elsif (($V_REPO{$q}) and ($V_INST{$q} ne $V_REPO{$q})) { $retval++;
} else {}
} elsif ($dtype =~ /^(current|isinst)$/) {
foreach my $q (@argq) {
if ( (! $V_INST{$q}) and (! who_aliased_to($q)) ) {
push @outfile, "$q: not installed"; $retval++;
} elsif ($V_INST{$q}) {
push @outfile, "$q: version $V_INST{$q}" if ($dtype eq "current");
push @outfile, "$q is installed." if ($dtype eq "isinst");
push @outfile, "$q is installed." if ($dtype eq "isinst");
} else {
push @outfile, "$q is provided by package ".who_aliased_to($q) if ($dtype eq "isinst");
push @outfile, "Package $q not installed" if ($dtype eq "current");
}
push @outfile, "$q is provided by package ".who_aliased_to($q)
if ($dtype eq "isinst");
push @outfile, "Package $q not installed" if ($dtype eq "current");
}
}
} else {}
}
return $retval, @outfile if ($dtype !~ /^(utd|sysup)/);
return $retval if ($dtype ne "sysup");
@ -694,10 +703,10 @@ sub deporder { # returns a sorted list of packages required.
# dependency cycle detection
if ($imark{$s}) {
return if ($greedy == 1);
print "Dependency cycle found: ";
foreach (@treewalk) { print "$_ => "; }
print "$s\n";
return if ($greedy == 1);
print "Dependency cycle found: ";
foreach (@treewalk) { print "$_ => "; }
print "$s\n";
}
push(@treewalk, $s); $imark{$s}=1;
@ -708,19 +717,17 @@ sub deporder { # returns a sorted list of packages required.
# if the user toggles --softdeps, consider the optional dependencies
# that are already installed or are given on the command line
if ($odepends{soft} == 1) {
foreach (grep { ($V_INST{$_}) or ($given{$_}) }
split /[ ,]/, $SOFTDEPS{$s}) {
$curdeps{$_} = 1;
}
foreach (grep { ($V_INST{$_}) or ($given{$_}) }
split /[ ,]/, $SOFTDEPS{$s}) { $curdeps{$_} = 1; }
}
foreach my $sd (keys %curdeps) {
my $subit = who_aliased_to($sd);
if ($subit) {
recurse_deptree($curdeps{$sd},$subit);
} else {
recurse_deptree($curdeps{$sd},$sd);
}
my $subit = who_aliased_to($sd);
if ($subit) {
recurse_deptree($curdeps{$sd},$subit);
} else {
recurse_deptree($curdeps{$sd},$sd);
}
}
delete $imark{$s}; pop(@treewalk);
$fmark{$s} = 1;
@ -732,8 +739,8 @@ sub deporder { # returns a sorted list of packages required.
}
sub up_inst { # returns scalar references to five arrays
my @requested=@_; my @sortedList; my @targets; my %pdirs;
my %builtpkg; my %mkcmd; my %addcmd; my %logfile; my %pvars; my $status;
my @requested=@_; my @sortedList; my @targets; my %pdirs; my %builtpkg;
my %mkcmd; my %addcmd; my $rs_cmd; my %logfile; my %pvars; my $status;
my %ok; my %not_ok; my %ok_pre; my %ok_post; my @ok_readme=();
my $PKGMK=$opkg{makecommand}; my $PKGADD=$opkg{addcommand};
@ -749,7 +756,8 @@ sub up_inst { # returns scalar references to five arrays
# omit the ports that appear up to date, unless a rebuild is forced
if ("$opkg{margs} $opkg{aargs}" !~ m/-f/) {
@targets = grep {( (! $V_INST{$_}) or ($V_REPO{$_} ne $V_INST{$_}) )} @targets;
@targets = grep {( (! $V_INST{$_})
or ($V_REPO{$_} ne $V_INST{$_}) )} @targets;
}
# exempt any locked ports from being updated
@ -771,7 +779,7 @@ sub up_inst { # returns scalar references to five arrays
$builtpkg{$t} =~ s/uuiRel/$pvars{'%r'}/g;
$mkcmd{$t} = "$PKGMK -d $opkg{$t}";
if (($altroot ne "") and ($opkg{aargs} !~ m/(-r|--root)/)) {
$opkg{aargs} .= " -r $altroot";
$opkg{aargs} .= " -r $altroot";
}
$addcmd{$t} = "$PKGADD -u $opkg{aargs} $builtpkg{$t}";
if ($olog{write} eq "enabled") {
@ -788,51 +796,53 @@ sub up_inst { # returns scalar references to five arrays
# build each package, unless already installed
BUILDLOG: foreach my $t (@targets) {
if ( (-f $builtpkg{$t}) and ($opkg{$t} !~ /-f/) and
((-M $builtpkg{$t}) > (-M "$pdirs{$t}/Pkgfile")) ) {
((-M $builtpkg{$t}) > (-M "$pdirs{$t}/Pkgfile")) ) {
$mkcmd{$t} = "echo \"skipped build (package already exists)\"";
}
if ($opkg{test} eq "yes") {
print("$t\n") if ($mkcmd{$t} !~ /skipped/);
$ok{$t}=1;
next BUILDLOG;
print("$t\n") if ($mkcmd{$t} !~ /skipped/);
$ok{$t}=1;
next BUILDLOG;
}
if ($mkcmd{$t} ne "") {
if (($opkg{runscripts} eq "yes") and (-f "$pdirs{$t}/pre-install")) {
if ($altroot ne "") {
system("chroot",$altroot,"sh","$pdirs{$t}/pre-install");
} else {
system("sh","$pdirs{$t}/pre-install");
}
( $?>>8 == 0 ) ? $ok_pre{$t} = 1 : delete $ok_pre{$t};
}
chdir $pdirs{$t}; system("$mkcmd{$t}"); $status=( $?>>8 == 0 );
if ($logfile{$t}) {
( ($mkcmd{$t} =~ /skipped build/) or ! log_failure($logfile{$t}) ) ? $ok{$t} = 1 : $not_ok{$t} = 1;
} else {
( $status ) ? $ok{$t} = 1 : $not_ok{$t} = 1;
}
if ( $ok{$t} ) {
$addcmd{$t} =~ s/ -u / / if (! $V_INST{$t});
system("$addcmd{$t}");
if ( $?>>8 == 0 ) { $ok{$t} = 1;
push (@ok_readme, $t) if (-f $pdirs{$t}."/README");
} else {
$not_ok{$t} = 1; delete $ok{$t};
}
unlink($logfile{$t}) if (($logfile{$t}) and
($olog{rm_on_success} eq "yes") );
} elsif ( ($not_ok{$t}) and (-f "$builtpkg{$t}") ) {
system("mv $builtpkg{$t} $builtpkg{$t}.CHECKME");
}
if (($ok{$t}) and ($opkg{runscripts} eq "yes")
and (-f "$pdirs{$t}/post-install")) {
if ($altroot ne "") {
system("chroot",$altroot,"sh","$pdirs{$t}/post-install");
} else {
system("sh","$pdirs{$t}/post-install");
}
( $?>>8 == 0 ) ? $ok_post{$t}=1 : delete $ok_post{$t};
}
if (($opkg{runscripts} eq "yes") and (-f "$pdirs{$t}/pre-install")) {
$rs_cmd="/bin/sh $pdirs{$t}/pre-install";
if ($altroot ne "") {
(-f "$altroot/$pdirs{$t}/pre-install") or
system("install -D $pdirs{$t}/pre-install $altroot/$pdirs{$t}/pre-install");
$rs_cmd = "chroot $altroot $rs_cmd";
}
(system("$rs_cmd")==0) ? $ok_pre{$t} = 1 : delete $ok_pre{$t};
}
chdir("$pdirs{$t}") or $not_ok{$t} = 1;
if ($not_ok{$t}) { next BUILDLOG; }
$status = (system("$mkcmd{$t}")==0);
if ($logfile{$t}) {
( ($mkcmd{$t} =~ /skipped build/) or ! log_failure($logfile{$t}) ) ?
$ok{$t} = 1 : $not_ok{$t} = 1;
} else {
($status) ? $ok{$t} = 1 : $not_ok{$t} = 1;
}
if ($ok{$t}) {
$addcmd{$t} =~ s/ -u / / if (! $V_INST{$t});
if (system("$addcmd{$t}")==0) {
$ok{$t} = 1;
push (@ok_readme, $t) if (-f "README");
} else {
$not_ok{$t} = 1; delete $ok{$t};
}
unlink($logfile{$t})
if ( ($logfile{$t}) and ($olog{rm_on_success} eq "yes") );
} elsif ( ($not_ok{$t}) and (-f "$builtpkg{$t}") ) {
rename("$builtpkg{$t}","$builtpkg{$t}.CHECKME");
}
if (($ok{$t}) and ($opkg{runscripts} eq "yes") and (-f "post-install")) {
$rs_cmd="/bin/sh post-install";
if ($altroot ne "") {
(-f "$altroot/$pdirs{$t}/post-install") or
system("install -D $pdirs{$t}/post-install $altroot/$pdirs{$t}/post-install");
$rs_cmd="chroot $altroot $rs_cmd";
}
(system("$rs_cmd")==0) ? $ok_post{$t}=1 : delete $ok_post{$t};
}
last if (($opkg{group} eq "yes") and ($not_ok{$t}));
}
@ -844,8 +854,7 @@ sub up_inst { # returns scalar references to five arrays
close(FH); return $failed;
}
my @ok = keys %ok;
my @not_ok = keys %not_ok;
my @ok = keys %ok; my @not_ok = keys %not_ok;
return \@ok, \%ok_pre, \%ok_post, \@ok_readme, \@not_ok;
}