#!/usr/bin/perl -w
use strict;

my $no_act=0;
my $verbose=1;
my $quiet=0;
my $bad_args=0;
my $help=0;
my $delete_arch=undef;
my ($start_new_arch, $move_home) = (0,0);
our $sh_faildie=1;

use Cwd qw();
use File::Basename;

use Getopt::Long;

sub usage {
  print STDERR <<EOF;
Usage: mover [-q | -n] (-s | -m | -d [A])

-q
    Be quiet.

-n
    No action. Just print what would have been done.

-s
    Create a new archive directory in ~/archive, move ~/old to it,
    and create a new ~/old symlink pointing to the new directory.

-m
    Move the non-permanent contents of ~/ into ~/old

-d [A]
    Delete the most recent archive directory, or archive directory A,
    moving the contents of this directory into the next archive
    directory, or ~/ if it was the most recent.
EOF
}

Getopt::Long::Configure ("bundling", "no_ignore_case");
GetOptions('-q' => \$quiet,
           '-n' => \$no_act,
           '-m' => \$move_home,
           '-s' => \$start_new_arch,
           '-d:s' => \$delete_arch,
           'h|help' => \$help) or $bad_args = 1;
$verbose = 0 if $quiet;
$help || $start_new_arch || $move_home || defined($delete_arch) or
    do { print STDERR "Must specify an action\n"; $bad_args = 1; };

usage if ($bad_args || $help);
exit 1 if $bad_args;
exit 0 if $help;

sub sh {
  my $cmd = shift;
  print "$cmd\n" if $verbose;
  unless ($no_act) {
    system($cmd) == 0 or 
        do {
          my $msg = "Error ".($?>>8).": $cmd\n";
          $sh_faildie ? die $msg : warn "$msg (ignored)"
            }
  }
}

if (defined($delete_arch)) {
  # if empty string, then use latest archive.
  my @l = split /\n/s, `ls $ENV{HOME}/archive | grep '^home-' | sort -n`;
  my $arch=$delete_arch || "$ENV{HOME}/archive/$l[$#l]";

  print "Are you sure you want to delete archive $arch? ";
  my $ans=<>;
  die "Canceled\n" if(!($ans =~ /^[yY]/));

  die "No archive specified and no 'old' link\n" if !$arch;
  die "Nonexistent: $arch\n" if !-e $arch;
  die "Not a directory: $arch\n" if !-d $arch;

  # move contents of specified archive to the one after it (or home
  # directory if latest), delete specified archive and fix up links.
  # ask first?

  # XXX: cheating. we don't really know that the path they gave points
  # inside the archive directory, should check. plus, would like 'old'
  # links to work
  $arch = basename Cwd::realpath $arch;

  chdir "$ENV{HOME}/archive";
  print "arch=$arch\n";
  print "archives: @l\n";
  my $next;
    # ".." is relative to archive dir
  while(@l) { if((shift @l) eq $arch) { $next = @l ? shift @l : ".."; last; } }
  print "next=$next\n";
  die "Internal error" if !-e $next;
  die "Next archive is not a directory: $next\n" if !-d $next;

  if (-l "$next/old" && !$no_act) {
    sh "rm -f \Q$next/old\E";
  }

  my @g=map { quotemeta $_ } glob("$arch/*");
  for(@g) {
    local $sh_faildie=0;
    sh "chmod u+w $_";
    sh "mv -i $_ $next";
  }
  sh "rmdir \Q$arch\E";
}
if ($start_new_arch) {
  chdir $ENV{HOME};
  my $arch=`echo -n archive/home-\$(date +%Y-%m-%d_%H.%M.%S)`;

  print "arch=$arch\n";

  die "Error: $arch already exists\n" if(-f $arch);

  print "Creating $arch\n";
  sh "mkdir -p \Q$arch\E";
  do {
    local $sh_faildie=0;
    sh "mv old \Q$arch\E";
  };
  sh "ln -sf \Q$ENV{HOME}/$arch\E old";
}
if ($move_home) {
  chdir $ENV{HOME};
  my @exclude=();
  my $mexcl = ".mover-exclude";
  if(-f $mexcl) {
    @exclude = grep { $_ !~ /^\s*(#.*)?$/ } (split /\n/, `cat $mexcl`);
    warn ("Excluding files: ".join(", ",@exclude)."\n") if $verbose;
  } else {
    warn "Missing $mexcl, continuing with empty exclude list\n" if $verbose;
  }
  my @g = glob("*");
  my %h = ();
  @h{@g} = (1)x@g;
  delete @h{@exclude};
  @g=map { quotemeta $_ } keys %h;
  for (@g) {
    local $sh_faildie=0;
    sh "mv $_ old";
  }
}