#!/usr/bin/perl -w

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

use 5.010;
use Getopt::Std;
use Term::ReadLine;
use Sys::Hostname;

$prg = $0;
$prg =~ s:.*/::;
$| = 1;

$ENV{FUA} = 'fexpack';

$usage = mjoin(
  "$prg: pack file(s) on fexserver (for copy&paste)",
  "usage: $prg [-k DAYS] [-a ARCHIVE] FILE...",
  "usage: $prg -u",
  "options:",
  "  -k  keep DAYS (default: 1 day)",
  "  -a  force ARCHIVE package (may have suffix .tar .tgz .zip .7z)",
  "  -u  generate upload function for copy&paste",
  "examples:",
  "  $prg *.jpg",
  "  $prg -k 10 -a PDF.zip *.pdf",
  "see also: xxx, fexsend",
);

$opt_h = $opt_v = $opt_u = $opt_U = 0;
$opt_k = 1;
$opt_a = '';
getopts('hvuUk:a:') or die $usage;
$opt_u ||= $opt_U;

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

if ($opt_u) {
  $_ = vsystem('fexsend -~ GENUKEY|');
  if ($? == 0 and /FUP=(http.+)/) {
    my $fup = $1;
    print "# to get upload function (one day valid) copy&paste:\n";
    print "eval \$(curl -s $fup)\n";
    print if $opt_v;
  }
  exit $?;
}

# $opt_v = 1;

if (scalar(@ARGV) == 0 ) {
  die $usage;
} elsif (scalar(@ARGV) == 1 and not $opt_a) {
  $arg = $ARGV[0];
  $arg =~ s:/+$::;
  if ($arg =~ /\.(tar|tgz|tar\.[\w\.]+|zip|7z)$/) {
    vexec(qw"fexsend -k",$opt_k,$arg,'.');
  } else {
    vexec(qw"fexsend -k",$opt_k,"-a","$arg.tar",$arg,'.');
  }
} else {
  if ($opt_a) {
    $archive = $opt_a;
  } else {
    $archive = inputline("archive name: ") or exit;
  }
  $archive =~ s/[^\w.+-]/_/g;
  $archive .= '.tar' if $archive !~ /\.(tar|tgz|zip|7z)$/;
  vexec(qw'fexsend -k',$opt_k,'-a',$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;
  }
}
