Documentation/scripts/prt-auf

#!/usr/bin/perl
#
# prt-auf --- add/update frontend to CRUX pkgutils (offers mostly the same
#             user experience as prt-get except for the slight delay
#             entailed by Perl having to compile this file on startup)
#
# distributed under the same license as the pkgutils,
# https://crux.nu/gitweb/?p=tools/pkgutils.git;a=blob_plain;f=COPYING;hb=HEAD
#
use warnings;
use strict;

################### Initialize global variables #######################
my $title="prt-auf";                   my $version=0.5;
my $CONFDIR = "/var/lib/pkg";          my $prtalias="/etc/prt-get.aliases";
my $pkgdb="$CONFDIR/db";               my $prtlocker="$CONFDIR/prt-get.locker";
my $prtcache="$CONFDIR/prt-get.cache"; my $LOCKED; my %ALIASES; my %DEPENDS;
my @allports; my %V_REPO; my %V_INST;  my %DESC;  
my @results; my $strf; my $ind;  my $hh; my $portpath; my $built_pkg;
my %osearch = ( cache => 0, regex => 0, path => 0, exact => 0, verbose => 0 );
my %odepends = ( tree => 0, recursive => 0, all => 0 );
my %opkg = ( margs => "", aargs => "", rargs => "", runscripts => "yes",
	makecommand => "/usr/bin/pkgmk", addcommand => "/usr/bin/pkgadd",
	removecommand => "/usr/bin/pkgrm", test => "no" );

my @bldirs = parse_prt_conf();
my @basedirs = @{$bldirs[0]}; my @localports = @{$bldirs[1]};

################### Process the given command #########################
my ($action, @query) = parse_args(@ARGV);

# load some data structures into memory for the actions that need them
if ($action !~ /^(fsearch|isinst|current)$/) {
  @allports = list_ports();
  fill_hashes_from_pkgfiles();
}
if ($osearch{cache}==1) { fill_hashes_from_cache(); }

if ($action !~ /^(quickdep|search|dsearch|fsearch|info|dup|readme|cat)$/) {
    open (DB, $pkgdb) or die "Could not open package database!\n";
    local $/="";
    while (<DB>) { $V_INST{$1} = $2 if m/^(.*)\n(.*)-[0-9]+\n/; }
    close (DB);
}

if ($action =~ /^(diff|quickdiff|depends|deptree|install|update|depinst|sysup)$/) {
    get_locked_and_aliased();
}

##############  Branch based on the requested action   #################

if ($action eq "path") {
  @results = find_port_by_name($query[0],1,1,0);
} elsif ($action eq "search") {
  @results = find_port_by_name($query[0],0,$osearch{path},1);
} elsif ($action eq "fsearch") {
  $hh = find_port_by_file(".footprint", $query[-1]);
} elsif ($action eq "dsearch") {
  @results = find_port_by_desc($query[0]);
} elsif ($action eq "info") {
  $portpath = find_port_by_name($query[0],1,1,0);
  @results = get_pkgfile_fields($portpath,"all") if ($portpath);
} elsif ($action eq "cache") { dump_flat_db();
} elsif ($action eq "lock") { port_lock(@query);
} elsif ($action eq "unlock") { port_unlock(@query);
} elsif ($action eq "dup") { find_dups();
} elsif ($action eq "ls") { port_ls($query[0]);
} elsif ($action =~ /^(cat|edit|readme)$/) { port_edit($1,@query);
} elsif ($action =~ /^(depends|deptree|quickdep)$/) {
  @results=deporder($1,@query);
} elsif ($action eq "dependent") {
  @results=list_ports("dependent",@query);
} elsif ($action eq "remove") { $ind=uninstall(@query);
} elsif ($action eq "sysup") { @results = sysup();
} elsif ($action =~ /^(install|update|depinst|grpinst)$/) {
  @results = up_inst($1,@query);
} elsif ($action =~ /^(isinst|current)$/) {
  $ind = port_diff($1,@query);
} elsif ($action =~ /(.*)diff$/) {
  $ind = port_diff($1);
} elsif ($action =~ /^list(.*)/) {
  @results = list_ports($1);
} elsif ($action eq "help") { print_help();
} elsif ($action eq "version") { print "$title $version\n";
} else { printf "Unsupported command '$action'.\n"; }

