#!/usr/bin/perl -w -s
use XML::DT;
use XML::TX;
use Data::Dumper;
use strict;
use warnings;
our ($correct);
my $txf = shift;
my $filename = shift || die("Usage $0 file.tx file.xml\n");

open(F,$txf) or die("cant open $txf\n");

my $types={};
my $r;
while(<F>){
 chomp;
 if($_ eq '%%'){undef $/; 
                $r=<F>; 
                $/="\n";
                eval($r); 
                die("Erro $@") if $@; 
                last}
 s/\#.*//g;                                   # elim comments
 if(/(\S+)\s+(.+)/){$types->{$1}=pro($2);  }  # define new types
  
}
close F;

if($correct){ fixit($filename,$types);}
else        { markit($filename,$types); }

sub pro{
 my $a = shift;
 my $b;
 my $e = '';
 for($a){
   if(s/\@([^)(, \[\]\<]+)/\$v{'$1'}/) {$e=1 }
   elsif(m/[\(\)]/                   ) {$e=2 }
 }
 if   ($e eq "1" ){ $b = sub{ eval($a) }}
 elsif($e eq "2" ){ $b = eval($a) }
 else             { $b = $a}
 $b
}

__END__

=head1 NAME

tx - Perl script for XML validation based on types

=head1 SYNOPSIS

 tx [-correct] tx-file xml-file

=head1 DESCRIPTION

Makes the validation of a xml-file based on tx-file description.
"tx-file" type description is a DSL that associates types with XML elements 
and may also define new types.

=head1 Example of a tx-file

 url          urlActive
 url2         url
 pos          enumFromFile("validPOS")
 orth         text("en")
 translation  text("pt")
 domain       text(@xml:lang)

 %%

 use LWP::Simple;
 addType(
  urlActive =>
    { markit => sub{ $c = markAsErr($c) unless (LWP::Simple::head($c));
                     toxml()}, } );

=head1 AUTHOR

J.Joao Almeida, jj@di.uminho.pt

=head1 SEE ALSO

XML::TX(3pm)

perl(1)

=cut      

# enumFromFile("tpos","POS");

addType(
  urlActive =>
    { markit => sub{ $c = markAsErr($c) unless (LWP::Simple::head($c));
                     toxml()}, } );

enum("dia",[1..31]);

#print ( isvalid( 39,"dia") ? "ok" : "ko");
#print ( isvalid( "cataaa",text("en")) ? "ok" : "ko");


__END__
%handler=(
     '-begin' => sub{$n=0;},
     'translation' => sub{$tab{$n}=$c;"\cA".$n++."\cA"}
);

sub extrai_f{
     $tab{$n}=$c;"\cA".$n++."\cA"
}

open(A,">tmpdic") or die;
print A dt($filename,%handler);
close A;

spell_table(\%tab);

sub load_table{
 my $tab;
 my $filename = shift;
 open(T,"$filename") or die;
 local $/;
 $/= "\n\cA";
 while(<T>){
  chomp;
  if(m{^(\d+):(.*)}s){$tab->{$1}=$2}
  else{}
 }
 close T;
 $tab;
}

sub save_table{
 my $tab=shift;
 my $filename = shift;
 open(T,">$filename") or die;

 for(keys %$tab){ print T "\n\cA$_: $tab->{$_}\n"}
 close T;
}

sub spell_table{
 my $t = shift;
 save_table($t,"/tmp/aux");
 system ("xterm -e 'jspell -d port /tmp/aux'");
}