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