#################### Post-transaction reports #######################
$strf = "%s\n";
if (($action =~ /^(listinst|listorphans)/)
   or (($action eq "dependent") and ($odepends{all}==0))) {
    foreach my $result (@results) {
   $result .= " $V_INST{$result}" if $osearch{verbose}==1;
   $result .= " $V_INST{$result}\n$DESC{$result}\n" if $osearch{verbose}>1;
        printf "$strf", $result;
    }
} elsif ($action =~ /^(list|search|dsearch|path|dependent)/) {
    exit 1 if ($#results < 0);
    foreach my $result (@results) {
   $result =~ s/.*\/(.*)$/$1/ if (($action ne "path") and ($osearch{path}==0));
   $result .= " $V_REPO{$result}" if $osearch{verbose}==1;
   $result .= " $V_REPO{$result}\n$DESC{$result}\n" if $osearch{verbose}>1;
        printf $strf, $result;
    }
} elsif ($action =~ /^(fsearch)/) {
   my %hits = %{$hh}; $strf = "%20s  %s\n";
   printf $strf, "Found in", "Matching File";
   foreach my $fh (keys %hits) {
	chomp($hits{$fh});
	printf $strf, $fh, (split /\s/, $hits{$fh})[-1];
   }
} elsif ($action =~ /^(diff|quickdiff|current|isinst)$/) {
  exit $ind;
} elsif ($action =~ /^(depends|deptree|quickdep)$/) {
  print "-- dependencies ([i] = installed, [a] = provided by an alias)\n" if ($action =~ /^dep/);
  my $indent=($action eq "deptree") ? "  " : "";
  my @installed=keys %V_INST unless ($action eq "quickdep");
  my %seen; my $strf="%3s %s\n"; my $depline; my $dep; my $missing=0;
  foreach $depline (@results) {
    if ($depline =~ /MISSING/) { $missing=1; print "-- missing packages\n"; next; }
    my $cleandep = $depline;
    $cleandep =~ s/ .provided by .*// if ($action eq "deptree");
    $dep = (split / /, $cleandep)[-1];
    next if (($seen{$dep}) and ($odepends{all}==0));
    $seen{$dep}=1;
    if ($action ne "quickdep") {
      $ind = (grep { $_ eq $dep } @installed) ? "[i]" : "[ ]";
      if ($ind ne "[i]") {
          $ind = (who_aliased_to($dep)) ? "[a]" : $ind;
      }
    }
    $depline .= " $V_REPO{$dep}" if $osearch{verbose}==1;
    $depline .= " $V_REPO{$dep}\n$DESC{$dep}" if $osearch{verbose}>1;
    printf "$strf", $ind, $depline 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", "Packager", "Maintainer",
     "Readme", "PreInstall", "PostInstall");
  $results[1] =~ s/^(.*)\/.*$/$1/;
  for (my $i=0; $i<7; $i++) {
    printf $strf, $fields[$i], $results[$i];
  }
  printf $strf, $fields[8], $results[8];
} elsif ($action eq "remove") {
  my %removed = %$ind;
  my @successes = grep { $removed{$_}==1 } keys %removed;
  my @failures = grep { $removed{$_}==0 } keys %removed;
  print "Ports removed:\n" if (@successes);
  foreach my $p (@successes) { print "$p\n"; }
} elsif ($action =~ /^(install|update|depinst|grpinst)$/) {
  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 "no") and (@ok)) {
    print "Successful ports:\n";
    foreach my $k (@ok) {
      $note = (grep /^$k$/, @ok_pre) ? " pre: ok. " : "";
      $note .= (grep /^$k$/, @ok_post) ? " post: ok. " : "";
      $note = ((grep /^$k$/, @ok_pre) or (grep /^$k$/, @ok_post))? "($note)" : "";
      print "  $k $note\n";
    }
    print "\n";
  }
  if (($opkg{test} eq "no") and (@ok_readme)) {
    print "Successful ports with README files:\n";
    foreach (@ok_readme) { print "  $_\n"; }
    print "\n";
  }
  if (($opkg{test} eq "no") and (@not_ok)) {
    print "Ports with pkgmk/pkgadd failures:\n";
    foreach (@not_ok) { print "  $_\n"; }
    print "\n";
  }
} else {}

# Done!

