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