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