view release on metacpan or  search on metacpan

cgis/nat-search.cgi  view on Meta::CPAN

# Create JavaScript combo-box to change corpus being queried
my $s = join("\n",
	     join("\n", map {
	       "source[\"$_\"]=\"$corpora->{$_}{source}\";"} keys %$corpora),
	     join("\n", map {
	       "target[\"$_\"]=\"$corpora->{$_}{target}\";"} keys %$corpora));

my $JSCRIPT = <<"EOS";

var source = new Array();
var target = new Array();

$s

function changeLanguages() {
  var corpus = document.getElementById('crp').value;
  document.getElementById('source').innerHTML = source[corpus];
  document.getElementById('target').innerHTML = target[corpus];
}

function go(l,c) {
  if (parseInt(navigator.appVersion)>=4)
    if (navigator.userAgent.indexOf("MSIE")>0) { //IE 4+
      var sel=document.selection.createRange();
      sel.expand("word");
      window.location="nat-dict.cgi?compact=1&corpus=" + c + "&" + l + "=" + escape(sel.text)
    } else // NS4+
      window.location="nat-dict.cgi?compact=1&corpus=" + c + "&" + l + "=" + escape(document.getSelection())
}

function help() {
   window.open('nat-search.cgi?HELP=1','NAT-QI Quick Help',
               'menubar=no,height=600,width=800,resizable=yes,toolbar=no,location=no,status=no');
}
EOS

print Lingua::NATools::CGI::my_header(jscript => $JSCRIPT);

#my $x = Vars;
#print pre(Dumper($x));

# Check if we were asked for help
if (param("HELP")) {
  print Lingua::NATools::CGI::close_window();
  print_help();
  print Lingua::NATools::CGI::my_footer();
  exit;
}

# Print form HTML
print div({-class=>"hlpbt",
           -onclick=>"help()"}, "Help  ");

print h1("NAT-QI: NATools Corpora Query Interface");

print start_form({-class=>"main"});
print "<table>\n";
print Tr(td({-rowspan=>'3'},submit("Search")),
	 td({-rowspan=>'3'}, "&nbsp;&nbsp;&nbsp;"),
	 td({-colspan=>6, -style=>"text-align: left"},
	    "Corpus: ",popup_menu(-onchange=>"changeLanguages();",
				  -name=>'crp',
				  -id => 'crp',
				  -default=>$name,
				  -values=>[keys %$corpora])));
print Tr(td(["Search on ",
	     span({id=>"source"}, $corpora->{$name}{source}), " language: ",
             textfield("l1"),
	     "&nbsp;&nbsp;&nbsp;&nbsp;",
	    ]),
	 td({-style=>"text-align: left"},label(checkbox(-name=>'sequence', -checked=>0,
							-value=>'ON', -label=>'Pattern Matching'))),
	 td(["&nbsp;&nbsp;&nbsp;&nbsp;",
	     "Result-set size",popup_menu(-name=>'count',
					  -values=>['20','50','100','500'])
	    ]));
print Tr(td(["Search on ",
	     span({id=>"target"}, $corpora->{$name}{target}), " language: ",
             textfield("l2"),
	     "&nbsp;&nbsp;&nbsp;&nbsp;"]),
	 td({-style=>"text-align: left"},
	    label(checkbox(-name=>'horiz', -checked=>0,
			    -value=>'ON', -label=>'Horizontal Mode')),
	   ));
print "</table>";
print end_form;

my $count = param("count") || 20;

# If we have a corpus, and at least one word in one of the two
# languages, then query the server
if ($crp && (param("l1") || param("l2"))) {

#  param("l1", lc(param("l1"))) if param("l1");
#  param("l2", lc(param("l2"))) if param("l2");

  # print the corpus name and a link to the information page
  print h1($name);
  print "<center>",
    a({-style=>"font-size: small;", -href=>"nat-about.cgi?corpus=$crp"},
      "meta-information"), "</center>",br;

  # variable to store the query results
  my $results;
  my $ptds;

  # Check if we are looking for a pattern or a set of words
  $mod = (param("sequence") && param("sequence") eq "ON") ? "=" : "-";

  if (param("l1") && !param("l2")) {
    # We have just source language...
    $results = $server->conc({count => $count,
			      crp => $crp,
			      direction => "$mod>"}, param("l1"));

    # get PTDs for all searched words
    $ptds = get_ptds($server, $crp, "~>", lc(param("l1")));

  } elsif (param("l2") && !param("l1")) {
    # We have just the target language
    $results = $server->conc({count => $count,
			      crp => $crp,
			      direction => "<$mod"}, param("l2"));

    # get PTDs for all searched words
    $ptds = get_ptds($server, $crp, "<~", lc(param("l2")));

  } else {
    # We have both languages
    $results = $server->conc({count => $count,
			      crp => $crp,
			      direction => "<$mod>"}, param("l1"), param("l2"));
    $ptds = [];
  }