#!/usr/bin/perl -w

# vv  : visual versioning
# zz  : generic shell clip board
# ezz : clip board editor
# del : (un)delete
#
# http://fex.belwue.de/fstools/vv.html
# http://fex.belwue.de/fstools/zz.html
# http://fex.belwue.de/fstools/del.html
#
# by Ulli Horlacher <framstag@belwue.de>
#
# Perl Artistic Licence

# vv is a script to handle file versions:
# list, view, recover, diff, purge, migrate, save, delete
#
# vv is an extension to emacs idea of backup~ files
#
# vv does version rotating, the newest version is always #1
#
# Versions are stored in local subdirectory .versions/
#
# You can integrate vv into your editor, so file versions will be automatically
# created!
#
# To integrate vv into vim, add to $HOME/.vimrc:
#
#   autocmd BufWritePre  * execute '! vv -qs ' . shellescape(@%)
#   autocmd BufWritePost * execute '! vv -qs ' . shellescape(@%)
#
# To integrate vv into emacs, add to $HOME/.emacs:
#
#   (add-hook 'before-save-hook (lambda () (shell-command (
#    concat "vv -qs " (shell-quote-argument (buffer-file-name))))))
#   (add-hook 'after-save-hook  (lambda () (shell-command (
#    concat "vv -qs " (shell-quote-argument (buffer-file-name))))))
#   (setq make-backup-files nil)
#
# To integrate vv into jed, see http://fex.belwue.de/sw/share/jedlib/vv.sl
#
# To use vv with ANY editor, first set:
#
#   export EDITOR=your_favourite_editor
#   alias ve='vv -e'
#
# and then edit your file with:
#
#   ve file
#
# $HOME/.vvrc is the config file for vv and will be created and filled with
# default values, if it does not exist.
#
# vv contains also del, zz and ezz. To install them, call: perl vv -I

# del needs GNU cp and find

# 2013-04-15 initial version
# 2013-04-16 added options -m and -v
# 2013-04-18 added option -s
# 2013-04-22 realfilename() fixes symlink problematics
# 2013-04-22 use rsync instead of cp
# 2013-04-23 added option -I
# 2013-04-23 renamed from jedv to vv
# 2013-04-24 added options -e -0
# 2013-05-09 added option -R
# 2013-05-22 modified option -d to double argument
# 2013-05-22 added vvrc with $exclude and @diff
# 2013-07-05 fixed bug potential endless loop in rotate()
# 2014-04-16 added change-file-test for opt_s (needs .versions/$file)
# 2014-04-18 added option -b : save backup
# 2014-05-02 fixed bug wrong file ownership when using as root
# 2014-06-18 options -r -d -v : parameter is optional, default is 1
# 2014-06-18 fixed (stupid!) bug option -s does only sometimes saving
# 2014-06-20 options -d -v : argument is optional, default is last file
# 2014-07-22 fixed bug no (new) backup version 0 on option -r
# 2014-11-14 added option -D : delete last saved version
# 2014-11-14 make .versions/ mode 777 if parent directory is world writable
# 2015-03-19 allow write access by root even if file and .versions/ have different owners
# 2015-03-20 better error formating for jed
# 2015-06-02 added option -r . : restore backup
# 2016-03-07 added options -M -L : 10 or 100 versions
# 2016-03-08 renamed option -I to -H
# 2016-05-02 call rsync -A to preserve ACLs
# 2016-06-07 option -v : use PAGER=cat if STDOUT is not a tty
# 2016-06-08 added zz, ezz and installer vvzz
# 2016-07-06 avoid empty $ZZ versioning
# 2016-09-12 added vv option -q : quiet mode
# 2016-11-29 show bytes up to 9999999, then M or G
# 2016-11-29 added vv option -P : delete all versions
# 2016-11-29 support for rsync without -A option
# 2016-11-30 fixed bug vv option -r breaks hard links
# 2016-11-30 added version number/range argument to vv option -D
# 2016-12-03 installer creates symbolic links, no more hard links
# 2016-12-03 handle backup as regular version: vv option -b acts like -s
# 2016-12-04 added del
# 2016-12-04 added vv option -I : installation
# 2016-12-04 added vv option -N : set number of versions
# 2016-12-04 removed vv options -M -L
# 2016-12-05 added vv option -U : update
# 2016-12-06 fixed bug cannot handle files with meta characters
# 2016-12-07 added vv option -V : show programm version and history
# 2016-12-08 better (more secure) directory handling for del
# 2016-12-08 added del option -f : force deletion of directories
# 2016-12-08 added del option -D : real delete
# 2016-12-08 modified del option -p : purge named file(s)
# 2016-12-08 modified del option -P : purge all file(s)
# 2016-12-08 modified vv option -v : verbose
# 2016-12-14 recognize identical files on vv option -r
# 2016-12-15 modified option -V : show history only with -v
# 2017-02-08 added vv option -f : force = ignore exclude lists
# 2017-02-23 modified vv option -r : number is optional
# 2017-02-24 ask user for missing version number on vv -r or vv -d
# 2017-10-26 added option -D .
# 2018-06-08 added ezz options -1 ... -9
# 2018-06-10 reverse list if there are more than 20 versions and STDOUT is a tty
# 2018-08-28 fixed bug cannot edit new file with vv -e
# 2018-11-30 ezz STDIN is /dev/tty for $EDITOR
# 2018-12-17 del DIRECTORY does not remove existing .del/DIRECTORY, but appends
# 2018-12-18 added vv option -M : move
# 2018-12-19 vv: new .versions/ gets same permissions and ownership as .
# 2018-12-19 vv: new versions gets same permissions and ownership as file
# 2019-02-14 vv: added $excludedir to vvrc
# 2019-07-25 vv: added command execution
# 2019-08-01 vv: new .versions directory gets owner and group from parent directory
# 2019-08-01 vv: added optional configuration variable $versionsdir_perms
# 2019-08-04 vv: added .versions read/write check ==> better error message
# 2019-08-21 vv: added $versions to vvrc
# 2019-08-29 vv: added btrfs clone-copy support
# 2019-08-29 vv: speedup (less md5sum checks)
# 2019-12-09 vv: option -l shows modifiction date of last version

use Getopt::Std;
use File::Basename;
use Term::ReadLine;
use Digest::MD5 'md5_hex';
use Cwd qw'abs_path getcwd';

$prg = basename($0);
$ZZ = $ENV{ZZ} || "$ENV{HOME}/.zz";

$version = 0;
unless ($version) {
  my @d = localtime((stat $0)[9]);
  $version = sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3])
}

&install if $prg eq 'vvzz' or "@ARGV" eq '-I';
&update  if                   "@ARGV" eq '-U';
&zz      if $prg eq 'zz';
&ezz     if $prg eq 'ezz';
&del     if $prg eq 'del';

$prg eq 'vv' or die "$0: must be named vv\n";

# vv
$usage = <<EOD;

usage:

  # list available versions
  vv [-l] [FILE]

  # save new version (-v : verbose, -f : force)
  vv -s [-v] [-f] FILE

  # recover version (-v : verbose)
  vv -r [-v] [VERSION_NUMBER] FILE [NEW_FILE]

  # show diff
  vv -d [VERSION_NUMBER[:VERSION_NUMBER]] [FILE]

  # delete versions (-v : verbose, from-to)
  vv -D [-v] [VERSION_NUMBER[-VERSION_NUMBER]] FILE

  # delete all versions (-v : verbose, -R : recursive)
  vv -D [-v] [-R] .

  # view version
  vv -v VERSION_NUMBER FILE

  # edit file with \$EDITOR (with versioning)
  vv -e file

  # set or show number of versions (1-99, use file "." to set or show default)
  vv -N [NUMBER] FILE

  # migrate backup~ files to version files (-v : verbose, -R : recursive)
  vv -m [-v] [-R]

  # purge orphaned versions (-v : verbose)
  vv -p [-v]

  # move file with versions to new directory
  vv -M [-v] FILE DIRECTORY

  # execute shell command on file and versions
  vv SHELL_COMMAND FILE~

  # show vv version (-v : history)
  vv -V [-v]

