src/Modules/Dict.pl

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