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
  24     #    return unless &::loadPerlModule("IO::Socket");
  25     my $port  = 2628;
  26     my $proto = getprotobyname('tcp');
  27     my @results;
  28     my $retval;
  29
  30     for ($query) {
  31         s/^[\s\t]+//;
  32         s/[\s\t]+$//;
  33         s/[\s\t]+/ /;
  34     }
  35
  36     # connect.
  37     # TODO: make strict-safe constants... so we can defer IO::Socket load.
  38     my $socket = new IO::Socket;
  39     socket( $socket, PF_INET, SOCK_STREAM, $proto )
  40       or return "error: socket: $!";
  41     eval {
  42         local $SIG{ALRM} = sub { die 'alarm' };
  43         alarm 10;
  44         connect( $socket, sockaddr_in( $port, inet_aton($server) ) )
  45           or die "error: connect: $!";
  46         alarm 0;
  47     };
  48
  49     if ($@) {
  50
  51         # failure.
  52         $retval = "i could not get info from $server '$@'";
  53     }
  54     else {    # success.
  55         $socket->autoflush(1);    # required.
  56
  57         my $num;
  58         if ( $query =~ s/^(\d+)\s+// ) {
  59             $num = $1;
  60         }
  61         my $dict = '*';
  62         if ( $query =~ s/\/(\S+)$// ) {
  63             $dict = $1;
  64         }
  65
  66         # body.
  67         push( @results, &Define( $socket, $query, $dict ) );
  68
  69         #push(@results, &Define($socket,$query,'foldoc'));
  70         #push(@results, &Define($socket,$query,'web1913'));
  71         # end.
  72
  73         print $socket "QUIT\n";
  74         close $socket;
  75
  76         my $count = 0;
  77         foreach (@results) {
  78             $count++;
  79             &::DEBUG("$count: $_");
  80         }
  81         my $total = scalar @results;
  82
  83         if ( $total == 0 ) {
  84             $num = undef;
  85         }
  86
  87         if ( defined $num and ( $num > $total or $num < 1 ) ) {
  88             &::msg( $::who, "error: choice in definition is out of range." );
  89             return;
  90         }
  91
  92         # parse the results.
  93         if ( $total > 1 ) {
  94             if ( defined $num ) {
  95                 $retval =
  96                   sprintf( "[%d/%d] %s", $num, $total, $results[ $num - 1 ] );
  97             }
  98             else {
  99
 100                 # suggested by larne and others.
 101                 my $prefix = "Dictionary '$query' ";
 102                 $retval = &::formListReply( 1, $prefix, @results );
 103             }
 104         }
 105         elsif ( $total == 1 ) {
 106             $retval = "Dictionary '$query' " . $results[0];
 107         }
 108         else {
 109             $retval = "could not find definition for \002$query\002";
 110             $retval .= " in $dict" if ( $dict ne '*' );
 111         }
 112     }
 113
 114     &::performStrictReply($retval);
 115 }
 116
 117 sub Define {
 118     my ( $socket, $query, $dict ) = @_;
 119     my @results;
 120
 121     &::DEBUG("Dict: asking $dict.");
 122     print $socket "DEFINE $dict \"$query\"\n";
 123
 124     my $def  = '';
 125     my $term = $query;
 126
 127     while (<$socket>) {
 128         chop;    # remove \n
 129         chop;    # remove \r
 130
 131         &::DEBUG("$term/$dict '$_'");
 132         if (/^552 /) {
 133
 134             # no match.
 135             return;
 136         }
 137         elsif (/^250 /) {
 138
 139             # end w/ optional stats
 140             last;
 141         }
 142         elsif (/^151 "([^"]*)" (\S+) .*/) {
 143
 144             # 151 "Good Thing" jargon "Jargon File (4.3.0, 30 APR 2001)"
 145             $term = $1;
 146             $dict = $2;
 147             $def  = '';
 148             &::DEBUG("term=$term dict=$dict");
 149         }
 150         else {
 151             my $line = $_;
 152
 153             # some dicts put part of the definition on the same line ie: jargon
 154             $line =~ s/^$term//i;
 155             $line =~ s/^\s+/ /;
 156             if ( $dict eq 'wn' ) {
 157
 158                 # special processing for sub defs in wordnet
 159                 if ( $line eq '.' ) {
 160
 161                     # end of def.
 162                     $def =~ s/\s+$//;
 163                     $def =~ s/\[[^\]]*\]//g;
 164                     push( @results, $def );
 165                 }
 166                 elsif ( $line =~ m/^\s+(\S+ )?(\d+)?: (.*)/ ) {
 167
 168                     # start of sub def.
 169                     my $text = $3;
 170                     $def =~ s/\s+$//;
 171
 172                     #&::DEBUG("def => '$def'.");
 173                     $def =~ s/\[[^\]]*\]//g;
 174                     push( @results, $def ) if ( $def ne '' );
 175                     $def = $text;
 176                 }
 177                 elsif (/^\s+(.*)/) {
 178                     $def .= $line;
 179                 }
 180                 else {
 181                     &::DEBUG("ignored '$line'");
 182                 }
 183             }
 184             else {
 185
 186                 # would be nice to divide other dicts
 187                 # but many are not always in a parsable format
 188                 if ( $line eq '.' ) {
 189
 190                     # end of def.
 191                     next if ( $def eq '' );
 192                     push( @results, $def );
 193                     $def = '';
 194                 }
 195                 elsif ( $line =~ m/^\s+(\S.*\S)\s*$/ ) {
 196
 197                     #&::DEBUG("got '$1'");
 198                     $def .= ' ' if ( $def ne '' );
 199                     $def .= $1;
 200                 }
 201                 else {
 202                     &::DEBUG("ignored '$line'");
 203                 }
 204             }
 205         }
 206     }
 207
 208     &::DEBUG( "Dict: $dict: found " . scalar(@results) . " defs." );
 209
 210     return if ( !scalar @results );
 211
 212     return @results;
 213 }
 214
 215 1;
 216
 217 # vim:ts=4:sw=4:expandtab:tw=80