examples:
  vv -s project.pl                  # save new version
  vv -e project.pl                  # edit with versioning
  vv project.pl                     # list versions
  vv -d 2 project.pl                # show difference to version 2
  vv -r project.pl                  # recover (with prompting)
  vv -r 2 project.pl project_2.pl   # recover version 2 as project_2.pl
  vv -N 20 project.pl               # max 20 versions for project.pl
  vv wc project.pl~                 # execute wc on project.pl and its versions

see also:
  del -h
  zz -h
EOD

$fmt = "  %-50s # %s\n";
$short_usage = "usage:\n";
foreach (split "\n",$usage) {
  last if /examples/;
  next if /vv -V|history/;
  if (/# (\w+.*(diff|number|all))/ or /# (\w+)/) {
    $comment = $1;
  } elsif (/(vv .+)/) {
    $short_usage .= sprintf($fmt,$1,$comment);
  }
}
$short_usage .= sprintf($fmt,"vv -H","help");

if ("@ARGV" !~ /^-/) {
  if (scalar(@ARGV) > 1) {
    if ("@ARGV " =~ /.~ /) {
      &vv_command;
      exit;
    } elsif (-f $ARGV[-1] and not -l $ARGV[-1]) {
      $ARGV[-1] .= '~';
      &vv_command;
      exit;
    } else {
      die $short_usage;
    }
  } else {
    $noopt = $opt_l = 1;
  }
}

$opt_h = $opt_p = $opt_m = $opt_s = $opt_0 = $opt_e = $opt_H = $opt_b = 0;
$opt_f = $opt_q = $opt_R = $opt_P = $opt_U = $opt_V = $opt_M = 0;
$opt_r = $opt_d = $opt_D = $opt_v = $opt_N = '';
${'opt_+'} = 0;
getopts('hHls0bepPfqmMRDdvV+rN') or die $short_usage;
$opt_s ||= $opt_b;

if ($opt_h) {
  print "vv: visual versioning\n";
  if ($opt_v) {
    print $usage;
  } else {
    print $short_usage;
  }
  exit;
}

if ($opt_H) {
  open $0,$0 or die "vv: $0 - $!\n";
  while (<$0>) {
    $help = $_ if /^# vv is/;
    if ($help) {
      last if /^\s*$/ or /^#\s*\d\d\d\d-\d\d-\d\d/;
      print;
    }
  }
  print "\nvv: visual versioning ($version)\n";
  print $usage;
  exit;
}

if ($opt_V) {
  warn "$prg: version $version\n";
  if ($opt_v) {
    open $0,$0 or die "$prg: $0 - $!\n";
    while (<$0>) {
      print if s/^#\s*(\d\d\d\d-\d\d-\d\d)/$1/;
    }
  }
  exit;
}

if ($opt_U) { &update }

$vvrc = $ENV{HOME} . '/.vvrc';
unless (-e $vvrc) {
  open $vvrc,'>',$vvrc or die "vv: cannot write $vvrc - $!\n";
  print {$vvrc} q{
# default number of versions
$versions = 9;

# exclude files (regexp)
$exclude = q(
  ~$
  \.tmp$
  ^mutt-.+-\d+
  ^#.*#$
);

# exclude directories (regexp)
$excludedir = q(
  /\.ssh/
  /\.versions/
);

# diff command
@diff = qw'diff -u';
};
  close $vvrc;

# default: use permissions of parent directory for .versions
# $versionsdir_perms = 0700;
}

$versions = 9;

require $vvrc;

$_ = `rsync -h`;
if (/rsync/) {
  @rsync = qw'rsync -a';
  push @rsync,'-A' if /-A.*ACL/;
} else {
  die "vv: no rsync found\n";
}

if ($< == 0 and scalar(@ARGV) and my @s = stat($ARGV[-1])) {
  local ($(,$>,$)) = (0,@s[4,5]);
}

if ($opt_d) {
  &check_ARGV;
  if (@ARGV and $ARGV[0] =~ /^\d\d?(:\d\d?)?$/) {
    $opt_d = shift;
  } else {
    $opt_d = 1;
    if (@ARGV) {
      my $a = $ARGV[0];
      if (-f $a) {
        my $v = sdf(abs_path($a),'.versions');
        if (-f "$v~01~" and -f "$v~02~" and same_file($a,"$v~01~")) {
          $opt_d = 2;
        }
      }
      vars($a);
      &vv_list;
      $term = new Term::ReadLine $0;
      $term->ornaments(0) unless $ENV{PERL_RL};
      $opt_d = $term->readline('show diff to version number: ',$opt_d);
      exit if $opt_d =~ /^\s*$/;
    }
  }
  option_usage('-d') if scalar(@ARGV) != 1;
  $a = shift @ARGV;
}

elsif ($opt_D) {
  if (@ARGV and $ARGV[0] =~ /^\d\d?(-(\d?\d?))?$/) {
    $opt_D = shift(@ARGV)||0;
  } else {
    $opt_D = '-';
  }
  option_usage('-D') if scalar(@ARGV) != 1;
  $a = shift @ARGV;
  if ($a eq '.') {
    if ($opt_R) {
      vsystem(qw'find . -name .versions -exec rm -rf {} +');
    } else {
      vsystem(qw'rm -rf .versions');
    }
    exit $?;
  }
}

elsif ($0 eq 've' or $opt_e) {
  $a = pop @ARGV or option_usage('-e');
  $opt_e = 1;
}

elsif ($opt_s) {
  option_usage('-s') if scalar(@ARGV) != 1;
  $a = shift @ARGV;
}

elsif ($opt_r) {
  my $nargs = scalar(@ARGV);
  option_usage('-r') if $nargs == 0 or $nargs > 3;
  if ($nargs == 1) {
    $opt_r = '-';
  } else {
    $opt_r = shift @ARGV;
    option_usage('-r') if $opt_r !~ /^\d\d?$/;
  }
  $a = shift @ARGV;
}

elsif ($opt_N) {
  $opt_N = shift @ARGV || '.';
  $a = shift @ARGV;
}

elsif ($opt_l or $opt_s or $opt_P or $opt_0) {
  $a = shift @ARGV;
}

elsif ($opt_M) {
  if (scalar(@ARGV) != 2) {
    die "usage: $prg file directory\n";
  }

  my ($file,$dir) = @ARGV;

  if (-l $file or not -f $file) {
    die "$prg: no such file '$file'\n";
  }
  unless (-d $dir) {
    die "$prg: no such directory '$dir'\n";
  }
  if (abs_path(dirname($file)) eq abs_path($dir)) {
    die "$prg: destination directory '$dir' is same as source\n";
  }
  unless (-w $dir) {
    die "$prg: no write access for directory '$dir'\n";
  }
  print "'$file' -> '$dir/'\n" if $opt_v;
  if (system('mv',$file,$dir)==0) {
    my $vfile = $file;
    $vfile =~ s:(.+)/(.+):$1/.versions/$2: or $vfile = ".versions/$vfile";
    my $vdir = "$dir/.versions";
    checkvdir($vdir,'w');
    if (mkdir $vdir and my @s = stat("$vdir/..")) {
      chmod $versionsdir_perms||$s[2],$vdir;
      chown $s[4],$s[5],$vdir;
    }
    if (my @versions = fmatch(quotemeta($vfile).'(~\d\d?~)?')) {
      system('mv',@versions,$vdir)
    }
  }
  exit $?;
}

elsif ($opt_m or $opt_p or $opt_N) {
}

elsif ($opt_v) {
  if (@ARGV and $ARGV[0] =~ /^\d\d?$/) { $opt_v = shift }
  else                                 { $opt_v = 1 }
  # &check_ARGV;
  option_usage('-v20~') if scalar(@ARGV) != 1;
  $a = shift @ARGV;
}

