take a few more things literally

[infobot.git] / src / Modules / Dict.pl

diff --git a/src/Modules/Dict.pl b/src/Modules/Dict.pl
index d310491773c43c2ea6610fffbfdf8c4b55d453a0..8fccf13b4f87b42cde12bac37a000f6d7dab6500 100644 (file)
--- a/src/Modules/Dict.pl
+++ b/src/Modules/Dict.pl
@@ -3,6 +3,7 @@
 #   Author: dms
 #  Version: v0.6c (20000924).
 #  Created: 19990914.
+#  Updates: Copyright (c) 2005 - Tim Riker <Tim@Rikers.org>
 #
 # see http://luetzschena-stahmeln.de/dictd/
 # for a list of dict servers
@@ -15,8 +16,7 @@ use strict;
 #use vars qw(PF_INET);
 
 # need a specific host||ip.
-#my $server    = "dict.org";
-my $server     = "127.0.0.1";
+my $server     = "dict.org";
 
 sub Dict {
     my ($query) = @_;
@@ -37,7 +37,7 @@ sub Dict {
     my $socket = new IO::Socket;
     socket($socket, PF_INET, SOCK_STREAM, $proto) or return "error: socket: $!";
     eval {
-       local $SIG{ALRM} = sub { die "alarm" };
+       local $SIG{ALRM} = sub { die 'alarm' };
        alarm 10;
        connect($socket, sockaddr_in($port, inet_aton($server))) or die "error: connect: $!";
        alarm 0;
@@ -53,15 +53,25 @@ sub Dict {
        if ($query =~ s/^(\d+)\s+//) {
            $num = $1;
        }
+       my $dict = '*';
+       if ($query =~ s/\/(\S+)$//) {
+           $dict = $1;
+       }
 
        # body.
-       push(@results, &Dict_Wordnet($socket,$query));
-       push(@results, &Dict_Foldoc($socket,$query));
+       push(@results, &Define($socket,$query,$dict));
+       #push(@results, &Define($socket,$query,'foldoc'));
+       #push(@results, &Define($socket,$query,'web1913'));
        # end.
 
        print $socket "QUIT\n";
        close $socket;
 
+       my $count=0;
+       foreach (@results) {
+           $count++;
+           &::DEBUG("$count: $_");
+       }
        my $total = scalar @results;
 
        if ($total == 0) {
@@ -86,102 +96,87 @@ sub Dict {
            $retval = "Dictionary '$query' ".$results[0];
        } else {
            $retval = "could not find definition for \002$query\002";
+           $retval .= " in $dict" if ($dict ne '*');
        }
     }
 
     &::performStrictReply($retval);
 }
 
-sub Dict_Wordnet {
-    my ($socket, $query) = @_;
+sub Define {
+    my ($socket, $query, $dict) = @_;
     my @results;
 
-    &::status("Dict: asking Wordnet.");
-    print $socket "DEFINE wn \"$query\"\n";
+    &::DEBUG("Dict: asking $dict.");
+    print $socket "DEFINE $dict \"$query\"\n";
 
-    my $def            = "";
-    my $wordtype       = "";
+    my $def = '';
+    my $term = $query;
 
     while (<$socket>) {
        chop;   # remove \n
        chop;   # remove \r
 
-       &::DEBUG("got '$_'");
-       if ($_ eq ".") {                                # end of def.
-           push(@results, $def);
-       } elsif (/^250 /) {                             # stats.
-           last;
-       } elsif (/^552 no match/) {                     # no match.
+       &::DEBUG("$term/$dict '$_'");
+       if (/^552 /) {
+           # no match.
            return;
-       } elsif (/^\s+(\S+ )?(\d+)?: (.*)/) {   # start of sub def.
-           my $text = $3;
-           $def =~ s/\s+$//;
-###        &::DEBUG("def => '$def'.");
-           push(@results, $def)                if ($def ne "");
-           $def = $text;
-
-           if (0) {    # old non-fLR format.
-               $def = "$query $wordtype: $text" if (defined $text);
-               $wordtype = substr($1,0,-1)     if (defined $1);
-###            &::DEBUG("_ => '$_'.") if (!defined $text);
+       } elsif (/^250 /) {
+            # end w/ optional stats
+           last;
+       } elsif (/^151 "([^"]*)" (\S+) .*/) {
+            # 151 "Good Thing" jargon "Jargon File (4.3.0, 30 APR 2001)"
+            $term=$1;
+           $dict=$2;
+           $def = '';
+            &::DEBUG("term=$term dict=$dict");
+       } else {
+           my $line = $_;
+           # some dicts put part of the definition on the same line ie: jargon
+           $line =~ s/^$term//i;
+           $line =~ s/^\s+/ /;
+           if ($dict eq 'wn') {
+               # special processing for sub defs in wordnet
+               if ($line eq '.') {
+                   # end of def.
+                   $def =~ s/\s+$//;
+                   $def =~ s/\[[^\]]*\]//g;
+                   push(@results, $def);
+               } elsif ($line =~ m/^\s+(\S+ )?(\d+)?: (.*)/) {
+                   # start of sub def.
+                   my $text = $3;
+                   $def =~ s/\s+$//;
+                   #&::DEBUG("def => '$def'.");
+                   $def =~ s/\[[^\]]*\]//g;
+                   push(@results, $def) if ($def ne '');
+                   $def = $text;
+               } elsif (/^\s+(.*)/) {
+                   $def .= $line;
+               } else {
+                   &::DEBUG("ignored '$line'");
+               }
+           } else {
+               # would be nice to divide other dicts
+               # but many are not always in a parsable format
+               if ($line eq '.') {
+                   # end of def.
+                   next if ($def eq '');
+                   push(@results, $def);
+                   $def = '';
+               } elsif ($line =~ m/^\s+(\S.*\S)\s*$/) {
+                   #&::DEBUG("got '$1'");
+                   $def .= ' ' if ($def ne '');
+                   $def .= $1;
+               } else {
+                   &::DEBUG("ignored '$line'");
+               }
            }
-
-       } elsif (/^\s+(.*)/) {
-           s/^\s{2,}/ /;
-           $def        .= $_;
-           $def =~ s/\[.*?\]$//g;
        }
     }
 
-    &::status("Dict: wordnet: found ". scalar(@results) ." defs.");
-
-    return if (!scalar @results);
-
-    return @results;
-}
-
-sub Dict_Foldoc {
-    my ($socket,$query) = @_;
-    my @results;
-
-    &::status("Dict: asking Foldoc.");
-    print $socket "DEFINE foldoc \"$query\"\n";
-
-    my $firsttime = 1;
-    my $string;
-    while (<$socket>) {
-       chop;   # remove \n
-       chop;   # remove \r
-
-       &::DEBUG("got '$_'");
-       return if /^552 /;              # no match.
-
-       if ($firsttime) {
-           $firsttime-- if ($_ eq "");
-           next;
-       }
-
-       last if (/^250/ or /^\.$/);     # stats; end of def.
-
-       s/^\s+|\s+$//g;                 # each line.
-
-       if ($_ eq "") {                 # sub def separator.
-           $string =~ s/^\s+|\s+$//g;  # sub def.
-           $string =~ s/[{}]//g;
-
-           next if ($string eq "");
-
-           push(@results, $string);
-           $string = "";
-       }
-
-       $string .= $_." ";
-    }
-
-    &::status("Dict: foldoc: found ". scalar(@results) ." defs.");
+    &::DEBUG("Dict: $dict: found ". scalar(@results) ." defs.");
 
     return if (!scalar @results);
-    pop @results;      # last def is date of entry.
 
     return @results;
 }