#!/usr/bin/env perl
#
# pkg-get - A binary package management utility for CRUX Linux
# Copyright (C) 2004-2006 Simone Rota <sip@varlock.com>
# Copyright (C) 2006-2025 by CRUX team (http://crux.nu)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

use warnings;
use strict;
use Getopt::Long;
use Digest::file qw(digest_file_hex);
use File::Path;

my $VERSION = "0.5.1";
my $CFGFILE = "/etc/pkg-get.conf";
my $addcommand = "/usr/bin/pkgadd";
my $rmcommand = "/usr/bin/pkgrm";
my $runscriptscommand = "/bin/bash";
my $LOCKFILE = "/var/lib/pkg/pkg-get.locker";
my $PKGDB    = "/var/lib/pkg/db" ;

$SIG{HUP} = \&trap; $SIG{INT} = \&trap;
$SIG{QUIT} = \&trap; $SIG{TERM} = \&trap;

# Global vars
my @repos = (); # package repositories
my @donetasks; my @failtasks; my @prevtasks; my %pptasks; my %readmetasks;
my $curraction = ""; my %depmap; my %locked; my %checksumsize;
my %fullpath; my %remote; my %prepostread; my %description;
my %instver; my %repver; my %shortstatus;

# CL Options
my $download_only; my @howMuchHelp; my $pre_install; my $post_install;
my $root=""; my $install_scripts; my $all; my $filter = ""; my $unused;
my $aargs=""; my $ignore_md5sum; my $force; my $force_reinst; 
GetOptions("do"=>\$download_only, "help"=>sub{ push @howMuchHelp, "help" },
            "version"=>sub{ push @howMuchHelp, "version" },
            "pre-install"=>\$pre_install, "post-install"=>\$post_install,
            "install-scripts"=>\$install_scripts, "all"=>\$all,
            "filter=s"=>\$filter, "config=s"=>\$CFGFILE, "aargs=s"=>\$aargs,
            "f"=>\$force, "im"=>\$ignore_md5sum, "margs=s"=>\$unused,
            "fr"=>\$force_reinst, "rargs=s"=>\$unused, "r=s"=>\$root)
	    or die("Error parsing options!\n");

if (@howMuchHelp) {
    help(@howMuchHelp);
}

if ($root) {
    $LOCKFILE = $root.$LOCKFILE ;
    $PKGDB = $root.$PKGDB;
}

# Get command, verify it's valid
my $command = getcommand(@ARGV);
if (index($command,"Error: ") eq 0 ) {
    $command =~ s/Error\: //;
    exiterr($command);
}

readconfig();
get_locked() unless ($command =~
    /^(info|help|readme|search|dsearch|list|path|depend|current|isinst)$/);

SWITCH: {
    if ($command =~ /^(version|help)$/) { help($command); last SWITCH; }
    if ($command eq "sync") { sync(); last SWITCH; }
    if ($command =~ /^(info|path|readme)$/) { info($1); last SWITCH; }
    if ($command =~ /^(d|)search$/) { search(); last SWITCH; }
    if ($command eq "list") { list(); last SWITCH; }
    if ($command eq "remove") { remove(); last SWITCH; }
    if ($command eq "listinst") { listinst(); last SWITCH; }
    if ($command eq "lock") { dolock(); last SWITCH; }
    if ($command eq "unlock") { unlock(); last SWITCH; }
    if ($command eq "listlocked") { listlocked(); last SWITCH; }
    if ($command eq "printf") { doprintf(); last SWITCH; }
    if ($command =~ /^(isinst|current)$/) { current(); last SWITCH; }
    if ($command =~ /^(diff|quickdiff|sysup)$/) { diff($1); last SWITCH; }
    if ($command eq "dup") { dup(); last SWITCH; }
    if ($command =~ /^(install|update)$/) { upinst(@ARGV); last SWITCH; }
    if ($command eq "dependent") { dependent(); last SWITCH; }
    if ($command =~ /^(depends|quickdep)$/) { load_depmap(); depends($1); last SWITCH; }
    if ($command eq "depinst") { load_depmap(); depinst(); last SWITCH; }
}

