Net-Dict-2.19/000755 000765 000024 00000000000 12444145641 013315 5ustar00neilbstaff000000 000000 Net-Dict-2.19/Changes000644 000765 000024 00000017366 12444145417 014626 0ustar00neilbstaff000000 000000 Revision history for Perl module Net::Dict 2.19 2014-12-17 - Fixed failing tests - caused by updated dictionaries on dict.org - Added a TODO.md file with the things I want to get around to doing. 2.18 2014-06-26 - Some of the dict.org databases have been updated, needing updates to databases. Reported by RJBS. - Converted tests to use eq_or_diff() from Test::Differences, also suggested by RJBS. 2.17 2014-04-25 - Converted all remaining tests to use Test::More - Tidied up SEE ALSO, including fixing of broken links - Tidied up code snippets in the doc - Reformatted code according to my current conventions, and got rid of a few rogue tab characters 2.16 2014-04-20 - Test server config in Net::Dict::TestConfig in t/lib. We no longer prompt for test config -- it hasn't changed in years. - Refactored t/connection.t to use Test::More 2.15 2014-04-04 - tkdict script had a very site-specific #! path. Changed to use env. RT#92184 2.14 2014-03-28 - We weren't correctly handling dictionary db names containing a '-'. Fix from RJBS. 2.13 2013-12-23 - Added "use warnings" to Net::Dict - Specified min perl version as 5.006 in Makefile.PL 2.12 2013-11-18 - Corrected the dependency I meant to add in the previous release. I added a dependency on Net::Dict (ie itself) instead. 2.11 2013-11-15 - Added missing dependency (AppConfig::Std) to Makefile.PL 2.10 2013-07-20 - Reformatted this file according to CPAN::Changes::Spec - Repository details added to metadata (Makefile.PL) and pod - License type added to metadata (Makefile.PL) 2.09 2011-12-18 - Fixed tests that started breaking due to changes in the dict.org server - Renamed ChangeLog to Changes & tweaked formatting to CPAN::Changes::Spec 2.08 2011-08-02 - updated testsuite to refer to dict.org, as test.dict.org no longer exists - updated testsuite to reflect the much longer list of databases now hosted on dict.org 2.07 2003-05-06 - updated testsuite to refer to test.dict.org, and to reflect changes in the databases. 2.06 2002-03-23 - imported into my home machine's CVS repository - updated email address 2.05 2001-04-25 - moved the inline documentation to a separate file Dict.pod - added examples/portuguese.pl which illustrates accessing an english-portuguese dictionary. Example from Jose Joao Dias de Almeida . 2.04 2001-04-23 - tidied up the code for auth(), removing debugging statements, etc. - added documentation for the auth() method. - renamed auth.t to auth.test - don't want this run as part of "make test": it needs my local config for testing. Do something about that later. 2.03 2001-04-23 - Added code which parses the welcome banner, to get msg id and optional capabilities. - Added capabilities() method which returns a list of supported optional capabilities. - Added has_capability() method for checking whether a capability is supported by the server. - msg_id() method which returns the msg id from the server. This is used in the auth() method. - Added auth() method, which uses Digest::MD5. - Created a testsuite for auth - auth.t 2.02 2001-04-03 - Oops - forgot to add documentation for the status() method. 2.01 2001-04-03 - Added status() method to Net::Dict - returns the string returned by the DICT server when STATUS command is sent. Couple of test cases in t/connection.t - When using the sample dict client, if no definition was found, then it will use Levenshtein or Soundex matching to look for close words. If the server doesn't support either strategy, then it just gives a basic error message. - Updated the testsuite - new databases on dict.org meant that certain tests failed (eg where the date is included in the title of a database). 2.00 2001-04-01 - up'd the major version number - this will be the first public release version since changing the API for the constructor. - updated dict and tkdict to use the new method name - Various documentation updates, including: - adding more to the descriptive section of the documentation. - reformatting the METHODS section - strats() method renamed to strategies(). The old name is retained for backwards compatibility. - Put a hack in the match.t test to supress unwanted output from _print_isa function in Net::Cmd. - Removed the dependence on Net::Config from Makefile.PL 1.09 2001-03-26 - Send the CLIENT command to identify us before any other command is sent. - Don't need to "use Net::Config" now - dbTitle() checks whether the given DB name is valid. If it isn't, and debug is set to non-zero, then we now carp. - Fixed a bug in define() - couldn't handle multi-word entries, eg: $dict->define("oboe d'amore"); didn't work as it should. The private _DEFINE method now quotes all arguments before passing them on, since having everything quoted is ok by RFC 2229. - Fixed the same bug in match() method. - Finished first pass at testsuite for define() method. 1.08 2001-03-22 - first version of testsuite - not the full set, but enough to get a few people to test and find out if it's sensible. - Makefile.PL updated to get hostname and port for test server, it builds a config file in t/ - dbInfo now returns a string rather than an array of lines. This means it now matches the documentation! - dbTitle() returns undef if you request a title of a non-existent database. - Now checks for legality of arg names passed to constructor - constructor requires hostname as first argument - don't look for default list of hosts to try from Net::Config - updated checking of arguments to constructor and error messages - changed all self variables from $obj to $self - improved wording of error messages when checking method arg lists - private method _CLIENT now takes arg, rather than hard-coding reference to package variable $CLIENT_INFO - Removed references in to the doc to ConfigFile and HTML arguments - they weren't actually supported - now mention this in the LIMITATIONS section - Put an example of use of constructor with all arguments in the doc 1.07 2001-03-04 - Updated the one-line description in the NAME pod section. Previous one was a bit terse - that's what shows up on search.cpan.org, and similar places. 1.06 2001-03-04 - created tkdict, first cut at a Perl/Tk DICT client. The interface is currently very DICT protocol centric. - added dbTitle() method, which is used to query the title string for a specific database. - the description strings returned by dbs() and strats() were quoted with double strings (if that's what the server returned). Similarly every word returned by match() was quoted. Now the quotation marks are removed. 1.05 2001-03-01 - added "dict", a sample client script - strats() method was including a newline in the description of each strategy, unlike dbs(), which chomp()s the description. strats() now chomps as well! - added Client option to Net::Dict, for CLIENT identifier string - added AUTHOR and ABSTRACT_FROM keys to Makefile.PL 1.04 2001-02-22 - First version under maintenance of Neil Bowers - Added Makefile.PL, README, MANIFEST. - Added examples/simple.pl, based on example submitted by Jose Joao Dias de Almeida - Modified in constructor for default port number, also from Jose. - previous versions released by Dmitry Rubinstein Net-Dict-2.19/dict000755 000765 000024 00000032604 12317565033 014173 0ustar00neilbstaff000000 000000 #!/usr/bin/env perl # # dict - perl DICT client (for accessing network dictionary servers) # # $Id: dict,v 1.2 2003/05/05 23:55:00 neilb Exp $ # use strict; use warnings; use Net::Dict; use AppConfig::Std; use vars qw($VERSION); $VERSION = sprintf("%d.%d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/); #----------------------------------------------------------------------- # Global variables #----------------------------------------------------------------------- my $PROGRAM; # The name we're running as, minus path my $config; # Config object (AppConfig::Std) my $dict; # Dictionary object (Net::Dict) initialise(); #----------------------------------------------------------------------- # Deal with any informational options #----------------------------------------------------------------------- print $dict->serverInfo(), "\n" if $config->serverinfo; show_db_info($config->info) if $config->info; list_databases() if $config->dbs; list_strategies() if $config->strats; $dict->setDicts($config->database) if $config->database; #----------------------------------------------------------------------- # Perform define or match, if a word or pattern was given #----------------------------------------------------------------------- if (@ARGV > 0) { if ($config->match) { match_word(shift @ARGV); } else { define_word(shift @ARGV); } } exit 0; #======================================================================= # # define_word() # # Look up definition(s) for the specified word. # #======================================================================= sub define_word { my $word = shift; my $eref; my $entry; my ($db, $def); $eref = $dict->define($word); if (@$eref == 0) { _no_definitions($word); } else { foreach $entry (@$eref) { ($db, $def) = @$entry; print "--- [from $db] ---\n", $def, "\n"; } } } #======================================================================= # # _no_definitions() # # Called when no definitions were found for the given word. # We use either 'lev' or 'soundex' matching to look for words # which are "close" to the given word, in-case they've mis-spelled # it, etc. # #======================================================================= sub _no_definitions { my $word = shift; my %strategies; my %words; my $strategy; %strategies = $dict->strategies; if (!exists($strategies{'lev'}) && !exists($strategies{'soundex'})) { print " no definition found for \"$word\"\n"; return; } $strategy = exists $strategies{'lev'} ? 'lev' : 'soundex'; foreach my $entry (@{ $dict->match($word, $strategy) }) { $words{$entry->[1]}++; } if (keys %words == 0) { print " no definition found for \"$word\", ", "and no similar words found\n"; } else { print " no definition found for \"$word\" - perhaps you meant:\n"; print " ", join(', ', keys %words), "\n"; } } #======================================================================= # # match_word() # # Look for matches of the given word, using the strategy specified # with the -strategy switch. # #======================================================================= sub match_word { my $word = shift; my $eref; my $entry; my ($db, $match); unless ($config->strategy) { die "you must specify -strategy when using -match\n"; } $eref = $dict->match($word, $config->strategy); if (@$eref == 0) { print " no matches for \"$word\"\n"; } else { foreach $entry (@$eref) { ($db, $match) = @$entry; print "$db : $match\n"; } } } #======================================================================= # # list_databases() # # Query and display the list of available databases on the selected # DICT server. # #======================================================================= sub list_databases { my %dbs = $dict->dbs(); tabulate_hash(\%dbs, 'Database', 'Description'); } #======================================================================= # # list_strategies() # # Query and display the list of matching strategies supported # by the DICT server. # #======================================================================= sub list_strategies { my %strats = $dict->strategies(); tabulate_hash(\%strats, 'Strategy', 'Description'); } #======================================================================= # # show_db_info() # # Query the server for information about the specified database, # and display the results. # # The information is typically several pages of text, # describing the contents of the dictionary, where it came from, # credits, etc. # #======================================================================= sub show_db_info { my $db = shift; my %dbs = $dict->dbs(); if (not exists $dbs{$config->info}) { print " dictionary \"$db\" not known\n"; return; } print $dict->dbInfo($config->info); } #======================================================================= # # initialise() # # check config file and command-line # #======================================================================= sub initialise { #------------------------------------------------------------------- # Initialise misc global variables #------------------------------------------------------------------- ($PROGRAM = $0) =~ s!.*/!!; #------------------------------------------------------------------- # Create AppConfig::Std, define parameters, and parse command-line #------------------------------------------------------------------- $config = AppConfig::Std->new({ CASE => 1 }) || die "failed to create AppConfig::Std: $!\n"; $config->define('host', { ARGCOUNT => 1, ALIAS => 'h' }); $config->define('port', { ARGCOUNT => 1, ALIAS => 'p', DEFAULT => 2628 }); $config->define('database', { ARGCOUNT => 1, ALIAS => 'd' }); $config->define('match', { ARGCOUNT => 0, ALIAS => 'm' }); $config->define('dbs', { ARGCOUNT => 0, ALIAS => 'D' }); $config->define('strategy', { ARGCOUNT => 1, ALIAS => 's' }); $config->define('strats', { ARGCOUNT => 0, ALIAS => 'S' }); $config->define('client', { ARGCOUNT => 1, ALIAS => 'c', DEFAULT => "$PROGRAM $VERSION ". "[using Net::Dict $Net::Dict::VERSION]", }); $config->define('info', { ARGCOUNT => 1, ALIAS => 'i' }); $config->define('serverinfo', { ARGCOUNT => 0, ALIAS => 'I' }); $config->define('verbose', { ARGCOUNT => 0 }); $config->args(\@ARGV) || die "run \"$PROGRAM -help\" to see valid options\n"; #------------------------------------------------------------------- # Consistency checking, ensure we have required options, etc. #------------------------------------------------------------------- $config->host('dict.org') unless $config->host; print $config->client, "\n" if $config->verbose || $config->debug; #------------------------------------------------------------------- # Create connection to DICT server #------------------------------------------------------------------- $dict = Net::Dict->new($config->host, Port => $config->port, Client => $config->client, Debug => $config->debug, ) || die "failed to create Net::Dict: $!\n"; } #======================================================================= # # tabulate_hash() # # format a hash as a simple ascii table, for displaying lists # of databases and strategies. # #======================================================================= sub tabulate_hash { my $hashref = shift; my $keytitle = shift; my $value_title = shift; my $width = length $keytitle; my ($key, $value); #------------------------------------------------------------------- # Find the length of the longest key, so we can right align # the column of keys #------------------------------------------------------------------- foreach $key (keys %$hashref) { $width = length($key) if length($key) > $width; } #------------------------------------------------------------------- # print out keys and values in a basic ascii formatted table view #------------------------------------------------------------------- printf(" %${width}s $value_title\n", $keytitle); print ' ', '-' x $width, ' ', '-' x (length $value_title), "\n"; while (($key, $value) = each %$hashref) { printf(" %${width}s : $value\n", $key); } print "\n"; } __END__ =head1 NAME dict - a perl client for accessing network dictionary servers =head1 SYNOPSIS B [OPTIONS] I =head1 DESCRIPTION B is a client for the Dictionary server protocol (DICT), which is used to query natural language dictionaries hosted on a remote machine. When used in the most simple way, % dict word B will look for definitions of I in the dictionaries hosted at B. If no definitions are found, then dict will look for words which are similar, and list them: % dict bonana no definition for "bonana" - perhaps you meant: banana, bonanza, Banana, Bonanza, Bonasa This feature is only available if the remote DICT server supports the I or I matching strategies. You can use the B<-stats> switch to find out for yourself. You can specify the hostname of the DICT server using the B<-h> option: % dict -h dict.org dictionary A DICT server can support a number of databases; you can use the B<-d> option to specify a particular database. For example, you can look up computer-related terms in the Free On-line Dictionary Of Computing (FOLDOC) using: % dict -h dict.org -d foldoc byte To find out what databases (dictionaries) are available on a server, use the B<-dbs> option: % dict -dbs There are many dictionaries hosted on other servers around the net; a list of some of them can be found at http://www.dict.org/links.html =head2 MATCHING Instead of requesting word definitions, you can use dict to request a list of words which match a pattern. For example, to look for four-letter words starting in 'b' and ending in 'p', you would use: % dict -match -strategy re '^b..p$' The B<-match> option says you want a list of matching words rather than a definition. The B<-strategy re> says to use POSIX regular expressions when matching the pattern B<^b..p$>. Most DICT servers support a number of matching strategies; you can get a list of the strategies provided by a server using the B<-strats> switch: % dict -h dict.org -strats =head1 OPTIONS =over 4 =item B<-h> I or B<-host> I The hostname for the DICT server. If one isn't specified then defaults to B. =item B<-p> I or B<-port> I Specify the port for connections (default is 2628, from RFC 2229). =item B<-d> I or B<-database> I The name of a specific database (dictionary) to query. =item B<-m> or B<-match> Look for words which match the pattern (using the specified strategy). =item B<-i> I or B<-info> I Request information on the specified database. Typically results in a couple of pages of text. =item B<-c> I or B<-client> I Specify the CLIENT identification string sent to the DICT server. =item B<-D> or B<-dbs> List the available databases (dictionaries) on the DICT server. =item B<-s> I or B<-strategy> I Specify a matching strategy. Used in combination with B<-match>. =item B<-S> or B<-strats> List the matching strategies (used in -strategy) supported by the DICT server. =item B<-I> or B<-serverinfo> Request information on the selected DICT server. =item B<-help> Display a short help message including command-line options. =item B<-doc> Display the full documentation for B. =item B<-version> Display the version of B =item B<-verbose> Display verbose information as B runs. =item B<-debug> Display debugging information as B runs. Useful mainly for developers. =back =head1 KNOWN BUGS AND LIMITATIONS =over 4 =item * B doesn't know how to handle firewalls. =item * The authentication aspects of RFC 2229 aren't currently supported. =item * Display of list results (eg from B<-strats> and B<-dbs>) could be better. =item * B isn't very smart at handling combinations of options. =item * Currently no support for a configuration file - will add one soon. =back =head1 SEE ALSO =over 4 =item www.dict.org The DICT home page, with all sorts of useful information. There are a number of other DICT clients available. =item dict The C dict client written by Rik Faith; the options are pretty much lifted from Rik's client. =item RFC 2229 The document which defines the DICT network protocol. http://www.cis.ohio-state.edu/htbin/rfc/rfc2229.html =item Net::Dict The perl module which implements the client API for RFC 2229. =back =head1 VERSION $Revision: 1.2 $ =head1 AUTHOR Neil Bowers =head1 COPYRIGHT Copyright (C) 2002 Neil Bowers. All rights reserved. This script is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Net-Dict-2.19/examples/000755 000765 000024 00000000000 12444145641 015133 5ustar00neilbstaff000000 000000 Net-Dict-2.19/lib/000755 000765 000024 00000000000 12444145641 014063 5ustar00neilbstaff000000 000000 Net-Dict-2.19/Makefile.PL000644 000765 000024 00000002326 12352650227 015271 0ustar00neilbstaff000000 000000 # # Makefile.PL for Net-Dict # # $Id: Makefile.PL,v 1.2 2003/05/05 23:56:17 neilb Exp $ # use ExtUtils::MakeMaker; my $mm_ver = $ExtUtils::MakeMaker::VERSION; if ($mm_ver =~ /_/) { # dev version $mm_ver = eval $mm_ver; die $@ if $@; } &WriteMakefile( NAME => 'Net::Dict', DISTNAME => 'Net-Dict', VERSION_FROM => 'lib/Net/Dict.pm', PREREQ_PM => { 'IO::Socket' => 0, 'Net::Cmd' => 0, 'Carp' => 0, 'AppConfig::Std' => 0, }, EXE_FILES => [qw(dict tkdict)], AUTHOR => 'Neil Bowers ', ABSTRACT_FROM => 'lib/Net/Dict.pod', META_MERGE => { resources => { repository => 'https://github.com/neilbowers/Net-Dict', }, no_index => { package => ['Net::Dict::TestConfig'], } }, LICENSE => 'perl', dist => {COMPRESS => 'gzip', SUFFIX => 'gz'}, ($mm_ver >= 6.48 ? (MIN_PERL_VERSION => 5.006) : () ), ($mm_ver >= 6.64 ? (TEST_REQUIRES => { 'Test::More' => 0.88, 'Test::Differences' => 0.62, }) : () ), ); Net-Dict-2.19/MANIFEST000644 000765 000024 00000000605 12444145641 014447 0ustar00neilbstaff000000 000000 README MANIFEST Makefile.PL Changes lib/Net/Dict.pm lib/Net/Dict.pod dict tkdict examples/simple.pl examples/portuguese.pl t/connection.t t/database.t t/define.t t/match.t t/auth.test t/lib/Net/Dict/TestConfig.pm TODO.md META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Net-Dict-2.19/META.json000644 000765 000024 00000002366 12444145641 014745 0ustar00neilbstaff000000 000000 { "abstract" : "client API for accessing dictionary servers (RFC 2229)", "author" : [ "Neil Bowers " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.02, CPAN::Meta::Converter version 2.143240", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-Dict", "no_index" : { "directory" : [ "t", "inc" ], "package" : [ "Net::Dict::TestConfig" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0", "Test::Differences" : "0.62", "Test::More" : "0.88" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "AppConfig::Std" : "0", "Carp" : "0", "IO::Socket" : "0", "Net::Cmd" : "0", "perl" : "5.006" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "https://github.com/neilbowers/Net-Dict" } }, "version" : "2.19" } Net-Dict-2.19/META.yml000644 000765 000024 00000001337 12444145641 014572 0ustar00neilbstaff000000 000000 --- abstract: 'client API for accessing dictionary servers (RFC 2229)' author: - 'Neil Bowers ' build_requires: ExtUtils::MakeMaker: '0' Test::Differences: '0.62' Test::More: '0.88' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.02, CPAN::Meta::Converter version 2.143240' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Net-Dict no_index: directory: - t - inc package: - Net::Dict::TestConfig requires: AppConfig::Std: '0' Carp: '0' IO::Socket: '0' Net::Cmd: '0' perl: '5.006' resources: repository: https://github.com/neilbowers/Net-Dict version: '2.19' Net-Dict-2.19/README000644 000765 000024 00000002607 12172613255 014201 0ustar00neilbstaff000000 000000 Net::Dict This distribution contains the Net::Dict module for Perl. Net::Dict is a class implementing a simple client API for the DICT protocol defined in RFC2229. To install this module, you should just have to run the following: % perl Makefile.PL % make % make test % make install When you run "perl Makefile.PL" you'll be asked for the hostname and port for the DICT server used when testing. If you're not going to run "make install", then just press return. You should be able to just press return on the two questions anyway. This module now supports the AUTH optional capability. To use this you will need the Digest::MD5 module, available from CPAN. The module is documented using pod. When you "make install", you will get a man-page Net::Dict. You can also generate HTML using pod2html: % pod2html lib/Net/Dict.pm Three sample clients are included in this distribution. Any additional modules required are noted, and available from CPAN. dict A basic command-line client, based on the C dict client by Rik Faith. Requires: AppConfig, AppConfig::Std tkdict A first cut at a Perl/Tk client. This is pretty rough; any suggestions or patches are welcome! Requires: AppConfig, AppConfig::Std, Tk, Tk::Dialog examples/simple.pl Illustrates basic use of Net::Dict. Net::Dict was written by Dmitry Rubinstein, but is now maintained by me. Neil Bowers Net-Dict-2.19/t/000755 000765 000024 00000000000 12444145641 013560 5ustar00neilbstaff000000 000000 Net-Dict-2.19/tkdict000755 000765 000024 00000052402 12317565105 014530 0ustar00neilbstaff000000 000000 #!/usr/bin/env perl # # tkdict - a Perl/Tk DICT client, for accessing network dictionary servers # # Neil Bowers # Copyright (C) 2001-2002, Neil Bowers # use strict; use warnings; use Tk; use Tk::Dialog; use Net::Dict; use AppConfig::Std; use vars qw($PROGRAM $VERSION); $VERSION = sprintf("%d.%d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/); my $warn_dialog; my $dict_server; my $word; my $text_window; my $bgcolor; my $mw; my $config; my $help; my ($info_top, $info_text, $info_title); my $ht; my %helpString; my $dict; my ($lookup_mode, $modeDisplay); my $mbDefine; my ($sframe, $strat_menu, $strategy, $strategyDisplay); my ($db_frame, $db_menu, $db, $dbDisplay); my $bar3; main(); exit 0; #======================================================================= # # main() # # This is the main body of tkdict # #======================================================================= sub main { initialise(); create_gui(); if ($config->host) { $dict_server = $config->host; select_server(); } $mw->protocol('WM_DELETE_WINDOW', \&tkdict_exit); MainLoop(); } #======================================================================= # # initialise() # # check config file and command-line # #======================================================================= sub initialise { #------------------------------------------------------------------- # Initialise misc global variables #------------------------------------------------------------------- $PROGRAM = "TkDict"; $lookup_mode = "define"; #------------------------------------------------------------------- # Create AppConfig::Std, define parameters, and parse command-line #------------------------------------------------------------------- $config = AppConfig::Std->new() || die "failed to create AppConfig::Std: $!\n"; $config->define('host', { ARGCOUNT => 1, ALIAS => 'h' }); $config->define('port', { ARGCOUNT => 1, ALIAS => 'p', DEFAULT => 2628 }); $config->define('client', { ARGCOUNT => 1, ALIAS => 'c', DEFAULT => "$PROGRAM $VERSION ". "[using Net::Dict $Net::Dict::VERSION]", }); $config->args(\@ARGV) || die "run \"$PROGRAM -help\" to see valid options\n"; #------------------------------------------------------------------- # Consistency checking, ensure we have required options, etc. #------------------------------------------------------------------- } #======================================================================= # # select_server() # # connect to the server, and get information needed to # configure the user interface. # #======================================================================= sub select_server { if (not defined $dict_server || $dict_server eq '') { configure_dict_gui(); return; } $word = ''; #------------------------------------------------------------------- # Create connection to DICT server #------------------------------------------------------------------- $dict = Net::Dict->new($dict_server, Port => $config->port, Client => $config->client, Debug => $config->debug, ); if (not defined $dict) { tkd_warn("Failed to connect to DICT server $dict_server"); configure_dict_gui(); return; } configure_dict_gui(); } #======================================================================= # # configure_dict_gui() # # Configure the relevant bits of the GUI according to # the current DICT connection. # #======================================================================= sub configure_dict_gui { my @dbs; my %dbhash; my @strats; my %shash; $text_window->delete('0.0', 'end'); if (not defined $dict) { $bar3->packForget(); $db_frame->packForget(); } else { $bar3->pack(-side => 'top', -fill => 'x'); %dbhash = $dict->dbs(); @dbs = map { [$dbhash{$_}, $_] } sort keys %dbhash; unshift(@dbs, ['search all databases', '*'], ['search all, stop after 1st match', '!']); $db_menu->configure(-options => \@dbs); %shash = $dict->strategies(); @strats = map { [$shash{$_}, $_] } sort keys %shash; $strat_menu->configure(-options => \@strats); $db_frame->pack(-side => 'left'); } } #======================================================================= # # create_gui() # # This procedure creates the widgets for the tkdict GUI # #======================================================================= sub create_gui { my $bar2; my $menu_bar; my $mbFile; my $mbView; my $mbHelp; my $server_entry; my $word_entry; $mw = MainWindow->new(-title => "$PROGRAM $VERSION"); $bgcolor = $mw->cget(-bg); #--------------------------------------------------------------------- # menu bar #--------------------------------------------------------------------- $menu_bar = $mw->Frame(-relief => 'raised', -bd => 2); $menu_bar->pack(-side => 'top', -fill => 'x'); #--------------------------------------------------------------------- # Menu: File # # Create the File menu and the entries on the menu #--------------------------------------------------------------------- $mbFile = $menu_bar->Menubutton( -text => 'File', -underline => 0, -tearoff => 0, -menuitems => [ '-', ['command' => 'Exit', -underline => 1, -command => \&tkdict_exit] ]); $mbFile->pack(-side => 'left'); #--------------------------------------------------------------------- # Menu: View # # Create the View menu and the entries on the menu #--------------------------------------------------------------------- $mbView = $menu_bar->Menubutton( -text => 'View', -underline => 0, -tearoff => 0, -menuitems => [ ['command' => 'Server Information', -command => [\&show_info, 'server']], ['command' => 'Database Information', -command => [\&show_info, 'db']], ]); $mbView->pack(-side => 'left'); #--------------------------------------------------------------------- # Menu: Help # # Create the Help menu and the entries on the menu #--------------------------------------------------------------------- $mbHelp = $menu_bar->Menubutton( -text => 'Help', -underline => 0, -tearoff => 0, -menuitems => [ ['command' => 'Overview', -command => [\&show_help, 'overview']], ['command' => 'ToDo List', -command => [\&show_help, 'todo']], '-', ['command' => 'About TkDict ...', -command => [\&show_help, 'about']], ]); $mbHelp->pack(-side => 'right'); #--------------------------------------------------------------------- # bar which has the entries for specifying server and select a dict #--------------------------------------------------------------------- $bar2 = $mw->Frame(-relief => 'raised', -bd => 2); $bar2->pack(-side => 'top', -fill => 'x'); $bar2->Label(-text => 'Server: ')->pack(-side => 'left'); $server_entry = $bar2->Entry(-relief => 'sunken', -textvariable => \$dict_server, -width => 16)->pack(-side => 'left', -fill => 'x'); $server_entry->bind('', \&select_server); $server_entry->bind('', sub { $server_entry->configure(-bg => 'white'); }); $server_entry->bind('', sub { $server_entry->configure(-bg => "$bgcolor"); }); $db_frame = $bar2->Frame(); $db_frame->Label(-text => 'Dictionary: ')->pack(-side => 'left'); $db_menu = $db_frame->Optionmenu(-variable => \$db, -textvariable => \$dbDisplay, -options => [], )->pack(-side => 'left'); #------------------------------------------------------------------- # Bar which has the entry for entering the word to be defined #------------------------------------------------------------------- $bar3 = $mw->Frame(-relief => 'raised', -bd => 2); $bar3->pack(-side => 'top', -fill => 'x'); # $bar3->Label(-text => 'Define word:')->pack(-side => 'left'); $mbDefine = $bar3->Optionmenu( -textvariable => \$modeDisplay, -variable => \$lookup_mode, -command => \&set_mode, -options => [ ['Define word', 'define'], ['Match pattern', 'match'], ], ); $mbDefine->pack(-side => 'left'); $word_entry = $bar3->Entry(-relief => 'sunken', -textvariable => \$word, -width => 16)->pack(-side => 'left'); $word_entry->bind('', \&lookup_word); $word_entry->bind('', sub { $word_entry->configure(-bg => 'white'); }); $word_entry->bind('', sub { $word_entry->configure(-bg => "$bgcolor"); }); $sframe = $bar3->Frame(); $sframe->Label(-text => 'Strategy')->pack(-side => 'left'); $strat_menu = $sframe->Optionmenu(-variable => \$strategy, -textvariable => \$strategyDisplay, -options => [], )->pack(-side => 'left'); $sframe->pack(-side => 'left'); $bar3->packForget(); #------------------------------------------------------------------- # Bar which has the entry for entering the word to be defined #------------------------------------------------------------------- $text_window = $mw->Scrolled('Text', -bg => 'white', -fg => 'black', -width => 72, -height => 16, -scrollbars => 'osoe'); $text_window->pack(-side => 'bottom', -fill => 'both', -expand => 1); #-- accelerators --------------------------------------------- $mw->bind('', \&tkdict_exit); set_mode(); $mw->update; } #======================================================================= # # set_mode() # # Configure the GUI according to the lookup mode selected. # If 'match', then show the menu for selecting the match strategy. # If 'define', then hide the strategy selection menu. # #======================================================================= sub set_mode { if ($lookup_mode eq 'match') { $sframe->pack(); } else { $sframe->packForget(); } } #======================================================================= # # lookup_word() # # Look up the word entered by the user. # This will either be a match or a define operation. # #======================================================================= sub lookup_word { my $string = ''; my $eref; if (!defined($word) || length($word) == 0) { tkd_warn("You need to type something first!"); return; } #------------------------------------------------------------------- # clear out any help text which might be displayed #------------------------------------------------------------------- $text_window->delete('0.0', 'end'); if ($lookup_mode eq 'define') { #--------------------------------------------------------------- # Word definitions requested. We get back a list ref: # [ [db,definition], [db,definition], ... ] #--------------------------------------------------------------- $eref = $dict->define($word, $db); if (@$eref == 0) { $string = "no definition found for \"$word\"\n"; } else { foreach my $entry (@$eref) { $string .= "--- ".$dict->dbTitle($entry->[0])." ---\n"; $string .= $entry->[1]."\n\n"; } } } else { #--------------------------------------------------------------- # List of matching words requested. #--------------------------------------------------------------- my %dbwords; my ($dbname, $match); $eref = $dict->match($word, $strategy); if (@$eref == 0) { $string = "no words matched :-(\n"; } else { foreach my $entry (@$eref) { ($dbname, $match) = @$entry; $dbwords{$dbname} = [] if not exists $dbwords{$dbname}; push(@{ $dbwords{$dbname }}, $match); } foreach $dbname (sort keys %dbwords) { my @words; $string .= $dict->dbTitle($dbname).":\n"; $string .= join(', ', @{ $dbwords{$dbname}}); $string .= "\n\n"; } } } #------------------------------------------------------------------- # display the resulting string in the scrolling text window #------------------------------------------------------------------- $text_window->insert('end', $string); } #======================================================================= # # tkdict_exit() # # quit from TkDict. In the future there might be # more to do here, hence the function. # #======================================================================= sub tkdict_exit { exit 0; } #======================================================================= # # show_info() # # Display information which is retrieved from the server. # An argument is passed to identify which piece of info: # # server: information about the server # db : information about the selected DB (dictionary) # #======================================================================= sub show_info { my $topic = shift; if ($topic eq 'server' && !$dict_server) { tkd_warn("You have to connect to a server first!"); return; } if ($topic eq 'db' && (!$db || $db eq '*' || $db eq '!')) { tkd_warn("You must select a specific database first"); return; } if (not Exists($info_top)) { $info_top = $mw->Toplevel(-class => 'TkDictInfo'); $info_top->title("$PROGRAM Info"); $info_title = $info_top->Label(); $info_title->pack(-side => 'top', -fill => 'x'); $info_text = $info_top->Scrolled('Text', -bg => 'white', -fg => 'black', -width => 60, -height => 12, -scrollbars => 'osoe', )->pack(-side => 'top', -fill => 'both', -expand => 1); $info_top->Button(-text => "Close", -command => sub {$info_top->withdraw})->pack(-side => 'bottom'); } else { $info_top->deiconify(); $info_top->raise(); } $info_text->delete('0.0', 'end'); if ($topic eq 'server') { $info_title->configure(-text => "Server: $dict_server"); $info_text->insert('end', $dict->serverInfo()); } else { $info_title->configure(-text => "Database: ".$dict->dbTitle($db)); foreach my $line ($dict->dbInfo($db)) { $info_text->insert('end', $line); } } } #======================================================================= # show_help() - display a selected help message # $topic - the identifier for the topic to display # # This procedure is used to display a help message. An identifying # string is passed in, which is used to index the associative array # holding the help text. #======================================================================= sub show_help { my $topic = shift; #-- create the help display toplevel, if needed -------------- if (not Exists($help)) { $help = $mw->Toplevel(-class => 'TkDictHelp'); $help->title("$PROGRAM Help"); $ht = $help->Scrolled('Text', -bg => 'white', -fg => 'black', -width => 60, -height => 12, -scrollbars => 'osoe', )->pack(-side => 'top', -fill => 'both', -expand => 1); $help->Button(-text => "Close", -command => sub {$help->withdraw})->pack(-side => 'bottom'); initialise_help(); } else { $help->deiconify(); $help->raise(); } #-- clear out any help text which might be displayed --------- $ht->delete('0.0', 'end'); #-- insert the selected help message in text widget ---------- $ht->insert('end', $helpString{$topic}); } #======================================================================= # # tkd_warn() # # Display a warning message in a dialog, then wait for the # user to acknowledge it. # #======================================================================= sub tkd_warn { my $message = shift; my $choice; if (not Exists($warn_dialog)) { $warn_dialog = $mw->Dialog( -title => "Warning", -text => $message, -bitmap => 'warning', -default_button => "OK", ); } else { $warn_dialog->configure(-text => $message); } $choice = $warn_dialog->Show(-global); } #======================================================================= # initialise_help() - initialize the help strings # # This procedure initializes the global array helpString, which holds # the text for the different help messages. The array is indexed by # single word identifiers. #======================================================================= sub initialise_help { $helpString{about} = < Copyright (C) 2001-2002, Neil Bowers EOFABOUT $helpString{overview} = <dbs(); if (not exists $dbs{$config->info}) { print " dictionary \"$db\" not known\n"; return; } print $dict->dbInfo($config->info); } __END__ =head1 NAME tkdict - a perl client for accessing network dictionary servers =head1 SYNOPSIS tkdict [OPTIONS] =head1 DESCRIPTION B is a Perl/Tk client for the Dictionary server protocol (DICT), which is used to query natural dictionaries hosted on a remote machine. At the moment it's not very user oriented, since I've just been creating an interface to the protocol. There is more information available in the B menu when running B. =head1 OPTIONS =over 4 =item B<-h> I or B<-host> I The hostname for the DICT server. =item B<-p> I or B<-port> I Specify the port for connections (default is 2628, from RFC 2229). =item B<-c> I or B<-client> I Specify the CLIENT identification string sent to the DICT server. =item B<-help> Display a short help message including command-line options. =item B<-doc> Display the full documentation for B. =item B<-version> Display the version of B =item B<-verbose> Display verbose information as B runs. =item B<-debug> Display debugging information as B runs. Useful mainly for developers. =back =head1 KNOWN BUGS AND LIMITATIONS =over 4 =item * B doesn't know how to handle firewalls. =item * The authentication aspects of RFC 2229 aren't currently supported. =item * See the B page under the B menu. =back =head1 SEE ALSO =over 4 =item www.dict.org The DICT home page, with all sorts of useful information. There are a number of other DICT clients available. =item dict The C dict client written by Rik Faith; the options are pretty much lifted from Rik's client. =item RFC 2229 The document which defines the DICT network protocol. http://www.cis.ohio-state.edu/htbin/rfc/rfc2229.html =item Net::Dict The perl module which implements the client API for RFC 2229. It includes a command-line perl client, B, as well as B. =back =head1 VERSION $Revision: 1.1.1.1 $ =head1 AUTHOR Neil Bowers =head1 COPYRIGHT Copyright (C) 2001-2002 Neil Bowers. All rights reserved. This script is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Net-Dict-2.19/TODO.md000644 000765 000024 00000000356 12442543604 014407 0ustar00neilbstaff000000 000000 * Move all live dict.org tests to xt/release * Come up with some sensible tests for t/ that don't require a remote DICT server * Full test coverage * Change t/define.t to use Test::Differences * Better OO design * Switch to Dist::Zilla Net-Dict-2.19/t/auth.test000644 000765 000024 00000011624 12172612121 015414 0ustar00neilbstaff000000 000000 #!./perl # # auth.test - Net::Dict testsuite for auth method # # this is not called auth.t because we don't want # it run automatically when you run "make test". # This testsuite requires a server configured # correctly - ie like my test server here, which # isn't publicly accessible. # use Net::Dict; $^W = 1; my $HOST = 'dalek'; my $PORT = 2628; my $WARNING; my %TESTDATA; my $section; my $string; my $dbinfo; print "1..9\n"; $SIG{__WARN__} = sub { $WARNING = join('', @_); }; #----------------------------------------------------------------------- # Build the hash of test data from after the __DATA__ symbol # at the end of this file #----------------------------------------------------------------------- while () { if (/^==== END ====$/) { $section = undef; next; } if (/^==== (\S+) ====$/) { $section = $1; $TESTDATA{$section} = ''; next; } next unless defined $section; $TESTDATA{$section} .= $_; } #----------------------------------------------------------------------- # Make sure we have HOST and PORT specified #----------------------------------------------------------------------- if (defined($HOST) && defined($PORT)) { print "ok 1\n"; } else { print "not ok 1\n"; } #----------------------------------------------------------------------- # connect to server #----------------------------------------------------------------------- eval { $dict = Net::Dict->new($HOST, Port => $PORT); }; if (!$@ && defined $dict) { print "ok 2\n"; } else { print "not ok 2\n"; } #----------------------------------------------------------------------- # call dbs() with an argument - it doesn't take any, and should die #----------------------------------------------------------------------- eval { %dbhash = $dict->dbs('foo'); }; if ($@ && $@ =~ /takes no arguments/) { print "ok 3\n"; } else { print "not ok 3\n"; } #----------------------------------------------------------------------- # METHOD: dbs # get a list of database, render into a string, match to expected #----------------------------------------------------------------------- $string = ''; eval { %dbhash = $dict->dbs(); }; if (!$@ && defined %dbhash && do { foreach my $db (sort keys %dbhash) { $string .= "${db}:$dbhash{$db}\n"; }; 1; } && $string eq $TESTDATA{dblist}) { print "ok 4\n"; } else { print "not ok 4\n"; } #----------------------------------------------------------------------- # METHOD: auth # call with no arguments - should croak() #----------------------------------------------------------------------- if ($dict->can('auth') && do { eval { $dict->auth(); }; 1;} && $@ && $@ =~ /takes two arguments/ ) { print "ok 5\n"; } else { print "not ok 5\n"; } #----------------------------------------------------------------------- # METHOD: auth # call with only one argument - should croak() #----------------------------------------------------------------------- if ($dict->can('auth') && do { eval { $dict->auth('testuser'); }; 1;} && $@ && $@ =~ /takes two arguments/ ) { print "ok 6\n"; } else { print "not ok 6\n"; } #----------------------------------------------------------------------- # METHOD: auth # call with three arguments - should croak() #----------------------------------------------------------------------- $string = ''; if ($dict->can('auth') && do { eval { $dict->auth('testuser', 'open sesame', 'foobar'); }; 1;} && $@ && $@ =~ /takes two arguments/ ) { print "ok 7\n"; } else { print "not ok 7\n"; } #----------------------------------------------------------------------- # METHOD: auth # call with two valid arguments - should work ok #----------------------------------------------------------------------- $string = ''; if ($dict->can('auth') && do { eval { $dict->auth('testuser', 'open sesame'); }; 1;} && !$@ ) { print "ok 8\n"; } else { print "not ok 8\n"; } #----------------------------------------------------------------------- # METHOD: dbs # get a list of database, render into a string, match to expected #----------------------------------------------------------------------- $string = ''; eval { %dbhash = $dict->dbs(); }; if (!$@ && defined %dbhash && do { foreach my $db (sort keys %dbhash) { $string .= "${db}:$dbhash{$db}\n"; }; 1; } && $string eq $TESTDATA{'auth-dblist'}) { print "ok 9\n"; } else { print STDERR "AUTH test 9\n", "expected \"", $TESTDATA{'auth-dblist'}, "\", got\n\"$string\"\n"; print "not ok 9\n"; } exit 0; __DATA__ ==== dblist ==== elements:Elements database 20001107 foldoc:The Free On-line Dictionary of Computing (13 Mar 01) jargon:Jargon File (4.2.3, 23 NOV 2000) ==== auth-dblist ==== devils:THE DEVIL'S DICTIONARY ((C)1911 Released April 15 1993) elements:Elements database 20001107 foldoc:The Free On-line Dictionary of Computing (13 Mar 01) jargon:Jargon File (4.2.3, 23 NOV 2000) ==== END ==== Net-Dict-2.19/t/connection.t000644 000765 000024 00000031064 12444145271 016107 0ustar00neilbstaff000000 000000 #!./perl # # use Net::Dict; use strict; $^W = 1; use Test::More 0.88 tests => 17; use Test::Differences qw/ eq_or_diff /; use lib 't/lib'; use Net::Dict::TestConfig qw/ $TEST_HOST $TEST_PORT /; my $WARNING; my %TESTDATA; my $section; my @caps; my $description; my $dict; my $string; $SIG{__WARN__} = sub { $WARNING = join('', @_); }; #----------------------------------------------------------------------- # Build the hash of test data from after the __DATA__ symbol # at the end of this file #----------------------------------------------------------------------- while () { if (/^==== END ====$/) { $section = undef; next; } if (/^==== (\S+) ====$/) { $section = $1; $TESTDATA{$section} = ''; next; } next unless defined $section; $TESTDATA{$section} .= $_; } #----------------------------------------------------------------------- # Make sure we have HOST and PORT specified #----------------------------------------------------------------------- ok(defined($TEST_HOST) && defined($TEST_PORT), "have a HOST and PORT defined"); #----------------------------------------------------------------------- # constructor with no arguments - should result in a die() #----------------------------------------------------------------------- eval { $dict = Net::Dict->new(); }; ok((not defined $dict) && $@ =~ /takes at least a HOST/, "Not passing a DICT server name should croak"); #----------------------------------------------------------------------- # pass a hostname of 'undef' we should get undef back #----------------------------------------------------------------------- eval { $dict = Net::Dict->new(undef); }; ok((not defined($dict)), "passing undef for hostname should fail"); #----------------------------------------------------------------------- # pass a hostname of empty string, should get undef back #----------------------------------------------------------------------- eval { $dict = Net::Dict->new(''); }; ok(!$@ && !defined($dict), "Passing an empty hostname should result in undef"); #----------------------------------------------------------------------- # Ok hostname given, but unknown argument passed. # => return undef # => doesn't die #----------------------------------------------------------------------- eval { $dict = Net::Dict->new($TEST_HOST, Foo => 'Bar'); }; ok($@ && !defined($dict) && $@ =~ /unknown argument/, "passing an unknown argument to constructor should croak"); #----------------------------------------------------------------------- # Ok hostname given, odd number of following arguments passed # => return undef # => doesn't die #----------------------------------------------------------------------- eval { $dict = Net::Dict->new($TEST_HOST, 'Foo'); }; ok($@ =~ /odd number of arguments/, "Odd number of arguments after hostname should croak"); #----------------------------------------------------------------------- # Valid hostname and port - should succeed #----------------------------------------------------------------------- $WARNING = undef; eval { $dict = Net::Dict->new($TEST_HOST, Port => $TEST_PORT); }; ok(!$@ && defined $dict && !defined $WARNING, "valid hostname and port to constructor should return object"); #----------------------------------------------------------------------- # Check the serverinfo string. # We compare this with what we expect to get from dict.org # We strip off the first two lines, because they have time-varying # information; but we make sure they're the lines we think they are. #----------------------------------------------------------------------- $description = "check serverinfo string"; my $serverinfo = $dict->serverInfo(); if (exists $TESTDATA{serverinfo} && defined($serverinfo) && do { $serverinfo =~ s/^dictd.*?\n//s} && do { $serverinfo =~ s/^On pan\.alephnull\.com.*?[\n\r]+//s} ) { eq_or_diff($serverinfo, $TESTDATA{serverinfo}, $description); } else { fail($description); } #----------------------------------------------------------------------- # METHOD: status # call with an argument - should die since it takes no args. #----------------------------------------------------------------------- eval { $string = $dict->status('foo'); }; ok ($@ && $@ =~ /takes no arguments/, "status() with an argument should croak"); #----------------------------------------------------------------------- # METHOD: status # call with no args, and check that the general format of the string # is what we expect #----------------------------------------------------------------------- eval { $string = $dict->status(); }; ok(!$@ && defined $string && $string =~ m!^status \[d/m/c.*\]$!, "status() with no args should result in a particular format string"); #----------------------------------------------------------------------- # METHOD: capabilities # call with an arg - doesn't take any, and should die #----------------------------------------------------------------------- eval { @caps = $dict->capabilities('foo'); }; ok($@ && $@ =~ /takes no arguments/, "passing an argument when getting capabilities should croak"); #----------------------------------------------------------------------- # METHOD: capabilities #----------------------------------------------------------------------- $description = "capabilities() should return a lit of them"; if ($dict->can('capabilities') && eval { @caps = $dict->capabilities(); } && !$@ && @caps > 0 && do { $string = join(':', sort(@caps)); 1;} ) { eq_or_diff($string."\n", $TESTDATA{'capabilities'}, $description); } else { fail($description); } #----------------------------------------------------------------------- # METHOD: has_capability # no argument passed #----------------------------------------------------------------------- ok($dict->can('has_capability') && do { eval { $dict->has_capability(); }; 1;} && $@ && $@ =~ /takes one argument/, "no argument passed to has_capability() should croak"); #----------------------------------------------------------------------- # METHOD: has_capability # pass two capability names - should also die() #----------------------------------------------------------------------- ok($dict->can('has_capability') && do { eval { $dict->has_capability('mime', 'auth'); }; 1; } && $@ && $@ =~ /takes one argument/, "passing to arguments to has_capability() should croak"); #----------------------------------------------------------------------- # METHOD: has_capability #----------------------------------------------------------------------- ok($dict->can('has_capability') && $dict->has_capability('mime') && $dict->has_capability('auth') && !$dict->has_capability('foobar'), "check valid use of has_capability()"); #----------------------------------------------------------------------- # METHOD: msg_id # with an argument - should cause it to die() #----------------------------------------------------------------------- ok($dict->can('msg_id') && do { eval { $string = $dict->msg_id('dict.org'); }; 1;} && $@ && $@ =~ /takes no arguments/, "Passing an argument to msg_id() should croak"); #----------------------------------------------------------------------- # METHOD: msg_id # with no arguments, should get valid id back, of the form <...> #----------------------------------------------------------------------- ok($dict->can('msg_id') && do { eval { $string = $dict->msg_id(); }; 1;} && !$@ && defined($string) && $string =~ /^<[^<>]+>$/, "calling msg_id() with no arguments should return id of form <...>"); exit 0; __DATA__ ==== serverinfo ==== Database Headwords Index Data Uncompressed gcide 203645 3859 kB 12 MB 38 MB wn 147311 3002 kB 9247 kB 29 MB moby-thesaurus 30263 528 kB 10 MB 28 MB elements 142 2 kB 17 kB 53 kB vera 11877 135 kB 222 kB 735 kB jargon 2314 40 kB 577 kB 1432 kB foldoc 15031 298 kB 2198 kB 5379 kB easton 3968 64 kB 1077 kB 2648 kB hitchcock 2619 34 kB 33 kB 85 kB bouvier 6797 128 kB 2338 kB 6185 kB devil 1008 15 kB 161 kB 374 kB world02 280 5 kB 1543 kB 7172 kB gaz2k-counties 12875 269 kB 280 kB 1502 kB gaz2k-places 51361 1006 kB 1711 kB 13 MB gaz2k-zips 33249 454 kB 2122 kB 15 MB --exit-- 0 0 kB 0 kB 0 kB fd-tur-eng 1032 14 kB 11 kB 24 kB fd-por-deu 8300 124 kB 110 kB 276 kB fd-nld-eng 22753 378 kB 366 kB 991 kB fd-eng-ara 87430 1404 kB 721 kB 2489 kB fd-spa-eng 4508 67 kB 77 kB 190 kB fd-eng-hun 89685 1907 kB 2158 kB 5876 kB fd-ita-eng 3435 48 kB 37 kB 92 kB fd-wel-eng 734 9 kB 7 kB 17 kB fd-eng-nld 7720 119 kB 168 kB 446 kB fd-fra-eng 8511 131 kB 138 kB 385 kB fd-tur-deu 947 13 kB 11 kB 24 kB fd-swe-eng 5226 71 kB 52 kB 128 kB fd-nld-fra 16776 270 kB 249 kB 672 kB fd-eng-swa 1458 18 kB 11 kB 37 kB fd-deu-nld 12818 200 kB 192 kB 524 kB fd-fra-deu 6120 90 kB 108 kB 275 kB fd-eng-cro 59211 1220 kB 971 kB 2706 kB fd-eng-ita 4525 59 kB 40 kB 108 kB fd-eng-lat 3032 40 kB 39 kB 100 kB fd-lat-eng 2311 31 kB 24 kB 62 kB fd-fra-nld 9610 152 kB 195 kB 502 kB fd-ita-deu 2929 40 kB 37 kB 87 kB fd-eng-hin 25648 418 kB 1041 kB 3019 kB fd-deu-eng 81622 1613 kB 1346 kB 4176 kB fd-por-eng 10667 164 kB 125 kB 315 kB fd-lat-deu 7342 107 kB 105 kB 365 kB fd-jpn-deu 447 5 kB 6 kB 12 kB fd-eng-deu 93279 1708 kB 1403 kB 4212 kB fd-eng-scr 605 7 kB 8 kB 21 kB fd-eng-rom 996 14 kB 12 kB 31 kB fd-iri-eng 1191 16 kB 11 kB 28 kB fd-cze-eng 494 6 kB 5 kB 11 kB fd-scr-eng 401 6 kB 4 kB 11 kB fd-eng-cze 150010 2482 kB 1463 kB 8478 kB fd-eng-rus 1699 23 kB 26 kB 71 kB fd-afr-deu 3806 52 kB 49 kB 129 kB fd-eng-por 15854 248 kB 239 kB 634 kB fd-hun-eng 139941 3343 kB 2244 kB 6184 kB fd-eng-swe 5485 71 kB 75 kB 191 kB fd-deu-ita 4460 64 kB 38 kB 99 kB fd-cro-eng 79821 1791 kB 1016 kB 2899 kB fd-dan-eng 4003 54 kB 43 kB 103 kB fd-eng-tur 36595 580 kB 1687 kB 4214 kB fd-eng-spa 5913 76 kB 81 kB 217 kB fd-nld-deu 17230 278 kB 306 kB 827 kB fd-deu-por 8748 130 kB 104 kB 270 kB fd-swa-eng 1554 19 kB 13 kB 43 kB fd-hin-eng 32971 1227 kB 1062 kB 3274 kB fd-deu-fra 8174 120 kB 81 kB 216 kB fd-eng-fra 8805 129 kB 137 kB 361 kB fd-slo-eng 833 11 kB 9 kB 20 kB fd-gla-deu 263 3 kB 4 kB 7 kB fd-eng-wel 1066 13 kB 12 kB 31 kB fd-eng-iri 1365 17 kB 18 kB 45 kB english 0 0 kB 0 kB 0 kB trans 0 0 kB 0 kB 0 kB all 0 0 kB 0 kB 0 kB ==== capabilities ==== auth:mime ==== END ==== Net-Dict-2.19/t/database.t000644 000765 000024 00000027366 12444145167 015532 0ustar00neilbstaff000000 000000 #!./perl # # database.t - Net::Dict testsuite for database related methods # use Test::More 0.88 tests => 13; use Test::Differences qw/ eq_or_diff /; use Net::Dict; use lib 't/lib'; use Net::Dict::TestConfig qw/ $TEST_HOST $TEST_PORT /; $^W = 1; my $WARNING; my %TESTDATA; my $section; my $string; my $dbinfo; my $title; $SIG{__WARN__} = sub { $WARNING = join('', @_); }; #----------------------------------------------------------------------- # Build the hash of test data from after the __DATA__ symbol # at the end of this file #----------------------------------------------------------------------- while () { if (/^==== END ====$/) { $section = undef; next; } if (/^==== (\S+) ====$/) { $section = $1; $TESTDATA{$section} = ''; next; } next unless defined $section; $TESTDATA{$section} .= $_; } #----------------------------------------------------------------------- # Make sure we have HOST and PORT specified #----------------------------------------------------------------------- ok(defined($TEST_HOST) && defined($TEST_PORT), "Do we have a test host and port?"); #----------------------------------------------------------------------- # connect to server #----------------------------------------------------------------------- eval { $dict = Net::Dict->new($TEST_HOST, Port => $TEST_PORT); }; ok(!$@ && defined $dict, "Connect to DICT server"); #----------------------------------------------------------------------- # call dbs() with an argument - it doesn't take any, and should die #----------------------------------------------------------------------- eval { %dbhash = $dict->dbs('foo'); }; ok($@ && $@ =~ /takes no arguments/, "dbs() with an argument should croak"); #----------------------------------------------------------------------- # pass a hostname of empty string, should get undef back #----------------------------------------------------------------------- $string = ''; $title = "Check list of database names"; eval { %dbhash = $dict->dbs(); }; if (!$@ && %dbhash && do { foreach my $db (sort keys %dbhash) { $string .= "${db}:$dbhash{$db}\n"; }; 1; }) { eq_or_diff($string, $TESTDATA{dblist}, $title); } else { fail($title); } #----------------------------------------------------------------------- # call dbInfo() method with no arguments #----------------------------------------------------------------------- $dbinfo = undef; eval { $dbinfo = $dict->dbInfo(); }; ok($@ && $@ =~ /one argument only/, "dbInfo() with no arguments should croak"); #----------------------------------------------------------------------- # call dbInfo() method with more than one argument #----------------------------------------------------------------------- $dbinfo = undef; eval { $dbinfo = $dict->dbInfo('wn', 'web1913'); }; ok($@ && $@ =~ /one argument only/, "dbInfo() with more than one argument should croak"); #----------------------------------------------------------------------- # call dbInfo() method with one argument, but it's a non-existent DB #----------------------------------------------------------------------- $dbinfo = undef; eval { $dbinfo = $dict->dbInfo('web1651'); }; ok(!$@ && !defined($dbinfo), "dbInfo() on a non-existent DB should return undef"); #----------------------------------------------------------------------- # get the database info for the wordnet db, and compare with expected #----------------------------------------------------------------------- $string = ''; $dbinfo = undef; $title = "Do we get expected DB info for wordnet?"; eval { $dbinfo = $dict->dbInfo('wn'); }; if (!$@ && defined($dbinfo)) { eq_or_diff($dbinfo, $TESTDATA{'dbinfo-wn'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # METHOD: dbTitle # Call method with no arguments - should result in die() #----------------------------------------------------------------------- eval { $string = $dict->dbTitle(); }; ok($@ && $@ =~ /method expects one argument/, "dbTitle() with no arguments should croak"); #----------------------------------------------------------------------- # METHOD: dbTitle # Call method with too many arguments - should result in die() #----------------------------------------------------------------------- eval { $string = $dict->dbTitle('wn', 'foldoc'); }; ok($@ && $@ =~ /method expects one argument/, "dbTitle() with more than one argument should croak"); #----------------------------------------------------------------------- # METHOD: dbTitle # Call method with non-existent DB - should result in undef #----------------------------------------------------------------------- $WARNING = ''; eval { $string = $dict->dbTitle('web1651'); }; ok(!$@ && !defined($string), "dbTitle() on a non-existent DB should return undef"); #----------------------------------------------------------------------- # METHOD: dbTitle # Call method with non-existent DB - should result in undef # We set debug level to 1, should result in a warning message as # well as undef. The Net::Cmd::debug() line is needed to suppress # some verbosity from Net::Cmd when we turn on debugging. # This is done so that the "make test" *looks* clean as well as being clean. #----------------------------------------------------------------------- Net::Dict->debug(0); $dict->debug(1); $WARNING = ''; eval { $string = $dict->dbTitle('web1651'); }; ok(!$@ && !defined($string) && $WARNING =~ /unknown database/, "dbTitle on a non-existent database name should return undef"); $dict->debug(0); #----------------------------------------------------------------------- # METHOD: dbTitle # Call method with an OK DB name #----------------------------------------------------------------------- $title = "check dbTitle() on wordnet"; eval { $string = $dict->dbTitle('wn'); }; if (!$@ && defined($string)) { eq_or_diff($string."\n", $TESTDATA{'dbtitle-wn'}, $title); } else { fail($title); } exit 0; __DATA__ ==== dblist ==== all:All Dictionaries (English-Only and Translating) bouvier:Bouvier's Law Dictionary, Revised 6th Ed (1856) devil:The Devil's Dictionary (1881-1906) easton:Easton's 1897 Bible Dictionary elements:The Elements (07Nov00) english:English Monolingual Dictionaries fd-afr-deu:Afrikaans-German FreeDict Dictionary ver. 0.3 fd-cro-eng:Croatian-English Freedict Dictionary fd-cze-eng:Czech-English Freedict dictionary fd-dan-eng:Danish-English FreeDict Dictionary ver. 0.2.1 fd-deu-eng:German-English FreeDict Dictionary ver. 0.3.3 fd-deu-fra:German-French FreeDict Dictionary ver. 0.3.1 fd-deu-ita:German-Italian FreeDict Dictionary ver. 0.1.1 fd-deu-nld:German-Dutch FreeDict Dictionary ver. 0.1.1 fd-deu-por:German-Portuguese FreeDict Dictionary ver. 0.2.1 fd-eng-ara:English-Arabic FreeDict Dictionary ver. 0.6.2 fd-eng-cro:English-Croatian Freedict Dictionary fd-eng-cze:English-Czech fdicts/FreeDict Dictionary fd-eng-deu:English-German FreeDict Dictionary ver. 0.3.5 fd-eng-fra:English-French FreeDict Dictionary ver. 0.1.4 fd-eng-hin:English-Hindi FreeDict Dictionary ver. 1.5.1 fd-eng-hun:English-Hungarian FreeDict Dictionary ver. 0.1 fd-eng-iri:English-Irish Freedict dictionary fd-eng-ita:English-Italian FreeDict Dictionary ver. 0.1.1 fd-eng-lat:English-Latin FreeDict Dictionary ver. 0.1.1 fd-eng-nld:English-Dutch FreeDict Dictionary ver. 0.1.1 fd-eng-por:English-Portuguese FreeDict Dictionary ver. 0.2.2 fd-eng-rom:English-Romanian FreeDict Dictionary ver. 0.6.1 fd-eng-rus:English-Russian FreeDict Dictionary ver. 0.3 fd-eng-scr:English-Serbo-Croat Freedict dictionary fd-eng-spa:English-Spanish FreeDict Dictionary ver. 0.2.1 fd-eng-swa:English-Swahili xFried/FreeDict Dictionary fd-eng-swe:English-Swedish FreeDict Dictionary ver. 0.1.1 fd-eng-tur:English-Turkish FreeDict Dictionary ver. 0.2.1 fd-eng-wel:English-Welsh Freedict dictionary fd-fra-deu:French-German FreeDict Dictionary ver. 0.1.1 fd-fra-eng:French-English FreeDict Dictionary ver. 0.3.4 fd-fra-nld:French-Dutch FreeDict Dictionary ver. 0.1.2 fd-gla-deu:Scottish Gaelic-German FreeDict Dictionary ver. 0.1.1 fd-hin-eng:English-Hindi Freedict Dictionary [reverse index] fd-hun-eng:Hungarian-English FreeDict Dictionary ver. 0.3 fd-iri-eng:Irish-English Freedict dictionary fd-ita-deu:Italian-German FreeDict Dictionary ver. 0.1.1 fd-ita-eng:Italian-English FreeDict Dictionary ver. 0.1.1 fd-jpn-deu:Japanese-German FreeDict Dictionary ver. 0.1.1 fd-lat-deu:Latin - German FreeDict dictionary ver. 0.4 fd-lat-eng:Latin-English FreeDict Dictionary ver. 0.1.1 fd-nld-deu:Dutch-German FreeDict Dictionary ver. 0.1.1 fd-nld-eng:Dutch-English Freedict Dictionary ver. 0.1.3 fd-nld-fra:Nederlands-French FreeDict Dictionary ver. 0.1.1 fd-por-deu:Portuguese-German FreeDict Dictionary ver. 0.1.1 fd-por-eng:Portuguese-English FreeDict Dictionary ver. 0.1.1 fd-scr-eng:Serbo-Croat-English Freedict dictionary fd-slo-eng:Slovak-English Freedict dictionary fd-spa-eng:Spanish-English FreeDict Dictionary ver. 0.1.1 fd-swa-eng:Swahili-English xFried/FreeDict Dictionary fd-swe-eng:Swedish-English FreeDict Dictionary ver. 0.1.1 fd-tur-deu:Turkish-German FreeDict Dictionary ver. 0.1.1 fd-tur-eng:Turkish-English FreeDict Dictionary ver. 0.2.1 fd-wel-eng:Welsh-English Freedict dictionary foldoc:The Free On-line Dictionary of Computing (20 July 2014) gaz2k-counties:U.S. Gazetteer Counties (2000) gaz2k-places:U.S. Gazetteer Places (2000) gaz2k-zips:U.S. Gazetteer Zip Code Tabulation Areas (2000) gcide:The Collaborative International Dictionary of English v.0.48 hitchcock:Hitchcock's Bible Names Dictionary (late 1800's) jargon:The Jargon File (version 4.4.7, 29 Dec 2003) moby-thesaurus:Moby Thesaurus II by Grady Ward, 1.0 trans:Translating Dictionaries vera:V.E.R.A. -- Virtual Entity of Relevant Acronyms (January 2014) wn:WordNet (r) 3.0 (2006) world02:CIA World Factbook 2002 ==== dbtitle-wn ==== WordNet (r) 3.0 (2006) ==== dbinfo-wn ==== ============ wn ============ 00-database-info This file was converted from the original database on: 2014-04-17T12:33:52 The original data is available from: ftp://ftp.cogsci.princeton.edu/pub/wordnet/2.0 The original data was distributed with the notice shown below. No additional restrictions are claimed. Please redistribute this changed version under the same conditions and restriction that apply to the original version. This software and database is being provided to you, the LICENSEE, by Princeton University under the following license. By obtaining, using and/or copying this software and database, you agree that you have read, understood, and will comply with these terms and conditions.: Permission to use, copy, modify and distribute this software and database and its documentation for any purpose and without fee or royalty is hereby granted, provided that you agree to comply with the following copyright notice and statements, including the disclaimer, and that the same appear on ALL copies of the software, database and documentation, including modifications that you make for internal use or for distribution. WordNet 3.0 Copyright 2006 by Princeton University. All rights reserved. THIS SOFTWARE AND DATABASE IS PROVIDED "AS IS" AND PRINCETON UNIVERSITY MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED. BY WAY OF EXAMPLE, BUT NOT LIMITATION, PRINCETON UNIVERSITY MAKES NO REPRESENTATIONS OR WARRANTIES OF MERCHANT- ABILITY OR FITNESS FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE, DATABASE OR DOCUMENTATION WILL NOT INFRINGE ANY THIRD PARTY PATENTS, COPYRIGHTS, TRADEMARKS OR OTHER RIGHTS. The name of Princeton University or Princeton may not be used in advertising or publicity pertaining to distribution of the software and/or database. Title to copyright in this software, database and any associated documentation shall at all times remain with Princeton University and LICENSEE agrees to preserve same. ==== END ==== Net-Dict-2.19/t/define.t000644 000765 000024 00000035307 12352641445 015210 0ustar00neilbstaff000000 000000 #!./perl # # define.t - Net::Dict testsuite for define() method # use Test::More 0.88 tests => 16; use Net::Dict; use lib 't/lib'; use Net::Dict::TestConfig qw/ $TEST_HOST $TEST_PORT /; $^W = 1; my $WARNING; my %TESTDATA; my $defref; my $section; my $string; my $dbinfo; my $title; $SIG{__WARN__} = sub { $WARNING = join('', @_); }; #----------------------------------------------------------------------- # Build the hash of test data from after the __DATA__ symbol # at the end of this file #----------------------------------------------------------------------- while () { if (/^==== END ====$/) { $section = undef; next; } if (/^==== (\S+) ====$/) { $section = $1; $TESTDATA{$section} = ''; next; } next unless defined $section; $TESTDATA{$section} .= $_; } #----------------------------------------------------------------------- # Make sure we have HOST and PORT specified #----------------------------------------------------------------------- ok(defined($TEST_HOST) && defined($TEST_PORT), "do we have test host and port"); #----------------------------------------------------------------------- # connect to server #----------------------------------------------------------------------- eval { $dict = Net::Dict->new($TEST_HOST, Port => $TEST_PORT); }; ok(!$@ && defined $dict, "connect to DICT server"); #----------------------------------------------------------------------- # call define() with no arguments - should die #----------------------------------------------------------------------- eval { $defref = $dict->define(); }; ok($@ && $@ =~ /takes at least one argument/, "define() with no arguments should croak"); #----------------------------------------------------------------------- # try and get a definition of something which won't have a definition # note: at this point we're using the default of '*' for dicts - ie all #----------------------------------------------------------------------- eval { $defref = $dict->define('asdfghijkl'); }; ok(!$@ && defined $defref && int(@{$defref}) == 0, "requesting a definition for a non-existent word should return no entries"); #----------------------------------------------------------------------- # METHOD: define # get definitions for biscuit, using the default of '*' for DBs #----------------------------------------------------------------------- $string = ''; $title = "do we get expected definitions for 'biscuit'"; eval { $defref = $dict->define('biscuit'); }; if (!$@ && defined($defref) && do { foreach my $entry (sort {$a->[0] cmp $b->[0]} @{ $defref }) { $entry->[1] =~ s/\r//sg; $string .= $entry->[0]."\n"; $string .= $entry->[1]; } 1; }) { is($string, $TESTDATA{'*-biscuit'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # METHOD: define # get definitions for biscuit, having set user dbs to (), and not # giving any as args - should croak #----------------------------------------------------------------------- $dict->setDicts(); eval { $defref = $dict->define('biscuit'); }; ok($@ && $@ =~ /select some dictionaries/, "calling define() after selecting empty DB list should croak"); #----------------------------------------------------------------------- # METHOD: define # get definitions for biscuit, specifying '*' explicitly for dicts #----------------------------------------------------------------------- $string = ''; $title = "check definitions for 'biscuit', setting '*' for DBs"; eval { $defref = $dict->define('biscuit', '*'); }; if (!$@ && defined($defref) && do { foreach my $entry (sort {$a->[0] cmp $b->[0]} @{ $defref }) { $entry->[1] =~ s/\r//sg; $string .= $entry->[0]."\n"; $string .= $entry->[1]; } 1; }) { is($string, $TESTDATA{'*-biscuit'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # METHOD: define # get definitions for biscuit, specifying '!' explicitly for dicts #----------------------------------------------------------------------- $string = ''; $title = "check result for 'biscuit' with DB set to '!'"; eval { $defref = $dict->define('biscuit', '!'); }; if (!$@ && defined($defref) && do { foreach my $entry (sort {$a->[0] cmp $b->[0]} @{ $defref }) { $string .= $entry->[0]."\n"; $string .= $entry->[1]; } 1; }) { is($string, $TESTDATA{'!-biscuit'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # METHOD: define # get definition for noun phrase (more than one word, separated # by spaces), specifying all dicts ('*') #----------------------------------------------------------------------- $string = ''; $title = "Test results for noun phrase, with dicts set to '*'"; eval { $defref = $dict->define('antispasmodic agent', '*'); }; if (!$@ && defined($defref) && do { foreach my $entry (sort {$a->[0] cmp $b->[0]} @{ $defref }) { $string .= $entry->[0]."\n"; $string .= $entry->[1]; } 1; }) { is($string, $TESTDATA{'*-antispasmodic_agent'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # METHOD: define # get definition a something containing an apostrophe ("ko'd") # specifying all dicts ('*') #----------------------------------------------------------------------- $string = ''; $title = "get definition for a word containing an apostrophe"; eval { $defref = $dict->define("ko'd", '*'); }; if (!$@ && defined($defref) && do { foreach my $entry (sort {$a->[0] cmp $b->[0]} @{ $defref }) { $string .= $entry->[0]."\n"; $string .= $entry->[1]; } 1; }) { is($string, $TESTDATA{'*-kod'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # METHOD: define # get definition of something with apostrophe and a space. # specifying all dicts ('*') #----------------------------------------------------------------------- $string = ''; $title = "get definition of a noun phrase containing an apostrophe"; eval { $defref = $dict->define("oboe d'amore", '*'); }; if (!$@ && defined($defref) && do { foreach my $entry (sort {$a->[0] cmp $b->[0]} @{ $defref }) { $string .= $entry->[0]."\n"; $string .= $entry->[1]; } 1; }) { is($string, $TESTDATA{'*-oboe_damore'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # METHOD: define # Very long entry, which also happens to have multiple spaces #----------------------------------------------------------------------- $string = ''; $title = "test getting definition for very long entry, with spaces"; eval { $defref = $dict->define("Pityrogramma calomelanos aureoflava", '*'); }; if (!$@ && defined($defref) && do { foreach my $entry (sort {$a->[0] cmp $b->[0]} @{ $defref }) { $string .= $entry->[0]."\n"; $string .= $entry->[1]; } 1; }) { is($string, $TESTDATA{'*-pityrogramma_calomelanos_aureoflava'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # METHOD: define # Valid word, invalid dbname - should return no entries #----------------------------------------------------------------------- eval { $defref = $dict->define('banana', 'web1651'); }; ok(!$@ && defined($defref) && int(@{$defref}) == 0, "valid word, invalid db name, should return 0 entries"); #----------------------------------------------------------------------- # METHOD: define # Call setDicts to select web1913, but then explicitly specify # "wn" as the dictionary to search when calling define. # the word ("banana") is in both dictionaries, but we should only # get the definition for wn #----------------------------------------------------------------------- $string = ''; $title = "search for a word, with DB passed to define()"; $dict->setDicts('web1913'); eval { $defref = $dict->define('banana', 'wn'); }; if (!$@ && defined($defref) && do { foreach my $entry (sort {$a->[0] cmp $b->[0]} @{ $defref }) { $string .= $entry->[0]."\n"; $string .= $entry->[1]; } 1; }) { is($string, $TESTDATA{'wn-banana'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # METHOD: define # Call define, passing undef for the word, and '*' for dicts #----------------------------------------------------------------------- $WARNING = ''; eval { $defref = $dict->define(undef, '*'); }; ok(!$@ && !defined($defref) && $WARNING =~ /empty word passed to define/, "passing undef for the word should return undef"); #----------------------------------------------------------------------- # METHOD: define # Call define, passing empty string for the word, and '*' for dicts #----------------------------------------------------------------------- $WARNING = ''; eval { $defref = $dict->define('', '*'); }; ok(!$@ && !defined($defref) && $WARNING =~ /empty word passed to define/, "passing an empty string returns undef"); exit 0; __DATA__ ==== *-biscuit ==== gcide Biscuit \Bis"cuit\, n. [F. biscuit (cf. It. biscotto, Sp. bizcocho, Pg. biscouto), fr. L. bis twice + coctus, p. p. of coquere to cook, bake. See {Cook}, and cf. {Bisque} a kind of porcelain.] 1. A kind of unraised bread, of many varieties, plain, sweet, or fancy, formed into flat cakes, and bakes hard; as, ship biscuit. [1913 Webster] According to military practice, the bread or biscuit of the Romans was twice prepared in the oven. --Gibbon. [1913 Webster] 2. A small loaf or cake of bread, raised and shortened, or made light with soda or baking powder. Usually a number are baked in the same pan, forming a sheet or card. [1913 Webster] 3. Earthen ware or porcelain which has undergone the first baking, before it is subjected to the glazing. [1913 Webster] 4. (Sculp.) A species of white, unglazed porcelain, in which vases, figures, and groups are formed in miniature. [1913 Webster] {Meat biscuit}, an alimentary preparation consisting of matters extracted from meat by boiling, or of meat ground fine and combined with flour, so as to form biscuits. [1913 Webster] moby-thesaurus 52 Moby Thesaurus words for "biscuit": Brussels biscuit, Melba toast, adobe, bisque, bone, bowl, brick, brownie, cement, ceramic ware, ceramics, china, cookie, cracker, crock, crockery, date bar, dust, enamelware, firebrick, fruit bar, ginger snap, gingerbread man, glass, graham cracker, hardtack, jug, ladyfinger, macaroon, mummy, parchment, pilot biscuit, porcelain, pot, pottery, pretzel, refractory, rusk, saltine, sea biscuit, ship biscuit, shortbread, sinker, soda cracker, stick, sugar cookie, tile, tiling, urn, vase, wafer, zwieback wn biscuit n 1: small round bread leavened with baking-powder or soda 2: any of various small flat sweet cakes (`biscuit' is the British term) [syn: {cookie}, {cooky}, {biscuit}] ==== !-biscuit ==== gcide Biscuit \Bis"cuit\, n. [F. biscuit (cf. It. biscotto, Sp. bizcocho, Pg. biscouto), fr. L. bis twice + coctus, p. p. of coquere to cook, bake. See {Cook}, and cf. {Bisque} a kind of porcelain.] 1. A kind of unraised bread, of many varieties, plain, sweet, or fancy, formed into flat cakes, and bakes hard; as, ship biscuit. [1913 Webster] According to military practice, the bread or biscuit of the Romans was twice prepared in the oven. --Gibbon. [1913 Webster] 2. A small loaf or cake of bread, raised and shortened, or made light with soda or baking powder. Usually a number are baked in the same pan, forming a sheet or card. [1913 Webster] 3. Earthen ware or porcelain which has undergone the first baking, before it is subjected to the glazing. [1913 Webster] 4. (Sculp.) A species of white, unglazed porcelain, in which vases, figures, and groups are formed in miniature. [1913 Webster] {Meat biscuit}, an alimentary preparation consisting of matters extracted from meat by boiling, or of meat ground fine and combined with flour, so as to form biscuits. [1913 Webster] ==== *-antispasmodic_agent ==== wn antispasmodic agent n 1: a drug used to relieve or prevent spasms (especially of the smooth muscles) [syn: {antispasmodic}, {spasmolytic}, {antispasmodic agent}] ==== *-oboe_damore ==== gcide Oboe \O"boe\, n. [It., fr. F. hautbois. See {Hautboy}.] (Mus.) One of the higher wind instruments in the modern orchestra, yet of great antiquity, having a penetrating pastoral quality of tone, somewhat like the clarinet in form, but more slender, and sounded by means of a double reed; a hautboy. [1913 Webster] {Oboe d'amore} [It., lit., oboe of love], and {Oboe di caccia} [It., lit., oboe of the chase], are names of obsolete modifications of the oboe, often found in the scores of Bach and Handel. [1913 Webster] wn oboe d'amore n 1: an oboe pitched a minor third lower than the ordinary oboe; used to perform baroque music ==== *-kod ==== gcide KO \KO\ v. t. [imp. & p. p. {KO'd}; p. pr. & vb. n. {KO'ing}.] To knock out; to deliver a blow that renders (the opponent) unconscious; -- used especially in boxing. [acronym] Syn: knockout. [WordNet 1.5] gcide KO'd \KO'd\ adj. [from {KO}, v. t.] rendered unconscious, usually by a blow. Syn: knocked out(predicate), kayoed, out(predicate), stunned. [WordNet 1.5] wn KO'd adj 1: knocked unconscious by a heavy blow [syn: {knocked out(p)}, {kayoed}, {KO'd}, {out(p)}, {stunned}] ==== *-pityrogramma_calomelanos_aureoflava ==== wn Pityrogramma calomelanos aureoflava n 1: tropical American fern having fronds with light golden undersides [syn: {golden fern}, {Pityrogramma calomelanos aureoflava}] ==== wn-banana ==== wn banana n 1: any of several tropical and subtropical treelike herbs of the genus Musa having a terminal crown of large entire leaves and usually bearing hanging clusters of elongated fruits [syn: {banana}, {banana tree}] 2: elongated crescent-shaped yellow fruit with soft sweet flesh ==== END ==== Net-Dict-2.19/t/lib/000755 000765 000024 00000000000 12444145641 014326 5ustar00neilbstaff000000 000000 Net-Dict-2.19/t/match.t000644 000765 000024 00000034605 12352647406 015055 0ustar00neilbstaff000000 000000 #!./perl # # match.t - Net::Dict testsuite for match() method # use Test::More 0.88 tests => 15; use Test::Differences qw/ eq_or_diff /; use Net::Dict; use lib 't/lib'; use Net::Dict::TestConfig qw/ $TEST_HOST $TEST_PORT /; use Env qw($VERBOSE); $^W = 1; my $WARNING; my %TESTDATA; my $defref; my $section; my $string; my $dbinfo; my %strathash; my $title; if (defined $VERBOSE && $VERBOSE==1) { print STDERR "\nVERBOSE ON\n"; } $SIG{__WARN__} = sub { $WARNING = join('', @_); }; #----------------------------------------------------------------------- # Build the hash of test data from after the __DATA__ symbol # at the end of this file #----------------------------------------------------------------------- while () { if (/^==== END ====$/) { $section = undef; next; } if (/^==== (\S+) ====$/) { $section = $1; $TESTDATA{$section} = ''; next; } next unless defined $section; $TESTDATA{$section} .= $_; } #----------------------------------------------------------------------- # Make sure we have HOST and PORT specified #----------------------------------------------------------------------- ok(defined($TEST_HOST) && defined($TEST_PORT), "Do we have a test HOST and PORT?"); #----------------------------------------------------------------------- # connect to server #----------------------------------------------------------------------- eval { $dict = Net::Dict->new($TEST_HOST, Port => $TEST_PORT); }; ok(!$@ && defined($dict), "connect to DICT server"); #----------------------------------------------------------------------- # call match() with no arguments - should die #----------------------------------------------------------------------- eval { $defref = $dict->match(); }; ok($@ && $@ =~ /takes at least two arguments/, "calling match() with no arguments should croak()"); #----------------------------------------------------------------------- # call match() with one arguments - should die #----------------------------------------------------------------------- eval { $defref = $dict->match('banana'); }; ok($@ && $@ =~ /takes at least two arguments/, "match() with no argument should croak"); #----------------------------------------------------------------------- # call match() with two arguments, but word is undef #----------------------------------------------------------------------- $WARNING = ''; eval { $defref = $dict->match(undef, '*'); }; ok(!$@ && !defined($defref) && $WARNING =~ /empty pattern passed to match/, "match() with 2 arguments, but word is undef, should return undef"); #----------------------------------------------------------------------- # call match() with two arguments, but word is empty string #----------------------------------------------------------------------- $WARNING = ''; eval { $defref = $dict->match('', '*'); }; ok(!$@ && !defined($defref) && $WARNING =~ /empty pattern passed to match/, "match() with 2 args but empty word should return undef"); #----------------------------------------------------------------------- # get a list of supported strategies, render as string and compare #----------------------------------------------------------------------- $title = "do we get the expected list of strategies"; $string = ''; eval { %strathash = $dict->strategies(); }; if (!$@ && %strathash && do { foreach my $s (sort keys %strathash) { $string .= $s.':'.$strathash{$s}."\n"; } 1; }) { eq_or_diff($string, $TESTDATA{'strats'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # same as previous test, but using obsolete method name #----------------------------------------------------------------------- $title = "do we get the expected list of strats (back compat)"; $string = ''; eval { %strathash = $dict->strats(); }; if (!$@ && %strathash && do { foreach my $s (sort keys %strathash) { $string .= $s.':'.$strathash{$s}."\n"; } 1; }) { eq_or_diff($string, $TESTDATA{'strats'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # A list of words which start with "blue screen" - ie contains # a space. #----------------------------------------------------------------------- $title = "get a list of words starting with 'blue screen'"; eval { $defref = $dict->match('blue screen', 'prefix', '*'); }; if (!$@ && defined $defref && do { $string = _format_matches($defref); }) { eq_or_diff($string, $TESTDATA{'*-prefix-blue_screen'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # A list of words which start with "blue " in the jargon dictionary. # We've previously specified a default dictionary of foldoc, # but we shouldn't get anything from that. #----------------------------------------------------------------------- $title = "list of words starting with 'blue ' in the jargon dict"; $dict->setDicts('foldoc'); eval { $defref = $dict->match('blue ', 'prefix', 'jargon'); }; if (!$@ && defined $defref && do { $string = _format_matches($defref); }) { eq_or_diff($string, $TESTDATA{'jargon-prefix-blue_'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # METHOD: match # Now we do the same match, but without specifying a dictionary, # so it should fall back on the previously specified foldoc #----------------------------------------------------------------------- $title = "match words starting with 'blue '"; $dict->setDicts('foldoc'); eval { $defref = $dict->match('blue ', 'prefix'); }; if (!$@ && defined $defref && do { $string = _format_matches($defref); }) { eq_or_diff($string, $TESTDATA{'foldoc-prefix-blue_'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # METHOD: match # Look for words with apostrophe in them, in a specific dictionary #----------------------------------------------------------------------- $title = "use match() to look for words with an apostophe, in world02"; eval { $defref = $dict->match("d'i", 're', 'world02'); }; if (!$@ && defined $defref && do { $string = _format_matches($defref); }) { eq_or_diff($string, $TESTDATA{"world02-re-'"}, $title); } else { fail($title); } #----------------------------------------------------------------------- # METHOD: match # look for all words in all dictionaries ending in "standard" #----------------------------------------------------------------------- $title = "look for words ending in 'standard' in all DBs"; eval { $defref = $dict->match("standard", 'suffix', '*'); }; if (!$@ && defined $defref && do { $string = _format_matches($defref); }) { eq_or_diff($string, $TESTDATA{'*-suffix-standard'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # METHOD: match # Using regular expressions to find all entries in a dictionary # of a given length #----------------------------------------------------------------------- $title = "use regexp to find all entries of a given length"; eval { $defref = $dict->match('^a....................$', 're', 'wn'); }; if (!$@ && defined $defref && do { $string = _format_matches($defref); }) { eq_or_diff($string, $TESTDATA{'web1913-re-dotmatch'}, $title); } else { fail($title); } #----------------------------------------------------------------------- # METHOD: match # Look for words which have a Levenshtein distance one # from "know" #----------------------------------------------------------------------- $title = "look for words with a Levenshtein distance one from 'know'"; eval { $defref = $dict->match('know', 'lev', '*'); }; if (!$@ && defined $defref && do { $string = _format_matches($defref); }) { eq_or_diff($string, $TESTDATA{'*-lev-know'}, $title); } else { fail($title); } exit 0; #======================================================================= # # _format_matches() # # takes a reference to a list which is assumed to be the result # from a match() - each entry in the list is a reference to # a 2-element list: [DICTIONARY, WORD] # # We return a string which has one line per entry: # DICTIONARY:WORD # sorted on the whole line (ie by dictionary, then by word) # #======================================================================= sub _format_matches { my $mref = shift; my $string = ''; foreach my $entry (sort { lc($a->[0].$a->[1]) cmp lc($b->[0].$b->[1]) } @$mref) { $string .= $entry->[0].':'.$entry->[1]."\n"; } return $string; } __DATA__ ==== strats ==== exact:Match headwords exactly first:Match the first word within headwords last:Match the last word within headwords lev:Match headwords within Levenshtein distance one nprefix:Match prefixes (skip, count) prefix:Match prefixes re:POSIX 1003.2 (modern) regular expressions regexp:Old (basic) regular expressions soundex:Match using SOUNDEX algorithm substring:Match substring occurring anywhere in a headword suffix:Match suffixes word:Match separate words within headwords ==== *-exact-blue ==== easton:Blue foldoc:Blue gazetteer:Blue web1913:Blue web1913:blue wn:blue ==== *-prefix-blue_screen ==== foldoc:blue screen of death foldoc:blue screen of life jargon:blue screen of death ==== jargon-prefix-blue_ ==== jargon:blue box jargon:blue glue jargon:blue goo jargon:blue screen of death jargon:blue wire ==== foldoc-prefix-blue_ ==== foldoc:blue book foldoc:blue box foldoc:blue dot syndrome foldoc:blue glue foldoc:blue screen of death foldoc:blue screen of life foldoc:blue sky software foldoc:blue wire ==== world02-re-' ==== world02:Cote d'Ivoire ==== *-suffix-standard ==== bouvier:STANDARD foldoc:a tools integration standard foldoc:advanced encryption standard foldoc:american national standard foldoc:binary compatibility standard foldoc:data encryption standard foldoc:de facto standard foldoc:digital signature standard foldoc:display standard foldoc:filesystem hierarchy standard foldoc:ieee floating point standard foldoc:international standard foldoc:object compatibility standard foldoc:recommended standard foldoc:robot exclusion standard foldoc:standard foldoc:video display standard gaz2k-places:Standard gcide:deficient inferior substandard gcide:Double standard gcide:double standard gcide:non-standard gcide:nonstandard gcide:standard gcide:Standard jargon:ansi standard moby-thesaurus:standard wn:accounting standard wn:double standard wn:gold standard wn:monetary standard wn:nonstandard wn:procrustean standard wn:silver standard wn:standard wn:substandard ==== web1913-re-dotmatch ==== wn:aaron montgomery ward wn:abelmoschus moschatus wn:aboriginal australian wn:abruptly-pinnate leaf wn:absence without leave wn:acacia auriculiformis wn:acid-base equilibrium wn:acquisition agreement wn:acute-angled triangle wn:adams-stokes syndrome wn:adenosine diphosphate wn:adlai ewing stevenson wn:advance death benefit wn:aeronautical engineer wn:affine transformation wn:africanized honey bee wn:ageratum houstonianum wn:aglaomorpha meyeniana wn:agnes george de mille wn:agnes gonxha bojaxhiu wn:agricultural labourer wn:agriculture secretary wn:agrippina the younger wn:agropyron intermedium wn:agropyron pauciflorum wn:agropyron subsecundum wn:air-to-ground missile wn:airborne transmission wn:aksa martyrs brigades wn:albatrellus dispansus wn:alben william barkley wn:aldous leonard huxley wn:aldrovanda vesiculosa wn:alex boncayao brigade wn:alexander archipelago wn:alexander graham bell wn:alexis de tocqueville wn:alfred alistair cooke wn:alfred bernhard nobel wn:alfred charles kinsey wn:alfred edward housman wn:alfred lothar wegener wn:alfred russel wallace wn:alkylbenzenesulfonate wn:allied command europe wn:allium cepa viviparum wn:amaranthus graecizans wn:ambloplites rupestris wn:ambrosia psilostachya wn:ambystomid salamander wn:amelanchier alnifolia wn:american bog asphodel wn:american mountain ash wn:american parsley fern wn:american pasqueflower wn:american red squirrel wn:american saddle horse wn:amphitheatrum flavium wn:amsinckia grandiflora wn:andrew william mellon wn:andropogon virginicus wn:anemopsis californica wn:angelica archangelica wn:angolan monetary unit wn:anogramma leptophylla wn:anointing of the sick wn:anterior crural nerve wn:anterior jugular vein wn:anterior labial veins wn:anthriscus sylvestris wn:anthyllis barba-jovis wn:anti-racketeering law wn:anti-submarine rocket wn:anti-takeover defense wn:antiballistic missile wn:antigenic determinant wn:antihemophilic factor wn:antihypertensive drug wn:antilocapra americana wn:antiophthalmic factor wn:antitrust legislation wn:anton van leeuwenhoek wn:antonio lucio vivaldi wn:antonius stradivarius wn:apalachicola rosemary wn:apex of the sun's way wn:aposematic coloration wn:appalachian mountains wn:appendicular skeleton wn:arceuthobium pusillum wn:archeological remains wn:archimedes' principle wn:arctostaphylos alpina wn:ardisia escallonoides wn:arenaria groenlandica wn:ariocarpus fissuratus wn:army of the righteous wn:arna wendell bontemps wn:arnold joseph toynbee wn:arrhenatherum elatius wn:artemisia californica wn:artemisia dracunculus wn:artemisia gnaphalodes wn:artemisia ludoviciana wn:artemisia stelleriana wn:artemision at ephesus wn:arteria intercostalis wn:arterial blood vessel wn:arthur edwin kennelly wn:articles of agreement wn:as luck would have it wn:asarum shuttleworthii wn:ascension of the lord wn:asclepias curassavica wn:asparagus officinales wn:aspergillus fumigatus wn:asplenium platyneuron wn:asplenium trichomanes wn:astreus hygrometricus wn:astrophyton muricatum wn:athyrium filix-femina wn:atmospheric condition wn:atrioventricular node wn:august von wassermann wn:augustin jean fresnel wn:australian blacksnake wn:australian bonytongue wn:australian grass tree wn:australian reed grass wn:australian sword lily wn:australian turtledove wn:austronesian language wn:automotive technology wn:aversive conditioning wn:avicennia officinalis wn:avogadro's hypothesis wn:azerbajdzhan republic ==== *-lev-know ==== easton:Knop easton:Snow gaz2k-counties:Knox gaz2k-places:Knox gcide:Aknow gcide:Enow gcide:Gnow gcide:Knaw gcide:Knew gcide:Knob gcide:Knop gcide:Knor gcide:knot gcide:Known gcide:Now gcide:Snow gcide:Ynow moby-thesaurus:knob moby-thesaurus:knot moby-thesaurus:now moby-thesaurus:snow vera:now wn:knob wn:knot wn:known wn:knox wn:now wn:snow ==== END ==== Net-Dict-2.19/t/lib/Net/000755 000765 000024 00000000000 12444145641 015054 5ustar00neilbstaff000000 000000 Net-Dict-2.19/t/lib/Net/Dict/000755 000765 000024 00000000000 12444145641 015737 5ustar00neilbstaff000000 000000 Net-Dict-2.19/t/lib/Net/Dict/TestConfig.pm000644 000765 000024 00000000235 12325044510 020331 0ustar00neilbstaff000000 000000 package Net::Dict::TestConfig; use parent 'Exporter'; our @EXPORT_OK = qw($TEST_HOST $TEST_PORT); our $TEST_HOST = 'dict.org'; our $TEST_PORT = 2628; 1; Net-Dict-2.19/lib/Net/000755 000765 000024 00000000000 12444145641 014611 5ustar00neilbstaff000000 000000 Net-Dict-2.19/lib/Net/Dict.pm000644 000765 000024 00000030614 12442543564 016042 0ustar00neilbstaff000000 000000 # # Net::Dict.pm # # Copyright (C) 2001-2003 Neil Bowers # Copyright (c) 1998 Dmitry Rubinstein . # # All rights reserved. This program is free software; you can # redistribute it and/or modify it under the same terms as Perl # itself. # package Net::Dict; use warnings; use strict; use IO::Socket; use Net::Cmd; use Carp; use vars qw(@ISA $debug); our $VERSION = '2.19'; #----------------------------------------------------------------------- # Default values for arguments to new(). We also use this to # determine valid argument names - if it's not a key of this hash, # then it's not a valid argument. #----------------------------------------------------------------------- my %ARG_DEFAULT = ( Port => 2628, Timeout => 120, Debug => 0, Client => "Net::Dict v$VERSION", ); @ISA = qw(Net::Cmd IO::Socket::INET); #======================================================================= # # new() # # constructor - open connection to host, get a list of databases, # and send CLIENT identification command. # #======================================================================= sub new { @_ > 1 or croak 'usage: Net::Dict->new() takes at least a HOST name'; my $class = shift; my $host = shift; int(@_) % 2 == 0 or croak 'Net::Dict->new(): odd number of arguments'; my %inargs = @_; my $self; my $argref; return undef unless defined $host; #------------------------------------------------------------------- # Process arguments, setting defaults if needed #------------------------------------------------------------------- $argref = {}; foreach my $arg (keys %ARG_DEFAULT) { $argref->{$arg} = exists $inargs{$arg} ? $inargs{$arg} : $ARG_DEFAULT{$arg}; delete $inargs{$arg}; } if (keys(%inargs) > 0) { croak "Net::Dict->new(): unknown argument - ", join(', ', keys %inargs); } #------------------------------------------------------------------- # Make the connection #------------------------------------------------------------------- $self = $class->SUPER::new(PeerAddr => $host, PeerPort => $argref->{Port}, Proto => 'tcp', Timeout => $argref->{Timeout} ); return undef unless defined $self; ${*$self}{'net_dict_host'} = $host; $self->autoflush(1); $self->debug($argref->{Debug}); if ($self->response() != CMD_OK) { $self->close(); return undef; } # parse the initial 220 response $self->_parse_banner($self->message); #------------------------------------------------------------------- # Send the CLIENT command which identifies the connecting client #------------------------------------------------------------------- $self->_CLIENT($argref->{Client}); #------------------------------------------------------------------- # The default - search ALL dictionaries #------------------------------------------------------------------- $self->setDicts('*'); return $self; } sub dbs { @_ == 1 or croak 'usage: $dict->dbs() - takes no arguments'; my $self = shift; $self->_get_database_list(); return %{${*$self}{'net_dict_dbs'}}; } sub setDicts { my $self = shift; @{${*$self}{'net_dict_userdbs'}} = @_; } sub serverInfo { @_ == 1 or croak 'usage: $dict->serverInfo()'; my $self = shift; return 0 unless $self->_SHOW_SERVER(); my $info = join('', @{$self->read_until_dot}); $self->getline(); $info; } sub dbInfo { @_ == 2 or croak 'usage: $dict->dbInfo($dbname) - one argument only'; my $self = shift; if ($self->_SHOW_INFO(@_)) { return join('', @{$self->read_until_dot()}); } else { return undef; } } sub dbTitle { @_ == 2 or croak 'dbTitle() method expects one argument - DB name'; my $self = shift; my $dbname = shift; $self->_get_database_list(); if (exists ${${*$self}{'net_dict_dbs'}}{$dbname}) { return ${${*$self}{'net_dict_dbs'}}{$dbname}; } else { carp 'dbTitle(): unknown database name' if $self->debug; return undef; } } sub strategies { @_ == 1 or croak 'usage: $dict->strategies()'; my $self = shift; return 0 unless $self->_SHOW_STRAT(); my (%strats, $name, $desc); foreach (@{$self->read_until_dot()}) { ($name, $desc) = (split /\s/, $_, 2); chomp $desc; $strats{$name} = _unquote($desc); } $self->getline(); %strats; } sub define { @_ >= 2 or croak 'usage: $dict->define($word [, @dbs]) - takes at least one argument'; my $self = shift; my $word = shift; my @dbs = (@_ > 0) ? @_ : @{${*$self}{'net_dict_userdbs'}}; croak 'select some dictionaries with setDicts or supply as argument to define' unless @dbs; my($db, @defs); #------------------------------------------------------------------- # check whether we got an empty word #------------------------------------------------------------------- if (!defined($word) || $word eq '') { carp "empty word passed to define() method"; return undef; } foreach $db (@dbs) { next unless $self->_DEFINE($db, $word); my ($defNum) = ($self->message =~ /^\d{3} (\d+) /); foreach (0..$defNum-1) { my ($d) = ($self->getline =~ /^\d{3} ".*" ([-\w]+) /); my ($def) = join '', @{$self->read_until_dot}; push @defs, [$d, $def]; } $self->getline(); } \@defs; } sub match { @_ >= 3 or croak 'usage: $self->match($word, $strat [, @dbs]) - takes at least two arguments'; my $self = shift; my $word = shift; my $strat = shift; my @dbs = (@_ > 0) ? @_ : @{${*$self}{'net_dict_userdbs'}}; croak 'define some dictionaries by setDicts or supply as argument to define' unless @dbs; my ($db, @matches); #------------------------------------------------------------------- # check whether we got an empty pattern #------------------------------------------------------------------- if (!defined($word) || $word eq '') { carp "empty pattern passed to match() method"; return undef; } foreach $db (@dbs) { next unless $self->_MATCH($db, $strat, $word); my ($db, $w); foreach (@{$self->read_until_dot}) { ($db, $w) = split /\s/, $_, 2; chomp $w; push @matches, [$db, _unquote($w)]; } $self->getline(); } \@matches; } sub auth { @_ == 3 or croak 'usage: $dict->auth() - takes two arguments'; my $self = shift; my $user = shift; my $pass_phrase = shift; my $auth_string; my $string; my $ctx; require Digest::MD5; $string = $self->msg_id().$pass_phrase; $auth_string = Digest::MD5::md5_hex($string); if ($self->_AUTH($user, $auth_string)) { #--------------------------------------------------------------- # clear the cache of database names # next time a method needs them, this will cause us to go # back to the server, and thus pick up any AUTH-restricted DBs #--------------------------------------------------------------- delete ${*$self}{'net_dict_dbs'}; } else { carp "auth() failed with error code ".$self->code() if $self->debug(); return; } } sub status { @_ == 1 or croak 'usage: $dict->status() - takes no arguments'; my $self = shift; my $message; $self->_STATUS() || return 0; chomp($message = $self->message); $message =~ s/^\d{3} //; return $message; } sub capabilities { @_ == 1 or croak 'usage: $dict->capabilities() - takes no arguments'; my $self = shift; return @{ ${*$self}{'net_dict_capabilities'} }; } sub has_capability { @_ == 2 or croak 'usage: $dict->has_capability() - takes one argument'; my $self = shift; my $cap = shift; return grep(lc($cap) eq $_, $self->capabilities()); } sub msg_id { @_ == 1 or croak 'usage: $dict->msg_id() - takes no arguments'; my $self = shift; return ${*$self}{'net_dict_msgid'}; } sub _DEFINE { shift->command('DEFINE', map { '"'.$_.'"' } @_)->response() == CMD_INFO } sub _MATCH { shift->command('MATCH', map { '"'.$_.'"' } @_)->response() == CMD_INFO } sub _SHOW_DB { shift->command('SHOW DB')->response() == CMD_INFO } sub _SHOW_STRAT { shift->command('SHOW STRAT')->response() == CMD_INFO } sub _SHOW_INFO { shift->command('SHOW INFO', @_)->response() == CMD_INFO } sub _SHOW_SERVER { shift->command('SHOW SERVER')->response() == CMD_INFO } sub _CLIENT { shift->command('CLIENT', @_)->response() == CMD_OK } sub _STATUS { shift->command('STATUS')->response() == CMD_OK } sub _HELP { shift->command('HELP')->response() == CMD_INFO } sub _QUIT { shift->command('QUIT')->response() == CMD_OK } sub _OPTION_MIME { shift->command('OPTION MIME')->response() == CMD_OK } sub _AUTH { shift->command('AUTH', @_)->response() == CMD_OK } sub _SASLAUTH { shift->command('SASLAUTH', @_)->response() == CMD_OK } sub _SASLRESP { shift->command('SASLRESP', @_)->response() == CMD_OK } sub quit { my $self = shift; $self->_QUIT; $self->close; } sub DESTROY { my $self = shift; if (defined fileno($self)) { $self->quit; } } sub response { my $self = shift; my $str = $self->getline() || return undef; if ($self->debug) { $self->debug_print(0,$str); } my($code) = ($str =~ /^(\d+) /); ${*$self}{'net_cmd_resp'} = [ $str ]; ${*$self}{'net_cmd_code'} = $code; substr($code,0,1); } #======================================================================= # # _unquote # # Private function used to remove quotation marks from around # a string. # #======================================================================= sub _unquote { my $string = shift; if ($string =~ /^"/) { $string =~ s/^"//; $string =~ s/"$//; } return $string; } #======================================================================= # # _parse_banner # # Parse the initial response banner the server sends when we connect. # Hoping for: # 220 blah blah # The string gives a list of supported extensions. # The last bit is a msg-id, which identifies this connection, # and is used in authentication, for example. # #======================================================================= sub _parse_banner { my $self = shift; my $banner = shift; my ($code, $capstring, $msgid); ${*$self}{'net_dict_banner'} = $banner; ${*$self}{'net_dict_capabilities'} = []; if ($banner =~ /^(\d{3}) (.*) (<[^<>]*>)?\s+(<[^<>]+>)\s*$/) { ${*$self}{'net_dict_msgid'} = $4; ($capstring = $3) =~ s/[<>]//g; if (length($capstring) > 0) { ${*$self}{'net_dict_capabilities'} = [split(/\./, $capstring)]; } } else { carp "unexpected format for welcome banner on connection:\n", $banner if $self->debug; } } #======================================================================= # # _get_database_list # # Get the list of databases on the remote server. # We cache them in the instance data object, so that dbTitle() # and databases() don't have to go to the server every time. # # We check to see whether we've already got the databases first, # and do nothing if so. This means that this private method # can just be invoked in the public methods. # #======================================================================= sub _get_database_list { my $self = shift; return if exists ${*$self}{'net_dict_dbs'}; if ($self->_SHOW_DB) { my ($dbNum) = ($self->message =~ /^\d{3} (\d+)/); my ($name, $descr); foreach (0..$dbNum-1) { ($name, $descr) = (split /\s/, $self->getline, 2); chomp $descr; ${${*$self}{'net_dict_dbs'}}{$name} = _unquote($descr); } # Is there a way to do it right? Reading the dot line and the # status line afterwards? Maybe I should use read_until_dot? $self->getline(); $self->getline(); } } #----------------------------------------------------------------------- # Method aliases for backwards compatibility #----------------------------------------------------------------------- *strats = \&strategies; 1; Net-Dict-2.19/lib/Net/Dict.pod000644 000765 000024 00000025656 12326562470 016220 0ustar00neilbstaff000000 000000 =head1 NAME Net::Dict - client API for accessing dictionary servers (RFC 2229) =head1 SYNOPSIS use Net::Dict; $dict = Net::Dict->new('dict.server.host'); $h = $dict->define("word"); foreach $i (@{$h}) { ($db, $def) = @{$i}; . . . } =head1 DESCRIPTION C is a perl class for looking up words and their definitions on network dictionary servers. C provides a simple DICT client API for the network protocol described in RFC2229. Quoting from that RFC: =over =item The Dictionary Server Protocol (DICT) is a TCP transaction based query/response protocol that allows a client to access dictionary definitions from a set of natural language dictionary databases. =back An instance of Net::Dict represents a connection to a single DICT server. For example, to connect to the dictionary server at C, you would write: $dict = Net::Dict->new('dict.org'); A DICT server can provide any number of dictionaries, which are referred to as I. Each database has a I and a I. The name is a short identifier, typically just one word, used to refer to that database. The title is a brief one-line description of the database. For example, at the time of writing, the C<dict.org> server has 11 databases, including a version of Webster's dictionary from 1913. The name of the database is I<web1913>, and the title is I<Webster's Revised Unabridged Dictionary (1913)>. To look up definitions for a word, you use the C<define> method: $dref = $dict->define('banana'); This returns a reference to a list; each entry in the list is a reference to a two item list: [ $dbname, $definition ] The first entry is a I<database name> as introduced above. The second entry is the text of a definition from the specified dictionary. =head2 MATCHING WORDS In addition the looking up word definitions, you can lookup a list of words which match a given pattern, using the B<match()> method. Each DICT server typically supports a number of I<strategies> which can be used to match words against a pattern. For example, using B<prefix> strategy with a pattern "anti" would find all words in databases which start with "anti": @mref = $dict->match('anti', 'prefix'); foreach my $match (@{ $mref }) { ($db, $word) = @{ $match }; } Similarly the B<suffix> strategy is used to search for words which end in a given pattern. The B<strategies()> method is used to request a list of supported strategies - see L<"METHODS"> for more details. =head2 SELECTING DATABASES By default Net::Dict will look in all databases on the DICT server. This is specified with a special database name of C<*>. You can specify the database(s) to search explicitly, as additional arguments to the B<define> and B<match> methods: $dref = $dict->define('banana', 'wn', 'web1913'); Rather than specify the databases to use every time, you can change the default from '*' using the C<setDicts> method: $dict->setDicts('wn', 'web1913'); Any subsequent calls to B<define> or B<match> will refer to these databases, unless over-ridden with additional arguments to the method. You can find out what databases are available on a server using the C<dbs> method: %dbhash = $dict->dbs(); Each entry in the returned hash has the name of a database as the key, and the corresponding title as the value. There is another special database name - C<!> - which says that all databases should be searched, but as soon as a definition is found, no further databases should be searched. =head1 CONSTRUCTOR $dict = Net::Dict->new (HOST [,OPTIONS]); This is the constructor for a new Net::Dict object. C<HOST> is the name of the remote host on which a Dict server is running. This is required, and must be an explicit host name. The constructor makes a connection to the remote DICT server, and sends the CLIENT command, to identify the client to the server. B<Note:> previous versions let you give an empty string for the hostname, resulting in selection of default hosts. This behaviour is no longer supported. C<OPTIONS> are passed in a hash like fashion, using key and value pairs. Possible options are: =over 4 =item B<Port> The port number to connect to on the remote machine for the Dict connection (a default port number is 2628, according to RFC2229). =item B<Client> The string to send as the CLIENT identifier. If not set, then a default identifier for Net::Dict is sent. =item B<Timeout> Sets the timeout for the connection, in seconds. Defaults to 120. =item B<Debug> The debug level - a non-zero value will resulting in debugging information being generated, particularly when errors occur. Can be changed later using the C<debug> method, which is inherited from Net::Cmd. More on the debug method can be found in L<Net::Cmd>. =back Making everything explicit, here's how you might call the constructor in your client: $dict = Net::Dict->new($HOST, Port => 2628, Client => "myclient v$VERSION", Timeout => 120, Debug => 0); This will return C<undef> if we failed to make the connection. It will C<die> if bad arguments are passed: no hostname, unknown argument, etc. =head1 METHODS Unless otherwise stated all methods return either a I<true> or I<false> value, with I<true> meaning that the operation was a success. When a method states that it returns a value, failure will be returned as I<undef> or an empty list. =head2 define ( $word [, @dbs] ) returns a reference to an array, whose members are lists, consisting of two elements: the dictionary name and the definition. If no dictionaries are specified, those set by setDicts() are used. =head2 match ( $pattern, $strategy [, @dbs] ) Looks for words which match $pattern according to the specified matching $strategy. Returns a reference to an array, each entry of which is a reference to a two-element array: database name, matching word. =head2 dbs Returns a hash with information on the databases available on the DICT server. The keys are the short names, or identifiers, of the databases; the value is title of the database: %dbhash = $dict->dbs(); print "Available dictionaries:\n"; while (($db, $title) = each %dbhash) { print "$db : $title\n"; } This is the C<SHOW DATABASES> command from RFC 2229. =head2 dbInfo ( $dbname ) Returns a string, containing description of the dictionary $dbname. =head2 setDicts ( @dicts ) Specify the dictionaries that will be searched during the successive define() or match() calls. Defaults to '*'. No existance checks are performed by this interface, so you'd better make sure the dictionaries you specify are on the server (e.g. by calling dbs()). =head2 strategies returns an array, containing an ID of a matching strategy as a key and a verbose description as a value. This method was previously called strats(); that name for the method is also currently supported, for backwards compatibility. =head2 auth ( $USER, $PASSPHRASE ) Attempt to authenticate the specified user, using the scheme described on page 18 of RFC 2229. The user should be known to the server, and $PASSPHRASE is a shared secret known only to the server and the user. For example, if you were using dictd from dict.org, your configuration file might include the following: database private { data "/usr/local/dictd/db/private.dict.dz" index "/usr/local/dictd/db/private.index" access { user connor } } user connor "there can be only one" To be able to access this database, you'd write something like the following: $dict = Net::Dict->new('dict.foobar.com'); $dict->auth('connor', 'there can be only one'); A subsequent call to the C<databases> method would reveal the C<private> database now accessible. Not all servers support the AUTH extension; you can check this with the has_capability() method, described below. =head2 serverInfo Returns a string, containing the information about the server, provided by the server: print "Server Info:\n"; print $dict->serverInfo(), "\n"; This is the C<SHOW SERVER> command from RFC 2229. =head2 dbTitle ( $DBNAME ) Returns the title string for the specified database. This is the same string returned by the C<dbs()> method for all databases. =head2 capabilities Returns a list of the capabilities supported by the DICT server, as described on pages 7 and 8 of RFC 2229. =head2 has_capability ( $cap_name ) Returns true (non-zero) if the DICT server supports the specified capability; false (zero) otherwise. Eg if ($dict->has_capability('auth')) { $dict->auth('genie', 'open sesame'); } =head2 status Send the STATUS command to the DICT server, which will return some server-specific timing or debugging information. This may be useful when debugging or tuning a DICT server, but probably won't be of interest to most users. =head1 KNOWN BUGS AND LIMITATIONS =over 4 =item * Need to add methods for getting lists of databases and strategies in the order they're returned by the remote server. Suggested by Aleksey Cheusov. =item * The following DICT commands are not currently supported: OPTION MIME =item * No support for firewalls at the moment. =item * Site-wide configuration isn't supported. Previous documentation suggested that it was. =item * Currently no way to specify that results of define and match should be in HTML. This was also previously a config option for the constructor, but it didn't do anything. =back =head1 EXAMPLES The distribution includes two example DICT clients: B<dict> is a basic command-line client, and B<tkdict> is a GUI-based client, created using Perl/Tk. The B<examples> directory of the Net-Dict distribution includes two basic examples. C<simple.pl> illustrates basic use of the module, and C<portuguese.pl> demos use of an English to Portuguese dictionary. Thanks to Jose Joao Dias de Almeida for the examples. =head1 SEE ALSO L<RFC 2229|https://tools.ietf.org/html/rfc2229> - the internet document which defines the DICT protocol. L<Net::Cmd> - a module which provides methods for a network command class, such as Net::FTP, Net::SMTP, as well as Net::Dict. Part of the libnet distribution, available from CPAN. L<Digest::MD5> - you'll need this module if you want to use the B<auth> method. L<dict.org|http://www.dict.org> - the home page for the DICT effort; has links to other resources, including other libraries and clients, and C<dictd>, the reference DICT server. =head1 REPOSITORY L<https://github.com/neilbowers/Net-Dict> =head1 AUTHOR The first version of Net::Dict was written by Dmitry Rubinstein E<lt>dimrub@wisdom.weizmann.ac.ilE<gt>, using Net::FTP and Net::SMTP as a pattern and a model for imitation. The module was extended, and is now maintained, by Neil Bowers E<lt>neil@bowers.comE<gt> =head1 COPYRIGHT Copyright (C) 2002-2014 Neil Bowers. All rights reserved. Copyright (C) 2001 Canon Research Centre Europe, Ltd. Copyright (c) 1998 Dmitry Rubinstein. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut ����������������������������������������������������������������������������������Net-Dict-2.19/examples/portuguese.pl����������������������������������������������������������������000755 �000765 �000024 �00000003312 12172612121 017662� 0����������������������������������������������������������������������������������������������������ustar�00neilb���������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # # portugueses.pl - example showing access to a translation dictionary # # DICT can also be used to provide translation dictionaries. # # Here we connect to a server which has an English->Portuguese # dictionary: natura.di.uminho.pt # # We select the specific dictionary, and then prompt the user # for words, displaying the translation back. # # This is based on an example from Jose Joao Dias de Almeida <jj@di.uminho.pt> # # $Id: portuguese.pl,v 1.1.1.1 2003/04/26 22:59:11 neilb Exp $ # use Net::Dict; use utf8; my $dict; my $host = 'natura.di.uminho.pt'; my $prompt = "english> "; my $database = 'eng-por'; my $entry; my $db; my $translation; #----------------------------------------------------------------------- # Turn off buffering on STDOUT #----------------------------------------------------------------------- $| = 1; #----------------------------------------------------------------------- # Create instance of Net::Dict, connecting to the server #----------------------------------------------------------------------- print "Connecting to $host ..."; $dict = Net::Dict->new($host); $dict->setDicts($database); #----------------------------------------------------------------------- # Let the user repeatedly enter words, which we then look up. #----------------------------------------------------------------------- print $prompt; while(<>) { chomp; next unless $_; $eref = $dict->define($_); if (@$eref == 0) { print " no translation for \"$_\"\n"; } else { foreach $entry (@$eref) { ($db, $translation) = @$entry; $translation =~ y/[\200-\377]/[\200-\377]/UC; print "$db--------\n",$translation; } } print $prompt; } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������Net-Dict-2.19/examples/simple.pl��������������������������������������������������������������������000755 �000765 �000024 �00000005033 12172612121 016753� 0����������������������������������������������������������������������������������������������������ustar�00neilb���������������������������staff���������������������������000000 �000000 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/usr/bin/perl -w # # simple.pl - a simple example illustrating use of Net::Dict # # This is a simple Net::Dict which illustrates basic use # to get word definitions. Usage: # # simple.pl myhost.org # simple.pl # # if no hostname is given, then default to dict.org # # The user is then prompted for words. We look up definitions # and display all that we get back. # # This is based on an example from Jose Joao Dias de Almeida <jj@di.uminho.pt> # # $Id: simple.pl,v 1.1.1.1 2003/04/26 22:59:11 neilb Exp $ # use strict; use Net::Dict; my $dict; my $host; my $prompt = "define> "; my $eref; my $entry; my $db; my $definition; #----------------------------------------------------------------------- # Turn off buffering on STDOUT #----------------------------------------------------------------------- $| = 1; #----------------------------------------------------------------------- # Create instance of Net::Dict, connecting either to a user-specified # dict server, or defaulting to dict.org #----------------------------------------------------------------------- $host = @ARGV > 0 ? shift @ARGV : 'dict.org'; print "Connecting to $host ..."; $dict = Net::Dict->new($host); print "\n"; #----------------------------------------------------------------------- # Let the user repeatedly enter words, which we then look up. #----------------------------------------------------------------------- print $prompt; while (<>) { chomp; next unless $_; #------------------------------------------------------------------- # The define() method returns an array reference. # The array has one entry for each definition found. # If the referenced array has no entries, then there were no # definitions in any of the dictionaries on the server. #------------------------------------------------------------------- $eref = $dict->define($_); if (@$eref == 0) { print " no definition for \"$_\"\n"; } else { #--------------------------------------------------------------- # Each entry is another array reference. The referenced array # for each entry has two elements: # $db - the name of the database (ie dictionary) # $definition - the text of the definition #--------------------------------------------------------------- foreach $entry (@$eref) { ($db, $definition) = @$entry; print "\n-----(from: $db)---------------------------\n", $definition; } } print $prompt; } ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������