$file = '*';
$vfile = '';
$vdir = '.versions';

if ($a) {

  vars($a);

  # change eugid if root and version directory belongs user
  my @s = stat($vdir);
  if (${">"} == 0 and (not @s or $s[4])) {
    if (my @s = stat($a)) {
      ${")"} = $s[5];
      ${">"} = $s[4];
    }
  }

  # rename old one-digit versions
  if ($vfile and (-f "$vfile~0~" or -f "$vfile~1~")) {
    for (my $i=0; $i<10; $i++) {
      my $vfile1 = "$vfile~$i~";
      my $vfile2 = "$vfile~0$i~";
      if (-f $vfile1) {
        rename $vfile1,$vfile2 or warn "vv: $vfile1 -> $vfile2 - $!\n";
      }
    }
  }

  if (not (length($opt_r) or $opt_N or $opt_v)) {
    if (not lstat $file) {
      if (-s $vfile) {
        warn "vv: '$a' does not exist any more\n";
        print "found '$vfile' - recover it? ";
        $_ = <STDIN>;
        copy($vfile,$file) if /^y/i;
        exit 0;
      }
      if (-e $vfile1) {
        warn "vv: '$a' does not exist any more\n";
        warn "found old:\n";
        &vv_list;
        $a = quote($a);
        warn "to recover latest version, use:\nvv -r $a\n";
        exit 1;
      }
      if (-e sdf($file,'.del')) {
        warn "vv: '$a' does not exist any more, but you can recover it with:\n";
        $a = quote($a);
        warn "del -u $a\n";
        exit 1;
      }
      die "vv: '$a' does not exist\n" unless $opt_e;
    }
    if (not $opt_e and (-l $file or not -f $file)) {
      die "vv: '$a' is not a regular file\n";
    }
  }
}

checkvdir($vdir);
$n = norm("$vdir/.versions/n");
if ($nn = readlink $n and $nn =~ /^\d\d?$/) {
  $nn--;
  unlink $n;
  symlink $nn,norm("$vdir/.versions/.versions");
}

if ($opt_N) {
  if (not $bfile) {
    if ($opt_N eq '.') {
      my $n = readlink('.versions/.versions/.versions')||9;
      print "files in this directory have default $n versions\n";
    } elsif (-f $opt_N) {
      my $file = $opt_N;
      my $vv = dirname($file).'/.versions/.versions';
      my $n = readlink($vv.'/'.basename($file))||
              readlink($vv.'/.versions')||
              9;
      print "'$file' has up to $n versions\n";
    } else {
      option_usage('-N');
    }
    exit;
  }
  option_usage('-N') if not $bfile or @ARGV;
  option_usage('-N') if $opt_N !~ /^\d\d?$/;
  checkvdir($vdir,'w');
  if (mkdir $vdir and my @s = stat("$vdir/..")) {
    chmod $versionsdir_perms||$s[2],$vdir;
    chown $s[4],$s[5],$vdir;
  }
  if (not -d $vdir) { die "vv: cannot mkdir $vdir - $!\n" }
  my $vvv = norm($vdir.'/.versions');
  if (mkdir $vvv and my @s = stat("$vvv/..")) {
    chmod $versionsdir_perms||$s[2],$vvv;
    chown $s[4],$s[5],$vvv;
  }
  if (not -d $vvv) { die "vv: cannot mkdir $vvv - $!\n" }
  if ($bfile eq '.') {
    $vvv .= "/.versions";
    unlink $vvv;
    symlink $opt_N,$vvv or die "vv: cannot create $vvv - $!\n";
  } else {
    $vvv .= "/$bfile";
    unlink $vvv;
    symlink $opt_N,$vvv or die "vv: cannot create $vvv - $!\n";
    print "'$file' has up to $opt_N versions\n" if $opt_v;
    for (my $i = $opt_N+1; $i <= 99; $i++) {
      unlink sprintf("$vfile~%02d~",$i);
    }
  }
  exit;
}

if ($opt_e) {
  option_usage('-e') if not $a or @ARGV;
  $editor = $ENV{EDITOR} or die "vv: environment variable EDITOR not set\n";
  system(qw'vv -qs',$file) if -f $file; # save current version
  system($editor,@ARGV,$file);
  exit $? if $?;
  unlink $ofile;                        # delete new file~ created by editor
  system(qw'vv -0',$file);              # delete last version if no change
  system(qw'vv -qs',$file);             # save new version
  exit;
}

if ($opt_p) {
  checkvdir($vdir,'w');
  opendir $vdir,$vdir or die "vv: no $vdir\n";
  while (defined($vfile = readdir($vdir))) {
    next unless -f norm("$vdir/$vfile");
    $bfile = $vfile;
    $bfile =~ s/~\d\d?~$//;
    if (not -f $bfile or -l $bfile) {
      unlink norm("$vdir/$vfile");
      $purge{$bfile}++;
    }
  }
  if (@purge = keys %purge) {
    foreach $p (@purge) {
      printf "%2d %s purged\n",$purge{$p},$p;
    }
  }
  exit;
}

if ($opt_m) {
  option_usage('-m') if @ARGV;
  migrate('.');
  exit;
}

if (length($opt_r)) {
  push @rsync,'--inplace';
  if ($opt_r eq '.') {
    # legacy backup file
    if (not -f $vfile) { die "vv: no backup '$vfile'\n" }
    if (lstat $file)   { die "vv: '$file' does exist\n" }
    copy($vfile,$file);
  } else {
    if ($opt_r eq '-') {
      $opt_r = 1;
      $md5f = md5f($file);
      foreach my $v ("$vfile~1~","$vfile~01~") {
        if (-f $v and $md5f eq md5f($v)) {
          $opt_r = 2;
          last;
        }
      }
      &vv_list;
      exit 1 unless -f $vfile1;
      $term = new Term::ReadLine $0;
      $term->ornaments(0) unless $ENV{PERL_RL};
      $opt_r = $term->readline('recover version number: ',$opt_r);
      exit if $opt_r =~ /^\s*$/;
      $opt_v = 1;
    }
    if ($opt_r =~ /^\d$/ and -f "$vfile~0$opt_r~") {
      $vfile .= "~0$opt_r~"
    } else {
      $vfile .= "~$opt_r~"
    }
    if (not -f $vfile) { die "vv: '$vfile' does not exist'\n" }
    if (defined($nfile = shift @ARGV)) {
      if (-f $nfile and not -l $nfile) {
        if (same_file($vfile,$nfile)) {
          warn "vv: '$file' and '$nfile' are identical\n";
          exit;
        }
        if ($opt_v) { system qw'vv -vs',$nfile }
        else        { system qw'vv -s',$nfile }
      } elsif (lstat $nfile) {
        die "vv: '$nfile' does already exist and is not a regular file\n";
      }
      copy($vfile,$nfile);
    } else {
      $md5f ||= md5f($file);
      if (md5f($vfile) eq $md5f) {
        warn "vv: '$file' and '$vfile' are identical\n";
      } else {
        if ($vfile ne $vfile0 and mtime($file) > mtime($vfile0)) {
          copy($file,$vfile0);
        }
        copy($vfile,$file);
      }
    }
  }
  exit;
}

if (length($opt_d)) {
  option_usage('-d') if @ARGV;
  if (not $bfile) { die "vv: no such file '$bfile'\n" }
  @diff = qw'diff -u' unless @diff;
  if ($opt_d =~ /^(\d\d?):(\d\d?)$/) {
    if (-f "$vdir/$bfile~0$1~" and -f "$vdir/$bfile~0$2~") {
      exec @diff,"$vdir/$bfile~0$2~","$vdir/$bfile~0$1~"
    } else {
      exec @diff,"$vdir/$bfile~$2~","$vdir/$bfile~$1~"
    }
  } else {
    if (-f "$vdir/$bfile~0$opt_d~") {
      exec @diff,"$vdir/$bfile~0$opt_d~",$file;
    } else {
      exec @diff,"$vdir/$bfile~$opt_d~",$file;
    }
  }
  exit $!;
}

