#!/usr/bin/perl
package U;

require Exporter;
@ISA=qw(Exporter);
@EXPORT=qw(dmsg vmsg nmsg
           pv pav phv sh *sh_err 
           *sh_ev *sh_failed *sh_sig *sh_core *sh_errno
           esh *sh_stderr *sh_stdout
           min max argmin argmax
           update_best
           sum cumsum ave clean_path save_cwd
           lock_file unlock_file read_file
           read_headers zip
           escape unescape iter *iter_num);

use warnings;
use strict;

use File::Temp;

our $debug=1;
our $verbose=1;
our $quiet=0;

sub dmsg { print STDERR @_, "\n" if($debug); }
sub vmsg { print STDERR @_, "\n" if $verbose; }
sub nmsg { print STDERR @_, "\n" if !$quiet; }

do {
  # Declaring this in package DB results in special "eval" behavior:
  # the expression is evaluated in the first non-DB lexical scope

  package DB;

  use Data::Dumper;

  # "Print value": display an expression, and then its value.
  # Evaluates the expression in the context of the caller. Useful for
  # debugging: just substitute "pv q{EXPR}" for "EXPR" when you want
  # to examine its value. EXPR should be a scalar, but arrays and
  # hashes can be made into scalars with [] and {}.
  sub pv {
    my $e = shift;
    my ($package, $filename, $line) = caller;
    local $Data::Dumper::Indent=0;
    local $Data::Dumper::Purity=1;
    local $Data::Dumper::Terse=1;
    my $v = Dumper(eval "package $package; ($e)");
    die $@ if $@;
    print STDERR "$e = $v\n" if $debug;
  }
};

*pv = \&DB::pv;

