Yawat - Yet Another Word Alignment Tool

#!/usr/bin/perl # Part of YAWAT -- Yet Another Word Aligment Tool # (c) 2007-2009 Ulrich Germann; all rights reserved # This is NOT free software, but permission is granted to use this # software free of charge for academic research purposes. # This script handles document delivery or prints an # index if no document is requested. # TO DO: # - set a cookie when logging in # done, but firefox won't forget cookies without an expiry date # (apparently by design) # - add logout button to yawat tool bar # - add password verification when logging in use strict; use Fcntl; use File::Basename; our %CFG; BEGIN { use File::Basename; no strict "subs"; use CGI::Carp qw(fatalsToBrowser carpout); sub readConfigFile { open CFGFILE, "$_[0]" or die "$_[0]: $!\n"; while (my $line = ) { next if $line =~ m/^\s*#/; chomp $line; my ($key,$value) = split(/\s*=\s*/, $line); $CFG{$key} = $value; } close CFGFILE; } # read config file yawat.cfg to get error log file name readConfigFile("yawat.cfg"); # open error log my $errorlog = ($CFG{"errorLog"} or "yawat.errors.log"); if (-e $errorlog and !-w $errorlog) { die "File '$errorlog' exists but is not writable\n"; } elsif (!-e $errorlog and !-w dirname($errorlog)) { die sprintf("Can't create file '%s' in '%s/'\n", $errorlog,dirname($errorlog)); } open ERRORS, ">>$errorlog" or die ("Could not open error log file '$errorlog': $!\n"); carpout(ERRORS); # put error messages in "errors.log" use CGI qw(:standard); } my $q = new CGI; # $recloc can be used to obtain the js file from a different location, # e.g., #my $recloc = "http://".$q->server_name()."/~germann/demo/yawat/"; my $recloc = "http://www.cs.toronto.edu/~germann/demo/yawat/"; my $annotator = $q->cookie('yawat-login'); my $login = $q->param('login'); if ($q->param('logout') or (-r ".htaccess" and not $q->remote_user()) or !($annotator or $login)) { &print_login_screen; exit(0); } # Note on the .htaccess part: If .htaccess is used (optional), # force new login after browser closure. # Firefox does not forget cookies without an expiry date when it # closes (apparently by design to be able to restore tabs) my $cookie = undef; if (!$annotator) { $annotator = $login; die "Can't read password file '$CFG{passwd}'!" unless -r $CFG{"passwd"}; open PASSWD, $CFG{"passwd"} or die "$CFG{passwd}: $!\n"; foreach my $line () { chomp $line; my ($who,$pw) = split / +/, $line; next if ($who ne $login || crypt($q->param('passwd'),$pw) ne $pw); $cookie = $q->cookie(-name=>"yawat-login", -value=>"$login"); last; } close PASSWD; if (!$cookie) { &print_login_screen(1); exit(0); } } my $datadir = $CFG{"datadir"}; # local setting override global settings my $localcfgfile = "$datadir/$annotator/yawat.cfg"; readConfigFile($localcfgfile) if -e $localcfgfile; my $diffMode = $CFG{"diffMode"}; my $keepProtocol = $CFG{"keepProtocol"}; $diffMode = "false" unless $diffMode; $keepProtocol = "true" unless $keepProtocol; my $this_script = $recloc; # $q->url(); $this_script .= "index.cgi" unless $this_script =~ /(yawat|index)\.cgi$/; my $text = $q->param('text'); my $datareq = $q->param('getdata'); my $path = dirname($this_script); my $subdir = $q->param('subdir'); my (@files,@sdirs); &process_annotator_directory; if (!$text && !$datareq) { &print_index; } elsif ($datareq) { &print_alignment_data; } else { &print_task; } sub includeScripts { for (@_) { print "\n"; } } sub print_login_screen() { my $loginerror = shift @_; my $clearcookie = $q->cookie(-name=>'yawat-login', -value=>''); print $q->header(-title=>'Yawat login', -cookie=>$clearcookie); print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "

\n"; print "\n"; print "

\n"; print "

The login name and the password for the demo account are 'demo'.
This paper explains what Yawat is all about, and how to use it.
You can save your alignment in the demo account, but there is currently no protection against several "; print "people editing the demo file at the same time, so your changes may not be preserved.
Yawat requires Firefox to work properly. It does not work in Google Chrome or Internet Explorer.
Yawat is available free of charge for academic research. To obtain it, fill in this license form "; print "and mail it to the author of the paper just mentioned.

