#! /usr/local/bin/perl -w

#  stowES - stow Enhancement Script
#  Copyright (C) 2000   Adam Lackorzynski <adam@os.inf.tu-dresden.de>
#
#  $Id: stowES.in,v 1.38 2003/09/03 10:16:39 al10 Exp $
#
#  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.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA


## ---------------------------

use strict;
use Getopt::Long;
use FileHandle;
require 5.004;
use POSIX qw(locale_h);
require 'getcwd.pl';

use diagnostics;
use Carp ();
# switch these two off when doing a real release
#local $SIG{__WARN__} = \&Carp::cluck;
#local $SIG{__DIE__}  = \&Carp::confess;

my $ProgramName = $0;
$ProgramName =~ s,.*/,,;

my $DEV = 0; # set to "1" while developing will switch on 
             # some additional checks not necessary for normal use
my $Version = '0.5.4';
my $VersionString = 'stowES - stow enhancement script';

# environment variable for storing options
my $ENV_STOWES   = 'STOWES';

my @Command;
my $Verbose;

my $Umask = 022;

my $TargetDir     = '/usr/local';
my $StowDirName   = 'stow';
my $StowDir       = $TargetDir."/".$StowDirName;
my $ConfigDirName = '.config';
my $DumpDir       = '/tmp';
my $SubDirName    = '';
my $InfoDir       = 'info'; # or 'share/info'

my $ActualCommand = undef;

my $ContentSearchPattern = '\Wstow\W';

my $DependencyFileName  = 'dependencies';
my $ChecksumFileName    = 'md5sums';
my $CreatorInfoFileName = 'creatorinfo';

my $ContentSearchFile  = '/dev/null';
my $LogFile            = '/dev/null';
my $OutputFile         = '-';

my $ProceedAllPackages = 0;
my $RemoveSource       = 0;
my $Ambiguous          = 0;
my $DryRun             = 0;
my $Continue           = 0;
my $ParallelJobs       = 1;

my $BoolCheckIn        = 1;
my $BoolDepends        = 1;
my $BoolChecksums      = 1;
my $BoolCheckChecksums = 1;
my $BoolStrip          = 0;
my $BoolConfigure      = 1;
my $BoolMake           = 1;
my $BoolMakeCheck      = 1;
my $BoolRotateInstall  = 0;
my $BoolForce          = 0;
my $BoolUseSavedOptions= 0;
my $BoolNoInstallInfo  = 0;

my $PackageSuffix      = undef;

my %ParamConfigure;
my %ParamMake;

my @rcFiles = ('/etc/stowESrc', '~/.stowESrc');
my @ConfigFiles = ();  # config-files given by the user

my %Progs = ( make     => 'make', 
	      md5sum   => 'md5',
	      stow     => 'stow',
	      gzip     => 'gzip',
	      bzip2    => 'bzip2', 
	      tar      => 'tar',
	      rm       => 'rm', 
	      cat      => 'cat',
	      mv       => 'mv',
	      strip    => 'strip',
	      ldd      => 'ldd',
              uname    => 'uname',
	      ldconfig => '/sbin/ldconfig', # always full path for ldconfig
	      'install-info' => 'install-info',
	    );
# Normally we complain if we can't find a certain program from the list
# above, but in some cases we can just switch off some functions
my %ProgsFailFuncs = ( 'install-info' => sub { $BoolNoInstallInfo = 1; }, );

my @Commands = sort 
  qw/make makeinst instpack remove checkin checkout depends checksums
     chkchksums package untar install strip list help version config
     contsearch rename contents checklibs checktarget checkstow rebuild
     shell showconfig exchange confhelp/;

my %CommandAliases =   # alias => original_command
  (  'ci'   => 'checkin',
     'co'   => 'checkout',
     'cnf'  => 'config',
     'cfg'  => 'config',
     'rm'   => 'remove',
     'ls'   => 'list',
     'mk'   => 'make',
     'cs'   => 'checkstow',
     'ct'   => 'checktarget',
     'hlp'  => 'help',
     'mkin' => 'makeinst',
     'chlp' => 'confhelp',
  );

my $PackageName = undef;

my $MakeErrorScanPattern = '^make.*: \*\*\* \[.+\] Error';
my $ConfigureErrorScanPattern = '^\*\*\* |configure: error: ';

my @ConfigVarList =
  qw/@Commands %ParamConfigure %ParamMake $Continue
  $ProgramName $Version @Command $Verbose
  $TargetDir $StowDirName $StowDir $DumpDir $ConfigDirName
  $DependencyFileName $ChecksumFileName $PackageName
  $ContentSearchPattern @ConfigFiles $RemoveSource
  $ContentSearchFile $ProceedAllPackages $PackageSuffix
  @rcFiles %Progs $Ambiguous $DryRun $LogFile $OutputFile
  $BoolCheckIn $BoolDepends $BoolChecksums $BoolCheckChecksums $BoolStrip
  %CommandAliases $ActualCommand $BoolConfigure $BoolMake $SubDirName
  $ParallelJobs $BoolNoInstallInfo $BoolUseSavedOptions $BoolForce
  $BoolRotateInstall $BoolMakeCheck /;

my @exclude_dep_libs = 
   ('ld-linux.so', 'nfslock.so', 'libc.so', 'libm.so');

my $CallLdconfig = 0;

#   --==---==---==---==---==---==---==---==---==---==---==---==--
# -=0=--=0=--=0=--=0=--=0=--=0=--=0=--=0=--=0=--=0=--=0=--=0=--=0=-
#   --==---==---==---==---==---==---==---==---==---==---==---==--

