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

Annotation of /cgi-bin/Dict

Parent Directory Parent Directory | Revision Log Revision Log


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

1 apollock 1.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     }
632    

  ViewVC Help
Powered by ViewVC 1.1.22