#!/usr/bin/perl -w

# CLI client for the F*EX service for file zipping
#
# see also: fexsend, fexpush
#
# Author: Ulli Horlacher <framstag@belwue.de>
#
# Perl Artistic Licence

use 5.010;
use Config;
use File::Basename;
use Getopt::Std;
use Term::ReadLine;
use Cwd qw(abs_path getcwd);

$| = 1;
$prg = $0;
$prg =~ s:(.*)/::;
@fexsend = ("$1/fexsend");

$ENV{FUA} = 'fexzip';

if ($prg =~ /7z/) {
  $opt_7 = $opt_z = 1;
  $usage = mjoin(
    "$prg: zip and store file(s) on fexserver with 7zip compression",
    "usage: $prg [-k DAYS] [-a ARCHIVE] FILE...",
    "options:",
    "  -k  keep DAYS (default: 1)",
    "  -a  ARCHIVE name",
    "examples:",
    "  $prg .",
    "  $prg -k 10 -a pictures *jpg",
  );
} else {
  $opt_7 = $opt_z = 0;
  $usage = mjoin(
    "$prg: zip and store file(s) to fexserver",
    "usage: $prg [-k DAYS] [-7] [-z] [-a ARCHIVE] FILE...",
    "options:",
    "  -k  keep DAYS (default: 1)",
    "  -7  use 7zip",
    "  -z  compress files",
    "  -a  ARCHIVE name",
    "examples:",
    "  $prg .",
    "  $prg -k 10 -a pictures *jpg",
  );
}

$opt_h = $opt_v = 0;
$opt_k = 1;
$opt_a = '';
getopts('hv7zk:a:') or die $usage;

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

if (scalar(@ARGV) == 0 and ($Config{osname} eq 'cygwin' or $ENV{CYGWIN})) {
  for (;;) {
    print "file or directory to send: ";
    chomp($file = <STDIN>);
    exit unless length $file;
    $file =~ s/^'(.+)'$/$1/;
    last if -e $file;
    warn "$file does not exist\n";
  }
  @ARGV = ($file);
}

if (scalar(@ARGV) == 0 ) {
  die $usage;
} else {
  foreach (@ARGV) {
    die "$prg: $_ does not exist\n"  unless -e;
    die "$prg: $_ is not readable\n" unless -r;
  }
  if ($opt_a) {
    $archive = $opt_a;
  } elsif (scalar @ARGV == 1) {
    $a = $ARGV[0];
    if ($a eq '.' or $a eq './') {
      $archive = basename(abs_path('.'));
    } else {
      $archive = basename($a);
    }
    if (chdir $a and chdir abs_path('.')) {
      @ARGV = (basename(getcwd()));
      chdir '..';
    } else {
      chdir dirname($a);
      @ARGV = (basename($a));
    }
    warn sprintf("\$ cd %s\n",abs_path('.')) if $opt_v;
  } else {
    $archive = inputline("archive name: ") or exit;
  }
  if ($archive =~ s/\.7z$//) {
    $opt_7 = 1;
  } elsif ($archive =~ s/\.zip$//) {
    $opt_7 = 0;
  }
  $archive =~ s/[^\w.+-]/_/g;
  $archive =~ s/^\./_/;
  $archive .= $opt_7 ? '.7z' : '.zip';
  push @fexsend,'-0' unless $opt_z;
  push @fexsend,('-k',$1) if $opt_k =~ /^(\d+)$/;
  if ($archive eq "@ARGV") {
    vexec(@fexsend,$archive,'.');
  } else {
    push @fexsend,($a and $a =~ /^\.\//) ? '-A' : '-a';
    vexec(@fexsend,$archive,@ARGV,'.');
  }
}


sub inputline {
  my $prompt = shift;
  my $default = shift||'';
  my $term = new Term::ReadLine $prg;

  $term->ornaments(0) unless $ENV{PERL_RL};
  return $term->readline($prompt,$default)||'';
}


sub mjoin {
  local $_;
  my $s;
  $s .= $_."\n" foreach @_;
  return $s;
}


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


sub vexec {
  vsystem(@_);
  exit $?;
}


sub vsystem {
  my @cmd = @_;
  my $cmd;
  my $shellmeta = '[\\\'"`*?&|<>(){};]';
  local $_;

  if ($opt_v) {
    if (-t STDIN) { print STDERR '$ ' }
    else          { print STDERR '| ' }
    if (scalar(@cmd) == 1) {
      warn "@cmd\n";
    } else {
      my @w;
      foreach (@cmd) {
        if (/\'/) {
          push @w,shellquote($_);
        } elsif (/[^\w\/:=~^%@,.+-]/) {
          push @w,"'$_'";
        } else {
          push @w,$_;
        }
      }
      warn "@w\n";
    }
  }

  $_ = "@cmd";
  if (scalar(@cmd) == 1 and /\s/ and not (/^\w+=/ or /$shellmeta/)) {
    @cmd = split;
  }

  if (scalar(@cmd) == 1) {
    $cmd = "@cmd";
    $cmd =~ s/\|&$/ 2>&1|/;
    if ($cmd =~ s/\|$//) {
      my @a = `$cmd`;
      if (wantarray) {
        map { chomp } @a;
        return @a;
      } else {
        chomp $a[0] if scalar(@a) == 1;
        return join('',@a);
      }
    } else {
      system $cmd;
    }
  } else {
    system @cmd;
  }
}
