#! /usr/bin/perl -w

#  stowES - stow Enhancement Script
#  Copyright (C) 2000   Adam Lackorzynski <al10@inf.tu-dresden.de>
#
#  $Id: stowES.in,v 1.9 2001/02/18 00:14:34 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 '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.4.2';
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 $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 $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 $BoolForceInstall   = 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   => 'md5sum',
	      stow     => 'stow',
	      gzip     => 'gzip',
	      bzip2    => 'bzip2', 
	      tar      => 'tar',
	      rm       => 'rm', 
	      cat      => 'cat',
	      mv       => 'mv',
	      strip    => 'strip',
	      ldd      => 'ldd',
              uname    => 'uname',
	    );

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/;

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',
  );

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/;

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


#   --==---==---==---==---==---==---==---==---==---==---==---==--
# -=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.
  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.
  depends   regexp           Create dependencies.
  checkin|ci  regexp         Call 'stow' for package.
  checkout|co  regexp        Call 'stow -D' for package.
  rebuild  regexp            Rebuild whole stow archive.
  strip    regexp            Strip files of package.
  rename regexp new          Rename package from old to new.
  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.
  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 package installation.
  -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).
  -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).
  --[no]removesource         Do [not] remove unpacked source after built.
  --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) = @_;
    $ENV{$name} = $s.((exists $ENV{$name})?($deli.$ENV{$name}):'');
  }

  # 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('LD_LIBRARY_PATH', $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 Done {
  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!", \$BoolForceInstall,
              "subdir=s", \$SubDirName,
	     );
  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);

  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); } 
    }
    die "Could not find program \"$bin\"!\n".
      "  Please install it or cheat me with the `--prog'-param.\n" unless $bo;
    print "found.\n" if $Verbose >= 3;
  }
}

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 FollowLink {
  my $lnk = shift;
  my $nlnk;
  while (defined ($nlnk = readlink($lnk))) {
    $lnk = $nlnk;
  }
  $lnk;
}

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 $error_text could not be matched on the output of the program
# returns 0 if $error_text 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, "/"));
}

# 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...
sub IsStowedIn {
  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;
}


# 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 $plength = length("$StowDir/$package") + 1;
  my $package_path = $StowDir.'/'.$package;
  my $filecount = 0;
  my $files_ok  = 0;
  my $skip_dir  = undef;
  my @conflicts = ();
  # also count the root directory of the package
  my @ppstat    = stat($package_path);
  my ($blocks, $size) = (0, 0);
  if (@ppstat) {
    $blocks    = $ppstat[12];
    $size      = $ppstat[7];
  }

  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);
            }
            if (@filestats) {
              unless ($link) {
                $blocks += (($filestats[12])?$filestats[12]:0);
                $size   += $filestats[7];
              }
            } else {
              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);
	    # maybe we should count the blocks and sizes here as well??
	    my @dirstats = stat($dir);
	    $blocks += (($dirstats[12])?$dirstats[12]:0);
	    $size   += $dirstats[7];	    
	    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, $blocks, $size, @conflicts)
    if (wantarray);
  return $ret;
}

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

  return "" if (IsStowedIn($package));

  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) = (getpwnam(getlogin))[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 && !$BoolForceInstall) {
    printV1 "$package does already exist!\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);
}