sub Usage {

   print <<EOF;
Usage: $ProgramName command[,command,..] [options...] [files|dirs|regexps|...]

Commands (with shorter aliases, they may also be abbreviated to uniqueness):
  list|ls   [regexp]         List packages in $StowDir.
  checkstow|cs [regexp]      Check packages in $StowDir.
  checktarget|ct [regex]     Check targetdir for (invalid) files.
  install  dir|file          Does untar, make, makeinst, checksums, checkin.
  untar   file               Un-tar file.
  confhelp dir|file          Call 'configure --help' from dir|file.
  make|mk  dir               Call 'configure' and 'make' in dir.
  makeinst|mkin  dir         Call 'make install' in dir.
  checksums  regexp          Create checksums of package.
  chkchksums regexp          Check checksums of package.
  showconfig regexp          Show configuration for package if available.
  depends   regexp           Create dependencies.
  checkin|ci  regexp         Call 'stow' for package.
  checkout|co  regexp        Call 'stow -D' for package.
  rebuild                    Rebuild whole stow archive.
  strip    regexp            Strip files of package.
  rename regexp new          Rename package from old to new.
  exchange oldpack newpack   Exchange (check in and out) two packages.
  remove|rm     regexp       Remove/Delete package from $StowDir.
  instpack   file            Install package created with 'package'.
  package    regexp          Create a package.
  contents   regexp          List contents for packages.
  contsearch regexp          Content search in package (see --contentpattern).
  checklibs  regexp          Check if all libs for package are available.
  shell                      Calls a shell (\$SHELL) with all env-vars set.
  help|hlp                   This help screen.
  config|cfg|cnf             Print configuration.
  version                    Print version information.

Options (may be abbreviated to uniqueness):
  -s, --stowdir dir          Stow dir, usually '/usr/local/stow'.
  -t, --targetdir dir        Target dir, usually '/usr/local'.
  --stowname name            Name of the stow directory, usually 'stow'.
  -p, --packagename name     Alternate package name.
  -a, --allpackages          Proceed all packages found in $StowDir.
  -r, --rotatinginstall      Loop over the packages to 
                              install as long as possible.
  -v, --verbose level        Verbose mode.
  -q, --quiet                Quiet mode.
  -f, --force                Force certain operations.
  -k, --continue             Continue after error if possible.
  -d, --dumpdir dir          Dir to store all the stuff, currently '$DumpDir'.
  -m, --ambiguous            Regexps may match more than one package.
  -n, --dryrun               Only show what to do (as far as possible).
  -j, --paralleljobs [nr]    Number of parallel jobs for make.
  -c, --configfile file      Specify a configfile (may be used multiple times).
  -o, --outputfile file      Output file, default STDOUT.
  -l, --logfile file         Log file, prints short messages, def. /dev/null.
  --subdir name              Specify subdir inside target to install to.
  --contentpattern pattern   Search pattern: '$ContentSearchPattern'.
  --contentsearchfile file   Filelist of matches: '$ContentSearchFile'.
  --configdirname dirname    Name for the configuration directory.
  --dependencyfilename file  Filename for dependencies: '$DependencyFileName'.
  --checksumfilename file    Filename for checksums: '$ChecksumFileName'.
  --creatorinfofilename file Filename for creatorinfo: '$CreatorInfoFileName'.
  --packagesuffix string     Additional name for packages (e.g. architecture).
  --use-saved-options        Use options from previously installed version.
  --[no]removesource         Do [not] remove unpacked source after built.
  --no-install-info          Don't manage info files via 'install-info'.
  --prog key=program         Specify alternate programs. 
                             For keys see \%Progs when doing \`$ProgramName config\'.
  --prm-conf regexp=param | param
  --prm-make regexp=param | param
                             Specify extra parameters for the call of 
                             configure and make.
                                                _
  --[no]makecheck, --[no]configure, --[no]make   \\       Switch these
  --[no]depends, --[no]checkin, --[no]strip,      >         options 
  --[no]chkchksums, --[no]checksums             _/         on or off.


 List command: I ... Installed, s ... Can be checked in (no conflict),
         - ... Cannot be checked in (first conflicting file in paranthesis)
 Check command: see list command plus package size in KB\'s plus
           X ... package broken (conflicts in paranthesis)
EOF
}

sub ShortUsage {
   print <<EOF;
Usage: $ProgramName command [options ...] [files|dirs|regexps|...]
    Use "$ProgramName help" for further help! 
EOF
}

sub Init {

  # switch buffering off
  $| = 1;
  
  # set umask
  umask $Umask;

  unless (open STDOUT, ">$OutputFile") {
    print STDERR "Error opening output stream!\n";
    exit 1;
  }

  unless (open LOG, ">$LogFile") {
    print STDERR "Error opening logfile $LogFile for writing!\n";
    exit 1;
  }
  LOG->autoflush(); # switch off buffering

  sub unshift_env_vars {
    my ($name, $s, $deli) = @_;
    my @e;
    @e = split(/$deli/, $ENV{$name}) if defined $ENV{$name};
    $ENV{$name} = join($deli, $s, @e);
  }

  my $LIBPATH_ENVVAR = 'LD_LIBRARY_PATH';
  # the documentation of LIBPATH (ld(1)) could be interpreted in such a way
  # that we need to add /usr/lib:/lib to LIBPATH as well if we set it
  # but I'm not sure about it; on the other way -L call will be used anyway
  $LIBPATH_ENVVAR = 'LIBPATH' if lc(getSystem()) eq 'aix';

  # set PATH and LD_LIBRARY_PATH so that you can try out software more
  # easily in /tmp or so...
  unshift_env_vars('PATH', $TargetDir.'/bin', ':');
  unshift_env_vars($LIBPATH_ENVVAR, $TargetDir.'/lib', ':');
  unshift_env_vars('LD_RUN_PATH', $TargetDir.'/lib', ':');

  # and give "configure" and "make" some hints where to find your stuff
  #unshift_env_vars('CFLAGS', "-O2", ' ');
  unshift_env_vars('LDFLAGS', "-L$TargetDir/lib", ' ');
  unshift_env_vars('CPPFLAGS', "-I$TargetDir/include", ' ');
}

sub EndWork() {
 
  FinishLdconfig();

  close STDOUT;
  close LOG;
}

sub printLOG {
  print LOG @_ if !$DryRun;
}

sub printV1 {
  print @_ if $Verbose;
}

sub printV2 {
  print @_ if $Verbose > 1;
}

sub CheckAmbiguousCommand {
  my $cmd = shift;
  my @c = grep(/^$cmd/, @Commands, keys %CommandAliases);  
  if ($#c == 0) {
      return((defined $CommandAliases{$c[0]})?$CommandAliases{$c[0]}:$c[0]);
  }  else {
    my @d = grep(/^$cmd$/, @c);
    if ($#d == 0) {
      return((defined $CommandAliases{$d[0]})?$CommandAliases{$d[0]}:$d[0]);
    }
  }
  print "--> Command `$cmd' is ambiguous.\n" if ($#c > 0);
  print "--> No such command `$cmd'.\n" if ($#c == -1);
  undef;
}

sub GetParams {

  ShortUsage(),exit(1) unless ($ARGV[0]);
  @Command = split(/,/,  shift @ARGV); # split and remove command from ARG's
  for(my $i = 0; $i <= $#Command; $i++) {
    ShortUsage(), exit(1)  unless 
      (defined ($Command[$i] = CheckAmbiguousCommand(lc($Command[$i]))));
  }

  $Verbose      = undef;
  my $quiet     = undef;
  my $stowdir   = undef;
  my $targetdir = undef;
  my @prm_conf  = undef;
  my @prm_make  = undef;
  my @AltProgs;
  my @opts = ("stowname|stowdirname=s", \$StowDirName,
              # may also use the + for increasing the level
	      "verbose|v:i", \$Verbose,
	      "dependencyfilename=s", \$DependencyFileName,
	      "checksumfilename=s", \$ChecksumFileName,
	      "packagename|p=s", \$PackageName,
	      "allpackages|a", \$ProceedAllPackages,
	      "quiet|q!", \$quiet,
	      "dumpdir|d=s", \$DumpDir,
	      "contentpattern=s", \$ContentSearchPattern, 
	      "contentsearchfile=s", \$ContentSearchFile, 
	      "removesource!", \$RemoveSource,
	      "checkin!", \$BoolCheckIn,
	      "depends!", \$BoolDepends,
	      "checksums!", \$BoolChecksums,
	      "chkchksums!", \$BoolCheckChecksums,
	      "ambiguous|multiple|m!", \$Ambiguous, 
	      "strip!", \$BoolStrip,
              "prog=s@", \@AltProgs,
	      "dryrun|n!", \$DryRun,
	      "prm-conf=s@", \@prm_conf,
	      "prm-make=s@", \@prm_make,
	      "logfile|l=s", \$LogFile,
	      "outputfile|o=s", \$OutputFile,
              "continue|k!", \$Continue,
	      "packagesuffix=s", \$PackageSuffix,
	      "configure!", \$BoolConfigure,
              "make!", \$BoolMake,
	      "makecheck!", \$BoolMakeCheck,
              "rotateinstall|r!", \$BoolRotateInstall,
              "creatorinfofilename=s", \$CreatorInfoFileName,
              "configdirname=s", \$ConfigDirName,
              "force|f!", \$BoolForce,
              "subdir=s", \$SubDirName,
              "paralleljobs|j:i", \$ParallelJobs,
              "use-saved-options!", \$BoolUseSavedOptions,
	      "no-install-info!", \$BoolNoInstallInfo,
	     );
  my @opts_stowtargetdir = ("stowdir|s=s", \$stowdir,
                            "targetdir|t=s", \$targetdir
                           );
  my @opts_configfile = ("configfile|c=s@", \@ConfigFiles);


  # the options from the environment variable
  my @env_options = 
    (exists $ENV{$ENV_STOWES})?(split /\s/, $ENV{$ENV_STOWES}):();
  
  # the options given on the command line
  my @orig_argv = @ARGV;

  Getopt::Long::config("pass_through");
  # get the config-files from the environment variable
  @ARGV = @env_options;
  my $ret = GetOptions(@opts_configfile);
  @env_options = @ARGV; # env_options now without the -c option
  $ret || (ShortUsage(), exit(1)); # useless here?

  # get the config-files from the command line
  @ARGV = @orig_argv;
  $ret = GetOptions(@opts_configfile);
  @orig_argv = @ARGV; # @orig_argv now without the -c option


  # now check the config-files for the existance of 
  # stowdir and targetdir options
  @ARGV = ReadConfigFile(@rcFiles, @ConfigFiles);
  $ret = GetOptions(@opts_stowtargetdir);
  my @config_options = @ARGV; # without the "-s" and "-t" options
  $ret || (ShortUsage(), exit(1)); # useless here?
  # save them
  my $configfile_stowdir   = $stowdir;
  my $configfile_targetdir = $targetdir;
  $stowdir = $targetdir = undef;


  # now check the env-var for the existance of 
  # stowdir and targetdir options
  if ($#env_options != -1) {
    @ARGV = @env_options;
    $ret = GetOptions(@opts_stowtargetdir);
    @env_options = @ARGV; # without the "-s" and "-t" options
    $ret || (ShortUsage(), exit(1)); # useless here?
  }
  my $env_stowdir = $stowdir;
  my $env_targetdir = $targetdir;
  $stowdir = $targetdir = undef;

  # read all the options from the command-line
  Getopt::Long::config("no_pass_through");
  @ARGV = (@config_options, @env_options, @orig_argv); # order matters here!
  $ret = GetOptions(@opts_stowtargetdir, @opts);
  $ret || (ShortUsage(), exit(1));

  $Verbose = (!defined $Verbose)?1:(!$Verbose)?2:($Verbose+1);
  $Verbose = 0 if (defined $quiet && $quiet);
  
  printV2("Using Stow-/TargetDir from ");
  unless ($stowdir || $targetdir) { # no -s or -t on command-line
    if ($env_stowdir || $env_targetdir) {
      $stowdir   = ($env_stowdir)?($env_stowdir):undef;
      $targetdir = ($env_targetdir)?($env_targetdir):undef;
      printV2 "environment variable \$$ENV_STOWES.\n";
    } else {
      $stowdir   = $configfile_stowdir;
      $targetdir = $configfile_targetdir;
      printV2(($configfile_stowdir || $configfile_targetdir)?
              ("config-files.\n"):("built-in values.\n"));
    }
  } else {
    printV2 "command line.\n";
  }

  $stowdir   = UnTildePath($stowdir)   if defined $stowdir;
  $targetdir = UnTildePath($targetdir) if defined $targetdir;

  my $cwd = GetCWD();  # cache cwd
  if (defined $targetdir) {
    ($TargetDir = RelToAbsPath($cwd, $targetdir)) =~ s,/*$,,;
    $StowDir = (defined $stowdir)?
      RelToAbsPath($cwd, $stowdir):$TargetDir."/".$StowDirName;
  } elsif (defined $stowdir) {
    $StowDir = RelToAbsPath($cwd, $stowdir);
    $TargetDir = GetParentDir($StowDir);
  }

  $DumpDir = RelToAbsPath($cwd, UnTildePath($DumpDir));
  
  # remove trailing "/"'s
  $StowDir =~ s,/*$,,;
  $TargetDir =~ s,/*$,,; # just to go for sure...
  $DumpDir =~ s,/*$,,;

  # remove to much slashes
  $SubDirName =~ s,/+,/,g;
  $SubDirName =~ s,^/*(.*?)/*$,$1,;
  # prepend a slash so that $SubDirName is directly insertable
  $SubDirName = '/'.$SubDirName if ($SubDirName ne '');

  for (@AltProgs) {
    my @a = split(/=/, $_, 2);
    next unless (defined $a[0] && defined $a[1]);
    ShortUsage(),exit(1) unless (grep(/^$a[0]$/, keys %Progs));
    $Progs{$a[0]} = $a[1];
  }

  sub __split_param_stuff {
    my %r;
    for (@_) {
      next unless defined;
      my @a = split /=/, $_, 2;
      if ($#a == 0) { $a[1] = $a[0]; $a[0] = ''; }
      
      $r{$a[0]} .= ((defined $r{$a[0]})?' ':'').$a[1];
    }
    %r;
  }
  
  %ParamConfigure = __split_param_stuff(@prm_conf);
  %ParamMake      = __split_param_stuff(@prm_make);

  $ParallelJobs = 1 if $ParallelJobs < 0;

  printV2 "Values: TargetDir \"$TargetDir\" and StowDir \"$StowDir\".\n",
    "Dumping files into \"$DumpDir\".\n";

  1;
}

sub CheckForExternalPrograms {
  # check for all programs in %Progs whether they're available
  my @p = map {UnTildePath($_)} split(/:/, $ENV{PATH});
  for (keys %Progs) {
    my $bin = (split(/\s+/, $Progs{$_}))[0];
    print "Checking for $bin ... " if $Verbose >= 3;
    my $bo = 0;
    $bo = 1 if $bin =~ /^\// && -x $bin;
    unless ($bo) {
      for my $p (@p) { $bo = 1,last if -x $p.'/'.$bin; } 
    }
    if ($bo) {
      print "found.\n" if $Verbose >= 3;
    } else {
      if (defined $ProgsFailFuncs{$_}) {
        &{$ProgsFailFuncs{$_}};
      } else {
        die "Could not find program \"$bin\"!\n".
            "  Please install it or cheat me with the `--prog'-param.\n";
      }
    }
  }
}

sub ReadConfigFile {
  my @args = ();
  foreach my $f ( @_ ) {
    $f = UnTildePath($f);
    open(FF, "+".$f) || next;
    while (defined ($_ = <FF>)) {
      s/(.*)\#.*/$1/;
      $_ = CutOffWhitespaces($_);
      next if (/^$/);
      push @args, split(/\s/); 
    }
    close(FF);
  }
  @args;
}

sub CutOffWhitespaces {
  $_ = $_[0];
  s/^\s*(.*?)\s*$/$1/; # cut off whitespaces
  $_;
}

