* support more dictionaries [dpkg specific]

git-svn-id: https://svn.code.sf.net/p/infobot/code/branches/don/dpkg@1281 c11ca15a-4712-0410-83d8-924469b57eb5

diff --git a/src/Modules/Dict.pl b/src/Modules/Dict.pl
index 05b3d0fad29c399b09b0708801a300c59b21d649..288b06ebf34e475005c41d87ca7924a26c3dfe95 100644 (file)
--- a/src/Modules/Dict.pl
+++ b/src/Modules/Dict.pl
@@ -53,25 +53,16 @@ sub Dict {
        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'));
+       push(@results, &Dict_Wordnet($socket,$query));
+       push(@results, &Dict_Foldoc($socket,$query));
+       push(@results, &Dict_web1913($socket,$query));
        # end.
 
        print $socket "QUIT\n";
        close $socket;
 
-       my $count=0;
-       foreach (@results) {
-           $count++;
-           &::DEBUG("$count: $_");
-       }
        my $total = scalar @results;
 
        if ($total == 0) {
@@ -96,87 +87,136 @@ sub Dict {
            $retval = "Dictionary '$query' ".$results[0];
        } else {
            $retval = "could not find definition for \002$query\002";
-           $retval .= " in $dict" if ($dict ne '*');
        }
     }
 
     &::performStrictReply($retval);
 }
 
-sub Define {
-    my ($socket, $query, $dict) = @_;
+sub Dict_Wordnet {
+    my ($socket, $query) = @_;
     my @results;
 
-    &::DEBUG("Dict: asking $dict.");
-    print $socket "DEFINE $dict \"$query\"\n";
+    &::status("Dict: asking Wordnet.");
+    print $socket "DEFINE wn \"$query\"\n";
 
-    my $def = "";
-    my $term = $query;
+    my $def            = "";
+    my $wordtype       = "";
 
     while (<$socket>) {
        chop;   # remove \n
        chop;   # remove \r
 
-       &::DEBUG("$term/$dict '$_'");
-       if (/^552 /) {
-           # no match.
-           return;
-       } elsif (/^250 /) {
-            # end w/ optional stats
+       &::DEBUG("got '$_'");
+       if ($_ eq ".") {                                # end of def.
+           push(@results, $def);
+       } elsif (/^250 /) {                             # 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 (/^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;
        }
     }
 
-    &::DEBUG("Dict: $dict: found ". scalar(@results) ." defs.");
+    &::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>) {
+       chomp;  # remove \r\n
+
+       &::DEBUG("got '$_'");
+       return if /^552 /;              # no match.
+
+       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 @results;
+}
+
+sub Dict_web1913 {
+    my ($socket,$query) = @_;
+    my @results;
+
+    &::status("Dict: asking web1913.");
+    print $socket "DEFINE web1913 \"$query\"\n";
+
+    my $string;
+    while (<$socket>) {
+       chop;   # remove \n
+       chop;   # remove \r
+
+       return if /^552/;               # no match.
+
+       last if (/^250/);       # stats; end of def.
+       next if (/^151/ or /^150/);       # definition and/or retrieval
+
+       s/^\s+|\s+$//g;                 # each line.
+
+       if ($_ eq "" or $_ =~ /^\.$/) {                 # sub def separator.
+           $string =~ s/^\s+|\s+$//g;  # sub def.
+           $string =~ s/[{}]//g;
+
+           next if ($string eq "");
+
+           push(@results, $string);
+           $string = "";
+       }
+
+       $string .= $_." ";
+    }
+
+    &::status("Dict: web1913: found ". scalar(@results) ." defs.");
 
     return if (!scalar @results);
+    pop @results;      # last def is date of entry.
 
     return @results;
 }