# 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]+//;
- s/[\s\t]+$//;
- s/[\s\t]+/ /;
+ s/^[\s\t]+//;
+ s/[\s\t]+$//;
+ s/[\s\t]+/ /;
}
# connect.
- socket($socket, PF_INET, SOCK_STREAM, $proto) or return "error: socket: $!";
+ # 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 {
- alarm 10;
- connect($socket, sockaddr_in($port, inet_aton($server))) or return "error: connect: $!";
- alarm 0;
+ local $SIG{ALRM} = sub { die 'alarm' };
+ alarm 10;
+ 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";
- } else { # success.
- $socket->autoflush(1); # required.
-
- my $num;
- if ($query =~ s/^(\d+)\s+//) {
- $num = $1;
- }
-
- # body.
- push(@results, &Dict_Wordnet($socket,$query));
- push(@results, &Dict_Foldoc($socket,$query));
- # end.
-
- print $socket "QUIT\n";
- close $socket;
-
- my $total = scalar @results;
-
- if ($total == 0) {
- $num = undef;
- }
-
- if (defined $num and ($num > $total or $num < 1)) {
- &::msg($::who, "error: choice in definition is out of range.");
- return;
- }
-
- # parse the results.
- if ($total > 1) {
- if (defined $num) {
- $retval = sprintf("[%d/%d] %s", $num, $total, $results[$num-1]);
- } else {
- # suggested by larne and others.
- my $prefix = "Dictionary '$query' ";
- $retval = &::formListReply(1, $prefix, @results);
- }
- } elsif ($total == 1) {
- $retval = "Dictionary '$query' ".$results[0];
- } else {
- $retval = "could not find definition for \002$query\002";
- }
+ if ($@) {
+
+ # failure.
+ $retval = "i could not get info from $server '$@'";
+ }
+ else { # success.
+ $socket->autoflush(1); # required.
+
+ my $num;
+ if ( $query =~ s/^(\d+)\s+// ) {
+ $num = $1;
+ }
+ my $dict = '*';
+ if ( $query =~ s/\/(\S+)$// ) {
+ $dict = $1;
+ }
+
+ # body.
+ 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 ) {
+ $num = undef;
+ }
+
+ if ( defined $num and ( $num > $total or $num < 1 ) ) {
+ &::msg( $::who, "error: choice in definition is out of range." );
+ return;
+ }
+
+ # parse the results.
+ if ( $total > 1 ) {
+ if ( defined $num ) {
+ $retval =
+ sprintf( "[%d/%d] %s", $num, $total, $results[ $num - 1 ] );
+ }
+ else {
+
+ # suggested by larne and others.
+ my $prefix = "Dictionary '$query' ";
+ $retval = &::formListReply( 1, $prefix, @results );
+ }
+ }
+ elsif ( $total == 1 ) {
+ $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.
- 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 (/^\s+(.*)/) {
- s/^\s{2,}/ /;
- $def .= $_;
- $def =~ s/\[.*?\]$//g;
- }
+ chop; # remove \n
+ chop; # remove \r
+
+ &::DEBUG("$term/$dict '$_'");
+ if (/^552 /) {
+
+ # no match.
+ return;
+ }
+ 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'");
+ }
+ }
+ }
}
- &::status("Dict: wordnet: found ". scalar(@results) ." defs.");
+ &::DEBUG( "Dict: $dict: 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.");
-
- return if (!scalar @results);
- pop @results; # last def is date of entry.
+ return if ( !scalar @results );
return @results;
}
1;
+
+# vim:ts=4:sw=4:expandtab:tw=80
projects / infobot.git / blobdiff