sub PrintValuesInString {
  my ($name, $ref) = @_;
  return unless (defined $ref);
  my $s;
  $s .= "$name = " if (defined $name);
  if (ref $ref eq "ARRAY") {
    $s .= "[ ".join(', ', @{$ref})." ]";
  } elsif (ref $ref eq "HASH") {
    $s .= "{ ". join(', ', map {"$_ => \"$$ref{$_}\""} keys(%{$ref})). " }";
 #   $s .= "{ ". join(', ', map {"$_ => ".((ref $$ref{$_} eq "ARRAY")?PrintValuesInString(undef, \@{$$ref{$_}}):$$ref{$_}) } keys(%{$ref})). " }";
  } else {
    $s .= ((defined $$ref)?"'$$ref'":"undef");
  }
  $s;
}

sub PrintValues {
  print PrintValuesInString(@_);
}

sub AreRegExpMatching {
  my ($file, $what, $index_pos, @re) = @_;
  foreach ( @re ) {
    if ($what) {
      # use real regexps
      return 1 if ($file =~ /$_/i);
    } else {
      if (defined $index_pos && $index_pos >= 0) {
        return 1 if (index($file, $_) == $index_pos);
      } else {
        return 1 if (index($file, $_) != -1);
      }
    }
  }
  0;
}

sub GetParamsForPrograms {
  my ($package, %Params) = @_;
  my $p = '';
  for (keys %Params) {
    $p .= $Params{''},next if ($_ eq '');
    $p .= ($package =~ /$_/i)?$Params{$_}.' ':'';
  }
  $p;
}

sub GetParamsForMake      { GetParamsForPrograms(shift, %ParamMake);      }
sub GetParamsForConfigure { GetParamsForPrograms(shift, %ParamConfigure); }

sub GetParallelParamForMake {
  if ($ParallelJobs == 0) {
    return "-j".getCPUNumber();
  } elsif ($ParallelJobs > 1) {
    return "-j$ParallelJobs";
  }
  return '';
}

sub FollowLink {
  my $lnk = shift;
  my $nlnk;
  while (defined ($nlnk = readlink($lnk))) {
    $lnk = $nlnk;
  }
  $lnk;
}

sub getSystem {
  my $sys = `uname -s 2>&1`;
  return undef if $?;
  chomp $sys;
  return $sys;
}

sub getCPUNumber {
  my $default_nr = 1;
  my $nr = 0;
  
  # try some methods to get the number
  my $sys = getSystem();
  return $default_nr unless defined $sys;

  if (lc($sys) eq 'linux') {
    # Linux with mounted /proc (should be usual)
    if (-r "/proc/cpuinfo") {
      open(A, "/proc/cpuinfo") || return $default_nr;
      while (<A>) {
	$nr++ if (/^processor\s+:/);
      }
      close A;
    }
  } elsif (lc($sys) eq 'aix') {
    if (open(A, "lsdev -C |")) {
      while (<A>) {
	$nr++ if (/^proc\d+\s+Available.+Processor/);
      }
      close A;
    }
  } elsif (lc($sys) eq 'sunos') {
    if (open(A, "mpstat |")) {
      while (<A>) {
	$nr++ if (/^\s*\d/);
      }
    }
  }

  return (($nr)?($nr):$default_nr);
}

sub NetGet {
  my ($url) = @_;
  my $file = GetBaseName($url);
#  return 1 if (is_success(getstore($url, $file)));
  0;
}

# DiveDir

# $path     ... path to begin
# $file_sub ... sub called for every not-dir found (with the name as param)
# $dir_sub  ... sub called for every dir found (with the name as param)
# $attrs    ... hash of values:
#   A default may be given in parentheses if none is given the option
#   has to be supplied.
#     - Dive ... true/1:  go recursively
#                false/0: process only files/dirs in $path
#     - RegExpIncl([]) ... RegExp(s) for names to include as an array
#                            if nothing is given "all" is assumed
#     - RegExpExcl([]) ... RegExp(s) for names to exclude as an array
#                            excludes are checked after the includes
#     - CheckWithPath(0) ... true/1:  Check whole path against regexps
#                            false/0: Only check "basename" against regexps
#     - RealRegExp(1) ... true/1:  Use real regexps for checking
#                         false/0: Use index function for checking (faster?)
#        (this is necessary for using filenames with special chars as
#         search expressions (e.g. gtk+ is a candidate here...))
#     - IndexPos(undef) ... Used if "RealRegExp"-Option is false
#                             if not set (undef) than the searchstring can
#                             match somewhere, if a position is set, the found
#                             substring has to start at this position, 0 is the
#                             first one (see index function in perlfunc)
#    THE LAST TWO ONES SEEM TO BE BROKEN OF CONCEPT... :-(
#     - Continue(0) ... true/1:  you want to go on even if a sub fails
#                                  or the return value of the sub is not
#                                  interesting to you...
#                       false/0: exit immediately if a sub 
#                                  returns someting != undef
#     - FollowLinks(0) ... true/1:  Follow (directory!) links
#                                      (infinite loops may occur!)
#                          false/0: Don't follow (directory) links
# Example:
#   DiveDir("/usr/local/stow", \&mydel, \&mydel, 
#           {Dive => 0, RegExpExcl => ["^stow\$"]});
#   sub mydel { `rm -rf $_[0]`; }

# these are the default-values for the options
my %DiveDir_DefaultOptionValues = 
  (  CheckWithPath => 0,
     RealRegExp    => 1,
     IndexPos      => undef,
     Continue      => 0,
     FollowLinks   => 0,
     RegExpIncl    => [],
     RegExpExcl    => [],
  );
my @DiveDir_MustBeGivenOptions = ('Dive');