#################### Begin Subroutines #######################
sub parse_args {
  my @query;
  $osearch{cache} = 1 if ($0 =~ /cache$/);
  while (my $arg = shift) {
    if ($arg =~ /^(search|dsearch|fsearch|path|info|list|dup)$/) { $action = $1;
    } elsif ($arg =~ /^(install|update|depinst|grpinst|sysup)$/) { $action = $1;
    } elsif ($arg =~ /^(lock|unlock|listlocked|current|isinst)$/) { $action = $1;
    } elsif ($arg =~ /^(diff|quickdiff|listinst|listorphans)$/) { $action = $1;
    } elsif ($arg =~ /^(depends|deptree|quickdep|dependent)$/) { $action = $1;
    } elsif ($arg =~ /^(readme|cat|edit|ls|help|version|cache)$/) { $action = $1;
    } elsif ($arg eq "--tree") { $odepends{tree} = 1; $odepends{recursive} = 1;
    } elsif ($arg eq "--all") { $odepends{all} = 1;
    } elsif ($arg eq "--recursive") { $odepends{recursive} = 1;
    } elsif ($arg eq "--path") { $osearch{path} = 1;
    } elsif ($arg eq "--regex") { $osearch{regex} = 1;
    } elsif ($arg eq "-v") { $osearch{verbose} += 1;
    } elsif ($arg eq "-vv") { $osearch{verbose} += 2;
    } elsif ($arg eq "--cache") { $osearch{cache} = 1;
    } elsif ($arg eq "--test") { $opkg{test} = "yes";
    } elsif ($arg eq "-fr") { $opkg{margs} .= " -f";
    } elsif ($arg =~ /^(-uf|-if|-us|-is|-ns|-kw)$/) { $opkg{margs} .= $1;
    } elsif ($arg =~ /^--margs=(.*)/) { $opkg{margs} .= $1;
    } elsif ($arg =~ /^--aargs=(-r|--root)=(.*)/) { $opkg{aargs} .= "$1 $2";
    } elsif ($arg =~ /^--rargs=(-r|--root)=(.*)/) { $opkg{rargs} .= "$1 $2";
    } elsif ($arg =~ /^-/) {
      print "'$arg' is not a recognized option.\n"; exit 1;
    } else { push (@query, $arg); }
  }
  if (($#query > -1) and
     ($action =~ /^(diff|quickdiff|cache|list|dup|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 last.\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|grpinst|remove)$/)) {
    print "$1 requires at least one argument.\n"; exit 1;
  }
  return $action, @query;
}

sub parse_prt_conf {
  my @basedirs; my @localports; my $runscripts; my $make; my $add; my $remove;
  my $conf = "/etc/prt-get.conf";

  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+(.*)#/;
    $opkg{makecommand} = $1 if /^makecommand\s+(.*)#/;
    $opkg{addcommand} = $1 if /^addcommand\s+(.*)#/;
    $opkg{removecommand} =$1 if /^removecommand\s+(.*)#/;
  }
  close(PORTS);
  return \@basedirs, \@localports;
}

