#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell

# Updated version of parser.cgi to run under mod_perl and Apache::Registry
# Seems to be much faster !

use CGI qw/-compile -nosticky :standard *pre *table start_map end_map map :html3 -private_tempfiles -oldstyle_urls/;
use CGI::Carp qw(fatalsToBrowser);
use strict;

#$CGI::POST_MAX=1024 * 500;  # max 500K posts

use POSIX qw(strftime);
#use IPC::Open2;
use IPC::Run qw(start finish run pump);
use IO::Socket;
##use Apache::Include;

#use Apache::SubProcess;

## my $r = shift;
## $r->send_http_header("text/html");

$SIG{CHLD} = 'IGNORE';


#$ENV{'PATH'} = '/bin:/usr/local/bin';
#$ENV{'DOTFONTPATH'} = '/usr/lib/office60/share/fonts/truetype/';

# Parameter: to be adjusted
our $dotcmd = '/usr/local/bin/dot'; 

local our $query = new CGI;
our $pattern = qr/(\w+)\s*(?:{(.*?)})?\((\d+),(\d+)\)/o;

our %accents = ( "e'" => ["e'",''],

		 'a`' => ['a`',''],
		 'e`' => ['e`', ''],
		 'u`' => ['u`',''],
		 
		 'a^' => ['a\^',''],
		 'e^' => ['e\^',''],
		 'i^' => ['i\^',''],
		 'o^' => ['o\^',''],
		 'u^' => ['u\^',''],
		 
		 'e"' => ['e"',''],
		 'i"' => ['i"',''],
		 'u"' => ['u"',''],
		 'y"' => ['y"',''],
		 
		 'c,' => ['c,(?=[aou])','']
		 
	       );

our $accentpat = join('|',map( $accents{$_}->[0], keys(%accents)));
$accentpat = qr/($accentpat)/o;

our %formats = ( 'raw' => 'raw',
		 'grammar' => 'html',
		 'tree' => 'dot',
		 'dependency' => 'dependency',
		 'xml' => 'xml',
		 'tagger' => 'tagger',
		 'easy' => 'easy',
		 'easy html' => 'easy',
		 'xmldep' => 'xmldep'
	       );

our %gif = (
	    'tree' => 1,
	    'dependency' => 1
	   );

our %graphics = ( 'gif' => { type => 'image/gif', 
			     dot => [qw{-Gbgcolor=linen -Gcolor=palegreen -Gstyle=filled/}], 
			     #			    dot => '-Gbgcolor=grey',
			     attachment => 'parser.gif' },
		  'png' => { type => 'image/png', 
			     dot => [qw{-Gbgcolor=linen}], 
			     attachment => 'parser.png' },
		  'ps' => {  type => 'application/postscript',
			     dot => ['-Gsize="8,8"','-Gmargin=".5,4"'],
			     attachment => 'parser.ps'
			  },
		  'dot' => { type=> 'text/plain',
			     attachment => 'parser.dot',
			     dot => []
			   },
		  'xml' => { type=> 'text/xml',
			     attachment => 'parser.xml',
			     dot => []
			   },
		  'xmldep' => { type=> 'text/xml',
				attachment => 'parser.dep.xml',
				dot => []
			      },
		  'easy' => { type=> 'text/xml',
			      attachment => 'parser.easy.xml',
			      dot => []
			    },
		  'easyhtml' => { type=> 'text/html',
				  attachment => 'parser.easy.html',
				  dot => []
				},
		  'svgz' => { type=> 'image/svg+xml',
			      attachment => 'parser.svgz',
			      dot => []
			    },
		  'imap' => { type=> 'application/x-httpd-imap',
			      attachment => 'parser.map',
			      dot => []
			    },
		  'cmap' => { type => 'text/html',
                               attachment => 'parser.cmap',
                               dot => [] },
		  'tagger' => { type=> 'text/plain',
				attachment => 'parser.tags',
				dot => []
			      }
		);

######################################################################
# Configuration 

our $server = { 'host' => 'localhost',
		'port' => '8999',
	      };

our %grammars = ();
our %labels = ();

if (!%grammars) {
  my $handle = send_server($server,"help\nquit");
  
  while (<$handle> !~ /^Parsers:/) {
    next;
  }
  while (<$handle> =~ /^\s*(\w+)\s+--\s*(.*)/) {
    $grammars{$1} = { 'server' => $server, 'label' => "$2" };
    $labels{$1} = "$2";
  }
  close($handle);
}

our %options = ( 'forest' => [ '-forest' ],
		 'trace' => ['-v','dyam']
	       );

######################################################################
# Reading params

##our $path_info = $query->path_info;

our $file = $query->upload('filename');

if (defined !$file && $query->cgi_error) {
  print $query->header(-status=>$query->cgi_error);
  exit 0;
}

