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