sub DiveDir {
  my ($path, $file_sub, $dir_sub, $attrs) = @_;

  # remove trailing slashes
  $path =~ s/(.*?)\/*$/$1/;

  if ($DEV) {
    # must options
    foreach (@DiveDir_MustBeGivenOptions) {
      die "$_-option not specified for DiveDir!" unless exists $$attrs{$_};
    }
  
    # check for validity
    foreach my $k (keys %$attrs) {
      die "Unknown option \"$k\" in DiveDir!" 
        unless (grep(/^$k$/, @DiveDir_MustBeGivenOptions, 
                     keys %DiveDir_DefaultOptionValues));
    }
  }

  # set std-values of options not given
  foreach (keys %DiveDir_DefaultOptionValues) {
    $$attrs{$_} = $DiveDir_DefaultOptionValues{$_}
      unless (defined $$attrs{$_});
  }

  DiveDirSub($path, $file_sub, $dir_sub, $attrs);
}

sub DiveDirSub {
  my ($path, $file_sub, $dir_sub, $attrs) = @_;
  my $entry;
  my $ret = undef;

  opendir(DIR, $path) || die "Can't open directory $path: $!";
  foreach ( sort readdir(DIR) ) {
    next if (/^\.{1,2}$/);
    $entry = $path."/".$_;

    next unless (!defined @{$$attrs{RegExpIncl}} ||
                 $#{$$attrs{RegExpIncl}} == -1 ||
                 AreRegExpMatching(($$attrs{CheckWithPath})?$entry:$_,
				   $$attrs{RealRegExp},
                                   $$attrs{IndexPos},
				   @{$$attrs{RegExpIncl}}));
    next if (defined @{$$attrs{RegExpExcl}} && 
	     $#{$$attrs{RegExpExcl}} != -1 &&
	     AreRegExpMatching(($$attrs{CheckWithPath})?$entry:$_,
                               $$attrs{RealRegExp},
                               $$attrs{IndexPos},
                               @{$$attrs{RegExpExcl}}));

    $ret = &$file_sub($entry) if (defined($file_sub) && ! -d $entry);
    $ret = &$dir_sub($entry)  if (defined($dir_sub) && -d $entry);

    if ($$attrs{Dive} && (!defined $ret || $$attrs{Continue}) &&
        -d $entry && ($$attrs{FollowLinks} || ! -l $entry)) {
      if (-r $entry) {
        $ret = DiveDirSub($entry, $file_sub, $dir_sub, $attrs);
      } else {
        print "WARNING: $entry not readable!\n" if $Verbose;
      }
    }
    return $ret if (!$$attrs{Continue} && defined $ret);
  }
  closedir(DIR);
  undef;
}



# ----------------------------------------

# calls a program, 
# returns 1 if program outputs nothing (success)
# returns 0 if program outputs something (failure)
sub CallSilent {
  my ($start_text, $exec_text, $print_output, $error_text, $end_text) = @_;

  if ($DryRun) {
    print "($exec_text)\n";
    return 1;
  }
  print $start_text if defined $start_text;
  my $output = `$exec_text 2>&1`;
  if (defined $error_text && $output ne '') {
    print $error_text;
    print $output if ($print_output);
    return 0;
  }
  print $end_text if defined $end_text;
  1;
}

# calls a program
# returns 1 (success) if the program returned with exit code 0
# returns 0 (failure) if the program returns with exit code != 0
# prints error message when exit code of program is != 0
sub CallExitCode {
  my ($start_text, $exec_text, $error_text, $end_text) = @_;
  
  if ($DryRun) {
    print "($exec_text)\n";
    return 1;
  }
  print $start_text if (defined $start_text);
  system($exec_text);
  my $status = $? >> 8;
  print $error_text if (defined $error_text && $status);
  print $end_text if (defined $end_text);
  !$status;
}

# calls a program
# returns 1 if $scan_pattern could not be matched on the output of the program
# returns 0 if $scan_pattern could be found in the output of the program
sub CallOutput {
  my ($start_text, $exec_text, $error_text, $scan_pattern, $end_text) = @_;
  
  if ($DryRun) {
    print "($exec_text)\n";
    return 1;
  }
  my $err = 1;
  printV1 $start_text if defined $start_text;
  unless (open(F, "$exec_text 2>&1 |")) {
    printV1 $error_text if defined $error_text;
    return 0;
  }
  while (<F>) { 
    print; 
    $err = 0 if defined $scan_pattern && $scan_pattern ne '' &&
		/$scan_pattern/i;
  }
  close F;
  printV1 $end_text if defined $end_text;
  $err;
}

# ----- ----- ----- -----

sub CopyFile { # why not use cp?
  my ($from, $to) = @_;
  printV1("cp $from $to.\n"), return(1) if ($DryRun);

  open(INP, "$from") || (printV1("Error opening file $from."), return 0);
  open(OUTP, ">$to") || (printV1("Error creating file $to."), return 0);
  while (<INP>) { print OUTP $_; }
  close(OUTP);
  close(INP);
  1;
}

# this sub will do a "mkdir -p $path"
sub MkDir {
  my ($path, $rights) = @_;
  return 1 unless ($path =~ /^\//);
  if ($DryRun) { 
    printV1("mkdir -p $path ",
            (defined $rights)?"with rights $rights (relative to umask)":"", 
            "\n");
    return 1;
  }

  my @spl = split("/", $path);
  my $p = "";
  for (@spl[1 ..$#spl]) {
    $p .= "/".$_;
    next if (-d $p);
    unless (mkdir($p, (defined $rights)?$rights:0777)) {
      printV1 "Could not create directory $p!\n";
      return 0;
    }    
  }
  1;
}

sub Uniq {
  my (@data) = @_;  # date should be sorted

  my $i = 0;
  while ($i < $#data) {
     if ($data[$i] eq $data[$i+1]) {
       splice(@data, $i, 1);
       next;
     }
     $i++;
  }
  @data;
}

sub ExcludeLibs {
  my (@libs) = @_; # array should be preprocessed by sort und Uniq...

  my $i = 0;
  my $bo;
  while ($i <= $#libs) {
    $bo = 0;
    foreach my $pattern ( @exclude_dep_libs ) {
      $bo = 1, last if ($libs[$i] =~ /$pattern/);
    }
    if ($bo) { 
      splice(@libs, $i, 1); 
    } else { 
      $i++; 
    }
  }
  @libs;
}

# this is not generally right, but will work for the needs it's used...
sub IsRuleInMakefile {
  my ($rule, $makefile) = @_;

  open(F, $makefile) || return 0;
  while (defined($_ = <F>)) {
    close(F),return(1) if (/^$rule:/);
  }
  close F;
  0;
}

sub CheckDir {
  my ($path, $p) = @_;
  
  return 1 if ($DryRun || -d $path);
  printV1 "There is no directory $path!\n" if (!defined $p || !$p);
  0;
}

sub RelToAbsPath {
  my ($wd, $relpath) = @_;
  
  return $relpath if ($relpath =~ /^\//);
  return undef if ($wd !~ /^\//);

  my @relparts = split('/', $relpath);
  my @wdparts  = split('/', $wd);
  shift(@wdparts);

  my $i = $#wdparts;
  for (@relparts) {
    $i--,next if ($i != -1 && $_ eq '..');
    next if ($_ eq '.' || $_ eq '..');
    $wdparts[++$i] = $_;
  }
  "/".join('/', @wdparts[0..$i]); 
}

sub UnTildePath {
  ($_ = shift) =~ s,^~([^/]*),($1 eq '')?$ENV{HOME}:(@_=(getpwnam $1))?$_[7]:"~$1",e;
  $_;
}

sub GetFirstDirFromTar {
  my ($tarfile, $prefilter) = @_;

  unless (open(F, "$prefilter $tarfile |")) {
    printV1 "Problems getting directory name from $tarfile!";
    return undef;
  }
  my $name = <F>;
  close(F);
  substr($name, 0, index($name, "/"));
}

sub getDottedFigure {
  ($_) = @_;
  # get thousands_sep info from locale,
  # I'm taking the monetary value here and I'm ignoring the
  # grouping value
  my ($thousands_sep) = @{localeconv()}{'mon_thousands_sep'};
  $thousands_sep = ',' unless defined $thousands_sep;
  my $ts_pat = ($thousands_sep eq '.')?'\\.':$thousands_sep;
  while(s/(\d)(\d{3}($ts_pat|$))/$1$thousands_sep$2/) {}
  $_;
}

# this sub checks the status of a package
# it may return:
#   - not checked in (really no file found)
#   - partionally checked in/broken (only some files are checked in)
#   - checked in (all files are checked in)
sub PACKAGE_CHECKEDIN  { 1; }
sub PACKAGE_CHECKEDOUT { 2; }
sub PACKAGE_BROKEN     { 3; }
sub GetPackageStatus {
  my $package = shift;

  my $package_path = $StowDir.'/'.$package;
  my $plength = length($package_path) + 1;
  my $filecount = 0;
  my $files_ok  = 0;
  my $skip_dir  = undef;
  my @conflicts = ();

  DiveDir($package_path,
	  sub {   # sub for file
	    my $file = shift;
	    my $targetlink = $TargetDir.'/'.substr($file, $plength);
	    my @filestats = lstat($file);
            my $leave = 0;
            my $link = 0;
            if (($filestats[2] & 0120000) == 0120000) {
              # $file is a link --> get real stats
              $link = 1;
              @filestats = stat($file);
            }
            unless (@filestats) {
              push(@conflicts, $file);
              $leave = 1;
            }

	    return if (defined $skip_dir && 
                       index($targetlink, $skip_dir) == 0);
	    $filecount++;
            return if $leave;

	    push(@conflicts, $targetlink),return unless (-l $targetlink);
	    my $targetfile = readlink($targetlink); 
	    # not checking if targetfile is defined since we have already 
	    # checked that targetlink is a link 
	    $targetfile = RelToAbsPath(GetPathName($targetlink), $targetfile);
            my @targetstats = stat($targetfile);
	    push(@conflicts, $targetfile),return 
	      unless ($#targetstats != -1 && $targetstats[1] == $filestats[1]);
	    $files_ok++;
	  },
	  sub {   # sub for dir
	    my $dir = shift;  
	    my $targetdir = $TargetDir.'/'.substr($dir, $plength);
	    return if (defined $skip_dir && index($targetdir, $skip_dir) == 0);

	    if (-l $targetdir) {
	      $filecount++; 
	      my $linkdir = 
		RelToAbsPath(GetPathName($targetdir), readlink($targetdir));
	      # not checking if readlink is succesful since targetdir
	      # is a link inside here...
	      if ($linkdir eq $dir) { $files_ok++; } 
	      else                  { push @conflicts, $linkdir;  } 
	    }
	    $skip_dir = (-l $targetdir)?$targetdir.'/':undef;
	  },
          {Dive=>1, Continue=>1, FollowLinks=>1});

  my $ret;
  if ($filecount == $files_ok) {
    $ret = PACKAGE_CHECKEDIN;
  } elsif ($files_ok == 0) {
    $ret = PACKAGE_CHECKEDOUT;
  } else {
    $ret = PACKAGE_BROKEN;
  }

  return ($ret, $filecount, $files_ok, @conflicts)
    if (wantarray);
  return $ret;
}


# if the package does NOT contain a file this will not work
#  (but which package does not contain one; at least .config
#   should be lying around...)
# this sub only checks for one file...
# and has a flaw, if the package is broken in a way that the
# first file which DiveDir gets has no link in the targetdir it
# reports that this package isn't checked in although it's checked
# in but broken
# nevertheless this sub is faster than GetPackageStatus but don't use
# it for serious work
sub IsStowedIn_simple {
  my ($pack_dirname) = @_;

  return 0 unless (CheckDir($StowDir."/".$pack_dirname));
  # Lets get a file of this package
  my $pfile = my $tfile =
    DiveDir($StowDir."/".$pack_dirname, sub { return $_[0]; }, undef,
             {Dive => 1});
  return 0 unless (defined $pfile);

  # cut off $StowDir/$pack_dirname from file and preceed $TargetDir
  $tfile = $TargetDir.substr($tfile, length($StowDir."/".$pack_dirname));

  # check files
  return 0 unless (-e $tfile);
  # check if $pfile and $tfile are the same
  #   (will only work on filesystems with inodes...)
  return 1 if ( (stat($pfile))[1] == (stat($tfile))[1]);
  0;
}

sub GetPackageSize {
  my $package = shift;

  my ($sizebytes, $sizeblocks) = (0, 0);
  my %hlinodes;

  my $filesize = sub {
    my @filestats = lstat(shift);
    if ($filestats[3] > 1) { # hard links
      unless (defined $hlinodes{$filestats[1]}) {
        $hlinodes{$filestats[1]}++;
	$sizebytes  += $filestats[7];
	$sizeblocks += $filestats[12];
      }
    } else {
      $sizebytes  += $filestats[7];
      $sizeblocks += $filestats[12];
    }
  };

  &$filesize($StowDir.'/'.$package);
  DiveDir($StowDir.'/'.$package,
          $filesize, # sub for files
          $filesize, # sub for dirs
          {Dive => 1, Continue => 1});

  return ($sizebytes, $sizeblocks);
}

# return "" if the answer is yes and the file conflicting if the
# answer is no
sub CanPackageBeStowedIn {
  my $package = shift;

  return "" if (GetPackageStatus($package) == PACKAGE_CHECKEDIN);

  my $plength = length("$StowDir/$package") + 1;
  my $res = 
    DiveDir($StowDir."/".$package,
	    sub { 
	      my $stowfile = shift;
	      my $targetfile = $TargetDir."/".substr($stowfile, $plength);
	      return $targetfile if (-f $targetfile);
	      undef;
	    }, 
             undef,
            {Dive=>1, FollowLinks=>1});
  return "" unless (defined $res);
  return $res;
}

# caching the "CWD" maybe a bad idea but it's faster currently...
my $__CWDfromFirstCall = undef;
sub GetCWD {
  #my $cwd;
  #chop($cwd = `pwd`);
  #return $cwd;
  $__CWDfromFirstCall = getcwd() unless (defined $__CWDfromFirstCall);
  return $__CWDfromFirstCall;
}

sub ChDir {
  chdir(shift);
  $__CWDfromFirstCall = getcwd();
}

sub GetBaseName {
  my $path = shift;
  $path =~ s,/+$,,;
  my @spl = split(/\//, $path);
  return $spl[$#spl];  
}

sub GetPathName {
  my $path = shift;
  $path =~ s,/+$,,;
  my @spl = split(/\//, $path);
  my $p = join('/', @spl[0..$#spl-1]);
  ($p eq '')?'/':$p;
}

sub GetParentDir {
  GetPathName(@_);
}

sub GetPackageName {
  my ($abspath) = @_;
  return $PackageName if (defined $PackageName);
  GetBaseName($abspath);
}

sub GetConfigDirForPackage {
  my $package = shift;
  return "$StowDir/$package/$ConfigDirName/$package";
}

sub CreateConfigDirInPackage {
  my $package = shift;
  return 0 unless (MkDir(GetConfigDirForPackage($package)));
  1;
}

# don't forget to change DoRename if changing sth here...
sub CreateCreatorInfoFile {
  my $package = shift;
  my $file = GetConfigDirForPackage($package).'/'.$CreatorInfoFileName;
  printV1("Would create creatorinfo in $file\n"), return 1 if ($DryRun);

  my ($user, $gcos) = (getpwuid($<))[0, 6];
  $gcos =~ s/^(.*?),/$1/;
  open(CI, ">$file") || return 0;
  print CI 
    "Package   : $package\n",
    "Creator   : ", $user, " ($gcos)\n",
    "Date      : ", scalar localtime(time), "\n",
    # Splitting these up isn't really platform independant
    "Host-Info : ", `$Progs{uname} -a`,
    "stowES    : $Version\n";
  close CI;
  1;
}

sub CheckPackageExistance {
  my $package = shift;
  if (-d $StowDir."/".$package && !$BoolForce) {
    printV1 "$package does already exists!\n";
    return 0;
  }
  1;
}

sub CountMatchesInDir {   # takes: dir, regexp, regexp, more regexps, ...
  my $counter = 0;
  DiveDir(shift, sub { $counter++; }, sub { $counter++; },
          {Dive=>0, Continue=>1, FollowLinks=>1, RegExpIncl=>\@_});
  $counter;
}

sub GetMatchesInDir {     # takes: dir, regexp, regexp, more regexps, ...
  my @matches = ();
  DiveDir(shift,
	  sub { push @matches, $_[0]; }, 
	  sub { push @matches, $_[0]; },
          {Dive=>0, Continue=>1, FollowLinks=>1, RegExpIncl=>\@_});
  @matches;
}


sub GetTempFile {
  my $dir = shift;
  my $prefix = shift;
  
  $dir = $DumpDir unless ($dir);
  $dir =~ s,/*$,/,;
  $prefix = "" unless (defined $prefix);
  my $file = undef;
  my $f;

  for my $c ( 1 .. 50 ) {
    $f = $dir.$prefix."_temp_$c"."_".time();
    unless (-e $f) {
      $file = $f;
      last;
    }
  }
  unless (defined $file) {
    printV1 "Couldn't create temporary file, giving up!";
    return undef;
  }
  $file;
}

sub ReplaceInFile {
  my ($file, $from, $to) = @_;

  printV1("Replacing \"$from\" in file \"$file\" to \"$to\".\n"), return(1)
    if $DryRun;

  -r $file || (printV1("Cannot read file $file!\n"), return 0);
  
  my $tempfile = GetTempFile(GetPathName($file), $ChecksumFileName);
  return 0 unless ($tempfile);

  open(RF, $file) || 
    (printV1("Could not open file $file for reading!\n"), return 0);
  open(WF, ">$tempfile") ||
    (printV1("Could not open file $tempfile for writing!\n"), return 0);
  while (defined ($_ = <RF>)) {
    s/$from/$to/g;
    print WF;
  }
  close WF;
  close RF;

  unlink($file) || (printV1("Could not delete file $file!\n"), return 0);
  rename($tempfile, $file) || 
    (printV1("Could not rename $tempfile to $file!\n"), return 0);
  1;
}

# give a file (with full absolute path) and get the package it belongs to;
# return undef if no package could be found
sub GetPackageNameForFile {
  $_ = shift;
  return undef unless (s,^$StowDir/,,);
  return (split(/\//))[0];
}

# this sub checks the targetdir only contains links and dirs (1)
# and that the links are pointing into the $StowDir (2)
# (1) ... if not the files/dirs are prefixed with "f:"
# (2) ... if not -"- -------------- " ----------  "o:"
sub CheckTargetDir {
  my @err_files_and_dirs = ();

  DiveDir($TargetDir,
	  sub {  # files
	    my $file = shift;

            my $real = readlink $file;
            if (defined $real) {
              # check link here
              if (index(RelToAbsPath(GetPathName($file), $real),
                        $StowDir) == -1) {
                push @err_files_and_dirs, "o:".$file;
              }
            } else {
              push @err_files_and_dirs, "f:".$file;
            }
	  },
         undef,
         {Dive=>1, CheckWithPath=>1, RealRegExp=>1, Continue=>1,
          RegExpExcl => ["^$StowDir\$"]});

  return (wantarray)?@err_files_and_dirs:($#err_files_and_dirs+1);
}

# get configuration options of package out of store "config.status" files
# given back as a string, undef if file couldn't be opened
sub GetPackageConfiguration {
  my $package = GetBaseName(shift);

  return undef
    unless (open(C, GetConfigDirForPackage($package).'/config.status'));

  # this is highly dependant on the layout of
  # the config.status file of autoconf

  my $d = $/;
  undef $/;
  # suck whole file in this variable so that we can apply a regexp on it
  $_ = <C>;
  close C;
  $/ = $d;

  # config.status-layout by autoconf < 2.5
  return $1
    if /# on host \S+:.#.#\s+\S+configure\s+(.+?)$/smi;

  # layout used by autoconf >= 2.5
  return $1
    if /config\.status.*?^configured by .+?configure, generated by GNU Autoconf .+?,.  with options \\\"(.*?)\\\"$/smi;

  # this is e.g. found in gcc, neglecting the possible path issue of the
  # configure call
  return $1
    if /^\.\/configure\s*(.+?)$/mi;
  
  '__NONE__';
}

sub GetTarfileDecompressor {
  my $file = shift;

  if ($file =~ /\.t?gz$/) {
    return "$Progs{gzip} -cd";
  } elsif ($file =~ /\.bz2$/) {
    return "$Progs{bzip2} -cd";
  } elsif ($file =~ /\.tar$/) {
    return $Progs{cat};
  } else {
    printV1("Unsupported format for $file!\n");
    return undef;
  }
}

sub RegisterInfoDocumentation {
  my $package = GetPackageName(shift);

  #if (! -e "$TargetDir/info/dir" || -f "$TargetDir/info/dir") {
  #  `$Progs{'install-info'} --infodir=$TargetDir/info `;
  #}
  #

  DiveDir("$StowDir/$package/$InfoDir",
          sub {
	  
	  },
	  undef,
	  {RegExpIncl => ['\.info(\.gz)?$']});

}

sub UnregisterInfoDocumentation {

}

# find an older configuration for a given file using some "magic"
# to get the latest installed package
sub GetSavedOptionsFromOlderPackage {
  my $package = GetPackageName(shift);

  # the version of the "old" package and the package we're just installing
  # will usually be different, so we'll have to find an appropriate base
  # name to choose the old configuration from...
  my $basename = $package;

  my @b = split //, $basename;
  
  my $start_block = 0;
  my $cont_block = 0;
  my $regexp = '\d';
  my $version_start = 0;
  for (my $i = 0; $i <= @b; $i++) {
    $version_start = 1
      if (defined $b[$i] && $b[$i] !~ /[\w\d]/);

    if ($version_start && defined $b[$i] && $b[$i] =~ /$regexp/) {
      $start_block = $i unless $start_block;
    } elsif ($start_block) {
      splice(@b, $start_block, $i-$start_block,
             ($cont_block)?'[\w\d]*':'\d+');
      $cont_block++;
      $regexp = '[\d\w]';
      $i = $start_block+1;
      $start_block = 0;
    }
  }
  
  $basename = join('', @b);

  # - now, that we've got the basename of the package we can go out
  #   and search for a package with the pattern "^$basename"
  # - once found we'll take latest one assuming that this is highest
  #   installed version

  my ($rpathtime, $rpath) = (0, '');;
  DiveDir($StowDir, undef, sub {
            my $d = shift;
            my $t = (stat($d))[9];
            #print "$d: ", scalar localtime $t, "\n";
            ($rpath, $rpathtime) = ($d, $t)
              if ($t > $rpathtime);
          },
          {Dive=>0, RegExpIncl=> ["^$basename"], Continue => 1});

  printV1("Retrieving configuration from basename \"$basename\".\n");

  if ($rpathtime > 0) {
    my $conf = GetPackageConfiguration($rpath);

    if (!defined $conf || $conf eq '__NONE__') {
      print "$package: No configuration found (probably couldn't parse config.status, fixme!)!\n";
      return undef;
    }

    # take --prefix=... option out
    
    $conf =~ s/\s--prefix=.+?\s/ /;
    $conf =~ s/^\s+//;

    if ($Verbose) {
      print("Options taken from ", GetBaseName($rpath), ": ",
            $conf, "\n");
      # give the user a chance to validate the configuration
      print "Sleeping..."; sleep(3); print "done.\n";
    }

    return $conf;
  }
  return undef;
}

# Merge options, kill every option in addopts which is also in opts
# this doens't consider --enable/--disable nor --with/--without pairs
# XXX todo if pain raises
sub MergeOptions {
  my ($opts, $addopts) = @_;

  $opts    = '' unless defined $opts;
  $addopts = '' unless defined $addopts;

  my @o  = split /\s+/, $opts;
  my @ao = split /\s+/, $addopts;

  foreach (@o) {
    if (/^'?(--?[-\d\w]+)/) {
      my $p = $1;
      for (my $i = 0; $i < scalar @ao;) {
        if ($ao[$i] =~ /^'?(--?[-\d\w]+)/ &&
	    $p eq $1) {
	  splice(@ao, $i, 1);
	  next;
	}
	$i++;
      }
    }
  }
  join(' ', @o, @ao);
}

# we don't want to run ldconfig all the time, just at the end
# should be sufficient, so we just save the wish here and
# FinishLdconfig does the real call
sub RequestLdconfig {
  $CallLdconfig = 1;
}

# call ldconfig if available and UID==0
sub FinishLdconfig {
  
  # only run if running ldconfig was requested
  return 1 unless $CallLdconfig;

  # return successful if $Dryrun
  return 1 if $DryRun;

  # do nothing and return with success if not root...
  return 1 if $>;

  # assumption: if the system has a ldconfig it's in /sbin
  return 1 unless -x $Progs{ldconfig};

  # call it
  printV1 "Calling ldconfig.\n";
  system($Progs{ldconfig});
  return 0 if $?;

  return 1;

}

#  - -- ------ - - - --- - - - - - - -     - - - - - - - - - - - -
# the following subs are beginning with "Do" and are normally given
# the params from @ARGV
# they should return 1 on success and 0 otherwise

sub DoMakeInst {
  my $path = shift;

  $path = RelToAbsPath(GetCWD(), UnTildePath($path));
  if ($path !~ /\//) {
    printV1("Error with path!\n");
    return 0;
  }
  my $package = GetPackageName($path);
  unless (defined $package) {
    printV1("Could not determine package name!\n");
    return 0;
  }
  printV1("Package name: $package\n");

  # check if we're in the right dir
  unless ($DryRun || -r "$path/config.status") {
    printV1("no $path/config.status found!, aborting.\n");
    return 0;
  }

  my $ret = my $packageNotExisted = CheckPackageExistance($package);
  
  my $m = GetParamsForMake($package);
  $m = ' '.$m if $m ne '';
  $m = "prefix=\"$StowDir/$package$SubDirName\"".$m;
  printV1 "Installing package via \"$Progs{make} install $m\"\n"
    if $ret;
  $ret &&= CallOutput(("#"x75)."\n",
                      "cd \"$path\"; $Progs{make} install $m", 
                      "Couldn't exec \"$Progs{make} install".$m."\"!",
                      $MakeErrorScanPattern,
                      ("#"x75)."\n");

  # create additional dirs to save configs
  printV1 "Copying config-file ..." if $ret && !$DryRun;
  $ret &&= CreateConfigDirInPackage($package);
  $ret &&= CreateCreatorInfoFile($package);
  $ret &&= CopyFile("$path/config.status",
                    GetConfigDirForPackage($package)."/config.status");
  printV1 "done.\n" if $ret && !$DryRun;

  $ret &&= !(defined DoDepends($package));
  $ret &&= !(defined DoStrip($package));
  $ret &&= $BoolStrip || !(defined DoChecksums($package));
  $ret = DoRemoveSource($path, $package) && $ret
    if ($RemoveSource && ($ret || $ActualCommand eq 'install'));

  unless ($BoolNoInstallInfo) {
    # XXX RegisterInfoDocumentation();
  }

  # something failed --> remove broken package if was not forced
  DoRemove($package) 
    if !$ret && $packageNotExisted && !$BoolForce &&
        -e $StowDir."/".$package;

  printLOG("$package: makeinst ", ($ret)?"successful.":"failed!", "\n");
  $ret;
}

sub DoRemoveSource {
  my $path = shift; 
  my $package = shift; # only for needed for output
  return 0 unless (-d $path);
  my $p = GetBaseName($path);
  $package = $p unless (defined $package);
  my $cwd = GetCWD();
  ChDir('..') if (!$DryRun && index($path.'/', "$cwd/") != -1);
  return 0 unless 
    (CallSilent("Removing unpacked source of package $package ...",
	     "$Progs{rm} rm -rf \"$path\"",
	     1, "\n", "done.\n"));
  printLOG "$package: unpacked source removed\n";
  1;
}

sub DoUnTar {
  my $file = shift;
  my @extractfiles = @_;

  $file = RelToAbsPath(GetCWD(), $file);

  if (! -r $file || -d $file) {
    printV1("File $file does not exist!\n");
    return 0;
  }

  # find out type of package
  my $decomp = GetTarfileDecompressor($file);
  return 0 unless defined $decomp;
  return 0 unless (MkDir($DumpDir));
  
  # tar out the file
  my $ret = CallExitCode
    ("Un-tar-ing file $file in $DumpDir ...",
     "cd \"$DumpDir\"; $decomp \"$file\" | $Progs{tar} xf - ".
     join(' ', @extractfiles),
     "Error while Un-tar-ing file $file!\n",
     "done.\n");
  
  printLOG("$file un-tar-", ($ret)?"ed successfully":"ing failed", ".\n");
  return $ret if (!defined wantarray || !wantarray);
  
  ($ret, $DumpDir.'/'.GetFirstDirFromTar($file, "$decomp"));
}

sub DoConfHelp {
  my $p = RelToAbsPath(GetCWD(), shift);

  if (-d $p) {
    if (! -x "$p/configure") {
      printV1("There's no `configure' script in $p!");
      return 0;
    }
    system("$p/configure", '--help');
    return 1;
  }

  # $p is a file
  my $d = GetFirstDirFromTar($p, GetTarfileDecompressor($p));
  my ($ret, $tardir) = DoUnTar($p, "$d/configure");
  return 0 unless $ret;

  if (-x "$tardir/configure") {
    system("$tardir/configure", '--help');
  } else {
    printV1("$p does not seem to contain a configure script!");
  }

  return DoRemoveSource($tardir, $tardir);
}

sub DoMake {
  my $path = shift;
  
  $path = RelToAbsPath(GetCWD(), UnTildePath($path));
  if ($path !~ /\//) {
    printV1("Error with path!\n");
    return 0;
  }
  my $package = GetPackageName($path);
  unless (defined $package) {
    printV1("Could not determine package name!\n");
    return 0;
  }
  
  # check, if the package contains a "configure" script...
  if ($BoolConfigure && !$DryRun && !-x "$path/configure") {
    printV1("Package $package does not contain \"configure\" file!\n");
    return 0;
  }

  # this prints a warning if the package already exists...
  CheckPackageExistance($package);

  # call "configure" now
  if ($BoolConfigure) {
    my $c = GetParamsForConfigure($package);
    $c = ' '.$c if $c ne '';
    $c = "--prefix=\"$TargetDir$SubDirName\"".$c;
    if ($BoolUseSavedOptions) {
      $c = MergeOptions($c, GetSavedOptionsFromOlderPackage($package));
    }
    return 0 unless 
      CallOutput("Calling \"configure $c\" ...\n".('#'x75)."\n",
	  "cd \"$path\"; ./configure $c",
	  "Error while processing \"configure ".$c."\"\n",
	  $ConfigureErrorScanPattern,
	  ('#'x75)."\n");
    printLOG("$package: 'configure' was successful.\n");
  }


  my $m = GetParamsForMake($package);
  $m = ' '.$m if $m ne '';
  my $j = GetParallelParamForMake();
  $j = ' '.$j if $j ne '';
  # call make now
  return 0 unless 
    (!$BoolMake ||
     CallOutput("Calling \"make".$j.$m."\" ...\n".('#'x75)."\n",
		"cd \"$path\"; $Progs{make}".$j.$m,
		"Error while running \"make".$m."\"!\n",
		$MakeErrorScanPattern,
		('#'x75)."\n"));
  printLOG("$package: 'make' was successful.\n") if ($BoolMake);
  
  if ($BoolMake && $BoolMakeCheck &&
      IsRuleInMakefile('check', "$path/Makefile")) {
    return 0 unless
      (CallOutput("Calling \"make check".$m."\" ...\n".('#'x75)."\n",
                  "cd \"$path\"; $Progs{make} check".$m,
                  "Error while running \"make check".$m."\"!\n",
                  $MakeErrorScanPattern,
                  ('#'x75)."\n"));
      
    printLOG("$package: 'make check' was successful\n");
  }

  1;
}

sub DoInstPackage {
  my ($file) = @_;

  $file = RelToAbsPath(GetCWD(), $file);

  if (! -r $file) {
    printV1("File $file does not seem to exist!\n");
    return 0;
  }

  my $package = my $dn = GetFirstDirFromTar($file, "$Progs{gzip} -cd");
  $package = GetPackageName($package) if (defined $package);
  unless (defined $package) {
    printV1("Could not determine package name!\n");
    return 0;
  }
  return 0 unless (CheckPackageExistance($package));

  return 0 
    unless (CallSilent("Unpacking $file in $StowDir ...",
		       "cd \"$StowDir\"; $Progs{gzip} -cd \"$file\" | tar xf -",
		       1, "\nErrors while un-tar-ing package!\n",
		       "done.\n"));

  if ($dn ne $package) {
    return 0 unless DoRename($dn, $package);
  }
  
  return 0 if (defined DoCheckIn($package));

  printLOG "$file successfully installed\n";
  1;
}

sub DoInstall {
  my $arg = UnTildePath(shift);
  
  return 0 unless (-e $arg);
  my $p = $arg;
  unless ( -d $arg) {
    my @a = DoUnTar($arg);
    unless ($a[0]) {
      DoRemoveSource($a[1]) if $RemoveSource && $a[1];
      return 0;
    }
    $p = $a[1];
  }
  unless (DoMake($p) && DoMakeInst($p)) {
    DoRemoveSource(RelToAbsPath(GetCWD(), $p)) if $RemoveSource;
    return 0;
  }
  unless ( -d $arg) {
    return 0 if (defined DoCheckIn($p));
  } else {
    return 0 
      if (defined DoCheckIn(GetPackageName(RelToAbsPath(GetCWD(), $p))));
  }
  1;
}

sub DoRename {
  my $oldpackage = GetBaseName(shift);
  my $newpackage = shift;

  unless (-d $StowDir."/".$oldpackage) {
    printV1("Package $oldpackage does not exist!\n");
    return 0;
  }
  
  if (-d $StowDir."/".$newpackage) {
    printV1("Package $newpackage does already exist\n");
    return 0;
  }
    
  my $stowedin = 0;
  my $ostat = GetPackageStatus($oldpackage);
  if (!$BoolForce && $ostat == PACKAGE_BROKEN) {
    printV1("Package $oldpackage is broken, please correct\n");
    return 0;
  }
  if ($ostat != PACKAGE_CHECKEDOUT) {
    return 0 if (defined DoCheckOut($oldpackage));
    $stowedin = 1;
  }
  return 0 unless 
    (CallSilent("Renaming package from \"$oldpackage\" to \"$newpackage\" ...",
		"cd \"$StowDir\"; $Progs{mv} \"$oldpackage\" \"$newpackage\"",
		1, "\n"));
  if ( -d "$StowDir/$newpackage/$ConfigDirName/$oldpackage") {
    return 0 unless
      (CallSilent(undef, 
                  "cd \"$StowDir/$newpackage/$ConfigDirName\"; ".
                  "$Progs{mv} \"$oldpackage\" \"$newpackage\"",
                  1, "\n"));
  }
  my $confdirnew = GetConfigDirForPackage($newpackage);
  if ( -r "$confdirnew/$ChecksumFileName") {
    return 0 unless 
      (ReplaceInFile("$confdirnew/$ChecksumFileName",
                     " $ConfigDirName/$oldpackage",
                     " $ConfigDirName/$newpackage"));
  }
  if ( -r "$confdirnew/$CreatorInfoFileName") {
    return 0 unless
      (ReplaceInFile("$confdirnew/$CreatorInfoFileName",
                     "^Package.*$oldpackage",
                     "Package   : $newpackage"));
  }
  
  printV1("done.\n");
  
  if ($stowedin) {
    return 0 if (defined DoCheckIn($newpackage));
  }
  
  printLOG "$oldpackage successfully renamed to $newpackage\n";
  1;
}

sub DoExchange {
  my ($from, $to) = @_;

  ($from, $to) = (GetPackageName($from), GetPackageName($to));

  DoCheckOut($from);
  DoCheckIn($to);

  printLOG "Package $to and $from exchanged\n";
  1;
}

sub DoRebuild {
  return 0 unless (CheckDir($StowDir));
  # memorize all packages which are checked in
  # broken packages will _not_ be checked in again
  printV1("Memorizing checked in/checked out situation ...");
  my %rebuild_mem = ();
  DiveDir($StowDir, undef, sub {
            my $p = GetBaseName(shift);
            $rebuild_mem{$p} = 
              ((GetPackageStatus($p))[0] == PACKAGE_CHECKEDIN);
          },
          {Dive=>0, FollowLinks=>1, Continue=>1});
  printV1("done.\nRemoving link farm ...");
  sub __rebuild_rm { 
    CallSilent(undef, "$Progs{rm} -rf \"$_[0]\"");
    undef;
  }
  DiveDir($TargetDir, \&__rebuild_rm, \&__rebuild_rm,
          {Dive=>0, CheckWithPath=>1, RealRegExp=>1, Continue=>1,
           RegExpExcl => ["^$StowDir\$"]});
  printV1("done.\nChecking package(s) in again:\n");
  foreach (keys %rebuild_mem) {
    print("  "), DoCheckIn($_) if ($rebuild_mem{$_});
  }
  printV1("rebuild done.\n");
  printLOG "rebuild done\n";
  1; # we return 1 for success in this section of the source file
}

sub DoConfig {
  # print the values of the following vars
  foreach ( sort @ConfigVarList ) {
    eval "PrintValues('$_', \\$_);";
    print "\n";
    print $@ if ($@ ne '');
  }
  1; # success
}

sub DoShell {
  printV1("Would start your shell.\n"), return(1) if $DryRun;
  # calling shell with all environment variables set
  my $sh = $ENV{SHELL};
  if (defined $sh && -x $sh) {
    printV1 "Calling \"$sh\".\n";
    system($sh);
    printV1 "stowES: shell done.\n";
  } else {
    print "Could not start ", (defined $sh)?"\"".$sh."\"":"nothing";
  }
  1; # success
}

sub DoCheckTarget {
  return 0 unless (CheckDir($StowDir));
  print "Checking targetdir $TargetDir: ";
  my @ctd = CheckTargetDir();
  if ($#ctd == -1) {
    print "OK\n";
  } else {
    print "\n";
    my @ar_f = map{(s/^f:(.*)/$1/)?($_):()} @ctd;
    my @ar_o = map{(s/^o:(.*)/$1/)?($_):()} @ctd;
    print "  Not a directory or link: ", join(', ', @ar_f), "\n"
      if ($#ar_f != -1);
    print "  Wrong link(s): ", join(', ', @ar_o), "\n"
      if ($#ar_o != -1);
  }
  1; # success here
}

#  - -- ------ - - - --- - - - - - - -     - - - - - - - - - - - -
# the following subs are beginning with "Do" and are normally used
# with DiveDir so that they should return "undef" if operation was
# successful...


my $__Command_CheckStow_AccSize;   # global var accumulation package sizes
my $__Command_CheckStow_AccSize_I; # acc package sizes for installed packs
# this one is called from DoList and DoCheckStow because these
# commands do nearly the same...
sub __DoList_and_CheckStow {
  my $package = GetPackageName(shift);
  my $mode = shift;
  my $status;
  my @conflicts;
  my $size = "";
  my $kbytes = 0;

  if ($mode eq "check") {
    # GetPackageStatus takes a really long time
    ($status, undef, undef, @conflicts) = GetPackageStatus($package);
    # assumption: 2 blocks are 1 kbyte
    $kbytes = (GetPackageSize($package))[1]/2;
    $__Command_CheckStow_AccSize += $kbytes;
    $size = sprintf("(%7s) ", getDottedFigure($kbytes));
  } else {   # mode is "list"
    # IsStowedIn is faster than GetPackageStatus but will not check
    # for broken packages...
    $status = (IsStowedIn_simple($package))?PACKAGE_CHECKEDIN:PACKAGE_CHECKEDOUT;
  }

  if ($status == PACKAGE_CHECKEDIN) {
    print "I $size$package\n";
    $__Command_CheckStow_AccSize_I += $kbytes;
  } elsif ($status == PACKAGE_BROKEN) {
    my $l = length($TargetDir)+1;
    print("X $size$package (", 
          join(', ', map {substr($_, $l)} @conflicts), ")\n");
  } else {
    my $res = CanPackageBeStowedIn($package);
    if ($res eq '') {
      print "s $size$package\n";
    } else {
      my $l = readlink($res);
      if (defined $l) {
	my $t = $res;
	$res = $l if (defined $l);
	$res = RelToAbsPath(GetPathName($t), $res);
      }
      print "- $size$package (", substr($res, length($TargetDir)+1), ")\n";
    }
  }
  undef;
}

sub DoCheckStow { __DoList_and_CheckStow(shift, "check"); }
sub DoList      { __DoList_and_CheckStow(shift, "list");  }

sub DoChecksums {
  return undef unless ($BoolChecksums);
  my $package = GetPackageName(shift);
  return 0 unless (CheckDir($StowDir."/".$package));
  
  unless (CheckDir(GetConfigDirForPackage($package), 1)) {
    return 0 unless (CreateConfigDirInPackage($package));
  }

  if ($DryRun) {
    print "Would create checksums for package $package.\n";
    return undef;
  }

  printV1 "Creating MD5sums for package $package ...";
  unless (open(MD5FILE, 
	       ">".GetConfigDirForPackage($package)."/$ChecksumFileName")) {
    printV1("Error creating file $ChecksumFileName!\n");
    return 0;
  }
  DiveDir($StowDir."/".$package,
	  sub { 
	    my $output = `$Progs{md5sum} "$_[0]"`;
	    my $s = "$StowDir/$package";
	    my $i = index($output, $s);
	    $output = 
	      substr($output, 0, $i).substr($output, $i + length($s) + 1)
		if ($i != -1);
	    print MD5FILE $output; 
	  },
          undef,
          {Dive=>1, CheckWithPath=>1, RealRegExp=>0, Continue=>1,
          RegExpExcl => 
           [GetConfigDirForPackage($package)."/$ChecksumFileName"]});

  close MD5FILE;
  printV1 "done.\n";
  printLOG "$package: created checksums successfully\n";
  undef;
}

sub DoDepends {
  return undef unless ($BoolDepends);
  my $package = GetPackageName(shift);
  return 0 unless (CheckDir($StowDir."/".$package));

  unless (CheckDir(GetConfigDirForPackage($package))) {
    return 0 unless (CreateConfigDirInPackage($package));
  }

  if ($DryRun) {
    print "Would create dependencies for package $package.\n";
    return undef;
  }

  printV1 "Creating dependencies for package $package ...";
  my @dep_data = ();
  DiveDir($StowDir."/".$package,
	  sub { 
	    my ($file) = @_;
	    
	    return unless (-x $file); # only checking executables here...
	    # it's important that $file has a slash somewhere...
	    # see ldd(1)
	    my $text = `$Progs{ldd} "$file" 2>&1`;
	    return 
	      if ($text =~ /^ldd: /); # ldd: $file is not a.out or ELF
	    foreach my $line (split(/\n/, $text)) {
	      push @dep_data, $1 if $line =~ /\s(\S+)\s+=>\s/;
	    }
	  }, 
          undef,
         {Dive=>1, Continue=>1});
  @dep_data = ExcludeLibs( Uniq (sort @dep_data));
  
  unless (open(DEPFILE, 
	       ">".GetConfigDirForPackage($package)."/$DependencyFileName")) {
    printV1("Error creating file $DependencyFileName!\n");
    return 0;
  }
  print DEPFILE join("\n", @dep_data);
  close DEPFILE;
  printV1 "done.\n";
  printLOG "$package: created dependencies successfully\n";
  undef;
}

sub DoCheckIn {
  return undef unless ($BoolCheckIn);
  my $package = GetPackageName(shift);
  return 0 unless (CheckDir($StowDir."/".$package));
  my $stat = GetPackageStatus($package);
  if ($stat == PACKAGE_BROKEN) {
    printV1("Package $package is broken, please correct.\n");
    return 0;
  }
  if (GetPackageStatus($package) == PACKAGE_CHECKEDIN) {
    printV2 "No need to check in since package \"$package\" is checked in!\n";
    return undef;
  } elsif ($DryRun) {
    printV1 
      "Would check in package $package (it's not checked in currently).\n";
    return undef;
  }
  my $res = CanPackageBeStowedIn($package);
  if ($res ne '') {
    printV1("Package cannot be checked in, conflict: $res\n");
    return 0;
  }

  return 0 unless 
    CallSilent("Calling \"stow\" to check in package $package ...",
	       "$Progs{stow} --target=\"$TargetDir\" "
	       ."--dir=\"$StowDir\" \"$package\"",
	       1, "\nAn error occured while processing stow:\n",
	       "done.\n");
  # assumption: libs are in a lib directory
  RequestLdconfig() if -d "$StowDir/$package/lib";
  printLOG "$package: checked in\n";
  undef;
}

sub DoCheckOut {
  my $package = GetPackageName(shift);
  return 0 unless (CheckDir($StowDir."/".$package));
  if (GetPackageStatus($package) == PACKAGE_CHECKEDOUT) {
    printV2 "No need to check out since package $package is not checked in!\n";
    return undef;
  } elsif ($DryRun) {
    printV1 "Would check out package $package (it's checked in currently)\n";
    return undef;
  }

  return 0 unless 
    CallSilent("Calling \"stow -D\" to check out package $package ...",
	       "$Progs{stow} --target=\"$TargetDir\" "
	       ."--dir=\"$StowDir\" -D \"$package\"",
	       1, "\nAn error occured while processing stow:\n",
	       "done.\n");
  RequestLdconfig() if -d "$StowDir/$package/lib";
  printLOG "$package: checked out\n";
  undef;
}

sub DoRemove {
  my $package = GetPackageName(shift);
  return 0 unless (CheckDir($StowDir."/".$package));
  return 0 if (defined DoCheckOut($package));

  return 0 unless
    CallSilent("Calling \"rm -rf\" to remove package $package ...",
	       "cd \"$StowDir\"; $Progs{rm} -rf \"$package\"",
	       1, "\nAn error occured while removing package:\n",
	       "done.\n");
  printLOG "$package: removed\n";
  undef;
}

sub DoPackage {
  my $package = GetPackageName(shift);
  return 0 unless (CheckDir("$StowDir/$package"));
  return 0 unless (MkDir($DumpDir));

  my $packname = "$DumpDir/$package.stowES".
                  ((defined $PackageSuffix)?".$PackageSuffix":'').".tar.gz";
  
  return 0 
    unless (CallSilent("Creating a package of $package in $DumpDir ...",
		       "(cd \"$StowDir\"; $Progs{tar} cf - \"$package\") "
		       ."| $Progs{gzip} > \"$packname\"",
		       1, "\nError while creating package:\n",
		       "done.\n"));
  printLOG "$package: packaged\n";
  undef;
}

sub DoContentSearch {
  my $package = GetPackageName(shift);
  
  if ($DryRun) {
    print "Would search in package $package.\n";
    return undef;
  }

  print "Package $package:\n";
  DiveDir($StowDir."/".$package,
	  sub {
	    my $file = shift;
	    
	    unless (open F, $file) {
	      print "Could not open file $file!\n";
	      return;
	    }
	    my $matches = 0;
	    while (defined ($_ = <F>)) {
	      while (/$ContentSearchPattern/g) { $matches++ };
	    }
	    close F;
	    if ($matches) {
	      print "$matches match", ($matches>1)?"es":"", " in $file\n";
	      print CSF $file, "\n";
	    }
	  },
          undef,
          {Dive=>1, CheckWithPath=>1, RealRegExp=>0, Continue=>1,
          RegExpExcl=>
           [GetConfigDirForPackage($package)."/$ChecksumFileName"]});
  printLOG "$package: content search done\n";
  undef;
}

sub DoCheckChecksums {
  return undef unless ($BoolCheckChecksums);
  my $package = GetPackageName(shift);


  # this will only check files listed in $ChecksumFileName
  #   ----- Security-hole? -----
  CallSilent("Checking checksums for package $package ...",
	     "cd \"$StowDir/$package\"; $Progs{md5sum} -c "
	     ."\"$ConfigDirName/$package/$ChecksumFileName\"",
	     1, "\n",
	     " ok.\n");
  printLOG "$package: checked checksums\n";
  undef;
}

sub DoStrip {
  return undef unless ($BoolStrip);
  my $package = GetPackageName(shift);

  if ($DryRun) {
    print "Would strip files in package $package.\n";
    return undef;
  }

  printV1 "Stripping files for package $package ...";
  DiveDir($StowDir.'/'.$package,
	  sub {
	    my $file = shift;
	    CallSilent(undef, "$Progs{strip} \"$file\"", 0, undef, undef);
	  },
          undef,
          {Dive=>1, Continue=>1});
  printV1 "done.\n";
  printLOG "$package: stripped\n";

  # redo checksum
  return 1 if (defined DoChecksums($package));
  undef;
}

sub DoContents {
  my $package = GetPackageName(shift);
  if ($DryRun) {
    print "Would display contents of package $package.\n";
    return undef;
  }

  sub __l {
    my $file = shift;
    my $type = undef;
    $type = 'd' if -d $file;
    $type = 'l' if -l $file;
    $type = 'p' if -p $file;
    $type = 's' if -S $file;
    $type = 'b' if -b $file;
    $type = 'c' if -c $file;
    if (defined $type) {
      print "$type $file\n";
    } else {
      print "f $file (", (stat($file))[7], ")\n";
    }
  }

  print "Contents of package $package:\n";
  DiveDir($StowDir.'/'.$package, \&__l, \&__l,
          {Dive=>1, Continue=>1, FollowLinks=>1});
  
  printLOG "$package: displayed contents";
  undef;
}

sub DoCheckLibs {
  my $package = GetPackageName(shift);
  return 0 unless (CheckDir($StowDir.'/'.$package));

  if ($DryRun) {
    print "Checking libs for package $package.\n";
    return undef;
  }

  print "Package $package:\n";
  my $ff = undef;
  DiveDir($StowDir."/".$package,
	  sub {
	    my $file = shift;
	    return unless (-x $file && !defined $ff);
	    my $text = `$Progs{ldd} "$file" 2>&1`;
	    return if ($text =~ /^ldd: /); # no valid file
	    $ff = $file 
              if ($text =~ /(not found\)?|No such file or directory)$/m);
	  },
          undef,
         {Dive=>1, CheckWithPath=>1, RealRegExp=>0, Continue=>1,
          RegExpExcl => [GetConfigDirForPackage($package)]});

  print "Unmet dependency: $ff\n" if (defined $ff);
  printLOG "$package: checked libraries\n";
  undef;
}

sub DoShowConfig {
  my $package = GetPackageName(shift);
  return 0 unless (CheckDir($StowDir.'/'.$package));

  if ($DryRun) {
    print "Showing saved configuration for package $package.\n";
    return undef;
  }
  
  my $f = GetConfigDirForPackage($package).'/config.status';
  unless (-r $f) {
    print "No saved configuration for $package.\n";
    return undef;
  }


  my $ret = GetPackageConfiguration($package);

  if (!defined $ret) {
    print STDERR "Could not open $f!";
    return undef;
  }

  if ($ret ne '__NONE__') {
    print "Configuration for $package: $ret\n";
    printLOG "$package: showed configuration\n";
  } else {
    print "$package: No configuration found (probably couldn't parse config.status, fixme!)!\n";
    printLOG "$package: no configuration found\n";
  }

  undef;
}

# -- - - - -- - -- --- - - - - - - -- - - - - - -- - - - - - 

sub CallCommands {
  my $return_code = 1;
  for my $Command (@Command) {
    $ActualCommand = $Command; # using $ActualCommand directly does not work
    $return_code = eval("Command_$Command();") && $return_code;
    if ($@ ne '' && !$return_code && !$Continue) {
      print "Error code from eval: $@";
      return 3;
    }
  }
  $return_code;
}


# this is a sub used for Command_{checksums,depends,checkout,checkin}
# because these subs do nearly the same...
# they take packages as arguments
sub DoForPackagePack {
  my ($ambig, $func) = @_;
  if ($#ARGV == -1 && !$ProceedAllPackages) 
    { ShortUsage(); return 1; }
  return 1 unless (CheckDir($StowDir));
  if (defined $PackageName) {
    printV1("Option -p not possible here!\n");
    return 1;
  }
  my $matches;
  if ($ambig) {
    $matches = CountMatchesInDir($StowDir, @ARGV);
    $matches || (printV1("No matches to your query.\n"), return 1);
  }
  for my $arg (@ARGV) {
    unless ($ambig) { # check that every regexp matches exactly once
      $matches = CountMatchesInDir($StowDir, $arg);
      $matches || (printV1("No matches to your query \"$arg\".\n"), return 1);
    }
    if (!$ambig && (!$Ambiguous && !$ProceedAllPackages && $matches > 1)) {
      if ($Verbose) {
	print "Found $matches matches for \"$arg\". ".
	  "You may consider using option -m.\n";
	Command_list();
      } 
      return 1;
    }
  }
  return 1 if defined DiveDir($StowDir, undef, $func,
                               {Dive=>0, RegExpIncl=>\@ARGV, 
                                Continue => $Continue, FollowLinks=>1});
  0;
}

# this sub is used for commands taking files/dirs (makeinst, make, untar)
sub DoForPackageFile {
  my $func = shift;
  if ($#ARGV == -1) { ShortUsage(); return 1; }
  if (defined $PackageName && $#ARGV) {
    print "Option -p not possible when giving more than one argument!\n";
    return 1;
  }
  unless (CheckDir($StowDir)) {
    printV1("Creating directory $StowDir\n");
    return 1 unless (MkDir($StowDir));
  }

  if ($BoolRotateInstall && $ActualCommand eq 'install') {
    DoForPackageFileRotate($func);
  } else {
    DoForPackageFileNormal($func);
  }
}

# build packages in the normal way
sub DoForPackageFileNormal {
  my $func = shift;

  my $code = 1;
  for (@ARGV) {
    my $e = &{$func}($_);
    return 1 unless ($Continue || $e);
    $code = $code && $e;
  }
  !$code;
}

# the "build around the clock up to everything fails"-feature
sub DoForPackageFileRotate {
  my $func = shift;
  my @done;
  @done = map {0} @done[0..$#ARGV];
  my @old_done;
  my $goon;
  
  do {
    @old_done = @done;
    $goon = 0;
    for (my $i=0; $i <= $#ARGV; $i++) {
      $done[$i] = $done[$i] || &{$func}($ARGV[$i]);
      $goon ||= $old_done[$i] != $done[$i];
    }
  } while ($goon);
  for (my $i=0; $i <= $#ARGV; $i++) { 
    return 1 unless $done[$i]; 
  }
  0; # success
}

sub DoForCheck_List {
  my ($func, $cmd) = @_;
  my $c;
  return 0 unless (CheckDir($StowDir));
  print((($cmd eq 'list')?'List':'Check'), "ing packages in $StowDir");
  if ($#ARGV >= 0) {
    print " matching ";
    PrintValues(undef, \@ARGV);
    $c = CountMatchesInDir($StowDir, @ARGV);
  } else {
    $c = CountMatchesInDir($StowDir);
  }
  print " ($c match", ($c != 1)?"es":"", "):\n";
  $__Command_CheckStow_AccSize   = undef;
  $__Command_CheckStow_AccSize_I = 0;
  DiveDir($StowDir, undef, $func,
           {Dive => 0, RegExpIncl => \@ARGV, FollowLinks => 1});
  print "Sum: ", getDottedFigure($__Command_CheckStow_AccSize), " kB ".
    " Inst: ", getDottedFigure($__Command_CheckStow_AccSize_I)," kB\n"
    if ($__Command_CheckStow_AccSize);
  0;  
}

# -----------------------------------
# these functions (only these!) 
#  return 0 on success and a number > 0 on failure (--> exit-code)

sub Command_help       { Usage();  0;  }

sub Command_shell      { !DoShell(); }

sub Command_list       { DoForCheck_List(\&DoList,  "list");  }
sub Command_checkstow  { DoForCheck_List(\&DoCheckStow, "check"); }

sub Command_checktarget { !DoCheckTarget(); }

sub Command_config     { !DoConfig();  }
sub Command_rebuild    { !DoRebuild(); }

sub Command_makeinst   { DoForPackageFile(\&DoMakeInst);        }
sub Command_make       { DoForPackageFile(\&DoMake);            }
sub Command_untar      { DoForPackageFile(\&DoUnTar);           }
sub Command_instpack   { DoForPackageFile(\&DoInstPackage);     }
sub Command_install    { DoForPackageFile(\&DoInstall);         }
sub Command_confhelp   { DoForPackageFile(\&DoConfHelp);        }

sub Command_checksums  {  DoForPackagePack(0, \&DoChecksums);      }
sub Command_chkchksums {  DoForPackagePack(1, \&DoCheckChecksums); }
sub Command_depends    {  DoForPackagePack(0, \&DoDepends);        }
sub Command_checkin    {  DoForPackagePack(0, \&DoCheckIn);        }
sub Command_checkout   {  DoForPackagePack(0, \&DoCheckOut);       }
sub Command_package    {  DoForPackagePack(1, \&DoPackage);        }
sub Command_strip      {  DoForPackagePack(0, \&DoStrip);          }
sub Command_contents   {  DoForPackagePack(1, \&DoContents);       }
sub Command_checklibs  {  DoForPackagePack(1, \&DoCheckLibs);      }
sub Command_showconfig {  DoForPackagePack(1, \&DoShowConfig);     }
sub Command_remove {
  $ProceedAllPackages && (printV1("I won't make it that easy :-)\n"),return 1);
  DoForPackagePack(0, \&DoRemove);
}

sub Command_contsearch {  
  # open file to store found filenames
  unless ($DryRun || (open CSF, ">$ContentSearchFile")) {
    printV1("Could not open $ContentSearchFile!\n");
    return 1;
  }
  my $res = DoForPackagePack(1, \&DoContentSearch); 
  close CSF unless $DryRun;
  $res;
}

sub Command_rename {
  ShortUsage(),return(1) if $#ARGV < 1;
  if (defined $PackageName) {
    printV1("Option \"p\" not allowed here!\n");
    return 1;
  }
  while ($#ARGV > 0) {
    my @m = GetMatchesInDir($StowDir, $ARGV[0]);
    if ($#m == 0) {
      return 1 unless (DoRename($m[0], $ARGV[1]));
    } else {
      print "Regexp \"$ARGV[0]\" does not match exactly one package!\n";
      return 1;
    }
    splice(@ARGV, 0, 2);
  }
  0;
}

sub Command_exchange {
  ShortUsage(),return(1) if $#ARGV < 1;

  if (defined $PackageName) {
    printV1("Option \"p\" not allowed here!");
    return 1;
  }
  my ($from, $to) = (undef, undef);
  for (my $i = 0; $i < @ARGV; $i++) {
    my @m = GetMatchesInDir($StowDir, $ARGV[$i]);
    if (@m == 0) {
      print "No matches for \"$ARGV[$i]\"\n";
      return 1;
    } elsif (@m > 1) {
      print "Regexp \"$ARGV[$i]\" does not match exactly one package!\n";
      return 1;
    } else {
      if (!defined $from) {
        $from = $m[0];
      } else {
        $to = $m[0];
        last;
      }
    }
  }
  if (defined $from && defined $to) {
    return 1 unless DoExchange($from, $to);
  } else {
    
  }
  0;
}

sub Command_version {
  print $VersionString, " - version ", $Version, "\n";
  0;
}

# -----------------------------------

# Init
GetParams();
Init();
CheckForExternalPrograms() 
  unless(grep /^help$|^config$|^version$|^shell$/, @Command);

# call command
my $res = CallCommands();

# Done
EndWork();
exit($res);