if (defined $file) {
  my $type = $query->uploadInfo($file)->{'Content-Type'};
  unless ($type eq 'text/plain') {
    die "PLAIN FILES ONLY!";
  }
}

our ($grammar) = $query->param(-name=>'grammar');

our ($examples) = $query->param(-name=>'examples');

our ($format) = $query->param(-name=>'forest');

our ($view) = $query->param(-name=>'view');

$view='none' unless defined $view;

our @history=();

our ($sentence) = clean_sentence($query->param(-name=>'sentence'));

our ($turned_on) = $query->param(-name=>'save_history');

if (defined $file) {
    @history=();
    while (<$file>){
	next if /^\d*\s*$/;
	$_ =  clean_sentence($_);
	push(@history,$_) unless (/^$/);
    }
} elsif (defined $examples && $examples eq 'on') {
    @history = ();
    my $handle = send_server($grammars{$grammar}{'server'},<<MSG);
examples $grammar
quit
MSG
    while (<$handle>) {
	push(@history,clean_sentence($_));
    }
    close($handle);
    $query->param('examples', 'off');
} elsif (defined $turned_on && $turned_on eq 'on') {
    @history = $query->cookie('dyalog');
} else {
    @history = $query->param('hidden');
}

if ($sentence && ! grep("$_" eq $sentence,@history)) {
  @history=() if ($history[0] eq '<none>');
  unshift(@history,$sentence);
  #    $query->param(-name=>'history',-values=>[$sentence]);
}

if (!@history) {
    @history=('<none>');
}

$query->param(-name=>'history',-values=>[@history]);
$query->param('hidden',@history);

#my @options = $query->param('options');

######################################################################
# Emitting form

$view = 'xml' if (defined $format && $graphics{$format}{type} eq 'text/xml');

if (defined $graphics{$view}) {
  print $query->header(-type=> $graphics{$view}{type},
##                       -nph=>1,
##		       -attachment=> $graphics{$view}{attachment},
		       -expires=>'+1h');
  goto RESULT;
}

our $cookie;

if (defined $turned_on && ("$turned_on" eq 'on')) {
    $cookie = $query->cookie(-name=>'dyalog',
			     -value=>\@history,
			     -expires=>'+1h',
			     );
    print $query->header(-cookie=>$cookie);
} else {
    print $query->header;
}

our $JSCRIPT=<<END;
// Put selected history line into sentence part (erasing old sentence)
    function paste_into_sentence(element) {
	var sentence = element.options[element.selectedIndex].text;
	document.form1.sentence.value = sentence;
	document.form1.sentence.focus();
	return true;
    }
END

our $STYLE=<<END;
<!--
    BODY {background-color: linen;}
-->
END

print $query->start_html( -title => 'Parsing on line',
			  -script=> $JSCRIPT,
			  -style => { -code => $STYLE }
			  );
print h1('Parsing on line');
print $query->start_multipart_form(-name=>'form1');
print p('Select a parser ',
	br,
	$query->popup_menu(-name=>'grammar',
			   -values=> [ sort {$labels{$a} cmp $labels{$b}} keys %labels ],
			   -labels => \%labels,
			   -default=>'frmgtel'
			   ),
	$query->checkbox(-name=>'examples',
			 -value=>'on',
			 -label=>'Load default examples'
			),
	a({href=>'http://atoll.inria.fr/~clerger/help.html'},"Help")		
	);
print p('Forest format: ',
	$query->popup_menu( -name=>'forest',
			    -values=> [ sort keys %formats ],
			    -default=> 'dependency'),
	$query->hidden(-name=>'view',-default=>'none')
	);
print p('Enter a sentence or select one in the history popup menu',
	br,
	$query->textarea(-name=>'sentence', 
			 -rows=>3, -columns=>70));

print p('History popup menu',
	br,
	$query->popup_menu(-name=>'history',
			   -onChange=>'paste_into_sentence(this)'
			   ),
	$query->hidden(-name=>'hidden',-default=>[@history]),
	$query->checkbox(-name=>'save_history',
			 -value=>'on',
			 -label=>'Save/Restore history (using a cookie)')
	);

print p('Load your own file as history popup menu (a sentence per line)',
	br,
	$query->filefield(-name=>'filename',
			  -size=>50
			  ));

print p($query->reset,$query->submit('Action','Submit'));

print $query->endform;
print "<HR>\n";

######################################################################
# Emitting result

 RESULT:

goto NOTHING unless ($grammar && $sentence);