sub find_dups {
  my %seen;
  foreach my $pp (@allports) {
    my $pn = (split /\//, $pp)[-1];
    $seen{$pn}++;
  }
  my @dups = grep { $seen{$_} > 1 } keys %seen;
  foreach my $dup (@dups) {
    print "$dup\n" if ($osearch{verbose}==0);
    my @hits = grep /\/$dup$/, @allports;
    print "$hits[0] > $hits[1]\n" if ($osearch{verbose}==1);
    if ($osearch{verbose}>1) {
      print "* $dup\n";
      while (my $h=shift(@hits)) { print "  $h\n"; }
    }
  }
}

sub get_locked_and_aliased {
    local $/ = "\n";
    open (AL, $prtalias) or return;
    while (<AL>) { $ALIASES{$1} = $2 if m/^\s*(.*)\s*:\s*(.*)/; }
    close (AL);
    open (LK, $prtlocker) or return;
    while (<LK>) { $LOCKED .= " $_"; }
    close (LK);
}

sub who_aliased_to {
  my $target = shift;
  my @substitutes = grep { defined $V_INST{$_} } keys %ALIASES;
  @substitutes = grep { $ALIASES{$_} eq $target } @substitutes;
  my $who = (@substitutes) ? $substitutes[0] : undef ;
  return $who;
}

sub dump_flat_db {
  my $FS; my @pstats; my $p;
  open (CACHE,'>',$prtcache) or die "cannot create a new cache file";
  print CACHE "V5\n"; 
  foreach my $pp (@allports) {
      $p = (split /\//, $pp)[-1];
      @pstats = get_pkgfile_fields($pp,"all");
      for (my $ps=0; $ps<=$#pstats; $ps++) {
        printf CACHE "%s\n", $pstats[$ps];
      }
  } close (CACHE);
  print "cache created.\n";
}

sub fill_hashes_from_cache {
  open (my $cf,$prtcache) or die "cannot use $prtcache as a cache!\n";
  local $/="\n"; my $p; my $deps;
  my $ignored=<$cf>;    # first line only contains the cache format version

  while (1) {
     $p = <$cf>; last unless defined $p;
     chomp($p);
     $ignored = <$cf>; $V_REPO{$p} = <$cf>;
     $ignored = <$cf>; $DESC{$p} = <$cf>;
     $deps = <$cf>;
     chomp($deps, $DESC{$p}, $V_REPO{$p});
     $DEPENDS{$p} = ($deps ne "") ? $deps : " ";
     $DEPENDS{$p} =~ s/,/ /g;
     for (my $i=6; $i<13; $i++) { $ignored = <$cf>; }
  }
  close ($cf);
}

sub fill_hashes_from_pkgfiles {
  foreach my $pp (@allports) {
    my $p = (split /\//, $pp)[-1];

    my ($rver, $rrel, $rdesc, $rdeps) = get_pkgfile_fields($pp);
    $V_REPO{$p} = ($rver) ? $rver : "0";
    $DEPENDS{$p} = ($rdeps) ? $rdeps : "";
    $DEPENDS{$p} =~ s/,/ /g;
    $DESC{$p} = ($rdesc) ? $rdesc : "";
  }
}

sub get_pkgfile_fields {
  my ($descrip, $url, $maintainer, $packager, $Version, $Release)=('','','','','',0,0);
  my ($readme, $preInstall, $postInstall, $Dependencies)=("no","no","no",'');
  my $portpath = shift; my $Name = (split /\//, $portpath)[-1];
  my $pkgfile = "$portpath/Pkgfile";

  $readme = "yes" if (-f "$portpath/README") or (-f "$portpath/README.md");
  $preInstall = "yes" if (-f "$portpath/pre-install");
  $postInstall = "yes" if (-f "$portpath/post-install");
  $portpath =~ s/\/[a-zA-Z0-9]+$//;

  open(PF,$pkgfile) or die "Cannot open $pkgfile for reading!\n";
  while (<PF>) {
  chomp;
  if (s/^# Description:\s*(.*)/$1/)   { $descrip = $_; } 
  elsif (s/^# URL:\s*(.*)/$1/)        { $url = $_; }
  elsif (s/^version=(.*)/$1/)         { $Version = $_; }
  elsif (s/^release=(.*)/$1/)         { $Release = $_; }
  elsif (s/^# Depends on:\s*(.*)/$1/) { $Dependencies = $_; }
  elsif (s/^# Packager:\s*(.*)/$1/)   { $packager = $_; }
  elsif (s/^# Maintainer:\s*(.*)/$1/) { $maintainer = $_; }
  else {}
  } close(PF);

  if (shift) {
    return $Name, $portpath, $Version, $Release, $descrip, $Dependencies, $url,
    $packager, $maintainer, $readme, $preInstall, $postInstall, $built_pkg;
  } else { return $Version, $Release, $descrip, $Dependencies; }
}

sub find_port_by_file { # for now only used to search footprints, but can be generalized
  my $portfile = shift; my $query = shift; my ($lp, $candidate, $fh); my %hits=();
  my $linewanted = qr/$query/is;
  LOCALENTRY: foreach $lp (@localports) {
    open ($fh, "$lp/$portfile") or die "cannot open $portfile for $lp\n";
    while (<$fh>) {
      next if ($portfile eq "Pkgfile" and $_ !~ /^(name=|# Description)/);
      next LOCALENTRY if $hits{$lp};
      $hits{$lp} = $_ if $_ =~ $linewanted;
    } close ($fh);
  }
  foreach my $collection (@basedirs) {
    my $prefix = ( $osearch{path} == 1 ) ? "$collection/" : "";
    opendir (DIR, $collection) or return;
    PORTENTRY: foreach $candidate (sort(readdir(DIR))) {
      next if (! -f "$collection/$candidate/$portfile");
      open ($fh, "$collection/$candidate/$portfile") or die "cannot open $portfile in $candidate\n";
      while (<$fh>) {
	next PORTENTRY if $hits{"$prefix$candidate"};
        $hits{"$prefix$candidate"}=$_ if $_ =~ $linewanted;
      } close ($fh);
    } closedir(DIR);
  }
  return \%hits;
}

sub find_port_by_desc {
  my $query=shift;
  $query =~ s/\+/\\\+/g unless ($osearch{regex}==1);
  $query =~ s/\./\\\./g unless ($osearch{regex}==1);
  my @hits = grep { $DESC{$_} =~ /$query/i } keys %DESC;
  return @hits;
}

sub find_port_by_name {
  my $query = shift; my $exact=shift; my $fullpath=shift; my $exhaustive=shift;
  $query =~ s/\+/\\\+/g unless ($osearch{regex}==1);
  $query =~ s/\./\\\./g unless ($osearch{regex}==1);
  my $pattern = ($exact==1) ? qr/\/$query$/s : qr/$query/is;
  my @hits = grep { $_ =~ $pattern } @allports;
  @hits = grep { s/^(.*)\/// } @hits if ($fullpath==0);
  return @hits if ($exhaustive==1);
  return $hits[0] if ($exhaustive==0);
}

sub uninstall {
  my $PKGRM = $opkg{removecommand};
  my @targets = grep { defined $V_INST{$_} } @_;
  my @rubbish = grep { ! defined $V_INST{$_} } @_;
  foreach my $r (@rubbish) { print "$r not installed; ignoring.\n"; }
  my %removed = map { $_ => 0 } @targets;
  foreach my $t (@targets) {
    ($opkg{test} eq "no") ? system($PKGRM,$opkg{rargs},$t) : print "$PKGRM $opkg{rargs} $t\n";
    $removed{$t}=1 if ($?>>8 == 0);
  }
  return \%removed;
}

sub port_lock {
  my @newlocks = grep { " $LOCKED " !~ / $_ / } @_;
  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";
    } close (LK);
  }
}

sub port_unlock {
  foreach my $ul (@_) { $LOCKED =~ s/ $ul / /; }
  my @newlocks = split / /, $LOCKED;
  open (LL, $prtlocker."-tmp",">");
  foreach my $nl (@newlocks) { print LL "$nl\n"; }
  close (LL);
  system ("mv",$prtlocker."-tmp",$prtlocker);
}

sub list_ports {
  my @found; my $filter = shift;
  our $indent="0 "; our $height=0; our @descendants=(); our @outfile;

  if (! $filter) {      # empty arg: list all valid ports
    foreach my $collection (@basedirs) {
      opendir (DIR, $collection) or next;
      foreach my $port (sort(readdir DIR)) {
        next if (! -f "$collection/$port/Pkgfile");
	push (@found, "$collection/$port");
      } closedir (DIR);
    }
    foreach my $lp (@localports) {
      push (@found, $lp) if (-f "$lp/Pkgfile");
    }
  } elsif ($filter eq "inst") { @found = keys %V_INST;
  } elsif ($filter eq "locked") { @found=split / /, $LOCKED;
  } elsif ($filter =~ /^(orphans|dependent)$/) {
    my $seed=shift;
    if ( ((! $seed) and ($filter eq "dependent")) or
         ((shift @_) and ($filter eq "dependent")) ) {
	    print "dependent requires exactly one argument.\n";
	    return;
    }
    if (($filter eq "dependent") and (! find_port_by_name($seed,1,1,0))) {
	    print "$seed not found in the ports tree.\n"; return;
    }

    our @searchspace=(($filter eq "orphans") or ($odepends{all}==0)) ?
      keys %V_INST : keys %DEPENDS;
    @searchspace = grep { defined $DEPENDS{$_} } @searchspace;

    if ($filter eq "orphans") {
        my $inst_deps="";
        foreach my $port (@searchspace) {
	    $inst_deps .= " $DEPENDS{$port} " if ($DEPENDS{$port});
        }
	@found = grep { $inst_deps !~ / $_ / } @searchspace;
    } elsif (($filter eq "dependent") and ($odepends{recursive}==0)) {
	@found = grep { " $DEPENDS{$_} " =~ / $seed / } @searchspace;
    } elsif (($filter eq "dependent") and ($odepends{recursive}==1)) {
        push @outfile, "$seed";

        my @children = grep { " $DEPENDS{$_} " =~ / $seed / } @searchspace;
        foreach my $sd (@children) { recurse_offtree($sd); }

        sub recurse_offtree {
            my $s = shift; push @outfile, (${indent}x(1+$height))."$s";
            my @offspring = grep { " $DEPENDS{$_} " =~ / $s / } @searchspace;
            foreach my $dc (@offspring) {
               if (grep /^$dc$/, @descendants) {
                  print "Warning: cyclic dependencies found!\n";
                  return;
               }
            push (@descendants, $dc);
            $height = 1+$#descendants;
            recurse_offtree($dc);
	    pop(@descendants);
	    $height = 1+$#descendants;
            }
        }

        my %seen;
	@outfile = grep { !m/^\s*$/ } @outfile;
	@outfile = sort(@outfile) unless ($odepends{tree}==1);
        @found = ($odepends{tree}==1) ? grep { s/0 /  /g } @outfile :
	  grep !$seen{$_}++, grep { s/0 //g } @outfile;
        unshift (@found, $seed);
      }
      # possibilities for the recursive switch have been exhausted
      else { }
  } # possibilities for the filter have been exhausted
  else { }
  return @found;
}

sub port_diff { # returns a scalar indicating how many differences were found
  my $dtype=shift; my $lastcol;
  my @argq=@_; my $retval=0; my $format="%30s %20s %20s\n";

  if ($dtype !~ /^(current|isinst|utd)/) {
    printf "$format", "Port", "Installed", "In Repository" if (! $dtype);
    foreach my $p (keys %V_INST) {
      next if ((" $LOCKED " =~ / $p /) and ($odepends{all}==0));
      $lastcol = ($V_REPO{$p}) ? $V_REPO{$p} : "MISSING!";

      if ($lastcol ne $V_INST{$p}) {
      printf "$format", $p, $V_INST{$p}, $lastcol if (! $dtype);
      printf "%s ", $p if ($dtype eq "quick" and $lastcol ne "MISSING!");
      }
    }
    printf "\n" if ($dtype eq "quick");
  } elsif ($dtype eq "utd") {
    while (my $q=shift(@argq) and $retval==0) {
      $retval-- if (! $V_INST{$q});
      $retval++ if (($V_INST{$q}) and ($V_REPO{$q}) and ($V_INST{$q} ne $V_REPO{$q}));
    }
  } elsif ($dtype =~ /^(current|isinst)$/) {
      foreach my $q (@argq) {
        if (! $V_INST{$q}) {
          print "$q: not installed\n"; $retval++;
        } else {
          print "$q: version $V_INST{$q}\n" if ($dtype eq "current");
	  print "$q is installed.\n" if ($dtype eq "isinst");
        }
      }
  } else {}
  return $retval;
}

sub deporder {
  # returns an indented list if called with first arg "deptree",
  # otherwise returns a flattened list, pruned of duplicates.
  # Recursion does NOT continue beyond a dependency satisfied by an alias.

  my $format=shift; our $indent="0 "; our $height=0; our @seeds = @_;
  our @ancestry=(); our @outfile=(); our @missing; my %installable; my %seen;

  foreach my $s (@seeds) {
    if (find_port_by_name($s,1,0,0)) { $installable{$s} = 1;
    } else { $installable{$s} = 0;
        print "$s not found in the ports tree; ignoring.\n";
    }
  }

  foreach my $s (grep { $installable{$_}==1 } @seeds) {
    recurse_deptree($s);
  }

  sub recurse_deptree {
    my $s = shift;
    if (! grep /$s$/, @allports) { push @missing, "$s"; return; }
    my $substitute = who_aliased_to($s);
    my $note = ($substitute) ? " (provided by $substitute)" : "";
    push @outfile, (${indent}x(1+$height))."$s$note";

    my $depstr = $DEPENDS{$s} unless ($substitute);
    if ($depstr) {
      my @sdeps = split /[ ,]/, $depstr;
      foreach my $sd (@sdeps) {
        if (grep /^$sd$/, @ancestry) {
	  print "Warning: cyclic dependency found!\n";
	  print ((join " => ", @ancestry)."$sd\n");
	  return;
        }
        push (@ancestry,$sd);
        $height = 1+$#ancestry;
        recurse_deptree($sd);
        pop @ancestry;
	$height = 1+$#ancestry;
      }
    }
  }
  if ($format eq "deptree") {
    @outfile = grep { s/0 /  /g; !m/^\s*$/; } @outfile;
  } else {
    @outfile = grep !$seen{$_}++,
       (grep { s/0 //g; s/ .provided by .*//g; !m/^\s*$/; } sort(@outfile));
  }
  return @outfile unless ($#missing >= 0);
  return @outfile, "MISSING", @missing if ($#missing >= 0);
}

sub up_inst {  # returns scalar references to five arrays;
  my $type=shift; my @requested=@_;
  my $PKGMK=$opkg{makecommand}; my $PKGADD=$opkg{addcommand};
  my $SUDO="/usr/bin/doas"; my $FAKEROOT="/usr/bin/fakeroot";

  $SUDO = (-x $SUDO) ? $SUDO : "/usr/bin/sudo";
  $SUDO = (-x $SUDO) ? $SUDO : "/usr/bin/su -c";
  $FAKEROOT = (-x $FAKEROOT) ? $FAKEROOT : "/usr/bin/su -c";

  # prepend commands with sudo/doas/fakeroot if the effective user id is not root
  if ($> != 0) { $PKGADD = "$SUDO $PKGADD";
                  $PKGMK = "$FAKEROOT $PKGMK"; }

  # resolve all dependencies unless the command was 'grpinst'
  my @targets=($type eq "grpinst") ? @_ : deporder("quickdep",@_);

  # filter out the invalid ports if deporder() didn't do so already
  @targets = grep { (join " ", @allports) =~ / $_ / } @targets if ($type eq "grpinst");

  # exempt any locked ports from an sysup operation
  if ($action eq "sysup") { @targets = grep {" $LOCKED " !~ / $_ /} @targets;
  } else {
  @targets = grep {(" $LOCKED " !~ / $_ /) or (grep /$_/, @requested)} @targets;
  }

  # first determine the directories from which pkgmk must be called
  #   and the package that will appear after a successful build
  my %pdirs; my %builtpkg; my %mkcmd; my %addcmd; my %status;
  foreach my $t (@targets) {
	 $opkg{$t} = $opkg{margs};
	 $opkg{$t} =~ s/-f// if !(grep /$t/, @requested);
	 $pdirs{$t} = find_port_by_name($t,1,1,0);
	 $builtpkg{$t} = find_built_pkg($t);
	 $mkcmd{$t} = "$PKGMK -d $opkg{$t}";
	 $addcmd{$t} = "$PKGADD -u $builtpkg{$t}";
	 $status{$t} = "not done";
  }

  # build each package, unless already installed or satisfied by an alias
  foreach my $t (@targets) {
    if (who_aliased_to($t)) {
      $mkcmd{$t} = "echo \"skipped build ($t provided by an alias)\"";
    } else {
      $mkcmd{$t} = "" if ((port_diff("utd",$t)==0) and ($opkg{margs} !~ /-f/));
      $mkcmd{$t} = "" if (($type eq "install") and ($V_INST{$t}) and ($opkg{margs} !~ /-f/));
      $mkcmd{$t} = "echo \"skipped build ($t up to date)\"" if ((-f $builtpkg{$t}) and
	      ((-M $builtpkg{$t}) < (-M "$pdirs{$t}/Pkgfile")));
    }

    if ($mkcmd{$t}) {
      if ((-f "$pdirs{$t}/pre-install") and ($opkg{runscripts} eq "yes")) {
	      system("sh","$pdirs{$t}/pre-install") unless ($opkg{test} eq "yes");
	      $status{$t} += ( $?>>8 == 0 ) ? "pre-install ok. " : "pre-install failed. ";
      }
      ($opkg{test} eq "no") ? chdir $pdirs{$t} : print "cd $pdirs{$t}\n";
      ($opkg{test} eq "no") ? system("$mkcmd{$t}") : print "$mkcmd{$t}\n";
      $status{$t} .= ( $?>>8 == 0 ) ? "build ok. " : "build failed. ";
      $status{$t} = ( $mkcmd{$t} =~ /skipped/ ) ? "build skipped. " : $status{$t};
      if ($status{$t} =~ /build ok/) {
          $addcmd{$t} =~ s/ -u / / if (port_diff("utd",$t)<0);
	  ($opkg{test} eq "no") ? system("$addcmd{$t}") : print "$addcmd{$t}\n";
	  $status{$t} .= ( $?>>8 == 0 ) ? "pkgadd ok. " : "pkgadd failed. ";
      }
      if (($status{$t} =~ /pkgadd ok/) and (-f "$pdirs{$t}/post-install")
		      and ($opkg{runscripts} eq "yes")) {
	  system("sh","$pdirs{$t}/post-install") unless ($opkg{test} eq "yes");
	  $status{$t} .= ( $?>>8 == 0 ) ? "post-install ok. " : "post-install failed. ";
      }
    }

    last if (($status{$t} =~ /failed/) and ($type eq "grpinst"));
  }

  my @ok = grep { $status{$_} =~ /pkgadd ok/ } @targets;
  my @ok_pre = grep { $status{$_} =~ /pre-install ok/ } @targets;
  my @ok_post = grep { $status{$_} =~ /post-install ok/ } @ok;
  my @ok_readme = grep -f $pdirs{$_}."/README", @ok;
  my @not_ok = grep { $status{$_} =~ /(pkgadd|build) failed/ } @targets;
  return \@ok, \@ok_pre, \@ok_post, \@ok_readme, \@not_ok;
}

sub sysup {
  my @targets; my $v_repo;
  foreach my $p (keys %V_INST) {
    $v_repo = ($V_REPO{$p}) ? $V_REPO{$p} : "MISSING" ;
    push @targets, $p if (($v_repo ne $V_INST{$p}) and ($v_repo ne "MISSING"));
  }
  return up_inst("update",@targets);
}

sub find_built_pkg {
  my $target = shift; my $CONF="/etc/pkgmk.conf"; local $/="\n";
  my $COMPRESSION; my $PKG_DIR; my $portpath = (find_port_by_name($target,1,1,0))[0];
  my ($version, $release) = (get_pkgfile_fields($portpath))[0..1];

  open (CF,$CONF) or return;
  while (<CF>) {
     $COMPRESSION=$1 if m/^PKGMK_COMPRESSION_MODE=(.*)/;
     $PKG_DIR=$1 if m/^PKGMK_PACKAGE_DIR=(.*)/;
  } close (CF);

  if ($COMPRESSION) {
    $COMPRESSION =~ s/"//g;
    $COMPRESSION =~ s/'//g;
  } else { $COMPRESSION = "gz"; }

  if ($PKG_DIR) {
    $PKG_DIR =~ s/"//g; $PKG_DIR =~ s/'//g;
    $PKG_DIR =~ s/\$\{name\}/$target/g;
    $PKG_DIR =~ s/\$name/$target/g;
  } else { $PKG_DIR = $portpath; }

  return "$PKG_DIR/$target#$version-$release.pkg.tar.$COMPRESSION";
}

sub port_ls {
  my $port=shift; my $pp=find_port_by_name($port,1,1,0);
  return if (! defined $pp);
  opendir (DIR,$pp) or die "Cannot open $pp for directory listing!\n";
  foreach my $l (sort(readdir(DIR))) {
    next if (($l eq ".") or ($l eq ".."));
    print "$l\n";
  } closedir (DIR);
}

sub port_edit {
  my $type=shift; my $port=shift;
  my $file=shift; my $pp=find_port_by_name($port,1,1,0);
  return if (! defined $pp);
  my $EDITOR = ($ENV{EDITOR}) ? $ENV{EDITOR} : "/usr/bin/vi";

  if ($type eq "readme") {
    port_edit("cat",$pp,"README") if (-f "$pp/README");
    port_edit("cat",$pp,"README.md") if (-f "$pp/README.md");
  }

  if (($file) and (-f "$pp/$file") and ($type eq "edit")) {
    exec ($EDITOR,"$pp/$file");
  } else { exec ($EDITOR,"$pp/Pkgfile"); }

  if (($file) and (-f "$pp/$file") and ($type eq "cat")) {
    open (PF, "$pp/$file") or die "Could not open $pp/$file.\n";
    while (<PF>) { print $_ ; }
    close (PF);
  } else { 
    open (PF, "$pp/Pkgfile") or die "Could not open $pp/Pkgfile.\n";
    while (<PF>) { print $_ ; }
    close (PF);
  }
}

sub print_help {
  print <<EOF;
Usage: prt-auf <action> [options] <search term|port name>
where the actions include: 

SEARCH
  search  <expr>     show port names containing <expr>
  dsearch <expr>     show ports containing <expr> in the name or description
  fsearch <pattern>  show ports that provide filenames matching <pattern>

DIFFERENCES / DEPENDENCIES
  quickdiff          show outdated packages on a single line, separated by spaces
  quickdep  <port>   show the dependencies needed by <port>, on a single line
  deptree   <port>   show dependency tree for <port>
  dependent <port>   show installed packages which depend on <port>

INSTALL, UPDATE and REMOVAL
  install [opt] <port1 port2...>    install ports and their dependencies
  update  [opt] <port1 port2...>    update ports and their dependencies
  remove  [opt] <port1 port2...>    remove ports

GENERAL INFORMATION
  list               ports in the active repositories
  listinst           ports currently installed
  listorphans        installed ports that no other port claims as a hard dependency
  dup                ports that appear more than once in the active collections
  info    <port>     version, description, dependencies of <port>
  path    <port>     location from which pkgmk would be called to build <port>
  ls  <port>         the files in the <port> directory
  cat <port> <file>  the contents of <port>/<file> on STDOUT
  isinst  <port>     whether port is installed
  current <port>     installed version of port

SYSTEM UPDATE 
  sysup                     update all outdated ports, except those that are locked
  lock <port1 port2...>     lock each <port> at its current version
  unlock <port1 port2...>   release the lock on each <port>
  listlocked                list locked ports

COMMON OPTIONS
  -v        show version in listing
  -vv       show version and decription in listing
  --path    print path to port if appropriate (search, list, depends)
  --cache   use a cache file
  --test    do not actually run pkgmk/pkgadd, just print the commands on STDOUT
EOF
}