Re: [Bug-stow] very long runtime with 'stow -D pkgname'

[Laurent Besson]

Followinf your advice, I have written a first version to unstow
in the fast way.

So rather than exploring the target dir ans search for stowed
links, it explore the stow package to be removed and delete
corresponding link in the target dir.

The drawback of this is it can leave empty directories or does
not perform "factorisation".

I have written it as an external tool and not as an option to
stow.

Please feel free to integrate it in the official stow if you
like it and send me any comments.

Cheers,
Laurent.


address@hidden wrote:

> Laurent Besson a écrit :
>
> > I have tried to use the '-D' option of stow. It works but this is really
> > slow. Let me explain why:
>
> This is a know problem, with an alternative planned... some day.
>
>
> > I'm in a Sun working environment and I have no 'root' permission. So I install
> > every package I want to use in $HOME/stow and my target dir is $HOME.
> >
> > I also have a lot of data (and thus of directories) in my $HOME.
> >
> > When I run 'stow --verbose=3 -D some_package', I see that it is exploring
> > all the $HOME hierarchy, including places no stow program are stored.
> >
> > I was wondering why does stow explores all my 'target dir' (i.e. $HOME) to
> > remove my package ?
>
> Actually, stows looks in the whole target dir for files linking to the
> package you're unstowing, so it can detect when a directory is left with
> only links to another package after removing some links, and change that
> directory to a link to the package's directory. It can alos remove empty
> directories left by removing links.
>
>
> > Why doesn't it explore the 'package' hierachy and removing the appropriate
> > links in the 'target' dir ? I think this would much much faster.
>
> That's the alternative, "fast" unstowing that we plan on adding. But
> with this behavior you can leave empty directories and directories full
> of links to a single package, since you can't detect them. If you feel
> like coding it, you're welcome :)
>
> Gaël.

#!/bin/sh
#! -*- perl -*-
eval 'exec perl -x $0 ${1+"$@"}'
  if 0;

use strict;
use POSIX;
use File::Basename;
use Getopt::Long;

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

my $Version = '1.3.3';

my $Conflicts = 0;
my $Delete = 0;
my $NotReally = 0;
my $Verbose = 0;
my $ReportHelp = 0;
my $Stow = undef;
my $Target = undef;
my $Restow = 0;

sub parent {
  my $path = join('/', @_);
  my @elts = split(/\/+/, $path);
  pop(@elts);
  join('/', @elts);
}

sub JoinPaths {
  my(@paths, @parts);
  my ($x, $y);
  my ($result) = '';

  $result = '/' if ($_[0] =~ /^\//);
  foreach $x (@_) {
    @parts = split(/\/+/, $x);
    foreach $y (@parts) {
      push(@paths, $y) if ($y ne "");
    }
  }
  $result .= join('/', @paths);
}

sub FindStowMember {
  my ($start, $path) = @_;
  my(@x) = split(/\/+/, $start);
  my(@path) = split(/\/+/, $path);
  my($x);
  my(@d) = split(/\/+/, $Stow);

  while (@path) {
    $x = shift(@path);
    if ($x eq '..') {
      pop(@x);
      return '' unless @x;
    } elsif ($x) {
      push(@x, $x);
    }
  }
  while (@x && @d) {
    if (($x = shift(@x)) ne shift(@d)) {
      return '';
    }
  }
  return '' if @d;
  join('/', @x);
}

sub Unstow {
  my $package = shift;
  my $dir = shift;
  my $full_dir = JoinPaths($Stow,$package,$dir);

  if (!opendir(DIR, $full_dir)) {
    warn "Warning: $ProgramName: Cannot read directory '$full_dir' ($!). Stow 
might leave some links. If you think, it does. Rerun Stow with appropriate 
rights.\n";
  }

  my @contents = readdir(DIR);
  closedir(DIR);
  my $content;
  foreach $content (@contents) {
    next if (($content eq '.') || ($content eq '..'));
    my $relative_name = JoinPaths($package,$dir,$content);
    my $target_name = JoinPaths($Target,$dir,$content);
    # print "$target_name: ";
    if (-e $target_name) {
      if (-l $target_name) {
        &treat_link($target_name,$package);
      } elsif (-d $target_name) {
        # print "  this is a dir\n";
        &Unstow($package,JoinPaths($dir,$content));
      } else {
        # print "  this is a file\n";
      }
    } else {
      print "file $target_name has already been removed\n";
    }
  }
}

sub treat_link {
  my $link_name = shift;
  my $package = shift;
  my $linktarget = readlink($link_name);
  # print "  this is a link: $linktarget\n";
  my $targetdir = dirname $link_name;
  my $stowmember;
  if ($stowmember = &FindStowMember($targetdir,$linktarget)) {
    # print "this is a stow member $stowmember\n";
        my @stowmember = split(/\/+/, $stowmember);
        my $collection = shift(@stowmember);
    if ($collection eq $package) {
      print "Removing link '$link_name'\n";
      unlink $link_name if not $NotReally;
    }
  } else {
    # print "this is not a stow member\n";
  }
}

sub usage {
  my ($msg) = shift;

  if ($msg) {
    print "$ProgramName: $msg\n";
  }
  print "$ProgramName (GNU Stow) version $Version\n\n";
  print "Usage: $ProgramName [OPTION ...] PACKAGE ...\n";
  print <<EOT;
  -n, --no              Do not actually make changes
  -c, --conflicts       Scan for conflicts, implies -n
  -d DIR, --dir=DIR     Set stow dir to DIR (default is current dir)
  -t DIR, --target=DIR  Set target to DIR (default is parent of stow dir)
  -v, --verbose[=N]     Increase verboseness (levels are 0,1,2,3;
                          -v or --verbose adds 1; --verbose=N sets level)
  -D, --delete          Unstow instead of stow
  -R, --restow          Restow (like stow -D followed by stow)
  -V, --version         Show Stow version number
  -h, --help            Show this help
EOT
  exit($msg ? 1 : 0);
}

$Getopt::Long::passthrough = 1;
GetOptions("n|no" => \$NotReally,
           "d|dir=s" => \$Stow,
           "t|target=s" => \$Target,
           "h|help" => \&usage,
          );

&usage("No packages named") unless @ARGV;

# Changing dirs helps a lot when soft links are used
my $current_dir = &getcwd;
if ($Stow) {
  chdir($Stow) || die "Cannot chdir to target tree $Stow ($!)\n";
}
# This prevents problems if $Target was supplied as a relative path
$Stow = &getcwd;

$Target = &parent($Stow) unless $Target;
chdir($Target) || die "Cannot chdir to target tree $Target ($!)\n";
$Target = &getcwd;

if ($Target eq $Stow) {
  die "Target and Stow directories can't be the same\n";
}

chdir($current_dir) || die "Your directory does not seem to exist anymore 
($!)\n";

my $package;
foreach $package (@ARGV) {
  $package =~ s,/+$,,;          # delete trailing slashes
  if ($package =~ m,/,) {
    die "$ProgramName: slashes not permitted in package names\n";
  }
}

foreach $package (@ARGV) {  
  if (! -d "$Stow/$package") {
    die "Can't find '$package' package in '$Stow': $!\n";
  }
  &Unstow($package,"");
}