if ($gif{$format} && !(defined $graphics{$view})) {
    # delegate the work to a sub query !
    my $url = $query->self_url;
    $url =~ s/(history|hidden)=(.*?);//g;
    my $psurl = $url;
    $psurl =~ s%view=\w+%view=ps%;
    my $pngurl = $url;
    $pngurl =~ s%view=\w+%view=png%;
    my $doturl = $url;
    $doturl =~ s%view=\w+%view=dot%;
    my $svgurl = $url;
    $svgurl =~ s%view=\w+%view=svgz%;
    print "[",$query->a({href=>$psurl},"PostScript"),
      "|",$query->a({href=>$pngurl},"PNG"),
	"|",$query->a({href=>$doturl},"Dot"),
	  "|",$query->a({href=>$svgurl},"SVG"),"]\n";
    $url =~ s%view=\w+%view=gif%;
    print $query->div({align=>"CENTER"},
                      $query->img({src=>"$url",
				   align=>"CENTER",
				      alt => "please try reload",
				      'usemap' => '#map'
				     }));
##    goto NOTHING;
}

$sentence =~ s/$accentpat/$accents{$1}->[1]/og;

open(LOG,">> /tmp/cgi_dyalog.log") || 
    die "Can't open log file";

print LOG strftime("date= %b %e %Y %H:%M:%S\n", localtime);
print LOG "host=",remote_host(),"\n";
print LOG "grammar=",$grammar,"\n";
print LOG "sentence=",$sentence,"\n";
print LOG "format=",$format,"\n";
print LOG "=\n";

close(LOG);

my $handle = send_server($grammars{$grammar}{'server'},<<MSG);
set forest $formats{$format}
$grammar $sentence
quit
MSG

#print $query->pre("FOREST FORMAT $format $formats{$format}");

if ($format eq 'raw') {
  print $query->pre(join("",<$handle>));
  close $handle || die "cannot close: $!";
} elsif ($gif{$format} && !(defined $graphics{$view})) { # emit client map
  my @cmd = ($dotcmd,"-Tcmap",@{$graphics{cmap}{dot}});
  my $h = start \@cmd,
    '<',$handle,
      '>pipe',\*TATA,
	'2>pipe',\*ERR
	  or die "@cmd returned $?" ;
  print $query->start_map({name=>"map"});
  while (<TATA>){
    s/area\s+/area target="_blank" /;
    print $_;
  }
  print $query->end_map;
  close TATA || die "can't close: $!";
  finish $h;
} elsif ($gif{$format} && defined $graphics{$view}) { # dot format
  my @cmd = ($dotcmd,"-T$view",@{$graphics{$view}{dot}});
  my $h = start \@cmd,
    '<',$handle,
      '>pipe',\*TATA,
	'2>pipe',\*ERR
	  or die "@cmd returned $?" ;
   print <TATA>;
   close TATA || die "can't close: $!";
   finish $h;
   goto NOTHING;
} elsif ($format eq 'tagger') {
  print $query->pre(join("",<$handle>));
  close $handle || die "cannot close: $!";
  goto NOTHING;
} elsif ($format eq 'easy html') {
  my $convert = [qw{/usr/bin/xsltproc /var/www/perl/easy2html.xsl -}];
  my $h = start $convert,
    '<',$handle,
      '>pipe',\*TATA,
	'2>pipe',\*ERR
	  or die "@$convert returne $?";
  print <TATA>;
  close TATA || die "can't close: $!";
  finish $h;
} else {
  print <$handle>;
  close $handle || die "cannot close: $!";
}

exit if (defined $graphics{$view});

 NOTHING:
    
print hr,
    address(a({href=>'mailto:Eric.Clergerie@inria.fr'},'Eric de la Clergerie')),
    a({href=>'http://pauillac.inria.fr/~clerger/'},'Home Page');

print $query->end_html;

######################################################################
# sub routines

sub clean_sentence {
    my ($sentence)=@_;
    $sentence="" unless defined $sentence;
    $sentence =~ s/\s+/ /og;
    $sentence =~ s/^\s+//og;
    $sentence =~ s/\s+$//og;
    return $sentence;
}

sub send_server {
    my $server = shift;
    my $message = shift;

    my $host = $server->{'host'};
    my $port = $server->{'port'};

    my ($kidpid, $handle, $line);

    # create a tcp connection to the specified host and port
    $handle = IO::Socket::INET->new(Proto     => "tcp",
				    PeerAddr  => $host,
				    PeerPort  => $port
				)
	or die "can't connect to the server of parsers [$host:$port]";

    $handle->autoflush(1);

    # split the program into two processes, identical twins
    die "can't fork: $!" unless defined($kidpid = fork());

    # Child part
    if (!$kidpid) { # Child
#      $r->cleanup_for_exec(); # untie the socket
      close(STDIN);
      close(STDOUT);
      close(STDERR);
      print $handle $message;
      CORE::exit 0;
    }
    
    return $handle;
}