#  - -- ------ - - - --- - - - - - - -     - - - - - - - - - - - -
# 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 '');
  printV1 "Installing package via ",
  "\"$Progs{make} install prefix=$StowDir/$package$SubDirName".$m."\"\n" 
    if $ret;
  $ret &&= CallOutput(("#"x75)."\n",
                      "cd \"$path\"; $Progs{make} install "
                      ."prefix=\"$StowDir/$package$SubDirName\"".$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'));

  # something failed --> remove broken package if was not forced
  DoRemove($package) 
    if (!$ret && $packageNotExisted && !$BoolForceInstall && \
        -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;

  $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;
  if ($file =~ /\.t?gz$/) {
    $decomp = "$Progs{gzip} -cd";
  } elsif ($file =~ /\.bz2$/) {
    $decomp = "$Progs{bzip2} -cd";
  } elsif ($file =~ /\.tar$/) {
    $decomp = $Progs{cat};
  } else {
    printV1("Unsupported format for $file!\n");
    return 0;
  }

  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 -",
     "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 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"...
  unless ($DryRun || -x "$path/configure") {
    printV1("Package $package does not contain \"configure\"!\n");
    return 0;
  }

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

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

  my $m = GetParamsForMake($package);
  $m = ' '.$m if ($m ne '');
  # call make now
  return 0 unless 
    (!$BoolMake ||
     CallOutput("Calling \"make".$m."\" ...\n".('#'x75)."\n",
		"cd \"$path\"; $Progs{make}".$m,
		"Error while running \"make".$m."\"!\n",
		$MakeErrorScanPattern,
		('#'x75)."\n"));
  printLOG("$package: 'make' was successful.\n") if ($BoolMake);
  
  return 0 unless
    (!$BoolMakeCheck || !IsRuleInMakefile('check', "$path/Makefile") ||
     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;
  if (IsStowedIn($oldpackage)) {
    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 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 "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 links: ", 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
# 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 $blocks = undef;

  if ($mode eq "check") {
    # GetPackageStatus takes a really long time
    ($status, undef, undef, $blocks, $size, @conflicts)
      = GetPackageStatus($package);
    #$__Command_CheckStow_AccSize += ($size = int($size/1024+0.5));
    $__Command_CheckStow_AccSize += ($blocks /= 2);
    #$size = sprintf("(%7d) ", $size);
    $size = sprintf("(%7d) ", $blocks);
  } else {   # mode is "list"
    # IsStowedIn is faster than GetPackageStatus but will not check
    # for broken packages...
    $status = (IsStowedIn($package))?PACKAGE_CHECKEDIN:PACKAGE_CHECKEDOUT;
  }

  if ($status == PACKAGE_CHECKEDIN) {
    print "I $size$package\n";
  } 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 ) {
	      my @a = split(" => ", $line);
	      (my $lib = $a[0]) =~ s/^\s+(.*)\s/$1/;
	      push @dep_data, $lib;
	    }
	  }, 
          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));
  if (IsStowedIn($package)) { # package checked in -> no work
    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");
  printLOG "$package: checked in\n";
  undef;
}

sub DoCheckOut {
  my $package = GetPackageName(shift);
  return 0 unless (CheckDir($StowDir."/".$package));
  unless (IsStowedIn($package)) { # package is not checked in -> no work here
    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");
  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\)?$/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 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...
sub DoForPackage1 {
  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 DoForPackage2 {
  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') {
    DoForPackage2Rotate($func);
  } else {
    DoForPackage2Normal($func);
  }
}

# build packages in the normal way
sub DoForPackage2Normal {
  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 DoForPackage2Rotate {
  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;
  DiveDir($StowDir, undef, $func,
           {Dive => 0, RegExpIncl => \@ARGV, FollowLinks => 1});
  print "Sum: $__Command_CheckStow_AccSize 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   { DoForPackage2(\&DoMakeInst);        }
sub Command_make       { DoForPackage2(\&DoMake);            }
sub Command_untar      { DoForPackage2(\&DoUnTar);           }
sub Command_instpack   { DoForPackage2(\&DoInstPackage);     }
sub Command_install    { DoForPackage2(\&DoInstall);         }

sub Command_checksums  {  DoForPackage1(0, \&DoChecksums);      }
sub Command_chkchksums {  DoForPackage1(1, \&DoCheckChecksums); }
sub Command_depends    {  DoForPackage1(0, \&DoDepends);        }
sub Command_checkin    {  DoForPackage1(0, \&DoCheckIn);        }
sub Command_checkout   {  DoForPackage1(0, \&DoCheckOut);       }
sub Command_package    {  DoForPackage1(1, \&DoPackage);        }
sub Command_strip      {  DoForPackage1(0, \&DoStrip);          }
sub Command_contents   {  DoForPackage1(1, \&DoContents);       }
sub Command_checklibs  {  DoForPackage1(1, \&DoCheckLibs);      }
sub Command_remove {
  $ProceedAllPackages && (printV1("I won't make it that easy :-)\n"),return 1);
  DoForPackage1(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 = DoForPackage1(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";
    }
    splice(@ARGV, 0, 2);
  }
  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
Done();
exit($res);