sub sh_quote {
  my ($n) = shift;
  defined($n) or die "internal error";
  $n =~ s/([ \!\"\#\$\&\'\(\)\*\;\<\=\>\?\[\\\]\_\`\{\|\}\~\001-\037\177-\377])/\\$1/g;
#\`\'\"<>{}\[\]~\$&*?\#!\|; \n\t\(\)\\\001-\037\177-\377])/\\$1/g;
  return $n;
}

our ($no_act, $sh_err);
our ($sh_ev, $sh_failed, $sh_sig, $sh_core, $sh_errno);

# 'system' replacement. When evaluated in void context, takes care of
# dying on error, etc. When evaluated in array or scalar context,
# returns zero on any failure condition; these can be distinguished
# with $sh_ev, $sh_failed, $sh_sig. So, if you want to just get the
# exit status, be sure to observe the return value so that we aren't
# executing in void context ($_=sh... for instance), then check that
# $sh_failed and $sh_sig are both zero; then the exit status will be
# in $sh_ev.
sub sh {
  local $1;
  my (@args) = @_;
  my $cmd;

  if (@args>1) {
    $cmd = join(" ", map {sh_quote $_} @args);
  } else {
    $cmd = $args[0];
  }
  my $secret = "58ihaipX1";
  $cmd =~ s/\\\\/$secret/g;
  $cmd =~ s/\\\n/'\n'/g;
  $cmd =~ s/$secret/\\\\/g;
  return if !$cmd;
  vmsg "$cmd";
  unless($no_act) {
    do {
      local $SIG{__WARN__}=sub{};
      system($cmd);
    };

    ($sh_ev, $sh_failed, $sh_sig, $sh_core, $sh_errno) =
        ($?>>8, $?==-1, $? & 127, !!($? & 128), $!);
    
    if ($sh_failed) {
      $sh_err = "Failed to execute: $sh_errno";
    } elsif ($sh_sig) {
      $sh_err = "Died with signal $sh_sig".($sh_core?", dumped core":"");
    } elsif ($sh_ev) {
      $sh_err = "Exit value $sh_ev";
    } else {
      $sh_err = undef;
    }

    return !($sh_ev || $sh_failed || $sh_sig) if(defined(wantarray));
    
    # void context, take care of the error ourselves:
    die "$sh_err: $cmd\n" if defined($sh_err);
  }
}

# run a shell command, store its stdout and stderr in variables
our ($sh_stderr, $sh_stdout);
sub esh ($) {
  my $cmd = shift;
  my $efh = new File::Temp(UNLINK=>1);
  my $efname = $efh->filename;
  my $ofh = new File::Temp(UNLINK=>1);
  my $ofname = $ofh->filename;
  $sh_stderr = undef;
  $sh_stdout = undef;
  $_=sh "$cmd 2>\Q$efname\E >\Q$ofname\E";
  open IN, '<', $ofname;
  $sh_stdout = join("",<IN>);
  close IN;
  open EIN, '<', $efname;
  $sh_stderr = join("",<EIN>);
  close EIN;
  return $_ if(defined(wantarray));
  die "$sh_stderr" if !$_;
}

sub min {
  my $v = shift;
  for(@_) { $v = $_ if $_ < $v; }
  return $v;
}

sub max {
  my $v = shift;
  for(@_) { $v = $_ if $_ > $v; }
  return $v;
}

# return index of smallest element
sub argmin {
  my $n = 0;
  my $i = 0;
  my $v = shift;
  for(@_) {
    $i++;
    if($_ < $v) {
      $v = $_;
      $n = $i;
    }
  }
  return $n;
}

# return index of largest element
sub argmax {
  my $n = 0;
  my $i = 0;
  my $v = shift;
  for(@_) {
    $i++;
    if($_ > $v) {
      $v = $_;
      $n = $i;
    }
  }
  return $n;
}

sub update_best {
  my ($i, $f, $rbi, $rbf) = @_;
  if(!defined $$rbf || $f > $$rbf) {
    $$rbf = $f;
    $$rbi = $i;
  }
}

sub sum {
  my ($package, $filename, $line) = caller;
  my (@n) = @_;
  my $s = 0;
  for(@n) {
    warn "Passed undefined value to 'sum' on $filename:$line\n" if !defined($_);
    $s+=$_;
  }
  return $s;
}

sub cumsum {
  my ($package, $filename, $line) = caller;
  my (@n) = @_;
  my $s = 0;
  my @s = ($s);
  for(@n) {
    warn "Passed undefined value to 'cumsum' on $filename:$line\n" if !defined($_);
    $s+=$_;
    push @s, $s;
  }
  return @s;
}

sub ave {
  return sum(@_)/scalar(@_);
}

sub _strip_single_dots {
  while(s!(^|/)\./(.)!$1$2!g) {}
  while(s!/\.$!!g) {}
}

sub _strip_double_dots {
  while(s!^/\.\.?($|/)!/!) {};
  while(s!/[^/]+/\.\.($|/)!/!g) {};
  while(s!^[^/]+/\.\.($|/)!.$1!g) {};
}

# Return a "canonical" version of a file path. Similar to "$(cd $f;
# pwd)" in shell, but doesn't require the path to exist or be a
# directory, and keeps relative paths relative.
sub clean_path {
  $_=shift;
  my $changed=0;
  while(s!//+!/!g) {}
  _strip_single_dots;
  _strip_double_dots;
  _strip_single_dots;
  while(s!(.)/$!$1!g) {}
  return $_;
}

use File::Basename;
use Errno qw(EINTR EIO :POSIX);

sub lock_file {
  # XXX modify to optionally write and check pid
  my ($is_local, $lock) = @_;
  my $dir = dirname($lock);
  my $res;
 restart:
  if(-e $lock) {
    if($is_local) {
      open IN, '<', $lock or die "Couldn't open $lock for reading: $!";
      my $pid = join("", <IN>);
      close IN;
      $pid =~ /^\s*(\d+)\s*$/ or die "Expected pid number in $lock, found $pid";
      $pid = $1;
      if(!(kill 0, $pid) && $!{ESRCH}) {
        warn "Warning: deleting orphaned lockfile $lock from non-existent pid $pid";
        unlink $lock;
        goto restart;
      }
    }
    print "Already locked\n";
    $res = 0;
  } else {
    my $tmpf;
    do { $tmpf = "$dir/.lock.".(int rand 1000000000); } while (-e $tmpf);
    open OUT, '>', $tmpf or die "Couldn't create temporary file $tmpf: $!";
    print OUT "$$\n";
    close OUT;
    if((link $tmpf, $lock) || (stat $tmpf)[3] == 2) {
      (stat $tmpf)[3] == 2 or die "Internal error";
      $res = 1;
    } else {
      print "Couldn't take lock\n";
      $res = 0;
    }
    unlink $tmpf or die "Couldn't unlink $tmpf: $!";
  }
  return $res;
}

sub unlock_file {
  my ($lock) = @_;
  unlink $lock or die "Couldn't unlink $lock: $!";
}

sub read_file ($) {
  my ($file) = @_;
  my $data;
  open IN, '<', $file;
  $data = join("", <IN>);
  close IN;
  return $data;
}

sub defor ($$) {
  my ($a, $b) = @_;
  return $a if defined $a;
  return $b;
}

do {
  use Cwd;
  sub save_cwd (&) {
    my ($b) = @_;
    my $pwd = getcwd;
    if(wantarray) {
      my @res=&$b();
      chdir($pwd);
      return @res;
    } else {
      my $res=&$b();
      chdir($pwd);
      return $res;
    }
  }
};

# return a list of headers, with newlines removed
sub read_headers ($) {
  my ($f)=@_;
  my @hdr;
  local *IN;
  open IN, "<", $f or die "Couldn't open $f for reading";
  @hdr=();
  my $cur_hdr;
  while (<IN>) {
    chomp;
    if ($_ =~ /^[ \t]/) {
      warn "Bad header format: $_" unless defined $cur_hdr;
      $cur_hdr .= $_;
      next;
    }
    push @hdr, $cur_hdr if defined $cur_hdr;
    $cur_hdr=$_;
    if ($_ =~ /^$/) {
      last;
    }
  }
  close IN;
  return @hdr;
}

sub zip {
  my ($m,@r);
  $m = min map {scalar @$_} @_;
  for my $i (0..$m-1) {
    $r[$i] = [map {$_->[$i]} @_];
  }
  return @r;
}

my %esc_codes = (
    'n' => "\n",
    't' => "\t",
    'r' => "\r"
  );

my %esc_rev = (
    "\n" => 'n',
    "\t" => 't',
    "\r" => 'r',
    "\\" => '\\'
  );

sub unescape {
  my ($v)=@_;
  $v =~ s/(?<!\\)(\\(.))/$esc_codes{$2} || $2/gex;
  return $v;
}

sub escape {
  my ($v)=@_;
  my $old = $v;
  $v =~ s/([\n\r\t\\])/"\\".$esc_rev{$1}/gex;
  $old eq (unescape $v) or die "internal error";
  return $v;
}

my $t0 = time();
my $t1;
our $iter_num=0;
sub iter ($) {
  my ($skip) = (@_);
  $iter_num++;
  if (($iter_num%$skip)==0) {
    $t1 = time();
    if ($t1-$t0 > 0) {
      nmsg "Row $iter_num";
      $t0 = $t1;
    }
  }
}

1;