#!/usr/bin/perl -s

use strict;
use warnings;

use CWB;
use Lingua::PT::PLN;
use Data::Dumper;
use POSIX qw(locale_h);
setlocale(&POSIX::LC_ALL, "pt_PT");
use locale;


my $use = "usage tokens2cqp.pl <corpusfile> <metafile>";

my $regis = "/usr/local/share/cwb/registry";
my $corpdir = "/corpora";

my $corpusfile = shift or die($use);
my $metafile = shift or die($use);
my ($corpusname,@attribs,@tags_s,@tags_v);

open (F, "$metafile");

# reconhecimento da informação que está no  
# ficheiro meta que deve acompanhar o corpus
#
while (<F>) {
   if ($_ =~ /CORPUS: (.+)/) {
      $corpusname = lc($1);
      $corpusname =~ s/\./-/g;
   }
   if ($_ =~ /ATTRIBUTES: (.+)/) {
      @attribs = split(/[, ]+/,$1);
   }
   if ($_ =~ /TAGS S: (.+)/) {
      @tags_s = split(/[, ]+/,$1);
   }
   if ($_ =~ /TAGS V: (.+)/) {
      @tags_v = split(/[, ]+/,$1)
   }
}

close F;

my @corpusfiles = ($corpusfile);

# todos os ficheiros passados no metafile devem 
# ser mais recentes do que os que já lá estão. Isto,
# se eles já existirem e tiverem sido processados.
#
for my $tmx (@corpusfiles) {
   if (younger("$regis/$corpusname", "$tmx")) {
	  print "CWB corpus $corpusname already created\n";
   }
   else {
	  xml2cqp($corpusname, "$tmx");
	  print "fim de tokens2cqp\n";
   }
}

sub xml2cqp{  
	my $corpname=shift;  
	my @files=@_;  
	open (X , "> $corpname.corpus");  
	select(X);  

   my %t;
   
   for (@tags_s) {
      $t{s}{$_} = 1;
   }
   for (@tags_v) {
      $t{v}{$_} = 1;
   }
#	my %t=( s => {}, v => {text=>1,p=>1,s=>1});  

	my $n;  

	for $n (@files){    
		open F, $n or die "Can't open $n";
		while(<F>) {print};
		close F;
	}  
	
	select(STDOUT);  
	close(X);
	my ($r,$o)= tags2options($corpname,%t);
	mkdir("$corpdir/$corpname");
	mkdir("$corpdir/c1");
	mkdir($regis);
	unlink(<$corpdir/$corpname/*>);

	open(R,">$regis/$corpname")
	or die("cant create corpus registry for $corpname:$!\n(mkdir -p $regis;chmod a+rwx $regis)\n");
	print R $r;
	close R;

	!system ("$CWB::Encode -d $corpdir/$corpname -0 corpus -s $o < $corpname.corpus")||
	  die ("Erro Encode -d $corpdir/$corpname -s $o < $corpname.corpus ($?)$@$!\n");
	!system ("$CWB::Makeall $corpname") ||
	  die ("Erro Makeall ($?)$@$!\n");
}

sub tags2options{
	 my ($name,%t)=@_;
#	 my @v = keys(%{$t{v}});
#	 my @s = keys(%{$t{s}});
	 my $options = "";
	 my $registry= qq{
	 NAME "$name" 
	 ID $name
	 HOME $corpdir/$name
	 ATTRIBUTE word
	 };

	 for (@tags_v){ $registry .= "STRUCTURE $_\n"; }
	 for my $s (@tags_s){ $registry .= "STRUCTURE $s\n" unless grep(/^$s$/,@tags_v); }

    for my $att (@attribs) {
        $registry .= "ATTRIBUTE $att\n";
        $options .= " -P $att ";
    }
	 for (@tags_v){ $options.=" -V $_";}
	 for my $s (@tags_s){ $options.=" -S $s" unless grep(/^$s$/,@tags_v);}

	 ($registry,$options) 
}

sub younger{  ## f1 exists and is younger then f2 (for make f1)
	 my ($f1,$f2)=@_;
	 ## printf('%s %s -e = %d -Mf2 = %f >= -Mf1 %f',$f1, $f2, (-e $f1), (-M $f2), (-M $f1)), "\n";
	 (-e $f1 && -M $f2 >= -M $f1)
}

__END__