############################################################################
# Support functions
############################################################################

# Exit with error
sub exiterr {
    my ($msg) = @_;
    print "pkg-get: $msg\n";
    exit 1;
}

sub trap {
    printresults(1);
    die("\npkg-get: interrupted\n");
}

# Get command, return an error if not in the list of allowed commands
sub getcommand {
    my ($givencmd, $givenarg) = @_;
    if (not $givenarg){$givenarg = ""};
    if (not $givencmd){
        return "Error: no command given. try pkg-get help for more information";
    }

    my @allowed = ("depinst:", "install:", "sysup", "diff", "update:",
                   "depends:", "info:", "sync", "version", "help",
                   "quickdep:", "dependent:", "list", "listinst", "isinst:",
                   "search:", "dsearch:", "lock:", "unlock:", "listlocked",
                   "quickdiff", "printf:", "remove:", "readme:", "dup",
                   "path:", "current:");

    (grep { ($_ eq $givencmd) } @allowed)
     or ((grep { ($_ eq "${givencmd}:") } @allowed) and ($givenarg ne ""))
     or return "Error: improper command '$givencmd $givenarg'. Try pkg-get help for more information";

    return $givencmd;
}

# Parse the configuration file
sub readconfig {
    open(CFG, $CFGFILE) 
        or exiterr("could not open $CFGFILE");
    while (<CFG>) {
        chomp;
	if (/^pkgdir\s+(.*?)\s*(?:#.*)?$/) { (my $r = $1) =~ s/\s+$//; push (@repos, $r); }
	$install_scripts = 1 if /^runscripts\s+yes\s*/;
	if (/^addcommand\s+(.*?)\s*(?:#.*)?$/) { (my $c = $1) =~ s/\s+$//; $addcommand = $c; }
	if (/^rmcommand\s+(.*?)\s*(?:#.*)?$/) { (my $c = $1) =~ s/\s+$//; $rmcommand = $c; }
	if (/^runscriptscommand\s+(.*?)\s*(?:#.*)?$/) { (my $c = $1) =~ s/\s+$//; $runscriptscommand = $c; }
    }
    close(CFG);
}

# Populate a hash of installed packages
sub getinstalled {
    local $/ = ""; # read files paragraph-wise; see ``perldoc perlvar''
    open(DB, $PKGDB) or exiterr("could not open ".$PKGDB);
    while (<DB>) {
        my ($name, $version, @files) = split /\n/, $_;
        $instver{$name} = $version;
    }
    close(DB);
}

# Populate a hash of locked packages
sub get_locked {
    open (my $fL, $LOCKFILE) or return;
    while (<$fL>) { chomp; $locked{$_} = 1; }
    close ($fL);
}

# Populate hashes for the available packages
sub load_repos {
    (%instver) or ($command eq "list") or getinstalled();
    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
        while (<REPO>) {
            chomp;
	    my ($filename,$du,$checksum,$desc,$pre,$post,$read)=split(/:/,$_);
	    my $pkgname = $filename;
	    $pkgname =~ s/#.*//;
	    next if ($repver{$pkgname}); # only consider the first matching entry
	    $repver{$pkgname} = $1 if ($filename =~ m/.*#(.*)\.pkg\.tar\./);

            # no need to populate the remaining hashes if the user only asked for a list
	    next if ($command eq "list"); 
	    $remote{$pkgname} = ($url) ? "$url/$filename" : "";
	    $fullpath{$pkgname} = "$dir/$filename";
	    $checksumsize{$pkgname} = "$du:$checksum";
	    ($command ne "info") or $description{$pkgname} = $desc;
	    $prepostread{$pkgname} = "$pre:$post:$read";
	    if (! $instver{$pkgname}) {
		    $shortstatus{$pkgname} = "[ ]";
	    } elsif ($instver{$pkgname} eq $repver{$pkgname}) {
		    $shortstatus{$pkgname} = "[i]";
	    } else {
		    $shortstatus{$pkgname} = "[u]";
	    }
        }
        close (REPO);
    }
}

# Parse a line describing a package
sub parsepackage {
    my $type=shift; my @p = split(/\:/, $_[0]);
    if ($#p < 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")};
    my ($N, $V, $C) = ($p[0] =~ m/(.*)\#(.*)\.pkg\.tar\.(bz2|gz|lz|xz|zst)$/) ? ($1, $2, $3) : ("","","");
    ($type ne "light") or return ('name' => $N);
    my $R = ($V =~ m/^.*-(\w)$/) ? $1 : 0;
    $V =~ s/-\w$//;
    my %pkg = ( 'name' => $N, 'version' => $V, 'release' => $R, 'compression' => $C );
    if (not $_[2]) {$_[2] = $_[1]}; 
    $pkg{'path'} = $_[1];
    $pkg{'url'} = $_[2];
    $pkg{'url'} =~ s/\/$//;
    $pkg{'url'} .= "/$p[0]";
    $pkg{'size'} = $p[1];
    $pkg{'md5sum'} = $p[2];
    $pkg{'description'} = $p[3];
    $pkg{'pre_install'} = $p[4];
    $pkg{'post_install'} = $p[5];
    $pkg{'readme'} = $p[6];
    return %pkg;
}

# Print info about the given package
sub printinfo {
    my $pkgname = shift;
    my ($path, $version, $release) = ($1,$2,$3)
      if ($fullpath{$pkgname} =~ m/(.*)\/\Q$pkgname\E#(.*)-([0-9]*)\.pkg\.tar/);
    my ($du, $md5sum) = ($1,$2) if ($checksumsize{$pkgname} =~ m/([0-9]*):(.*)/);
    my $url = ($remote{$pkgname}) ? $remote{$pkgname} : $path;
    print "Name        : " . $pkgname . "\n";
    print "Version     : " . $version . "\n";
    print "Release     : " . $release . "\n";
    print "Description : " . $description{$pkgname} . "\n";
    print "URL         : " . $url . "\n";
    print "Md5sum      : " . $md5sum . "\n";
    print "Size        : " . $du . "\n";
    my $deps = ($depmap{$pkgname}) ? $depmap{$pkgname} : "";
    ($deps eq "") or print "Depends on  : $deps\n";
    my $files = "";
    if ($prepostread{$pkgname} =~ /:yes$/) {$files .= "README,"};
    if ($prepostread{$pkgname} =~ /^yes:/) {$files .= "pre-install,"};
    if ($prepostread{$pkgname} =~ /:yes:/) {$files .= "post-install,"};
    $files =~ s/\,$//;
    ($files eq "") or print "Files       : $files\n";
}

# Prints the README file to stdout
sub printreadme {
    my $pkgname = shift;
    my ($found, $finished) = (0, 0);
    my $path = $fullpath{$pkgname};
    $path =~ s/[^\/]*$//;
    open(READ, "$path/PKGREAD") 
        or exiterr("could not open $path/PKGREAD");
    while (<READ>) {
        chomp;
        if ( ($found == 1) and (/PKGREADME\:/) ) {
            $finished = 1;
        } elsif ($found == 1) {
            print "$_\n";
        } elsif ( /PKGREADME\: $pkgname$/ ) {
            $found = 1;
        }
    last if ($finished == 1);
    }
    close(READ);
}

# Print results for multiple package operations
sub printresults {
    my $okaction = $curraction;
    my $curr = "";
    my $action;
    my $pkg;
    my @readme;
    if (@donetasks) {
        @readme = grep { ($readmetasks{$_}) } @donetasks;
        print "\n-- Packages $okaction\n";
        foreach my $task(@donetasks) {
            print "$task" . $pptasks{$task}."\n";
        }
    }
    if (@prevtasks) {
        if ($okaction eq "installed") {
            print "\n-- Packages installed before this run (ignored)\n";
        } else {
            print "\n-- Packages skipped (ignored)\n";
        }
        foreach my $task(@prevtasks) { print "$task" . ($pptasks{$task} // "") . "\n"; }
    }
    if (@failtasks) {
        foreach my $task(sort @failtasks) {
            ($action, $pkg) = split(/,/,$task);
            if ($curr ne $action) {
                print "\n-- Packages $action\n";
                $curr = $action;
            }
            print "$pkg\n";
        }
    }
    if (@readme) {
        print "\n-- $okaction packages with README file\n";
    print join(", ",@readme);
    print "\n";
    }
    (! @donetasks) or (@failtasks) or ($_[0]) or
        print "\npkg-get: $okaction successfully\n";
}



# Initialize a hash of dependencies
sub load_depmap {
    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        open(DEPS, "$dir/PKGDEPS") or exiterr("could not open $dir/PKGDEPS");
	while (<DEPS>) {
		chomp;
		my ($pkgname,$pkgdep) = ($1,$2) if ( m/([^\s]*)\s*:\s*(.*)$/ );
		next if ($depmap{$pkgname});
		$depmap{$pkgname} = $pkgdep;
	}
    }
}

# Return a sorted list of packages required to satisfy all dependencies.
sub deporder {
  our $type=shift; my @seeds=@_; our @treewalk=(); our @result; our %missing;
  our %given = map { $_ => 1 } @seeds; our %imark=(); our %fmark=();

  foreach my $t (@seeds) { recurse_deptree($t,""); }

  sub recurse_deptree {
      my $s=shift; my $pkgparent=shift; my %curdeps=();

      # early return if this node has been visited already
      if ($fmark{$s}) { return; }

      # detect targets that are not present among the repositories
      if (! $repver{$s}) {
          $missing{$pkgparent} .= $s;
	  (! $pkgparent) or $missing{$pkgparent} .= " from $pkgparent;";
          $fmark{$s}=1;
          return;
      }

      # dependency cycle detection
      if ($imark{$s}) {
          print "Dependency cycle found: ";
          foreach (@treewalk) { print "$_ => "; }
          print "$s\n";
          return;
      }

      push(@treewalk, $s); $imark{$s}=1;

      # assemble the list of dependencies that must be visited next
      (! $depmap{$s}) or %curdeps = map { $_ => 1 } split / /, $depmap{$s};

      foreach my $sd (keys %curdeps) {
              recurse_deptree($sd,$s);
      }
      delete $imark{$s}; pop(@treewalk);
      $fmark{$s} = 1;
      ($type eq "quick") or $s = "$shortstatus{$s} $s";
      push(@result, $s);
   } 

   if ((%missing) and ($type ne "quick")) {
      push (@result, "--- missing deps:");
      foreach my $mdep (sort(keys %missing)) {
          push (@result, split /;/, $missing{$mdep});
      }
   }
   return @result;
}

# Download given package (if needed), check md5sum
sub downloadpkg {
    my $pkgname = shift;
    my $url = "$remote{$pkgname}";
    if ($url) {
        $url =~ s/\#/\%23/;
    } else {
        my $saved = (-f $fullpath{$pkgname}) ? 1 : 0;
        return $saved;
    }
    (! $force_reinst) or system("curl", "--retry", "3", "--retry-delay", "3",
        "-o", $fullpath{$pkgname}, $url) == 0 or return 0;
    (-f $fullpath{$pkgname}) or system("curl", "--retry", "3", "--retry-delay", "3",
        "-o", $fullpath{$pkgname}, $url) == 0 or return 0;
    # by now there should be a file in the expected location
    my $md5found = digest_file_hex($fullpath{$pkgname},"MD5");
    my $md5expected = $1 if ($checksumsize{$pkgname} =~ m/:(.*)/);
    if ($md5found ne $md5expected and not $ignore_md5sum) {
            print STDERR "=======> ERROR: md5sum mismatch for $pkgname:\n";
            print STDERR "required : $md5expected\n";
            print STDERR "found : $md5found\n";
            return 0;
    }
    return 1;
}

# Install given package
sub installpkg {
    my ($upgrade, $pkgname) = @_;
    if ($prepostread{$pkgname} =~ m/:yes$/) {$readmetasks{$pkgname} = 1};
    $pptasks{$pkgname} = "";
    my @args = ($addcommand);
    push @args, $upgrade if ($upgrade);
    push @args, split(' ', $aargs);
    push @args, "-f" if ($force);
    push @args, "-r", $root if ($root ne "");
    push @args, $fullpath{$pkgname};
    if ($install_scripts and $prepostread{$pkgname} =~ m/^yes/) {doscript("pre",$pkgname);}
    print "pkg-get: " . join(" ", @args) . "\n";
    system(@args) == 0 or return 0;
    if ($install_scripts and $prepostread{$pkgname} =~ m/:yes:/) {doscript("post",$pkgname);}
    return 1;
}

# Execute pre- or post-install script
sub doscript {
    my ($when, $pkgname) = @_;
    my $path = $fullpath{$pkgname};
    $path =~ s/[^\/]*$//;
    my @cmd;
    if ($root ne "") {
        @cmd = ("chroot", $root, $runscriptscommand, "$path/PKGINST", $pkgname, $when);
    } else {
        @cmd = ($runscriptscommand, "$path/PKGINST", $pkgname, $when);
    }
    if (system(@cmd) == 0) {
        $pptasks{$pkgname} .= " [$when: ok]";
    } else {
        $pptasks{$pkgname} .= " [$when: failed]";
    }
}

############################################################################
# Main functions (commands)
############################################################################


# Show brief help ##########################################################
sub help {
  foreach my $h (@_) {
    if ($h eq "help") {
      print "Usage: pkg-get command <package1> [package2 ... packageN] [options]

Some commands:
  sync      synchronize with the repository
  depinst   install package and its dependencies
  info      info about package
  sysup     update all outdated packages
  diff      list all outdated packages

Some options:
  -do   download only
  -im   ignore MD5 mismatches
  --install-scripts   use install scripts
  -r <root>  use <root> for pkgadd

Example:
  pkg-get install sqlite3 php-sqlite3

For other commands and samples, see the pkg-get(8) man page\n";
    } elsif ($h eq "version") {
      print "pkg-get $VERSION by Simone Rota <sip\@varlock.com>\n";
    }
  }
  exit 0;
}

# Sync with the remote server(s) ###########################################
sub sync {
    my $dlerror = 0;
    my $pid = $$;
    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        next if (not $url);
        print "Updating collection $dir\n";
        (-d $dir) or mkdir($dir) or exiterr("cannot create $dir");
        for my $f ("PKGREPO", "PKGDEPS", "PKGREAD", "PKGINST") {
            (! -f "$dir/$f") or rename("$dir/$f", "$dir/$f.old.$pid") or exiterr("cannot write to $dir");
            if (system("curl", "-s", "--output-dir", $dir, "-o", $f, "$url/$f") != 0) {
                print " cannot retrieve $f\n";
                $dlerror=1;
            }
        }
        if ($dlerror) { # restore backup repo
            for my $f ("PKGREPO", "PKGDEPS", "PKGREAD", "PKGINST") {
                (! -f "$dir/$f.old.$pid") or rename("$dir/$f.old.$pid", "$dir/$f") or exiterr("cannot write to $dir");
            }
        } else { # remove backup repo
            for my $f ("PKGREPO", "PKGDEPS", "PKGREAD", "PKGINST") {
                (! -f "$dir/$f.old.$pid") or unlink("$dir/$f.old.$pid") or exiterr("cannot write to $dir");
            }
        }
    }
}

# Show info/readme/path for specific packages ####################################
sub info {
    my ($type, @args) = @ARGV;
    (%repver) or load_repos();
    ($type ne "info") or load_depmap();
    foreach my $arg (@args) {
      ($fullpath{$arg}) or next;
      if ($type eq "info") {
	printinfo($arg);
      } elsif ($type eq "readme") {
	printreadme($arg);
      } else {
        my $path = $fullpath{$arg};
	$path =~ s/[^\/]*$//;
	print $path . "\n";
      }
    }
}

# List packages containing given string (name/description) #################
sub search {
    my $arg = $ARGV[1];
    my $parsetype = ($ARGV[0] =~ /^d/) ? "full" : "light";
    my %found;
    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
        while (<REPO>) {
            chomp;
            my %pkg = parsepackage($parsetype,$_, $dir, $url);
            next if ($found{$pkg{'name'}});
            (index($pkg{'name'}, $arg) < 0) or ($parsetype eq "full") or $found{$pkg{'name'}} = 1;
            ($parsetype ne "full") or (index($pkg{'description'}, $arg) < 0) or $found{$pkg{'name'}} = 1;
        }
        close(REPO);
    }
    foreach my $key (sort keys %found) { print "$key\n"; } 
    if (not %found) { print "No matching packages found\n"; }
}

# List all available packages ##############################################
# (requires a previous run of load_repos)
sub list {
    (%repver) or load_repos();
    foreach my $key(sort keys %repver) { print "$key\n"; }
}

# Remove given packages ####################################################
sub remove {
    $curraction = "removed";
    shift(@ARGV);
    my @cmd = ($rmcommand);
    push @cmd, "-r", $root if ($root ne "");
    foreach my $pkg(@ARGV) {
        $pptasks{$pkg} = "";
        if (system(@cmd, $pkg) == 0) {
            push(@donetasks, $pkg);
        } else {
            push(@failtasks, "where removal failed,$pkg");
        }
    }
    printresults();
}

# List installed packages ##################################################
sub listinst {
    getinstalled() if (! %instver);
    foreach my $key (sort keys %instver) { print "$key\n"; } 
}

# Print package version, or install status #################################
sub current {
    getinstalled() if (! %instver);
    my $type = shift(@ARGV); my $result;
    foreach my $pkg(@ARGV) {
        if ($instver{$pkg}) {
            $result = ($type eq "current") ? ": version $instver{$pkg}\n"
                       : " is installed\n";
        } else {
            $result = " not installed\n";
        }
        print "Package " . $pkg . $result;
    }
}

# Lock given packages ######################################################
sub dolock {
    shift(@ARGV);
    open(LCK, ">> $LOCKFILE") or exiterr("could not write to lock file");
    foreach my $arg(@ARGV) {
        if ($locked{$arg}) {
            print "Already locked: $arg\n"; next;
        }
        print LCK "$arg\n";
    }
    close(LCK);
}

# Unlock given packages ####################################################
sub unlock {
    shift(@ARGV);
    foreach my $arg(@ARGV) {
        if (! $locked{$arg}) {
            print "Not locked previously: $arg\n"; next;
        } else {
            delete $locked{$arg};
        }
    }
    open(my $fL, ">$LOCKFILE") or exiterr("could not write to lock file");
    foreach (sort keys %locked) { print $fL "$_\n"; }
    close($fL);
}

# List locked packages #####################################################
sub listlocked {
    foreach (sort keys %locked) { print "$_\n"; }
}

# Print formatted info #####################################################
sub doprintf {
    my %printed; my $linewanted;
    my $fmt = $ARGV[1];
    if (index($fmt,"%e")>=0) { load_depmap(); }
    if ($filter) {
        $filter =~ s/\*/.*/g;
        $linewanted = qr/^$filter$/is;
    }
    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
        while (<REPO>) {
            chomp;
            my %pkg = parsepackage("full",$_, $dir, $url);
            next if ($printed{$pkg{'name'}});
            if (($filter) and ($pkg{'name'} !~ $linewanted)) {
                $printed{$pkg{'name'}} = 1; next;
            }
	    my $printstring = $fmt;
            $printstring =~ s|%n|$pkg{'name'}|g;
            $printstring =~ s|%p|$pkg{'path'}|g;
            $printstring =~ s|%v|$pkg{'version'}|g;
            $printstring =~ s|%r|$pkg{'release'}|g;
            $printstring =~ s|%d|$pkg{'description'}|g;
            $printstring =~ s|%u|$pkg{'url'}|g;
            $printstring =~ s|%R|$pkg{'readme'}|g;
            $printstring =~ s|%E|$pkg{'pre_install'}|g;
            $printstring =~ s|%O|$pkg{'post_install'}|g;
            $printstring =~ s|%M|None|g; # for prt-get compatibility
            $printstring =~ s|%P|None|g; # for prt-get compatibility
            $printstring =~ s|\\n|\n|g;
            $printstring =~ s|\\t|\t|g;
            if (index($printstring,"%e") >=0) {
                my $deps = $depmap{$pkg{'name'}};
                $printstring =~ s|%e|$deps|g;
            }
            if (index($printstring,"%l") >=0) {
                my $locked = ($locked{$pkg{'name'}}) ? "yes" : "no";
                $printstring =~ s|%l|$locked|g;
                }
            if (index($printstring,"%i") >=0) {
                (%instver) or getinstalled();
                my $inst = ($instver{$pkg{'name'}}) ? "yes" : "no";
                ($inst eq "no") or
                ($instver{$pkg{'name'}} eq "$pkg{'version'}-$pkg{'release'}")
                    or $inst = "diff";
                $printstring =~ s|%i|$inst|g;
            }
	    print $printstring;
            $printed{$pkg{'name'}} = 1;
        }
        close(REPO);
   }
}

# Show or resolve differences between installed and available packages #####
sub diff {
    my $format = shift; my %found; my @diff;
    my $strf= ($format =~ /^quick/) ? "%s " : "%-19s %-19s %-19s\n";
    (%instver) or getinstalled();

    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
        my @multip=();
        while (<REPO>) {
            chomp;
            my %pkg = parsepackage("full",$_, $dir, $url);
            next if ( ($found{$pkg{'name'}}) or (! $instver{$pkg{'name'}}) );
            next if ( ($locked{$pkg{'name'}}) and (! $all) );
            my $lastcol = ($locked{$pkg{'name'}}) ? "locked" : "";
            ($lastcol eq "locked") or $lastcol = ($instver{$pkg{'name'}}
            eq "$pkg{'version'}-$pkg{'release'}") ? "uptodate" :
                   $pkg{'version'}."-".$pkg{'release'};
            push @multip, "$pkg{'name'}^$instver{$pkg{'name'}}^$lastcol";
        }
        close(REPO);
	my $maybeDup="";
        while (my $mp = shift @multip) {
            my ($mpname, $vinst, $mpinfo) = split /\^/, $mp;
            next if ( $mpname eq $maybeDup );
	    $maybeDup=$mpname;
            next if ($mpinfo eq "uptodate");
            ($format !~ /^(quick|sysup)/) or push @diff, $mpname;
            ($format =~ /^(quick|sysup)/) or push @diff, join("^",
             $mpname, $vinst, $mpinfo);
        }
    }
    ($#diff < 0) or ($format =~ /^(quick|sysup)/) or
        printf $strf, "Package","Installed", "Available in the repositories";
    if ($format ne "sysup") {
        print "\n";
        foreach my $dl (@diff) { printf $strf, split /\^/, $dl; }
    }
    ($format !~ /^quick/) or ($#diff < 0) or print "\n";
    ($#diff >= 0) or print "No differences found\n";

    # proceed with updates if sysup was requested
    ($#diff < 0) or ($format ne "sysup") or upinst("update", @diff);
}

# Display duplicate packages (found in more than one repo) #################
sub dup {
    my %found;
    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
        while (<REPO>) {
            chomp;
            my %pkg = parsepackage("full",$_, $dir, $url);
            $found{$pkg{'name'}} .= "###$pkg{'path'}/$pkg{'name'}#"
                                 . "$pkg{'version'}-$pkg{'release'}"
                                 . ".pkg.tar.$pkg{'compression'}";
        }
        close(REPO);
    }
    foreach my $key (sort keys %found) {
        my $value = $found{$key};
        $value =~ s/^\#\#\#//;
        (index($value, "###") > 0) or next;
        print "* $key\n";
        foreach my $dup(split(/\#\#\#/, $value)) { print "  $dup\n"; }
    }
}

# Show list of dependencies for package ####################################
sub depends {
    my ($j, $type) = ($ARGV[0] =~ /^quick/) ? (" ","quick") : ("\n","full");
    ($type eq "quick") or (%instver) or getinstalled();
    (%repver) or load_repos();
    my @args = @ARGV; shift @args;
    my @result=deporder($type,@args) or exiterr("package '$ARGV[1]' not found");
    (! @result) or ($type = "quick") or print "-- dependencies ([i] = installed, [u] = updatable)\n";
    foreach my $res (@result) { print $res . $j; }
    ($type ne "quick") or print "\n";
}

# Show packages directly depending from given package ######################
sub dependent {
    my $arg = $ARGV[1]; my %dp;
    getinstalled() unless (($all) or (%instver));
    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        open(DEPS, "$dir/PKGDEPS") 
            or exiterr("could not open $dir/PKGDEPS");
        while (<DEPS>) {
            chomp;
            my ($maybe, $deplist) = split /\:/;
            # collapse trailing or leading whitespace
            $maybe =~ s/\s+$//; $deplist =~ s/^\s+//;
            # match using word boundaries on the space-separated dep list
            $dp{$maybe} = 1 if ($deplist =~ /(?<!\S)\Q$arg\E(?!\S)/);
        }
        close(DEPS);
    }
    foreach my $res(keys %dp) {
        print "$res\n" unless ((not $all) and (! $instver{$res}));
    }
}

# Install or update given package ##########################################
sub upinst {
    my ($cmd, @args) = @_; my $aa;
    ($curraction, $aa) = ($cmd =~ /^up/) ? ("updated","-u") : ("installed","");

    if ($root ne "") {
        foreach my $repo(@repos) {
            my ($dir, $url) = split(/\|/, $repo);
	    ( -e "$root$dir" ) or make_path("$root$dir");
	    ( -d "$root$dir" ) or next;
            open(my $host, "$dir/PKGINST") or next;
            open(my $mount, ">$root$dir/PKGINST");
            while (<$host>) { print $mount $_; }
            close($mount);
            close($host);
        }
    }

    getinstalled() if (! %instver);
    load_repos() if (! %repver);

    foreach my $pkgname(@args) {
        my $failed=0;
        if (not $repver{$pkgname}) {
            push(@failtasks, "not found,$pkgname");
        } elsif ( $shortstatus{$pkgname} eq "[ ]" and $cmd eq "update" ) {
            $pptasks{$pkgname} = " [not installed]";
            push(@prevtasks, "$pkgname");
        } elsif ( $shortstatus{$pkgname} eq "[u]" and $cmd eq "install" ) {
            $pptasks{$pkgname} = " [use update]";
            push(@prevtasks, "$pkgname");
        } elsif ( $shortstatus{$pkgname} eq "[i]" and $cmd eq "install" ) {
            $pptasks{$pkgname} = " [already installed]";
            push(@prevtasks, "$pkgname");
        } elsif (downloadpkg($pkgname)) {
        ($download_only) or installpkg($aa, $pkgname) or $failed=1;
            ($failed == 1) ? push(@failtasks, "where $cmd failed,$pkgname")
                           : push(@donetasks, $pkgname);
        } else {
            push(@failtasks, "where download failed,$pkgname");
        }
    }
    printresults();
}

# Install given package, along with dependencies ###########################
sub depinst {
    my @toinst;
    $curraction = "installed";
    my @args = @ARGV; shift(@args);
    getinstalled() if (! %instver);
    (%repver) or load_repos();

    my @maybeinst = deporder("quick",@args);
    foreach my $pkg (@maybeinst) {
        next if (($locked{$pkg}) or (! $repver{$pkg}));
	if (! $instver{$pkg}) {
            push(@toinst, $pkg);
        }
    }
    upinst("install",@toinst) if (@toinst);
}