if ($opt_s) {
  option_usage('-s') if not $bfile or @ARGV;
  unless ($opt_f) {
    if ($exclude) {
      $exclude =~ s/^\s+//;
      $exclude =~ s/\s+$//;
      $exclude =~ s/\s*\n\s*/|/g;
      if ($bfile =~ /$exclude/) {
        warn "\r\nvv: ignoring '$bfile'\n" unless $opt_q;
        exit;
      }
    }
    if ($excludedir) {
      $excludedir =~ s/^\s+//;
      $excludedir =~ s/\s+$//;
      $excludedir =~ s/\s*\n\s*/|/g;
      my $afile = abs_path($file);
      if ($afile =~ /$excludedir/) {
        warn "\r\nvv: ignoring '$afile'\n" unless $opt_q;
        exit;
      }
    }
  }
  unless (-d $vdir) {
    mkdir $vdir or die "vv: cannot mkdir $vdir - $!\n";
    if (my @s = stat("$vdir/..")) {
      chmod $versionsdir_perms||$s[2],$vdir;
      chown $s[4],$s[5],$vdir;
    }
  }

  # migrate old file~ to versions
  if (-f $ofile and not -l $ofile and -r $ofile) {
    rotate($vfile);
    rename($ofile,$vfile1);
  }

  # turn old backup file into regular version
  if (-f $vfile) {
    rotate($vfile);
    rename($vfile,$vfile1);
  }

  # rotate if file has changed
  if (-f $vfile1 and not same_file($vfile1,$file)) {
    rotate($vfile);
  }

  copy($file,$vfile1);
  exit;
}

# special post rotating from -e : delete last version if no change
if ($opt_0) {
  my @sb = stat $file or die "vv: '$file' - $!\n";
  if (-f $vfile1) {
    while (my @sv = stat $vfile1) {
      # no version change?
      if ($sb[7] == $sv[7] and $sb[9] == $sv[9]) {
        rotate_back($vfile);
      } else {
        last;
      }
    }
  }
  exit;
}

# delete named version, roll back
if (length($opt_D)) {
  option_usage('-D') if @ARGV or not $file;
  stat $file or die "vv: '$file' - $!\n";
  # version 0 is special! ==> backup from recovery operation
  if ($opt_D =~ /^0\b/) {
    if (-f $vfile0) {
      if (unlink $vfile0) {
        printf "delete %s\n",quote($vfile0) if $opt_v;
      } else {
        die "vv: cannot delete '$vfile0' - $!\n";
      }
    } else {
      die "vv: no version 0 for '$file'\n";
    }
    $opt_D =~ s/^0-/1-/;
  }
  if ($opt_D eq '-') {
    # 0 version?
    if (-f $vfile0) {
      if (unlink $vfile0) {
        printf "delete %s\n",quote($vfile0) if $opt_v;
        exit;
      } else {
        die "vv: cannot delete '$vfile0' - $!\n";
      }
    } else {
      if (-f $vfile1) {
        printf "delete %s\n",quote($vfile1) if $opt_v;
        rotate_back($vfile)
      } else {
        die "vv: no versions for '$file'\n"
      }
    }
  } else {
    if ($opt_D =~ /^(\d\d?)$/) {
      $opt_D = int($1);
      if (-f $vfile1) {
        $dfile = sprintf "$vfile~%02d~",$opt_D;
        if (not -f $dfile) { die "vv: no version $opt_D for '$file'\n" }
        printf "delete %s\n",quote($dfile) if $opt_v;
        rotate_back($vfile,$opt_D);
      } else {
        die "vv: no versions found\n";
      }
    } elsif ($opt_D =~ /^(\d\d?)-(\d\d?)?$/) {
      $ds = $1;
      $de = $2;
      if (-f $vfile1) {
        $dfile = sprintf "$vfile~%02d~",$ds;
        if (not -f $dfile) { die "vv: no version $ds for '$file'\n" }
        if ($de) {
          for($n = $ds; $n <= $de and -f $dfile; $n++) {
            printf "delete %s\n",quote(sprintf "$vfile~%02d~",$n) if $opt_v;
            rotate_back($vfile,$ds);
          }
        } else {
          for($n = $ds; $n <= 99; $n++) {
            $dfile = sprintf("$vfile~%02d~",$n);
            if (unlink $dfile) {
              printf "delete %s\n",quote($dfile) if $opt_v;
            }
          }
        }
      } else {
        die "vv: no versions found\n";
      }
    }
  }
  exit;
}

# delete all versions (legacy option)
if ($opt_P) {
  unless ($bfile) { die $short_usage }
  if (not($vfile0 or $vfile1)) { die "vv: '$file' has no versions\n" }
  unlink fmatch(quotemeta($vfile).'(~\d\d?~)?');
  exit;
}

if ($opt_v and $bfile and not $opt_l) {
  if (-f "$vfile~0$opt_v~") { $vfile .= "~0$opt_v~" }
  else                      { $vfile .= "~$opt_v~" }
  if (-f $vfile) {
    if (-t STDOUT) {
      if (($ENV{EDITOR}||$0) =~ /jed/) {
        $ENV{JEDINIT} = "SAVE_STATE=0";
        exec 'jed','-most',$vfile;
        # exec 'jed',$vfile,qw'-tmp -f set_readonly(1)';
      } elsif ($ENV{PAGER}) {
        exec $ENV{PAGER},$vfile;
      } else {
        exec 'view',$vfile;
      }
    } else {
      exec 'cat',$vfile;
    }
  } else {
    die "vv: no '$vfile'\n";
  }
  exit;
}

# default!
if (scalar(@ARGV)) { die $short_usage }
&vv_list;
exit;


sub vv_list {
  my (@stat,%v,$ct);

  checkvdir($vdir);
  if (opendir $vdir,$vdir) {
    while (defined(my $vfile = readdir($vdir))) {
      if (-f "$vdir/$vfile") {
        if ($bfile) {
          if ($vfile =~ /^\Q$bfile\E~(\d\d?)~$/) {
            push @{$v{$file}},$1;
          }
        } else {
          if ($vfile =~ /^(.+)~(\d\d?)~$/) {
            push @{$v{$1}},$2;
          }
        }
      }
    }
    closedir $vdir;
    `stty -a` =~ /columns (\d+)/;
    $tw = ($1||80)-40;
    $ct = '';
    foreach my $file (sort keys %v) {
      # if (not $bfile and not -f $file or -l $file) {
      #  warn "vv: orphaned $file\n";
      #  next;
      # }
      my @v = sort @{$v{$file}};
      if ($bfile) {
        @stat = stat $file; # or die "vv: $file - $!\n";
        print "version      bytes       date time";
        if (${'opt_+'}) {
          print "     content";
          $ct = content($file);
          $ct =~ s/(.{$tw}).+/$1*/;
        }
        print "\n";
        if (length($v[0]) == 1) { $lf = "%s  %15s %s %s\n" }
        else                    { $lf = "%2s %15s %s %s\n" }
        if (scalar(@v) > 21 and -t STDOUT) {
          foreach my $v (reverse @v) {
            my $vfile = "$vdir/$bfile~$v~";
            @stat = stat $vfile or next;
            if (${'opt_+'}) {
              $ct = content($vfile);
              $ct =~ s/(.{$tw}).+/$1*/;
            }
            printf $lf,int($v),size($stat[7]),isodate($stat[9]),$ct;
          }
          @stat = stat $file;
          printf $lf,'.',size($stat[7]),isodate($stat[9]),$ct if @stat;
        } else {
          printf $lf,'.',size($stat[7]),isodate($stat[9]),$ct if @stat;
          foreach my $v (@v) {
            my $vfile = "$vdir/$bfile~$v~";
            @stat = stat $vfile or next;
            if (${'opt_+'}) {
              $ct = content($vfile);
              $ct =~ s/(.{$tw}).+/$1*/;
            }
            printf $lf,int($v),size($stat[7]),isodate($stat[9]),$ct;
          }
        }
      } else {
        if (my $n = scalar(@v)) {
          $n-- if $v[0] == 0; # do not count zero version
          my $orphaned = -f $file?'':' (orphaned)';
          if ($noopt) {
            printf "%2d %s%s\n",$n,quote($file),$orphaned;
          } else {
            my $mtime = mtime(".versions/$file~01~")||
                        mtime(".versions/$file~1~");
            printf "%s %s %s%s\n",isodate($mtime),$n,quote($file),$orphaned;
          }
        }
      }
    }
  }
  warn "vv: no versions found, usage: vv -h, help: vv -H\n" unless %v;
}


