#!/usr/bin/perl

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell
#
# Copyright (C) 2000, 2003, 2004 Eric de la Clergerie
#
# $Id: tag_converter,v 1.4 2004/02/19 13:31:12 clerger Exp $
#

use FindBin qw($Bin $Script);

use TAG;
use TAG::Tools;
use TAG::Strip;
use Getopt::Mixed "nextOption";

my @files;
my $outinfo = { type => 'xml' };

my $map = { 'axiom' => 's' };
my $mapfile;

my %writer =
    ( 'lp' => \&emit_lp,
      'rcg' => \&emit_rcg,
      'xrcg' => \&emit_xrcg,
      'rcglex' => \&emit_rcglex,
      'xrcglex' => \&emit_xrcglex,
      'check' => \&check,
      'header' => \&emit_header,
      'dump' => \&dump,
      'grove' => \&emit_grove,
      'xml' => \&emit_xml,
      'db' => \&dbi_dump,
      );

my %reader =
    ( 'lp' => \&lp_reader,
      'xml' => \&xml_reader,
      'db' => \&db_reader
      );

my %extensions =
    ( 'lp' => 'lp',
      'pl' => 'pl',
      'tag' => 'lp',
      'xml' => 'xml',
      'rcg' => 'rcg',
      'xrcg' => 'xrcg',
      'rcglex' => 'rcglex',
      'xrcglex' => 'xrcglex'
      );

my %transformers =
    ( 'strip' => \&TAG::Document::strip
      );

my $extkeys = join('|',keys %extensions);

my @apply = ();

Getopt::Mixed::init( "i=s in>i",
		     "o=s out>o",
		     "f=s from>f",
		     "t=s to>t",
		     "a=s apply>a",
		     "treefile=s",
		     "axiom=s",
		     "map:s"
		     );

while (my ($option, $value) = nextOption()) {
    $map->{'default'}{'family'} = $value, next if ($option eq 'treefile');
    $map->{'axiom'} = $value, next if ($option eq 'axiom');
    $mapfile = $value, next if ($option eq 'map');
    push(@files,$value), next if ($option eq 'i');
    $outinfo->{'file'} = $value, next if ($option eq 'o');
    $outinfo->{'type'} = $value, next if ($option eq 't');
    push(@apply,$transformers{$value}), next if ($option eq 'a');
}

&parse_map_file($map,$mapfile) if (defined $mapfile);

push(@files,@ARGV);

my $date = localtime($^T);

my $doc = TAG::Document->new( 'axiom' => $map->{'axiom'} );

foreach my $file (@files) {
    my $info = &find_file_type($file);
    my $reader = $reader{$info->{'type'}} || die "No reader for type $info->{type}";
    &$reader($file,$info);
}


## Transformers

&$_($doc) foreach (@apply);

my $outfile = $outinfo->{'file'};

$outinfo = &find_file_type($outfile) if ($outfile);

my $writer = $writer{$outinfo->{'type'}} || die "No writer for type $outinfo->{type}";

if ($outfile && $outinfo->{'type'} ne 'db') {
    open(OLDOUT, ">&STDOUT");
    open(STDOUT,">$outfile");
}

&$writer($outinfo);

if ($outfile && $outinfo->{'type'} ne 'db') {
    close(STDOUT);
    open(STDOUT, ">&OLDOUT");
}

######################################################################
# Readers

sub xml_reader {
    use TAG::XML::Parser;
    my $file = shift;
    my $parser = TAG::XML::Parser->new;
    $TAG::XML::Parser::doc = $doc;
    $parser->parsefile( $file);
}

sub lp_reader {
    use TAG::LP::Parser;
    my $file = shift;
    $parser = new TAG::LP::Parser;
    $/="";
    $parser->YYData->{TAG} = $doc; 
    $parser->YYParse( yylex => \&TAG::LP::Parser::_Lexer, 
		      yyerror => \&TAG::LP::Parser::_Error );
}

sub db_reader {
    use TAG::DBI::Reader;
    my $file = shift;
    my $db = shift;
    print STDERR "Connecting database $db->{dns}\n";
    $doc->dbi_read($db->{'dns'},$db->{'user'}, "");
}

######################################################################
# Writers

sub dump {
    use Data::Dumper;
    my $d = Data::Dumper->new([$doc]);   
    print $d->Dump,"\n\n";
}

sub check {
    use TAG::Checker;
    $doc->check();
}

sub emit_lp {
    use TAG::LP;
    my $s= <<EOF ;
%% Translated using $Script
%% Input files @files
%% Date $date

EOF
    $s .= $doc->LP($map);
    $s = UTF8toISO($s);
#    $s =~ tr/\0-\x{ff}//UC;          # needed if lexical values in latin-1
    print "$s\n";
}

sub emit_header {
    use TAG::Header;
    print <<EOF ;
%% Translated using $Script
%% Input files @files
%% Date $date

EOF
    $doc->header($map)->print_as_lp();
}