\n"; print "

\n"; print "\n"; print "\n"; } sub print_index { # print the index print $q->header({ -cookie=>$cookie, -'cache-control'=>'no-cache'}); my $logoutbutton = "\n"; print "\n"; if ($subdir) { my $updir = dirname($subdir); if ($updir ne ".") { print "\n"; } else { print "\n"; } } foreach my $d (@sdirs) { print "\n"; } foreach my $file (@files) { my $xsd = $subdir; if ($xsd) { $xsd .= "/" unless $xsd =~ /\/$/; } print "\n"; print "\n"; } print "

..
..
$d
$file	"; if (-e "$datadir/$annotator/$xsd$file.aln") { print "alignment data"; } print "

\n"; } sub print_alignment_data { print $q->header({ -charset=>"$CFG{'encoding'}", -'cache-control'=>'no-cache', -'content-type'=>'text/plain'}); open DATA, "$datadir/$annotator/$datareq.aln" or die "$datareq.aln: $!\n"; print (); close DATA; } sub include_css { my $rloc = ($recloc ? $recloc : dirname($this_script)); $rloc =~ s/\/$//; my $ret; foreach my $css (@_) { $ret .= "\n"; } return $ret; } sub pkgsnt # "package sentence" { $_[0] =~ s/'/\\'/g; my @x = split(/\s+/, $_[0]); return "['".join("','",@x)."']"; } sub print_task { my ($prevFile,$nextFile); for (my $i=0; $i <= $#files; $i++) { if ($files[$i] eq basename($text)) { $prevFile = $files[$i-1] if $i; $nextFile = $files[$i+1] if $i < $#files; } } my (%E,%F,%A,%X1,%X2); my $alnfile = "$datadir/$annotator/$text.aln"; my $roMode = !(-W "$alnfile") || $CFG{"allowEdit"} eq "false"; &get_bitext(\%E,\%F,"$datadir/$annotator/$text.crp"); read_alninfo(\%A,$alnfile); read_alninfo(\%X1,"$alnfile.1") if -e "$alnfile.1"; read_alninfo(\%X2,"$alnfile.2") if -e "$alnfile.2"; print $q->header({'-charset' => "$CFG{'encoding'}", '-cache-control'=> 'no-cache', '-pragma' => 'no-cache'}); print "\n"; print "\n"; print include_css("yawat.css","tagset.css"); print "Yawat - Yet Another Word Alignment Tool\n"; print "\n"; print "\n"; includeScripts("yawat.js", "yawat-tagset.js", "yawat-ctm.js", "yawat-ctm1.js", "yawat-word.js", "yawat-sentence.js", "yawat-agroup.js", "yawat-matrix.js", "yawat-pane.js", "yawat-application.js", "yawat-button.js"); print "\n"; print "\n\n"; } sub process_annotator_directory { my $xdir = "$datadir/$annotator"; $xdir .= "/$subdir" if $subdir; opendir(DIR,$xdir); my @cands = readdir(DIR); foreach my $c (@cands) { if (-d "$xdir/$c" && $c ne "backups" and $c !~ /^\./) { push @sdirs, ($subdir ? "$subdir/$c" : "$c"); } } @files = sort(grep /\.crp$/, @cands); for (@files) { s/\.crp//; } } sub get_bitext { my ($E,$F,$text) = @_; open BITEXT, $text; while (my $sid = and my $e = and my $f = ) { chomp $sid; # print "$sid\n"; $$E{$sid} = $e; $$F{$sid} = $f; } close BITEXT; } sub read_alninfo { my ($H,$src) = @_; open ALN, "$src"; while (my $a = ) { chomp $a; my ($sid,$alninfo) = split(/\s+/, $a, 2); $$H{$sid} = $alninfo; } close ALN; }

	"; print " \n"; print "Y et \n"; print "A nother \n"; print "W ord \n"; print "A lignment \n"; print "T ool. "; print "$authorship \n"; print "
	"; print "Login failed. Please try again.
\n"; print "Login:"; print "	\n"; print "
\n"; print "Password:"; print "	\n"; print "

Index (for $annotator) $logoutbutton