]> git.donarmstrong.com Git - infobot.git/blobdiff - src/Modules/Dict.pl
take a few more things literally
[infobot.git] / src / Modules / Dict.pl
index d58bf59848ca8875d8d2c054109bf117ee7cb7f8..8fccf13b4f87b42cde12bac37a000f6d7dab6500 100644 (file)
 #
 #  Dict.pl: Frontend to dict.org.
-#   Author: xk <xk@leguin.openprojects.net>
-#  Version: v0.6b (19991224).
+#   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
 
 package Dict;
 
 use IO::Socket;
 use strict;
 
-my $server     = "dict.org";   # need a specific host||ip.
-my $port       = 2628;
-my $proto      = getprotobyname('tcp');
+#use vars qw(PF_INET);
 
-###local $SIG{ALRM} = sub { die "alarm\n" };
+# need a specific host||ip.
+my $server     = "dict.org";
 
 sub Dict {
     my ($query) = @_;
-###    return unless &main::loadPerlModule("IO::Socket");
-    my $socket = new IO::Socket;
+#    return unless &::loadPerlModule("IO::Socket");
+    my $port   = 2628;
+    my $proto  = getprotobyname('tcp');
     my @results;
+    my $retval;
+
+    for ($query) {
+       s/^[\s\t]+//;
+       s/[\s\t]+$//;
+       s/[\s\t]+/ /;
+    }
 
     # connect.
+    # TODO: make strict-safe constants... so we can defer IO::Socket load.
+    my $socket = new IO::Socket;
     socket($socket, PF_INET, SOCK_STREAM, $proto) or return "error: socket: $!";
     eval {
-       alarm 15;
-       connect($socket, sockaddr_in($port, inet_aton($server))) or return "error: connect: $!";
+       local $SIG{ALRM} = sub { die 'alarm' };
+       alarm 10;
+       connect($socket, sockaddr_in($port, inet_aton($server))) or die "error: connect: $!";
        alarm 0;
     };
 
-    my $retval;
-    if ($@ && $@ ne "alarm\n") {       # failure.
-       $retval = "i could not get info from dict.org";
+    if ($@) {
+       # failure.
+       $retval = "i could not get info from $server '$@'";
     } else {                           # success.
        $socket->autoflush(1);  # required.
 
        my $num;
-       if ($query =~ /^(\d+)\s+/) {
+       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 (defined $num and ($num > $total or $num < 0)) {
-           &msg($main::who, "error: choice in definition is out of range.");
+       if ($total == 0) {
+           $num = undef;
+       }
+
+       if (defined $num and ($num > $total or $num < 1)) {
+           &::msg($::who, "error: choice in definition is out of range.");
            return;
        }
 
        # parse the results.
        if ($total > 1) {
            if (defined $num) {
-               $retval = sprintf("[%d/%d] %s", $num, $total, $results[$num]);
+               $retval = sprintf("[%d/%d] %s", $num, $total, $results[$num-1]);
            } else {
                # suggested by larne and others.
                my $prefix = "Dictionary '$query' ";
-               $retval = &main::formListReply(1, $prefix, @results);
+               $retval = &::formListReply(1, $prefix, @results);
            }
        } elsif ($total == 1) {
            $retval = "Dictionary '$query' ".$results[0];
        } else {
            $retval = "could not find definition for \002$query\002";
+           $retval .= " in $dict" if ($dict ne '*');
        }
     }
 
-    &main::performStrictReply($retval);
+    &::performStrictReply($retval);
 }
 
-sub Dict_Wordnet {
-    my ($socket, $query) = @_;
+sub Define {
+    my ($socket, $query, $dict) = @_;
     my @results;
 
-    &main::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
 
-       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+$//;
-###        &main::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);
-###            &main::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;
        }
     }
 
-    &main::status("Dict: wordnet: found ". scalar(@results) ." defs.");
-
-    return if (!scalar @results);
-
-    return @results;
-}
-
-sub Dict_Foldoc {
-    my ($socket,$query) = @_;
-    my @results;
-
-    &main::status("Dict: asking Foldoc.");
-    print $socket "DEFINE foldoc \"$query\"\n";
-
-    my $firsttime = 1;
-    my $string;
-    while (<$socket>) {
-       chop;   # remove \n
-       chop;   # remove \r
-
-       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 .= $_." ";
-    }
-
-    &main::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;
 }