/[cvs.andrew.net.au]/cgi-bin/Dict
ViewVC logotype

Contents of /cgi-bin/Dict

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Sat Jun 14 06:32:12 2003 UTC (19 years ago) by apollock
Branch: MAIN
CVS Tags: HEAD
Initial copy of CGI gateway to dict before I fiddle with it

1 #!/usr/bin/perl
2 #
3 # Name : Dict
4 # Purpose: perl script cgi program to submit dict queries.
5 # Author : Doug L. Hoffman (hoffman@shopthenet.net)
6 # Created: Thu Aug 14 09:51:28 1997 by hoffman
7 # Revised: Mon Sep 3 22:44:52 2001 by bam@miranda.org
8 #
9 # This perl script both generates the www-browser form and accepts the results
10 # of submitting the form. The search is transmitted to a central machine
11 # and the results are interpreted and reposted for the user.
12 #
13 # $Log: Dict,v $
14 # Revision 1.11 1998/03/30 17:33:26 hoffman
15 # added text of query to the web page title line.
16 #
17 # Revision 1.10 1998/02/23 17:46:04 hoffman
18 # Fixed problem with word list anchors caused by changes to the "exact"
19 # resopnse.
20 #
21 # Revision 1.9 1998/02/23 16:41:30 hoffman
22 # Made "exact" return list of words, not definitions.
23 #
24 # Revision 1.8 1998/02/20 16:00:01 hoffman
25 # gave the generated page(s) a general facelift, changed internal processing
26 # to use the short database name, not the description, and then spent time
27 # fixing various bugs that the name change caused. The server calls to fetch
28 # the search and database options have been combined into one.
29 #
30 # Revision 1.7 1998/02/19 15:10:26 hoffman
31 # Rik's updated version.
32 #
33 # Revision 1.6 1997/11/12 16:07:50 hoffman
34 # Added link to copyright info.
35 #
36 # Revision 1.5 1997/10/01 17:50:58 hoffman
37 # Fixed some of the field edits for Rik.
38 #
39 # Revision 1.4 1997/10/01 13:56:52 hoffman
40 # fixed problem with ()'s
41 #
42 # Revision 1.3 1997/08/17 20:48:04 hoffman
43 # added link to dict.org home page
44 #
45 # Revision 1.2 1997/08/17 20:07:37 hoffman
46 # Fixed imbedded blank sequence query scanning.
47 #
48 #
49
50 # Setup is minimal.
51 #
52 # You have to redefine at most the first few lines below
53 #
54 # $ReturnUrl is the url of this file. It should be changed to reflect
55 # the new location.
56
57 # ---------- Configuration variables
58
59 $Debug = 0;
60
61 $Pgm = "Dict";
62 #$hostUrl = "http://www.dict.org";
63 $hostUrl = "";
64 $cgiPath = "$hostUrl/cgi-bin";
65 $ReturnUrl = "$cgiPath/$Pgm";
66 $bin = "/data/httpd/html/bin";
67
68 $CRInfo = "$ReturnUrl?Form=$Pgm".
69 "1&Query=00-database-info&Strategy=*&Database=*";
70 $SInfo = "$ReturnUrl?Form=$Pgm". "4";
71
72 $Dict = "/usr/bin/dict -h localhost";
73 $DictAlt = "/usr/bin/dict -h dega.cs.unc.edu";
74 $Counter = "/usr/local/etc/Counter/data/$Pgm.dat";
75 $Count = "$cgiPath/Count.cgi";
76 $Background = "/gifs/grayback.jpg";
77 $Heading1= "The DICT Development Group: Online Dictionary Query";
78 $Heading2= "<a href=\"http://www.dict.org/\">The DICT Development Group</a>: Online&nbsp;Dictionary&nbsp;Query";
79 $Counter1= "<img src=\"$Count?sh=0|df=$Pgm.dat\" alt=\"\">";
80 $Counter2= "<img src=\"$Count?sh=0|df=total.dat\" alt=\"\">";
81 # $Counter1= "";
82 # $Counter2= "";
83 $WebMaster="<a href=\"mailto:webmaster\@dict.org\">webmaster\@dict.org</a>";
84
85 # --- display stuff
86
87 ##########################################################################
88 #
89 # Driving Program
90 #
91 #########################################################################
92
93 &init; # init globals
94 &ReadParse; # read stdin
95
96
97 #
98 #
99 # If there is no standard input, this the the users first request to see
100 # the page. Return a decent looking page. Otherwise, you have work to do.
101 #
102
103 if ($in{"Form"} eq "") {
104 $in{"Database"} = "*";
105 $in{"Strategy"} = "*";
106 print &PrintHeader();
107 &SendBeginning;
108 &SendForm1;
109 &SendEnding;
110 }
111 elsif ($in{"Form"} eq ($Pgm . '1')) {
112 print &PrintHeader();
113 &SendBeginning;
114 &StripFields; # clean up user entered data.
115 &CheckFields; # Make sure all required data are there.
116 &SendForm1;
117 if ($Error eq "") {
118 &SendListing;
119 }
120 &SendEnding;
121 }
122 elsif ($in{"Form"} eq ($Pgm . '2')) {
123 $in{"Strategy"} = "*";
124 print &PrintHeader();
125 &SendBeginning;
126 &StripFields; # clean up user entered data.
127 &CheckFields; # Make sure all required data are there.
128 &SendForm1;
129 if ($Error eq "") {
130 &SendListing;
131 }
132 &SendEnding;
133 }
134 elsif ($in{"Form"} eq ($Pgm . '3')) {
135 $in{"Strategy"} = "";
136 $in{"Query"} = "";
137 print &PrintHeader();
138 &SendBeginning;
139 &StripFields; # clean up user entered data.
140 # &CheckFields; # Make sure all required data are there.
141 &SendForm1;
142 if ($Error eq "") {
143 &SendListing;
144 }
145 &SendEnding;
146 }
147 elsif ($in{"Form"} eq ($Pgm . '4')) {
148 $in{"Strategy"} = "";
149 $in{"Query"} = "";
150 print &PrintHeader();
151 &SendBeginning;
152 &StripFields; # clean up user entered data.
153 # &CheckFields; # Make sure all required data are there.
154 &SendForm1;
155 if ($Error eq "") {
156 $in{"Query"} = "Server";
157 &SendListing;
158 }
159 &SendEnding;
160 }
161 else {
162 print &PrintHeader();
163 &SendBeginning;
164 print "<br><hr>Error, invalid syntax: $in<hr><br>\n";
165 &SendForm1; # wtfo? send form anyway.
166 &SendEnding;
167 }
168
169 #############################################################################
170 #
171 # --------------- Init global variables
172 #
173
174 sub init {
175 local( $name, $desc);
176 local( $flag = 0 );
177 local( $triedbackup = 0 );
178 #
179 # ----- List of database and search strategy options
180 #
181 # For each option, a comma separated string of the acceptable values
182 #
183 $Choices{"Database"} = "Any\tFirst match";
184
185 %Db = ("Any", "*",
186 "First match","!"
187 );
188
189 %Dbr = ("*", "Any",
190 "!","First match"
191 );
192
193 $Choices{"Strategy"} = "Return Definitions";
194
195 %St = ("Return Definitions", "*");
196
197 # ----- suck in the database/strategy names from the server
198
199 open(IN,"$Dict -DS |") || die "$Pgm: can't execute /usr/bin/dict\n";
200 restartopen:
201 <IN>;
202 LOOP: while (<IN>) {
203 ++$flag;
204 chop;
205 last LOOP if /^Strategies/;
206 $name = substr($_, 2, 10);
207 $name =~ s/\s+//g;
208 $desc = substr($_, 13);
209 $Choices{"Database"} .= "\t$desc";
210 $Db{$desc} = $name;
211 ($Dbr{$name} = $desc) =~ tr/ /+/; # reverse lookup index
212 }
213 while (<IN>) {
214 ++$flag;
215 chop;
216 $name = substr($_, 2, 10);
217 $name =~ s/\s+//g;
218 $desc = substr($_, 13);
219 $Choices{"Strategy"} .= "\t$desc";
220 $St{$desc} = $name;
221 }
222 close( IN );
223 if (!$flag) {
224 if (!$triedbackup) {
225 ++$triedbackup;
226 open(IN,"$DictAlt -DS |") || die "$Pgm: can't execute /usr/bin/dict\n";
227 goto restartopen;
228 }
229 }
230
231 #
232 # The regular expression contraints:
233 #
234 @Fields = ("Query", "Database", "Strategy", "Server");
235
236 @ReqFields = ("Query");
237 }
238
239 # ---------- Update the counter
240 #
241 sub UpdateCounter {
242 local ($count);
243 if ($Counter ne "") {
244 if (!(open(CT,"<$Counter"))) {
245 print "$Pgm: Couldn't open $Counter<p>\n";
246 return;
247 }
248 $count = <CT>;
249 close CT;
250 $count++;
251 if (!(open(CT,">$Counter"))) {
252 print "Couldn't write $Counter<p>\n";
253 return;
254 }
255 print CT $count;
256 close CT;
257 }
258 }
259
260
261 # ---------- Strip fields
262 #
263 # change tabs and stuff to blanks, strip any leading/trailing blanks.
264 #
265
266 sub StripFields {
267 foreach $x (@Fields) {
268 $in{$x} =~ y/{};/() /; # ensure no {, },",", or ";".
269 $in{$x} =~ y/\n\r\f\t\e/ /s; # ensure newlines or cr's.
270 $in{$x} =~ s/\'/\'\'/g;
271 $in{$x} =~ s/^\s*//;
272 $in{$x} =~ s/\s*$//;
273 $in{$x} =~ s/\s+/ /g;
274 }
275 }
276
277 #
278 # ---------- Check that the required fields are all present.
279 #
280
281 sub CheckFields {
282 $Error = "";
283 foreach $x (@ReqFields) {
284 if ($in{$x} eq "") {
285 $Error = $x;
286 return;
287 }
288 }
289 }
290
291
292 #############################################################################
293 #
294 # ---------- Send the html form for the editing of a record
295 #
296
297 sub SendForm1 {
298
299 # ----- send the header
300 #
301 local($q) = $in{"Query"};
302 #<!-- hidden counter -->
303 #$Counter1
304 #<!-- hidden counter -->
305 #$Counter2
306
307 print <<EOF;
308 <form method=POST action=$ReturnUrl>
309 <input type="hidden" name="Form" value="${Pgm}1">
310 <center>
311 <table><tr><td align="right">
312 <b>Query string:</b></td><td>
313 <input type="text" name="Query" size=40 value="$q">
314 <br></td></tr><td align="right">
315 <b>Search type:</b></td><td align="left">
316 <select name="Strategy">
317 EOF
318 foreach $x (split(/\t/,$Choices{"Strategy"})) {
319 print " <option value=\"$St{$x}\"";
320 if ($in{"Strategy"} eq $St{$x}) {
321 print " selected";
322 }
323 print ">$x\n";
324 }
325 print <<EOF2;
326 </select>
327 <br></td></tr><td align="right">
328 <b>Database:</b></td><td>
329 <select name="Database">
330 EOF2
331 foreach $x (split(/\t/,$Choices{"Database"})) {
332 print " <option value=\"$Db{$x}\"";
333 if ($in{"Database"} eq $Db{$x}) {
334 print " selected";
335 }
336 print ">$x\n";
337 }
338 print <<EOF3;
339 </select>
340 </td></tr></table>
341 <input type="submit" name="submit" value="Submit query">
342 <input type="reset" value="Reset form">
343 <p>
344 Definition not available or out of date?
345 <a href="http://www.dict.org/file.html">Contribute to FILE</a>.
346 <br>
347 <a href="$CRInfo">Database copyright information</a>
348 <br>
349 <a href="$SInfo">Server information</a>
350 </center>
351 </form>
352 <hr>
353 EOF3
354 }
355
356
357 #############################################################################
358 #
359 # ---------- Send the html form for the search listing results
360 #
361
362 sub SendListing {
363 local( $command, $d, $s, $q);
364 local( $i, $x );
365 local( $flag=0 );
366 local( $triedbackup = 0 );
367
368 # ----- add the hidden counter.
369
370 # print "\n<!-- hidden counter -->\n";
371 # print "<img src=\"/bin/Count.cgi?sh=0|df=$Pgm.dat\">\n";
372
373 # &UpdateCounter;
374
375 # ---------- report
376
377 $d = $in{"Database"};
378 $d = $in{"Database"} if ($d eq "");
379 $s = $in{"Strategy"};
380 $q = $in{"Query"};
381 $command = "--client \"$ENV{'REMOTE_HOST'} $ENV{'HTTP_USER_AGENT'}\" ";
382 if ($s eq "" && $q eq "") {
383 $command .= "-i '$d'";
384 } elsif ($s eq "" && $q eq "Server") {
385 $command .= "-I";
386 } else {
387 $command .= "-d '$d'";
388 $wordlist = 0;
389 if ($s eq '*') {
390 $command .= " \'". $q . "\'";
391 }
392 # elsif ($s eq 'exact') {
393 # $command .= " -s exact \'". $q ."\'";
394 # }
395 else {
396 $command .= " -s $s -m \'". $q ."\'";
397 }
398 }
399
400 print "$Dict $command <p>\n" if ($Debug);
401
402 if (!open(IN,"$Dict $command |")) {
403 print "<hr><p>\n";
404 print "<b>Backend database engine temporarily unavailable:\n";
405 print " please try again later</b>\n";
406 print "<p><hr>\n";
407 return;
408 }
409 if ($s eq "" && $q eq "") {
410 local($tmp) = &lx($Dbr{$d});
411 print "<b>From <a href=\"$ReturnUrl?Form=${Pgm}3&Database=$d\">$tmp<\/a>:</b>\n";
412 }
413 print "<pre>";
414 restart:
415 while(<IN>) {
416 ++$flag;
417 if (/^From/) {
418 if (/\[.*\]/) {
419 s/^From\s*(.*)\s*\[(.*)\]\s*:.*$/From <a href=\"$ReturnUrl?Form=${Pgm}3&Database=$2\">$1<\/a>:/; # "
420 }
421 print "</pre><b>$_</b><pre>\n";
422 }
423 elsif (/^\d+ /) {
424 print "</pre><b>$_</b><pre>";
425 }
426 elsif (/^No definitions/) {
427 print "</pre><b>$_</b><pre>\n";
428 }
429 elsif (/^No matches/) {
430 print "</pre><b>$_</b><pre>\n";
431 }
432 elsif (/^(\S+) /) {
433 $x = $1;
434 ($x, $line) = split(/:/, $_, 2);
435 $line = &anchor( $x, $line);
436 print "<b>$x:</b>$line";
437 $wordlist = 1;
438 }
439 elsif ($wordlist && (/^ (\S+) /)) {
440 $line = &anchor( $x, $_);
441 print $line;
442 }
443 else {
444 if (/(ftp|http):\/\/[^\s\)\}]*\}/) {
445 s,((ftp|http)://[^\s\)\}]*)\},}<a href="$1">$1</a>,g;
446 } else {
447 s,((ftp|http)://[^\s\)\}]*),<a href="$1">$1</a>,g;
448 }
449 s,(\s){([^}\s][^}]*)},$1.'<a href="'.$ReturnUrl.'?Form='.$Pgm.'2&Database=*&Query='.&xl($2).'">'.$2.'</a>',ge;
450 if (/(\s){([^}\s][^}]*)(\n)$/) {
451 $savefirst = $2;
452 }
453 s,(\s){([^}\s][^}]*)(\n)$,$1.'<a href="'.$ReturnUrl.'?Form='.$Pgm.'2&Database=*&Query='.&xl($2).'">'.$2.$3.'</a>',se;
454 s,^(\s*)([^}]*)},$1.'<a href="'.$ReturnUrl.'?Form='.$Pgm.'2&Database=*&Query='.&xl($savefirst).&xl(' ').&xl($2).'">'.$2.'</a>',e;
455 print;
456 }
457 }
458 print "</pre>\n";
459 close( IN );
460 if (!$flag) {
461 if (!$triedbackup) {
462 ++$triedbackup;
463 print "$DictAlt $command <p>\n" if ($Debug);
464 if (open(IN,"$DictAlt $command |")) {
465 print "</pre><b>Using backup server...</b>\n";
466 print "<hr><p><pre>\n";
467 goto restart;
468 }
469 }
470 print "<b>\n";
471 print "Backend database engine error: please try again later\n";
472 print "</b><p>";
473 }
474 print "<hr>\n";
475 }
476
477 sub xl { local($tmp) = $_[0]; $tmp =~ tr/ /+/; $tmp; }
478 sub lx { local($tmp) = $_[0]; $tmp =~ tr/+/ /; $tmp; }
479
480 sub anchor {
481 local( $dbname, $line) = @_;
482 local( $x, $y, $db, $new_line);
483
484 $odd = 1;
485 $db = $Dbr{$dbname};
486 $db = $dbname;
487 foreach $x (split("\"", $line)) {
488 if ($odd) {
489 $x =~ s/ (\S+)/ <a href="$ReturnUrl?Form=${Pgm}2&Database=$db&Query=$1">$1<\/a>/g;
490 $new_line .= $x;
491 $odd = 0;
492 }
493 else {
494 ($y = $x) =~ tr/ /+/;
495 $new_line .= "<a href=\"$ReturnUrl?Form=${Pgm}2&Database=$db&Query='$y'\">\"$x\"<\/a>";
496 $odd = 1;
497 }
498 }
499
500 return $new_line;
501 }
502
503 #
504 # ----- Common beginning.
505 #
506 sub SendBeginning {
507 local ($title);
508
509 $title = $Heading1;
510 if ($in{'Query'}) {
511 $title .= "- $in{'Query'}";
512 }
513
514 print <<EOF;
515 <!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
516 <html>
517 <head>
518 <title>$title</title>
519 </head>
520 <body background="$Background">
521 <center>
522 <table border=0><tr><td valign="middle">
523 <img src="/gifs/dict_logo2_tr.gif" width="55" height="48" border="0" alt="[DICT logo]">
524 </td><td valign="middle">
525 <font size="+3"><b>$Heading2</b></font>
526 </td></tr></table>
527 </center>
528 <hr size=3>
529 EOF
530 }
531
532 #
533 # ----- Common ending.
534 #
535 sub SendEnding {
536
537 print <<EOF;
538 <center>
539 <font size="-1">
540 Questions or comments about this site?
541 Contact $WebMaster
542 </font>
543 </center>
544 </body>
545 </html>
546 EOF
547 }
548
549 # --------------- Numeric sort function
550
551 sub bynumber { $a <=> $b; }
552
553
554 #############################################################################
555 #
556 # --------------- Library Stuff
557 #
558
559 # Perl Routines to Manipulate CGI input
560 # S.E.Brenner@bioc.cam.ac.uk
561 # $Header: /data/httpd/html/Internal/bin/RCS/Dict,v 1.11 1998/03/30 17:33:26 hoffman Exp $ #
562 # Copyright 1993 Steven E. Brenner
563 # Unpublished work.
564 # Permission granted to use and modify this library so long as the
565 # copyright above is maintained, modifications are documented, and
566 # credit is given for any use of the library.
567
568 # ReadParse
569 # Reads in GET or POST data, converts it to unescaped text, and puts
570 # one key=value in each member of the list "@in"
571 # Also creates key/value pairs in %in, using '\0' to separate multiple
572 # selections
573
574 # If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse,
575 # information is stored there, rather than in $in, @in, and %in.
576 sub ReadParse {
577 if (@_) {
578 local (*in) = @_;
579 }
580
581 local ($i, $loc, $key, $val);
582 local ($fp);
583 # Read in text
584 if ($ENV{'REQUEST_METHOD'} eq "GET") {
585 $in = $ENV{'QUERY_STRING'};
586 } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
587 #for ($i = 0; $i < $ENV{'CONTENT_LENGTH'}; $i++) {
588 # $in .= getc;
589 #}
590 $ntoread = $ENV{'CONTENT_LENGTH'};
591 $in = "";
592 $n = 60;
593 if ($ntoread < $n) {
594 $n = $ntoread;
595 }
596 while ($ntoread) {
597 $x = read(STDIN,$inn,$n);
598 $in = $in . $inn;
599 $ntoread = $ntoread - $x;
600 if ($ntoread < $n) {
601 $n = $ntoread;
602 }
603 }
604 #read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
605 }
606
607 @in = split(/&/,$in);
608
609 foreach $i (0 .. $#in) {
610 # Convert plus's to spaces
611 $in[$i] =~ s/\+/ /g;
612
613 # Convert %XX from hex numbers to alphanumeric
614 $in[$i] =~ s/%(..)/pack("c",hex($1))/ge;
615
616 # Split into key and value.
617 $loc = index($in[$i],"=");
618 $key = substr($in[$i],0,$loc);
619 $val = substr($in[$i],$loc+1);
620 $in{$key} .= '\0' if (defined($in{$key})); # \0 is the multiple separator
621 $in{$key} .= $val;
622 }
623 return 1; # just for fun
624 }
625
626 # PrintHeader
627 # Returns the magic line which tells WWW that we're an HTML document
628
629 sub PrintHeader {
630 return "Content-type: text/html\n\n";
631 }

  ViewVC Help
Powered by ViewVC 1.1.22