sub emit_rcg {
    use TAG::RCG;
    print <<EOF ;
%% Translated using $Script
%% Input files @files
%% Date $date

EOF
     foreach my $s ($doc->RCG()) {
	 $s = UTF8toISO($s);
#	 $s =~ tr/\0-\x{ff}//UC;          # needed if lexical values in latin-1
	 print "\n$s";
     }
}

sub emit_rcglex {
    use TAG::RCG;
    print <<EOF ;
%% Translated using $Script
%% Input files @files
%% Date $date

EOF
     foreach my $s ($doc->RCGlex()) {
	 $s = UTF8toISO($s);
#	 $s =~ tr/\0-\x{ff}//UC;          # needed if lexical values in latin-1
	 print "\n$s";
     }
}

sub emit_xrcg {
    use TAG::XRCG;
    print <<EOF ;
%% Translated using $Script
%% Input files @files
%% Date $date

EOF
     foreach my $s ($doc->XRCG($map)) {
	 $s = UTF8toISO($s);
#	 $s =~ tr/\0-\x{ff}//UC;          # needed if lexical values in latin-1
	 print "\n$s";
     }
}

sub emit_xrcglex {
    use TAG::XRCG;
    print <<EOF ;
%% Translated using $Script
%% Input files @files
%% Date $date

EOF
     foreach my $s ($doc->XRCGlex()) {
	 $s = UTF8toISO($s);
#	 $s =~ tr/\0-\x{ff}//UC;          # needed if lexical values in latin-1
	 print "\n$s";
     }
}

sub emit_xml {
    use TAG::XML::Writer;
    my $s = <<EOF ;
<?xml version="1.0" encoding="ISO-8859-1" ?>

<!DOCTYPE tag PUBLIC "-//INRIA//DTD TAG 1.0//EN"
    "http://atoll.inria.fr/~clerger/tag.dtd,xml">

EOF
    $s .= $doc->pretty_print( { 'map' => $map } ); 
    $s = UTF8toISO($s);
#    $s =~ tr/\0-\x{ff}//UC;	# needed if lexical values in latin-1
    print "$s\n";
}

sub dbi_dump {
    use TAG::DBI::Writer;
    my $db = shift;
    print STDERR "Connecting database $db->{dns}\n";
    $doc->dbi_dump($db->{'dns'},$db->{'user'}, "");
}

######################################################################
# Misc tools

sub find_file_type {
    my $filename = shift;
    return { 'type' => $extensions{$1} } if ($filename =~ /\.($extkeys)$/og);
    die "couldn't find type of $filename" unless ($filename =~ /^\w+:/);
    my ($driver,$user,$host,$port,$dbname) = ($filename =~ m{(\w+)://(?:(\w+)@)?(\w+)?(?::(\d+))?/(\S+)} );
#    print "driver=$driver user=$user host=$host port=$port dbname=$dbname\n";
    $driver = ucfirst($driver) || 'Pg';
    $host = defined $host ? ";host=$host" : '';
    $port = defined $port ? ";port=$port" : '';
    $user = defined $user ? $user : $ENV{'USER'};
    return { type => 'db',
	     dns => "dbi:$driver:dbname=$dbname$host$port",
	     user => "$user" };
}

sub parse_map_file {
    my $map = shift;
    my $file = shift;
    open("MAP","<$file") || die "can't open map file $file";
    while (<MAP>) {
	chop;
	next if (/^\#/);
	next if (/^\s*$/);
	$map->{$1}{$2} = $3, next if (/^(\w+)\s+(\S+)\s*:\s*(.+)\s*$/);
	$map->{$1} = $2, next if (/^(\w+)\s*:\s*(.+)\s*$/);
    }
    close(MAP);
}

1;

__END__

=head1 NAME

tag_converter - Converter of Tree Adjoining Grammars

=head1 SYNOPSIS

    ./tag_converter <file*> -o <outfile>

=head1 DESCRIPTION

tag_converter is a perl script that may be used to convert Tree
Adjoining Grammars [TAG] from one format to another one. At this time,
the recognized input formats are 'lp' (logic programming), 'xml', and
'db' (Postgress database). The output formats are 'lp', 'xml', 'db',
'rcg' (Range Concatenation Grammars), 'dump', 'check', and 'header'.

Internally, the script uses TAG objects.

=head1 AUTHOR

Eric de la Clergerie, Eric.De_La_Clergerie@inria.fr

=head1 SEE ALSO

TAG (3)
TAG::LP (3)
TAG::LP::Parser (3)
TAG::XML::Parser (3)
TAG::XML::Writer (3)
TAG::XML::Grove (3)
TAG::DBI::Reader (3)
TAG::DBI::Writer (3)
TAG::Checker (3)
TAG::Header (3)
TAG::RCG (3)

=cut











