# Author: dms
# Version: v0.6c (20000924).
# Created: 19990914.
+# Updates: Copyright (c) 2005 - Tim Riker <Tim@Rikers.org>
#
+# see http://luetzschena-stahmeln.de/dictd/
+# for a list of dict servers
package Dict;
use IO::Socket;
use strict;
-my $server = "dict.org"; # need a specific host||ip.
-my $port = 2628;
-my $proto = getprotobyname('tcp');
+#use vars qw(PF_INET);
-###local $SIG{ALRM} = sub { die "alarm\n" };
+# need a specific host||ip.
+my $server = "dict.org";
sub Dict {
my ($query) = @_;
-### return unless &::loadPerlModule("IO::Socket");
- my $socket = new IO::Socket;
+# return unless &::loadPerlModule("IO::Socket");
+ my $port = 2628;
+ my $proto = getprotobyname('tcp');
my @results;
+ my $retval;
for ($query) {
s/^[\s\t]+//;
}
# connect.
+ # TODO: make strict-safe constants... so we can defer IO::Socket load.
+ my $socket = new IO::Socket;
socket($socket, PF_INET, SOCK_STREAM, $proto) or return "error: socket: $!";
eval {
+ local $SIG{ALRM} = sub { die 'alarm' };
alarm 10;
- connect($socket, sockaddr_in($port, inet_aton($server))) or return "error: connect: $!";
+ connect($socket, sockaddr_in($port, inet_aton($server))) or die "error: connect: $!";
alarm 0;
};
- my $retval;
- if ($@ && $@ ne "alarm\n") { # failure.
- $retval = "i could not get info from dict.org";
+ if ($@) {
+ # failure.
+ $retval = "i could not get info from $server '$@'";
} else { # success.
$socket->autoflush(1); # required.
if ($query =~ s/^(\d+)\s+//) {
$num = $1;
}
+ my $dict = '*';
+ if ($query =~ s/\/(\S+)$//) {
+ $dict = $1;
+ }
# body.
- push(@results, &Dict_Wordnet($socket,$query));
- push(@results, &Dict_Foldoc($socket,$query));
+ push(@results, &Define($socket,$query,$dict));
+ #push(@results, &Define($socket,$query,'foldoc'));
+ #push(@results, &Define($socket,$query,'web1913'));
# end.
print $socket "QUIT\n";
close $socket;
+ my $count=0;
+ foreach (@results) {
+ $count++;
+ &::DEBUG("$count: $_");
+ }
my $total = scalar @results;
if ($total == 0) {
$retval = "Dictionary '$query' ".$results[0];
} else {
$retval = "could not find definition for \002$query\002";
+ $retval .= " in $dict" if ($dict ne '*');
}
}
&::performStrictReply($retval);
}
-sub Dict_Wordnet {
- my ($socket, $query) = @_;
+sub Define {
+ my ($socket, $query, $dict) = @_;
my @results;
- &::status("Dict: asking Wordnet.");
- print $socket "DEFINE wn \"$query\"\n";
+ &::DEBUG("Dict: asking $dict.");
+ print $socket "DEFINE $dict \"$query\"\n";
- my $def = "";
- my $wordtype = "";
+ my $def = '';
+ my $term = $query;
while (<$socket>) {
chop; # remove \n
chop; # remove \r
- if ($_ eq ".") { # end of def.
- push(@results, $def);
- } elsif (/^250 /) { # stats.
- last;
- } elsif (/^552 no match/) { # no match.
+ &::DEBUG("$term/$dict '$_'");
+ if (/^552 /) {
+ # no match.
return;
- } elsif (/^\s+(\S+ )?(\d+)?: (.*)/) { # start of sub def.
- my $text = $3;
- $def =~ s/\s+$//;
-### &::DEBUG("def => '$def'.");
- push(@results, $def) if ($def ne "");
- $def = $text;
-
- if (0) { # old non-fLR format.
- $def = "$query $wordtype: $text" if (defined $text);
- $wordtype = substr($1,0,-1) if (defined $1);
-### &::DEBUG("_ => '$_'.") if (!defined $text);
+ } elsif (/^250 /) {
+ # end w/ optional stats
+ last;
+ } elsif (/^151 "([^"]*)" (\S+) .*/) {
+ # 151 "Good Thing" jargon "Jargon File (4.3.0, 30 APR 2001)"
+ $term=$1;
+ $dict=$2;
+ $def = '';
+ &::DEBUG("term=$term dict=$dict");
+ } else {
+ my $line = $_;
+ # some dicts put part of the definition on the same line ie: jargon
+ $line =~ s/^$term//i;
+ $line =~ s/^\s+/ /;
+ if ($dict eq 'wn') {
+ # special processing for sub defs in wordnet
+ if ($line eq '.') {
+ # end of def.
+ $def =~ s/\s+$//;
+ $def =~ s/\[[^\]]*\]//g;
+ push(@results, $def);
+ } elsif ($line =~ m/^\s+(\S+ )?(\d+)?: (.*)/) {
+ # start of sub def.
+ my $text = $3;
+ $def =~ s/\s+$//;
+ #&::DEBUG("def => '$def'.");
+ $def =~ s/\[[^\]]*\]//g;
+ push(@results, $def) if ($def ne '');
+ $def = $text;
+ } elsif (/^\s+(.*)/) {
+ $def .= $line;
+ } else {
+ &::DEBUG("ignored '$line'");
+ }
+ } else {
+ # would be nice to divide other dicts
+ # but many are not always in a parsable format
+ if ($line eq '.') {
+ # end of def.
+ next if ($def eq '');
+ push(@results, $def);
+ $def = '';
+ } elsif ($line =~ m/^\s+(\S.*\S)\s*$/) {
+ #&::DEBUG("got '$1'");
+ $def .= ' ' if ($def ne '');
+ $def .= $1;
+ } else {
+ &::DEBUG("ignored '$line'");
+ }
}
-
- } elsif (/^\s+(.*)/) {
- s/^\s{2,}/ /;
- $def .= $_;
- $def =~ s/\[.*?\]$//g;
}
}
- &::status("Dict: wordnet: found ". scalar(@results) ." defs.");
-
- return if (!scalar @results);
-
- return @results;
-}
-
-sub Dict_Foldoc {
- my ($socket,$query) = @_;
- my @results;
-
- &::status("Dict: asking Foldoc.");
- print $socket "DEFINE foldoc \"$query\"\n";
-
- my $firsttime = 1;
- my $string;
- while (<$socket>) {
- chop; # remove \n
- chop; # remove \r
-
- return if /^552 /; # no match.
-
- if ($firsttime) {
- $firsttime-- if ($_ eq "");
- next;
- }
-
- last if (/^250/ or /^\.$/); # stats; end of def.
-
- s/^\s+|\s+$//g; # each line.
-
- if ($_ eq "") { # sub def separator.
- $string =~ s/^\s+|\s+$//g; # sub def.
- $string =~ s/[{}]//g;
-
- next if ($string eq "");
-
- push(@results, $string);
- $string = "";
- }
-
- $string .= $_." ";
- }
-
- &::status("Dict: foldoc: found ". scalar(@results) ." defs.");
+ &::DEBUG("Dict: $dict: found ". scalar(@results) ." defs.");
return if (!scalar @results);
- pop @results; # last def is date of entry.
return @results;
}