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         my $dict = '*';
  57         if ($query =~ s/\/(\S+)$//) {
  58             $dict = $1;
  59         }
  60
  61         # body.
  62         push(@results, &Define($socket,$query,$dict));
  63         #push(@results, &Define($socket,$query,'foldoc'));
  64         #push(@results, &Define($socket,$query,'web1913'));
  65         # end.
  66
  67         print $socket "QUIT\n";
  68         close $socket;
  69
  70         my $count=0;
  71         foreach (@results) {
  72             $count++;
  73             &::DEBUG("$count: $_");
  74         }
  75         my $total = scalar @results;
  76
  77         if ($total == 0) {
  78             $num = undef;
  79         }
  80
  81         if (defined $num and ($num > $total or $num < 1)) {
  82             &::msg($::who, "error: choice in definition is out of range.");
  83             return;
  84         }
  85
  86         # parse the results.
  87         if ($total > 1) {
  88             if (defined $num) {
  89                 $retval = sprintf("[%d/%d] %s", $num, $total, $results[$num-1]);
  90             } else {
  91                 # suggested by larne and others.
  92                 my $prefix = "Dictionary '$query' ";
  93                 $retval = &::formListReply(1, $prefix, @results);
  94             }
  95         } elsif ($total == 1) {
  96             $retval = "Dictionary '$query' ".$results[0];
  97         } else {
  98             $retval = "could not find definition for \002$query\002";
  99             $retval .= " in $dict" if ($dict ne '*');
 100         }
 101     }
 102
 103     &::performStrictReply($retval);
 104 }
 105
 106 sub Define {
 107     my ($socket, $query, $dict) = @_;
 108     my @results;
 109
 110     &::DEBUG("Dict: asking $dict.");
 111     print $socket "DEFINE $dict \"$query\"\n";
 112
 113     my $def = '';
 114     my $term = $query;
 115
 116     while (<$socket>) {
 117         chop;   # remove \n
 118         chop;   # remove \r
 119
 120         &::DEBUG("$term/$dict '$_'");
 121         if (/^552 /) {
 122             # no match.
 123             return;
 124         } elsif (/^250 /) {
 125             # end w/ optional stats
 126             last;
 127         } elsif (/^151 "([^"]*)" (\S+) .*/) {
 128             # 151 "Good Thing" jargon "Jargon File (4.3.0, 30 APR 2001)"
 129             $term=$1;
 130             $dict=$2;
 131             $def = '';
 132             &::DEBUG("term=$term dict=$dict");
 133         } else {
 134             my $line = $_;
 135             # some dicts put part of the definition on the same line ie: jargon
 136             $line =~ s/^$term//i;
 137             $line =~ s/^\s+/ /;
 138             if ($dict eq 'wn') {
 139                 # special processing for sub defs in wordnet
 140                 if ($line eq '.') {
 141                     # end of def.
 142                     $def =~ s/\s+$//;
 143                     $def =~ s/\[[^\]]*\]//g;
 144                     push(@results, $def);
 145                 } elsif ($line =~ m/^\s+(\S+ )?(\d+)?: (.*)/) {
 146                     # start of sub def.
 147                     my $text = $3;
 148                     $def =~ s/\s+$//;
 149                     #&::DEBUG("def => '$def'.");
 150                     $def =~ s/\[[^\]]*\]//g;
 151                     push(@results, $def) if ($def ne '');
 152                     $def = $text;
 153                 } elsif (/^\s+(.*)/) {
 154                     $def .= $line;
 155                 } else {
 156                     &::DEBUG("ignored '$line'");
 157                 }
 158             } else {
 159                 # would be nice to divide other dicts
 160                 # but many are not always in a parsable format
 161                 if ($line eq '.') {
 162                     # end of def.
 163                     next if ($def eq '');
 164                     push(@results, $def);
 165                     $def = '';
 166                 } elsif ($line =~ m/^\s+(\S.*\S)\s*$/) {
 167                     #&::DEBUG("got '$1'");
 168                     $def .= ' ' if ($def ne '');
 169                     $def .= $1;
 170                 } else {
 171                     &::DEBUG("ignored '$line'");
 172                 }
 173             }
 174         }
 175     }
 176
 177     &::DEBUG("Dict: $dict: found ". scalar(@results) ." defs.");
 178
 179     return if (!scalar @results);
 180
 181     return @results;
 182 }
 183
 184 1;
 185
 186 # vim:ts=4:sw=4:expandtab:tw=80