#!/usr/bin/env perl
#                                                          -*- cperl -*-
if ($^V lt v5.6.0) {
  print STDERR '-' x 50,"\n";
  print STDERR "WARNING: Your version of perl is older than v5.6.0\n";
  print STDERR "THINGS MAY NOT WORK AS EXPECTED!\n";
  print STDERR '-' x 50,"\n\n";
}

use Getopt::Std;
getopts('p:r:s:a:f:x:X:m:n:CETADRNGhu');

if (@ARGV<1 or $opt_h or $opt_u) {
  print <<EOF;
Usage: any2any [-s strip-sfx] [-a append-sfx] [-p strip-prefix] [-m merged-outfile]
               [-r add-prefix] [-f out-fmt] [-x extra_attribs]
               [ flags ] file1 [ file2 ... ]
EOF

  if ($opt_h) {
    print <<EOF;
Open a file and save it in FS format
Parameters:
  -f format          output format; one of: fs, csts, trxml, teixml, and storable.
                     Default is csts.
  -s suffix_regexp   strip strings matching given regexp from the end of filenames
  -a append          append given suffix to the filenames
  -p prefix_regexp   remove strings matching given regexp from the beginning of filenames
  -r prepend         prepend filenames with the given prefix
  -x extra_attribs   comma separated list of non-CSTS attributes to preserve when
                     converting to CSTS

  -m filename        Merge all given files into one huge file. The implementation is
                     rather imperfect since for instance CSTS headers are not merged.

  -n number          this option may be used in combination with -m to merge all
                     given files into one or more output files containing at most the
                     given number of trees. If this option is used,
                     the filename specified with -m must contain `%d'
                     or similar sprintf format instruction which will
                     be replaced by the number of the output file
                     (starting from one).

  -T                 if converting from csts, build tectogrammatical tree structure
  -R                 same as -T (for compatibility with TrEd/bTrEd)

  -X <gov>,[<ord>],[<hide>] - use attribute <gov> to build tree from CSTS
                     files, <ord> to order nodes, <hide> to distinguish
                     hidden nodes

  -A                 when converting from csts, use header for Arabic PADT treebank
  -N                 if empty, initialize ordering attribute with sentence ordering
  -G                 do not save dependency on the root of the tree in csts format
  -C                 convert to CSTS in mode quite compatible with Dan Zemans cstsfs
  -E                 when converting to CSTS, save err1 attribute to (non-CSTS) <err> element
  -D                 print various debugging information
EOF
  }
  exit 0;
}

use File::Glob qw(:glob);
use FindBin;
my $rb=$FindBin::RealBin;
if (exists $ENV{TREDHOME}) {
  $libDir=$ENV{TREDHOME};
} elsif (-d "$rb/tredlib") {
  $libDir="$rb/tredlib";
} elsif (-d "$rb/../lib/tredlib") {
  $libDir="$rb/../lib/tredlib";
} elsif (-d "$rb/../lib/tred") {
  $libDir="$rb/../lib/tred";
}
print STDERR "Trying $libDir\n" if ($opt_D and $libDir);
unshift @INC,"$libDir";

{
  my $ld=$libDir;
  require TrEd::Config;
  import TrEd::Config;
  import TrEd::Config qw(&read_config &set_default_config_file_search_list $defaultMacroFile);
  $libDir=$ld;
  my $libs = File::Spec->catfile($libDir,'libs');
  if (-d $libs) {
    push @INC, glob(File::Spec->catfile($libs,'*',''));
  }
}

$TrEd::Config::quiet=1;

if (defined $config_file) {
  @TrEd::Config::config_file_search_list=($config_file); 
  # override any other possible config files
} else {
  set_default_config_file_search_list();
}

my $configFile=read_config();

require Treex::PML;
import Treex::PML;

@backends=('FS',ImportBackends(qw(NTRED TrXML TEIXML CSTS Storable)));

($opt_T || $opt_R) && Csts2fs::setupTR();
$opt_A && Csts2fs::setupPADTAR();
if ($opt_X ne "") {
  Csts2fs::setupSpec(split ',',$opt_X,-1);
  Fs2csts::setupSpec(split ',',$opt_X,-1);
}

@Fs2csts::extra_attributes=split /,/,$opt_x;

$Treex::PML::Debug=1 if $opt_D;
$Csts2fs::fill_empty_ord = 1 if $opt_N;
$Fs2csts::export_dependency = 0 if $opt_G;
$Fs2csts::compatibility_mode = 1 if $opt_C;
$Fs2csts::preserve_err1 = 1 if $opt_E;

our $inputenc='iso-8859-2';

%bkmap=(
	fs => 'FS',
	csts => 'CSTS',
	trxml => 'TrXML',
	teixml => 'TEIXML',
	storable => 'Storable'
);

$fileno=0;

my @files;
if ($^O eq 'MSWin32') {
  @files=map glob, @ARGV;
} else {
  @files = @ARGV;
}
$filecount=scalar(@files);

$format=defined($opt_f) ? lc($opt_f) : "csts";
unless (  $backend = $bkmap{$format} ) {
  die "Unknown format $format. Use -f [fs|csts|trxml|teixml]\n";
}

if ($opt_m) {
  # merge all given files into one large output file
  my $outfs;
  $out = $opt_m;
  my $limit = $opt_n;
  if ($limit) {
    unless ($out =~ /(?:^|[^%])%[-#0 +'I]?\d*[diu]/) {
      die "Error: the output filename (-m filename) must contain sprintf\n".
          "formatting specifiersuch as '%d' when -n is used\n";
    }
  }
  my $outfileno=0;
  my @f;
  do {{
    my $prev_file;
    my @trees;
    foreach my $f (@files) {
      $f=~s/(##?[0-9A-Z]+(?:-?\.[0-9]+)?)$//;
      if (!defined($prev_file)) {
	$prev_file = $f;
	@trees=();
      } elsif ($f ne $prev_file) {
	push @f, [$prev_file,@trees];
	$prev_file = $f;
	@trees=();
      }
      push @trees, $1;
    }
    push @f, [$prev_file,@trees] if $prev_file;
  }};
  $filecount=scalar(@f);
  foreach my $fspec (@f) {
    my $f;
    $f=shift @$fspec;
    $fileno++;
    print STDERR "$f\t",int(100*$fileno / $filecount),"%\t$fileno of $filecount\n";
    $fs = Treex::PML::Factory->createDocumentFromFile($f,{
      encoding => $inputenc,
      backends => \@backends
    });
    if ($fs->lastTreeNo<0) {
      print STDERR "$f: empty or corrupt file!\n";
      next;
    }
    foreach my $tree (map { computeFileSuffix($fs,$_) } @$fspec) {
      if (defined($outfs)) {
	my $newdefs=$fs->FS->defs();
	my $fmt=$outfs->FS;
	my $defs=$fmt->defs();
	my $list=$fmt->list();
	foreach ($fs->FS->attributes()) {
	  push @$list, $_ unless ($fmt->exists($_));
	  $defs->{$_}=$newdefs->{$_};
	}
      } else {
	# create the output file according to the first file
	$outfs = Treex::PML::Factory->createDocument({
				name => ($limit ? sprintf($out,$outfileno++) : $out),
				format => $format,
				FS => $fs->FS->clone(),
				backend => $backend,
				encoding => $fs->encoding()
			       });
	$outfs->changePatterns($fs->patterns());
	$outfs->changeTail($fs->tail());
	$outfs->changeHint($fs->hint());
	print " -> ".$outfs->filename(),"\n";

	# merge fs headers
	my $newdefs=$fs->FS->defs();
	my $fmt=$outfs->FS;
	my $defs=$fmt->defs();
	my $list=$fmt->list();
	foreach ($fs->FS->attributes()) {
	  push @$list, $_ unless ($fmt->exists($_));
	  $defs->{$_}=$newdefs->{$_};
	}
      }

     # append trees
      push @{$outfs->treeList}, $tree;
      if ($limit and @{$outfs->treeList}>=$limit) {
	save($outfs);
	@{$outfs->treeList}=();
	undef $outfs;
      }
    }
    @{$fs->treeList}=(); # prevent them from being destroyed with $fs
    undef $fs;
  }
  save($outfs) if ($outfs and @{$outfs->treeList});
} else {
  foreach $f (@files) {
    $fileno++;

    my $out=$f;

    my $eval;
    $eval.="s%$opt_s\$%%;"  if ($opt_s);
    $eval.="\$_.=\"$opt_a\";" if ($opt_a);
    $eval.="s%^$opt_p%%;" if ($opt_p);
    $eval.="\$_=\"$opt_r\".\$_;" if ($opt_r);
    if ($eval) {
      use Safe;
      my $compartment = new Safe;
      $compartment->permit_only(qw(concat padany subst substcont :base_core));
      $_=$out;
      $compartment->reval($eval);
      print STDERR $@ if $@;
      $out=$_;
    }

    print STDERR "$f\t->\t$out\t",int(100*$fileno / $filecount),"%\t$fileno of $filecount\n";
    $fs = Treex::PML::Factory->createDocumentFromFile($f, {
      encoding => $inputenc,
      backends => \@backends
     });
    if ($fs->lastTreeNo<0) {
      print STDERR "$f: empty or corrupt file!\n";
      next;
    }
    $fs->changeBackend($backend);
    $fs->changeFilename($out);
    save($fs);
    undef $fs;
  }
}

sub computeFileSuffix {
  my ($fs,$suffix)= @_;
#  print STDERR "SUFFIX: $suffix\n";
  return () unless $fs;
  if ($suffix eq "") {
    return $fs->trees;
  } elsif ($suffix=~/^##([0-9]+)/) {
    if ($1-1<=$fs->lastTreeNo) {
      return ($fs->treeList->[$1-1]);
    }
  } elsif ($suffix=~/^#/) {
    # -- smells like PDT-specific code, at least the second case
    # but we want it, dont we:)
    for (my $i=0;$i<=$fs->lastTreeNo;$i++) {
      return ($fs->treeList->[$i]) if ($fs->treeList->[$i]->{form} eq $suffix);
    }
  }
  return ();
}


sub save {
  my ($fs) = @_;
  my $out=$fs->filename();
  if (-e $out) {
    unlink "$out~" if (-e "$out~" ); # silly MS OSs need this
    rename $out, "$out~" || die "Cannot create backup file named $out~ for $out\n";
  }
  $fs->writeFile($out);
}