sub vv_command {
  my @cmd = ();
  foreach my $a (@ARGV) {
    if ($a =~ /(.+)~$/) {
      my $file = $1;
      my $v = dirname($file).'/.versions/'.basename($file);
      $v =~ s/^\.\///;
      my @v = ();
      push @v,$file if -f $file and not -l $file;
      push @v,glob(shellquote($v).'~[0-9]~');
      push @v,glob(shellquote($v).'~[0-9][0-9]~');
      if (@v) {
        push @cmd,@v;
      } else {
        die "$prg: $file does not exist and has no versions\n";
      }
    } else {
      push @cmd,$a;
    }
  }
  warn "\$ @cmd\n";
  system @cmd;
}


sub shellquote {
  local $_ = shift;
  s/([^\w\@\/!^%:_.,=+-])/\\$1/g;
  return $_;
}

sub size {
  my $s = shift;
#  if    ($s > 9999999999) { $s = int($s/2**30).'G' }
#  elsif ($s > 9999999)    { $s = int($s/2**20).'M' }
#  elsif ($s > 9999)       { $s = int($s/2**10).'k' }
#  else                    { $s = d3($s) }
  $s = d3($s);
  return $s;
}


sub d3 {
  local $_ = shift;
  while (s/(\d)(\d\d\d\b)/$1,$2/) {};
  return $_;
}


sub content {
  my $file = shift;
  my $qfile = quotemeta($file);
  my $ct;
  local $_;

  chomp ($ct = `file $qfile`);
  $ct =~ s/.*?: //;
  $ct =~ s/,.*//;

  if ($ct =~ /text/ and open $file,$file) {
    read $file,$_,1024;
    close $file;
    s/[\x00-\x20]+/ /g;
    s/^ */\"/;
    s/ *$/\"/;
    $ct = $_;
  }

  return $ct;
}


