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         my $total = scalar @results;
  67
  68         if ($total == 0) {
  69             $num = undef;
  70         }
  71
  72         if (defined $num and ($num > $total or $num < 1)) {
  73             &::msg($::who, "error: choice in definition is out of range.");
  74             return;
  75         }
  76
  77         # parse the results.
  78         if ($total > 1) {
  79             if (defined $num) {
  80                 $retval = sprintf("[%d/%d] %s", $num, $total, $results[$num-1]);
  81             } else {
  82                 # suggested by larne and others.
  83                 my $prefix = "Dictionary '$query' ";
  84                 $retval = &::formListReply(1, $prefix, @results);
  85             }
  86         } elsif ($total == 1) {
  87             $retval = "Dictionary '$query' ".$results[0];
  88         } else {
  89             $retval = "could not find definition for \002$query\002";
  90         }
  91     }
  92
  93     &::performStrictReply($retval);
  94 }
  95
  96 sub Dict_Wordnet {
  97     my ($socket, $query) = @_;
  98     my @results;
  99
 100     &::status("Dict: asking Wordnet.");
 101     print $socket "DEFINE wn \"$query\"\n";
 102
 103     my $def             = "";
 104     my $wordtype        = "";
 105
 106     while (<$socket>) {
 107         chop;   # remove \n
 108         chop;   # remove \r
 109
 110         &::DEBUG("got '$_'");
 111         if ($_ eq ".") {                                # end of def.
 112             push(@results, $def);
 113         } elsif (/^250 /) {                             # stats.
 114             last;
 115         } elsif (/^552 no match/) {                     # no match.
 116             return;
 117         } elsif (/^\s+(\S+ )?(\d+)?: (.*)/) {   # start of sub def.
 118             my $text = $3;
 119             $def =~ s/\s+$//;
 120 ###         &::DEBUG("def => '$def'.");
 121             push(@results, $def)                if ($def ne "");
 122             $def = $text;
 123
 124             if (0) {    # old non-fLR format.
 125                 $def = "$query $wordtype: $text" if (defined $text);
 126                 $wordtype = substr($1,0,-1)     if (defined $1);
 127 ###             &::DEBUG("_ => '$_'.") if (!defined $text);
 128             }
 129
 130         } elsif (/^\s+(.*)/) {
 131             s/^\s{2,}/ /;
 132             $def        .= $_;
 133             $def =~ s/\[.*?\]$//g;
 134         }
 135     }
 136
 137     &::status("Dict: wordnet: found ". scalar(@results) ." defs.");
 138
 139     return if (!scalar @results);
 140
 141     return @results;
 142 }
 143
 144 sub Dict_Foldoc {
 145     my ($socket,$query) = @_;
 146     my @results;
 147
 148     &::status("Dict: asking Foldoc.");
 149     print $socket "DEFINE foldoc \"$query\"\n";
 150
 151     my $firsttime = 1;
 152     my $string;
 153     while (<$socket>) {
 154         chomp;  # remove \r\n
 155
 156         &::DEBUG("got '$_'");
 157         return if /^552 /;              # no match.
 158
 159         last if (/^250/ or /^\.$/);     # stats; end of def.
 160
 161         s/^\s+|\s+$//g;                 # each line.
 162
 163         if ($_ eq "") {                 # sub def separator.
 164             $string =~ s/^\s+|\s+$//g;  # sub def.
 165             $string =~ s/[{}]//g;
 166
 167             next if ($string eq "");
 168
 169             push(@results, $string);
 170             $string = "";
 171         }
 172
 173         $string .= $_." ";
 174     }
 175
 176     &::status("Dict: foldoc: found ". scalar(@results) ." defs.");
 177
 178     return if (!scalar @results);
 179     pop @results;       # last def is date of entry.
 180
 181     return @results;
 182 }
 183
 184 sub Dict_web1913 {
 185     my ($socket,$query) = @_;
 186     my @results;
 187
 188     &::status("Dict: asking web1913.");
 189     print $socket "DEFINE web1913 \"$query\"\n";
 190
 191     my $string;
 192     while (<$socket>) {
 193         chop;   # remove \n
 194         chop;   # remove \r
 195
 196         return if /^552/;               # no match.
 197
 198         last if (/^250/);       # stats; end of def.
 199         next if (/^151/ or /^150/);       # definition and/or retrieval
 200
 201         s/^\s+|\s+$//g;                 # each line.
 202
 203         if ($_ eq "" or $_ =~ /^\.$/) {                 # sub def separator.
 204             $string =~ s/^\s+|\s+$//g;  # sub def.
 205             $string =~ s/[{}]//g;
 206
 207             next if ($string eq "");
 208
 209             push(@results, $string);
 210             $string = "";
 211         }
 212
 213         $string .= $_." ";
 214     }
 215
 216     &::status("Dict: web1913: found ". scalar(@results) ." defs.");
 217
 218     return if (!scalar @results);
 219     pop @results;       # last def is date of entry.
 220
 221     return @results;
 222 }
 223
 224 1;