blootbot/src/Modules/Dict.pl

   1 #
   2 #  Dict.pl: Frontend to dict.org.
   3 #   Author: dms
   4 #  Version: v0.6c (20000924).
   5 #  Created: 19990914.
   6 #
   7
   8 package Dict;
   9
  10 use IO::Socket;
  11 use strict;
  12
  13 my $server      = "dict.org";   # need a specific host||ip.
  14 my $port        = 2628;
  15 my $proto       = getprotobyname('tcp');
  16
  17 ###local $SIG{ALRM} = sub { die "alarm\n" };
  18
  19 sub Dict {
  20     my ($query) = @_;
  21 ###    return unless &::loadPerlModule("IO::Socket");
  22     my $socket = new IO::Socket;
  23     my @results;
  24
  25     for ($query) {
  26         s/^[\s\t]+//;
  27         s/[\s\t]+$//;
  28         s/[\s\t]+/ /;
  29     }
  30
  31     # connect.
  32     socket($socket, PF_INET, SOCK_STREAM, $proto) or return "error: socket: $!";
  33     eval {
  34         alarm 10;
  35         connect($socket, sockaddr_in($port, inet_aton($server))) or return "error: connect: $!";
  36         alarm 0;
  37     };
  38
  39     my $retval;
  40     if ($@ && $@ ne "alarm\n") {        # failure.
  41         $retval = "i could not get info from dict.org";
  42     } else {                            # success.
  43         $socket->autoflush(1);  # required.
  44
  45         my $num;
  46         if ($query =~ s/^(\d+)\s+//) {
  47             $num = $1;
  48         }
  49
  50         # body.
  51         push(@results, &Dict_Wordnet($socket,$query));
  52         push(@results, &Dict_Foldoc($socket,$query));
  53         # end.
  54
  55         print $socket "QUIT\n";
  56         close $socket;
  57
  58         my $total = scalar @results;
  59
  60         if ($total == 0) {
  61             $num = undef;
  62         }
  63
  64         if (defined $num and ($num > $total or $num < 1)) {
  65             &::msg($::who, "error: choice in definition is out of range.");
  66             return;
  67         }
  68
  69         # parse the results.
  70         if ($total > 1) {
  71             if (defined $num) {
  72                 $retval = sprintf("[%d/%d] %s", $num, $total, $results[$num-1]);
  73             } else {
  74                 # suggested by larne and others.
  75                 my $prefix = "Dictionary '$query' ";
  76                 $retval = &::formListReply(1, $prefix, @results);
  77             }
  78         } elsif ($total == 1) {
  79             $retval = "Dictionary '$query' ".$results[0];
  80         } else {
  81             $retval = "could not find definition for \002$query\002";
  82         }
  83     }
  84
  85     &::performStrictReply($retval);
  86 }
  87
  88 sub Dict_Wordnet {
  89     my ($socket, $query) = @_;
  90     my @results;
  91
  92     &::status("Dict: asking Wordnet.");
  93     print $socket "DEFINE wn \"$query\"\n";
  94
  95     my $def             = "";
  96     my $wordtype        = "";
  97
  98     while (<$socket>) {
  99         chop;   # remove \n
 100         chop;   # remove \r
 101
 102         if ($_ eq ".") {                                # end of def.
 103             push(@results, $def);
 104         } elsif (/^250 /) {                             # stats.
 105             last;
 106         } elsif (/^552 no match/) {                     # no match.
 107             return;
 108         } elsif (/^\s+(\S+ )?(\d+)?: (.*)/) {   # start of sub def.
 109             my $text = $3;
 110             $def =~ s/\s+$//;
 111 ###         &::DEBUG("def => '$def'.");
 112             push(@results, $def)                if ($def ne "");
 113             $def = $text;
 114
 115             if (0) {    # old non-fLR format.
 116                 $def = "$query $wordtype: $text" if (defined $text);
 117                 $wordtype = substr($1,0,-1)     if (defined $1);
 118 ###             &::DEBUG("_ => '$_'.") if (!defined $text);
 119             }
 120
 121         } elsif (/^\s+(.*)/) {
 122             s/^\s{2,}/ /;
 123             $def        .= $_;
 124             $def =~ s/\[.*?\]$//g;
 125         }
 126     }
 127
 128     &::status("Dict: wordnet: found ". scalar(@results) ." defs.");
 129
 130     return if (!scalar @results);
 131
 132     return @results;
 133 }
 134
 135 sub Dict_Foldoc {
 136     my ($socket,$query) = @_;
 137     my @results;
 138
 139     &::status("Dict: asking Foldoc.");
 140     print $socket "DEFINE foldoc \"$query\"\n";
 141
 142     my $firsttime = 1;
 143     my $string;
 144     while (<$socket>) {
 145         chop;   # remove \n
 146         chop;   # remove \r
 147
 148         return if /^552 /;              # no match.
 149
 150         if ($firsttime) {
 151             $firsttime-- if ($_ eq "");
 152             next;
 153         }
 154
 155         last if (/^250/ or /^\.$/);     # stats; end of def.
 156
 157         s/^\s+|\s+$//g;                 # each line.
 158
 159         if ($_ eq "") {                 # sub def separator.
 160             $string =~ s/^\s+|\s+$//g;  # sub def.
 161             $string =~ s/[{}]//g;
 162
 163             next if ($string eq "");
 164
 165             push(@results, $string);
 166             $string = "";
 167         }
 168
 169         $string .= $_." ";
 170     }
 171
 172     &::status("Dict: foldoc: found ". scalar(@results) ." defs.");
 173
 174     return if (!scalar @results);
 175     pop @results;       # last def is date of entry.
 176
 177     return @results;
 178 }
 179
 180 1;