sub isodate {
  my @d = localtime shift;
  return sprintf('%d-%02d-%02d %02d:%02d:%02d',
                 $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
}


sub rotate {
  my $vf = shift; # version base file
  my $vf0 = "$vf~00~";
  my $vf1 = "$vf~01~";
  my $vv = dirname($vf).'/.versions'; # config .versions/.versions
  my $n = readlink($vv.'/'.basename($vf))||
          readlink($vv.'/.versions')||
          $versions;

  unlink $vf0 if same_file($vf0,$vf1);

  for (my $i = $n-1; $i >= 0; $i--) {
    my $vfi = sprintf("%s~%02d~",$vf,$i);
    my $vfn = sprintf("%s~%02d~",$vf,$i+1);
    if (-e $vfi) {
      rename $vfi,$vfn or die "vv: '$vfi' -> '$vfn' : $!\n";
    }
  }

  for (my $i = $n+1; $i <= 99; $i++) {
    unlink sprintf("%s~%02d~",$vf,$i);
  }

  if ($n > 1) {
    # was there a version 0?
    if (-e $vf1) {
      my $bf = $vf;
      $bf =~ s:/\.versions/:/:;
      my @sb = stat $bf;
      my @sv = stat $vf1;
      # same version? (size and mtime)
      if (@sb and @sv and $sb[7] == $sv[7] and $sb[9] == $sv[9]) {
        # same version
        unlink $vf1;
      } else {
        # new version
        rotate($vf);
      }
    }
  }
}


sub copy {
  my $from = rrp(shift);
  my $to = rrp(shift);
  my @copy = @rsync;
  my $qfrom = quote($from);

  unless (-e $from) {
    die "vv: '$from' does not exist\n";
  }
  if (-l $from or not -f $from) {
    die "vv: '$from' is not a regular file\n";
  }
  if (-l $to or -e $to and not -f $to) {
    die "vv: '$to' is not a regular file\n";
  }

  if (`stat -f -c %T $qfrom 2>/dev/null` =~ /^btrfs/) {
    @copy = qw'cp -ax --reflink';
  }

  if (open $to,'>>',$to) {
    close $to;
    if (system(@copy,$from,$to) == 0) {
      if ($ENV{VIMRUNTIME}) {
        print "\n";
      } else {
        print "$from -> $to\n" if $opt_v;
      }
    } else {
      exit $?;
    }
  } else {
    die "\r\nvv: cannot write '$to' - $!\n";
  }
}


sub realfilename {
  my $file = shift;

  return $file unless -e $file;

  if (-l $file) {
    my $link = readlink($file);
    if ($link !~ /^\// and $file =~ m:(.*/).:) {
      $link = $1 . $link;
    }
    return realfilename($link);
  } else {
    return $file;
  }
}


sub migrate {
  my $dir = shift;
  my $vdir = norm("$dir/.versions");
  my $dfile;

  unless (opendir $dir,$dir) {
    warn "vv: cannot read directory $dir - $!\n";
    return
  }
  while (defined($file = readdir($dir))) {
    $dfile = "$dir/$file";
    next if -l $dfile or $file eq '.' or $file eq '..';
    if (-d $dfile and $opt_R and $file ne '.versions') {
      migrate($dfile);
    } elsif (-f $dfile and $file =~ /~$/) {
      if (-d $vdir) {
        for ($i = 8; $i > 0; $i--) {
          $n = $i+1;
          rename "$vdir/$file$i~","$vdir/$file$n~";
        }
      } else {
        mkdir $vdir or die "vv: cannot mkdir $vdir - $!\n";
        if (my @s = stat("$vdir/..")) {
          chmod $versionsdir_perms||$s[2],$vdir;
          chown $s[4],$s[5],$vdir;
        }
      }
      $nfile = sprintf("%s/%s1~",$vdir,$file);
      rename $dfile,$nfile or die "vv: cannot move '$dfile' to '$nfile' - $!\n";
      print "$dfile -> $nfile\n" if $opt_v;
    }
  }
  closedir $dir;
}


sub mtime {
  my @s = stat shift;
  return @s ? $s[9] : 0;
}


sub md5f {
  my $file = shift;
  my $md5 = Digest::MD5->new;
  my $MB = 2**20;
  local $_;

  if (open $file,$file) {
    while (read($file,$_,$MB)) {
      $md5->add($_);
    }
    close $file;
  }

  return $md5->hexdigest;
}


sub same_file {
  my $file1 = shift;
  my $file2 = shift;

  return unless -f $file1 and -f $file2;
  return 0 if -s $file1 != -s $file2;
  return 1 if mtime($file1) == mtime($file2);
  return 1 if md5f($file1) eq md5f($file2);
  return 0;
}


# if ARGV is empty use last saved file as default file argument
sub check_ARGV {
  local $_;
  local *V;

  if (not @ARGV) {
    if (-d '.versions' and open V,'ls -at .versions|') {
      while (<V>) {
        chomp;
        if (-f ".versions/$_") {
          close V;
          s/~\d+~$//;
          warn "$prg: using $_\n";
          @ARGV = ($_);
          return;
        }
      }
    }
  }

}


sub rotate_back {
  my $vfile = shift;
  my $start = shift||1;

  for (my $i = $start; $i <= 98; $i++) {
    my $vfi = sprintf("%s~%02d~",$vfile,$i);
    my $vfn = sprintf("%s~%02d~",$vfile,$i+1);
    if (-f $vfn) {
      rename $vfn,$vfi;
    } else {
      unlink $vfi if $i == $start;
      last;
    }
  }
}


sub pathsearch {
  my $prg = shift;

  foreach my $dir (split(':',$ENV{PATH})) {
    return "$dir/$prg" if -x "$dir/$prg";
  }
}


# subdirectory file
sub sdf {
  my $file = shift;
  my $dir = shift;
  return rrp(sprintf("%s/%s/%s",dirname($file),$dir,basename($file)));
}


sub option_usage {
  my $o = shift;
  if ($usage =~ /(#.+)\n\s+(vv $o.*)/) {
    die "$1\n".
        "usage: $2\n".
        "help: vv -H\n";
  } else {
    die $short_usage;
  }
}


# zz is the generic clip board program
#
# to use zz with vim, write to your .vimrc:
#
# noremap <silent> zz> :w !zz<CR><CR>
# noremap <silent> zz< :r !zz --<CR>
sub zz {
  my $bs = 2**16;
  my $wm = '>';
  my ($file,$tee,$x);

  if ("@ARGV" =~ /^(-h|--help)$/) {
    print <<'EOD';
zz is the generic clip board program. It can hold any data, ASCII or binary.
The clip board itself is $ZZ (default: $HOME/.zz) and has up to 9 versions.
See also the clip board editor "ezz".
Limitation: zz does not work across accounts or hosts! Use xx instead.

Options and modes are:

  "zz"              show content of $ZZ
  "zz file(s)"      copy file(s) content into $ZZ
  "zz -"            write STDIN (keyboard, mouse buffer) to $ZZ
  "zz +"            add STDIN (keyboard, mouse buffer) to $ZZ
  "... | zz"        write STDIN from pipe to $ZZ
  "... | zz +"      add STDIN from pipe to $ZZ
  "... | zz -"      write STDIN from pipe to $ZZ and STDOUT
  "zz | ..."        write $ZZ to pipe
  "... | zz | ..."  save pipe data to $ZZ (like tee)
  "zz --"           write $ZZ to STDOUT
  "zz -v"           show clip board versions (history)
  "zz -1"           write $ZZ version 1 to STDOUT
  "zz -9"           write $ZZ version 9 to STDOUT

Examples:

  zz *.txt
  ls -l | zz
  zz | wc -l
  (within vi)   :w !zz
  (within vi)   :r !zz
  (within mutt) |zz
EOD
    exit;
  }

  if ("@ARGV" eq '-V') {
    warn "$prg: version $version\n";
    warn "see: vv -vV\n";
    exit;
  }

  if ("@ARGV" eq '-v') {
    exec qw'vv -+l',$ZZ;
  }

  if ("@ARGV" =~ /^-(\d)$/) {
    exec "vv -v $1 '$ZZ' | cat";
  }

  # read mode
  if (-t STDIN and not @ARGV or "@ARGV" eq '--') {
    exec 'cat',$ZZ;
  }

  # write mode
  system "vv -s '$ZZ' >/dev/null 2>&1" if -s $ZZ;

  if (@ARGV and $ARGV[0] eq '+') {
    shift @ARGV;
    $wm = '>>';
  }

  if ("@ARGV" eq '-') {
    @ARGV = ();
    $tee = 1 unless -t STDIN;
  }

  unless (@ARGV or -t STDIN or -t STDOUT) {
    $tee = $bs = 1;
  }

  open $ZZ,$wm,$ZZ or die "zz: cannot write $ZZ - $!\n";

  if (@ARGV) {
    while ($file = shift @ARGV) {
      if (-f $file) {
        if (open $file,$file) {
          while (read($file,$x,$bs)) {
            my $s = syswrite $ZZ,$x;
            defined($s) or die "zz: cannot write to $ZZ - $!\n";
          }
          close $file;
        } else {
          warn "zz: cannot read '$file' - $!\n";
        }
      } elsif (-e $file) {
        warn "zz: '$file' is not a regular file\n";
      } else {
        warn "zz: '$file' does not exist\n";
      }
    }
    close $ZZ;
    $ZZ1 = $ZZ.'~1~';
    $ZZ1 =~ s:(.*)/(.*):$1/.versions/$2:;
    if (-e $ZZ and not -s $ZZ and -s $ZZ1 ) {
      system @rsync,$ZZ1,$ZZ;
    }
  } else {
    while (read(STDIN,$x,$bs)) {
      syswrite $ZZ,$x;
      syswrite STDOUT,$x if $tee;
    }
  }

  exit;
}


sub ezz {
  my $bs = 2**16;
  my $wm = '>';
  my $editor = $ENV{EDITOR} || 'vi';
  my ($out,$file,$x);

  $ENV{JEDINIT} = "SAVE_STATE=0";

  if ("@ARGV" =~ /^(-h|--help)$/) {
    print <<'EOD';
ezz is the edit helper for the zz clip board program.
The clip board itself is $ZZ (default: $HOME/.zz) and has up to 9 versions.

Options and modes are:

  "ezz"                    edit $ZZ with $EDITOR
  "ezz -1"                 edit $ZZ version 1 (see: zz -v)
  "ezz -9"                 edit $ZZ version 9 (see: zz -v)
  "... | ezz"              write STDIN from pipe to $ZZ and call $EDITOR
  "... | ezz +"            add STDIN from pipe to $ZZ and call $EDITOR
  "ezz 'perl commands'"    execute perl commands on $ZZ
  "ezz - 'perl commands'"  execute perl commands on $ZZ and show result
  "ezz filter [args]"      run filter [with args] on $ZZ
  "ezz - filter [args]"    run filter [with args] on $ZZ and show result

Examples:

  ls -l | ezz
  ezz 's/ /_/g'
  ezz head -3
  ezz - head -3
EOD
    exit;
  }

  system "vv -s '$ZZ' >/dev/null 2>&1" if -s $ZZ;

  unless (-t STDIN) {
    if ("@ARGV" eq '+') {
      @ARGV = ();
      $wm = '>>';
    }
    open $ZZ,$wm,$ZZ or die "zz: cannot write $ZZ - $!\n";
    syswrite $ZZ,$x while read(STDIN,$x,$bs);
    close $ZZ;
  }

  if (-t STDIN and "@ARGV" =~ /^-([1-9])$/) {
    my $v = $1;
    $ZZ =~ s:(.+)/(.+):$1/.versions/$2~0$v~:;
    if (-f $ZZ) {
      close STDIN;
      open STDIN,'/dev/tty';
      exec $editor,$ZZ;
    } else {
      die "$0: no zz version $v\n";
    }
  }

  if (@ARGV) {
    $out = shift @ARGV if $ARGV[0] eq '-';
    $cmd = shift @ARGV or exec 'cat',$ZZ;
    rename $ZZ,"$ZZ~" or die "zz: cannot move $ZZ to $ZZ~ - $!\n";
    $cmd = quotemeta $cmd;
    @ARGV = map { quotemeta } @ARGV;
    if (pathsearch($cmd)) {
      system "$cmd @ARGV <'$ZZ~'>'$ZZ'";
    } else {
      system "perl -pe $cmd @ARGV <'$ZZ~'>'$ZZ'";
    }
    if ($? == 0) { unlink "$ZZ~" }
    else         { rename "$ZZ~",$ZZ }
    exec 'cat',$ZZ if $out;
  } else {
    close STDIN;
    open STDIN,'/dev/tty';
    exec $editor,$ZZ;
  }
  exit;
}


sub del {
  my $usage = <<EOD;
del: (un)delete file(s) (with versions)
usage: del [-v] [-f] file(s)
       del [-v] -u file(s)
       del [-v] -p file(s)
       del [-v] -P [-d days] [-r] [directory]
       del [-v] -D file(s)
       del [-v] -l
options: -v   verbose mode
         -f   force delete
         -u   undelete file(s)
         -p   purge deleted file(s)
         -P   purge all deleted files [older than -d days] [-r recursive]
         -D   real delete file(s) and versions (NO WAY BACK!)
         -l   list deleted files
examples: del *.tmp         # delete all *.tmp files
          del -u project.pl # undelete project.pl
          del -vprd 2       # verbose purge deleted files older than 2 days
see also: vv -h
EOD

  $error = 0;

  $opt_h = $opt_v = $opt_V = 0;
  $opt_u = $opt_p = $opt_P = $opt_D = $opt_r = $opt_l = $opt_d = $opt_f = 0;
  getopts('hvVufpPDlrd:') or die $usage;

  if ($opt_h) {
    print $usage;
    exit 0;
  }

  if ($opt_V) {
    warn "$prg: version $version\n";
    warn "see: vv -vV\n";
    exit;
  }


  if ($opt_u) {
    die $usage unless @ARGV;
    foreach $file (@ARGV) {
      $dfile = sdf($file,'.del');
      unless (lstat $dfile) {
        warn "del: '$dfile' does not exist\n";
        $error++;
        next;
      }
      if (lstat $file) {
        warn "del: '$file' does already exist\n";
        $error++;
        next;
      }
      if (move($dfile,dirname($file))) {
        print "'$dfile' -> '$file'\n" if $opt_v;
      } else {
        warn "del: moving '$dfile' to '$file' failed\n";
        $error++;
      }
    }
  }

  elsif ($opt_p) {
    die $usage if $opt_d or $opt_r or not @ARGV;
    $error = 0;
    foreach $file (@ARGV) {
      $dfile = ".del/$file";
      if (unlink $dfile) {
        printf "purge %s\n",quote($dfile) if $opt_v;
      } else {
        warn "del: '$dfile' dies not exist\n";
        $error++;
      }
    }
    exit $error;;
  }

  elsif ($opt_P) {
    die $usage if $opt_d !~ /^(\d+)$/;
    $dir = shift @ARGV || '.';
    die $usage if @ARGV;
    die "del: $dir is not a directory\n" if -l $dir or not -d $dir;
    if ($opt_r) {
      $find = "find $dir -type d -name .del 2>/dev/null";
      open $find,"$find|" or die "del: cannot run find - $!\n";
      while (<$find>) {
        chomp;
        purge($_);
      }
    } else {
      purge("$dir/.del");
    }
    rmdir("$dir/.del");
    exit;
  }

  elsif ($opt_D) {
    unless (@ARGV) { die $usage }
    $error = 0;
    foreach $p (@ARGV) {
      $p =~ s:/+$::;
      @x = ();
      push @x,$p if lstat $p;
      $d = sdf($p,'.del');
      push @x,$d if lstat $d;
      push @x,fmatch(quotemeta(sdf($p,'.versions')).'~\d\d?~'),
              fmatch(quotemeta(sdf($p,'.del/.versions')).'~\d\d?~');
      if (@x) {
        if ($opt_v) {
          foreach my $x (@x) {
            printf "purge %s\n",quote($x);
          }
        }
        system qw'rm -rf',@x;
      } else {
        warn "del: cannot purge '$p': not found\n";
        $error++;
      }
    }
    exit $error;;
  }

  elsif ($opt_l) {
    $dir = $ARGV[0] || '.';
    $deldir = "$dir/.del";
    chdir $deldir or die "del: $deldir - $!\n";
    opendir $deldir,'.' or die "del: cannot open $deldir - $!\n";
    @files = grep { not /^(\.\.?|\.del|\.versions)$/ } readdir($deldir);
    die "del: no deleted files found\n" unless @files;
    foreach $file (sort { lc $a cmp lc $b } @files) {
      printf "%s %15s ",mdtime($file),d3size($file) if $opt_v;
      print quote($file);
      print '/' if -d $file;
      print ' -> '.quote(readlink $file) if $opt_v and -l $file;
      print "\n";
    }
    exit;
  }

  else {
    die $usage unless @ARGV;

    foreach $file (@ARGV) {
      if ($file =~ /(.+)\/+$/ and not -d $1 and not -l $1 and -e $1) {
        warn "del: '$1' is a file, not a directory\n";
        $error++;
        next;
      }
      if (not -l $file and -e $file) {
        if (-d $file) {
          $dir = abs_path($file);
          if (not $opt_f and $dir !~ m:^/tmp/: and
             ($dir =~ m:^/[^/]*$: or $dir =~ m:^/[^/]*/[^/]*$:)
          ) {
            warn "del: cannot delete '$dir/', too dangerous\n";
            $error++;
            next;
          }
          if (not $file =~ s/\/+$// and not $opt_f) {
            warn "del: '$file' is a directory, use '$file/' to delete it\n";
            $error++;
            next;
          }
        }
      }
      unless (lstat $file) {
        warn "del: '$file' does not exist\n";
        $error++;
        next;
      }
      $dir = dirname($file);
      $deldir = norm("$dir/.del");
      unless (-d $deldir) {
        unless (mkdir($deldir)) {
          warn "del: cannot mkdir $deldir - $!\n";
          $error++;
          next;
        }
        if (my @s = stat($dir)) {
          chmod $s[2],$deldir;
          chown $s[4],$s[5],$deldir;
        }
      }
      if (cpal($file,$deldir)) {
        if (-l $file or not -d $file) {
          unlink $file;
          my $vfile = "$dir/.versions/".basename($file);
          if (my @versions = fmatch(quotemeta($vfile).'(~\d\d?~)?')) {
            my $vdir = norm($deldir.'/.versions');
            mkdir $vdir;
            system 'mv',@versions,$vdir if -d $vdir;
          }
        } else {
          system qw'rm -rf',$file;
        }
      } else {
        warn "del: moving '$file' to '$deldir/' failed";
        $error++;
      }
    }
  }

  exit $error ? 1 : 0;

}

sub cpal {
  my $f = shift;
  my $ddir = shift;
  my @cp = qw'cp -laf';
  push @cp,'-v' if $opt_v;

  $f =~ s:/+$::;
  unless (lstat $f) {
    warn "$0: cannot access '$a'\n";
    return 0;
  }
  unless (lstat $ddir) {
    warn "$0: cannot access '$ddir'\n";
    return 0;
  }
  if (-l $ddir or not -d $ddir) {
    warn "$0: '$ddir' is not a directory\n";
    return 0;
  }

  my @files = ();
  if (open my $find,'-|',qw'find',$f,'-print0') {
    local $_;
    local $/ = "\0";
    while (<$find>) {
      chomp;
      push @files,$_;
    }
    close $find;
  }
  my $dir = dirname($f).'/';
  $dir = '' if $dir eq './';
  foreach my $s (@files) {
    my $d = $s;
    $d =~ s:^\Q$dir:$ddir/:;
    if ((-l $s or not -d $s) and (-d $d and not -l $d)) {
      system qw'rm -rf',$d;
    } elsif ((-d $s and not -l $s) and (-l $d or not -d $d)) {
      unlink $d;
    }
  }

  my @cmd = (@cp,$f,$ddir);
  # print "\$ @cmd\n" if $opt_v;
  system @cmd;
  if ($?) {
    return 0;
    # $error = (($? >> 8) || 1);
  } else {
    return 1;
  }
}


# move file and versions
sub move {
  my $file = rrp(shift);
  my $ddir = rrp(shift);
  my $fdir = dirname($file);
  my $dfile = basename($file);
  my $ddf;

  unless (lstat $file) {
    warn "del: '$file' does not exist\n";
    $error++;
    return;
  }

  unless (-d $ddir) {
    die "del: destionation '$ddir' is not a directory (internal error)";
  }

  if ($dfile =~ m:^/*$: or $dfile eq '.' or $dfile eq '..') {
    die "del: \$dfile == '$dfile' ?!"
  }

  $ddf = norm("$ddir/$dfile");
  if (lstat $ddf) {
    if ($ddf =~ m:/\.del/:) {
      # not used any more, but cpal()
      unlink $ddf or system qw'rm -rf',$ddf;
      if (lstat $ddf) {
        unlink $ddf;
        $error++;
        return;
      }
    } else {
      warn "del: '$ddf' does already exist\n";
      $error++;
      return;
    }
  }
  if (rename $file,$ddf) {
    my $vfile = "$fdir/.versions/$dfile";
    if (my @versions = fmatch(quotemeta($vfile).'(~\d\d?~)?')) {
      my $vdir = norm($ddir.'/.versions');
      mkdir $vdir;
      if (-d $vdir) {
        system 'mv',@versions,$vdir;
      }
    }
    # printf "%s -> %s\n",quote(rrp($file)),quote(rrp($ddf)) if $opt_v;
    @s = lstat($ddf);
    utime($s[8],$s[9],$ddf); # set CTIME
    return $ddf;
  } else {
    $error++;
  }
}


# relative path without leading ./
sub rrp {
  local $_ = shift;
  s:^\./:: if m:/.+/:;
  s://+:/:g;
  return $_;
}


sub norm {
  local $_ = shift;
  s://+:/:g;
  s:^\./(.):$1:;
  return $_;
}


sub mdtime {
  my @d = localtime((lstat shift)[9]);
  return sprintf('%d-%02d-%02d %02d:%02d:%02d',
                 $d[5]+1900,$d[4]+1,$d[3],$d[2],$d[1],$d[0]);
}


sub purge {
  my $ddir = shift;
  my $after = $opt_d * 60*60*24;
  my $now = time();
  my $cwd = getcwd();
  local $_;

  die "del: purge $ddir ?!\n" if $ddir !~ /\.del$/;
  die "del: $ddir is a symlink\n" if -l $ddir;
  if ($< + $opt_d == 0) {
    opendir $ddir,$ddir or die "del: cannot open $ddir - $!\n";
    my @f = ();
    while (defined(my $f = readdir $ddir)) {
      push @f,"$ddir/$f" if $f ne '.' and $f ne '..';
    }
    if ($opt_v and @f) {
      printf "purge %s\n",quote($_) foreach (sort @f);
    }
    system qw'rm -rf',$ddir;
    if (lstat $ddir) {
      warn "del: cannot purge '$ddir'\n";
      $error++;
    } else {
      printf "purge %s\n",quote($ddir) if $opt_v;
    }
    return;
  }
  chdir($ddir) or die "del: cannot chdir($ddir) - $\n";
  if (opendir my $dir,'.') {
    foreach my $file (sort(readdir($dir))) {
      next if $file =~ /^\.\.?$/;
      my @stat = lstat $file;
      unless (@stat) {
        warn "del: cannot purge '$ddir/$file' - $!\n";
        $error++;
        next;
      }
      if ($now > $stat[10]+$after) {
        local ($(,$>,$)) = (0,@stat[4,5]) if $< == 0;
        unlink $file or system qw'rm -rf',$file;
        if (lstat $file) {
          unlink $file;
          warn "del: cannot purge '$ddir/$file' - $!\n";
          $error++;
        } else {
          unlink fmatch("$ddir/.versions/".quotemeta($file).'~\d\d?~');
          printf "purge %s\n",quote("$ddir/$file") if $opt_v;
        }
      }
    }
  } else {
    warn "del: cannot open $ddir - $!\n";
    $error++;
  }
  chdir($cwd);
}


sub quote {
  local $_ = shift;
  my $mc = '\'\[\]\\\\ `"$?&<>$*()|{};';

  unless (defined $_) {
    die "@_";
    @x = caller;
    die "@x";
  }
  if (s/[\000-\037\200-\237\241-\250]/?/g or /\'/) {
    s/([$mc])/\\$1/g;
    s/^~/\\~/;
  } elsif (/[$mc]/) {
    $_ = "'$_'";
  }
  return $_;
}


sub checkvdir {
  my $vdir = shift;
  my $mode = shift||'';

  if (-d $vdir) {
    if (not -x $vdir or not -r $vdir) {
      die "$prg: cannot read $vdir\n";
    }
    if ($mode eq 'w' and not -w $vdir) {
      die "$prg: cannot write to $vdir\n";
    }
  }
}


# file regexp match
sub fmatch {
  my $m = shift;
  my $dir = dirname($m);
  my $fre = basename($m);
  my @match = ();

  $dir =~ s/\\//g;

  if (opendir $dir,$dir) {
    while (defined(my $file = readdir($dir))) {
      next if $file eq '.' or $file eq '..';
        if ($file =~ /^$fre$/) {
        if ($dir eq '.') {
          push @match,$file;
        } else {
          push @match,"$dir/$file";
        }
      }
    }
    closedir $dir;
  }

  return sort(@match);
}


sub d3size {
  $file = shift;
  if (-f $file and not -l $file) {
    return d3(-s $file);
  } else {
    return '-';
  }
}


sub update {
  $0 = abs_path($0);
  die "vv: cannot write $0\n" unless -w $0;
  my $url = 'http://fex.belwue.de/fstools/bin/vv';
  warn "vv: downloading $url\n";
  my $new = `wget -qO- $url`;
  if ($new !~ /visual versioning/) { die "vv: bad update\n" }
  if ($new =~ /version = (\d+)/ and $1 le $version) {
    warn "vv: version $version is uptodate\n";
    exit;
  }
  system qw'vv -s',$0;
  exit $? if $?;
  open $0,'>',$0 or die "vv: cannot write $0 - $!\n";
  print {$0} $new;
  close $0;
  exit;
}


sub vars {
  my $a = shift;

  $file = realfilename($a);
  $ofile = "$file~";
  $bfile = basename($file);
  $dir = dirname($file);
  $vdir = norm("$dir/.versions");
  $vfile = "$vdir/$bfile";
  $vfile0 = "$vfile~00~";
  $vfile1 = "$vfile~01~";
}


sub vsystem {
  print "\$ @_\n" if $opt_v;
  return system @_;
}


sub install {
  my ($dir);
  local $| = 1;

  $0 = abs_path($0);

  print "Installation directory [.]: ";
  $dir = <STDIN>||'';
  chomp $dir;
  $dir =~ s:/+$::;
  $dir ||= '.';
  if ($dir eq '.') {
    if ($0 =~ /vvzz$/) {
      unlink qw'zz ezz del vv';
      rename $0,'vv'    or die "$0: cannot create vv - $!\n";
    }
    symlink 'vv','zz'   or die "$0: cannot create zz - $!\n";
    symlink 'vv','ezz'  or die "$0: cannot create ezz - $!\n";
    symlink 'vv','del'  or die "$0: cannot create del - $!\n";
  } else {
    if (not -e $dir) { die "$0: $dir does not exist\n" }
    if (not -d $dir) { die "$0: $dir is not a directory\n" }
    if (not -w $dir) { die "$0: $dir is not writable\n" }
    chdir $dir or die "$0: cannot cd $dir - $!\n";
    unlink qw'zz ezz del vv';
    system qw'rsync -a',$0,'vv';
    exit $? if $?;
    symlink 'vv','zz'  or die "$0: cannot create $dir/zz - $!\n";
    symlink 'vv','ezz' or die "$0: cannot create $dir/ezz - $!\n";
    symlink 'vv','del' or die "$0: cannot create $dir/del - $!\n";
  }
  print "Installation completed. See:\n";
  print "$dir/vv -h\n";
  print "$dir/zz -h\n";
  print "$dir/ezz -h\n";
  print "$dir/del -h\n";
  exit;
}