[libnet-dict-perl] 01/03: Import original source of Net-Dict 2.19
Lucas Kanashiro
kanashiro-guest at moszumanska.debian.org
Sun Jul 19 17:04:10 UTC 2015
This is an automated email from the git hooks/post-receive script.
kanashiro-guest pushed a commit to branch master
in repository libnet-dict-perl.
commit 40a98ea245e1046585c820886e9c45b1d9bf445f
Author: Lucas Kanashiro <kanashiro.duarte at gmail.com>
Date: Sun Jul 19 12:23:34 2015 -0300
Import original source of Net-Dict 2.19
---
Changes | 222 ++++++++++++
MANIFEST | 19 ++
META.json | 55 +++
META.yml | 32 ++
Makefile.PL | 53 +++
README | 47 +++
TODO.md | 7 +
dict | 527 ++++++++++++++++++++++++++++
examples/portuguese.pl | 69 ++++
examples/simple.pl | 83 +++++
lib/Net/Dict.pm | 473 +++++++++++++++++++++++++
lib/Net/Dict.pod | 394 +++++++++++++++++++++
t/auth.test | 211 ++++++++++++
t/connection.t | 293 ++++++++++++++++
t/database.t | 290 ++++++++++++++++
t/define.t | 454 ++++++++++++++++++++++++
t/lib/Net/Dict/TestConfig.pm | 10 +
t/match.t | 537 +++++++++++++++++++++++++++++
tkdict | 795 +++++++++++++++++++++++++++++++++++++++++++
19 files changed, 4571 insertions(+)
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..e782591
--- /dev/null
+++ b/Changes
@@ -0,0 +1,222 @@
+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 <jj at di.uminho.pt>.
+
+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 <jj at di.uminho.pt>
+ - Modified in constructor for default port number,
+ also from Jose.
+ - previous versions released by Dmitry Rubinstein
+ <dimrub at wisdom.weizmann.ac.il>
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..e3f5f65
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,19 @@
+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)
diff --git a/META.json b/META.json
new file mode 100644
index 0000000..3878681
--- /dev/null
+++ b/META.json
@@ -0,0 +1,55 @@
+{
+ "abstract" : "client API for accessing dictionary servers (RFC 2229)",
+ "author" : [
+ "Neil Bowers <neil at bowers.com>"
+ ],
+ "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"
+}
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..ef3cc7b
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,32 @@
+---
+abstract: 'client API for accessing dictionary servers (RFC 2229)'
+author:
+ - 'Neil Bowers <neil at bowers.com>'
+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'
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..bdc0a44
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,53 @@
+#
+# 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 <neil at bowers.com>',
+ 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,
+ })
+ : ()
+ ),
+
+);
+
diff --git a/README b/README
new file mode 100644
index 0000000..099a69b
--- /dev/null
+++ b/README
@@ -0,0 +1,47 @@
+
+ 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 <neil at bowers.com>
diff --git a/TODO.md b/TODO.md
new file mode 100644
index 0000000..93cf641
--- /dev/null
+++ b/TODO.md
@@ -0,0 +1,7 @@
+* 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
diff --git a/dict b/dict
new file mode 100755
index 0000000..7f91346
--- /dev/null
+++ b/dict
@@ -0,0 +1,527 @@
+#!/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<dict> [OPTIONS] I<word>
+
+=head1 DESCRIPTION
+
+B<dict> 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<dict> will look for definitions of I<word> in the dictionaries
+hosted at B<dict.org>. 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<soundex> or I<Levenshtein> 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<server> or B<-host> I<server>
+
+The hostname for the DICT server. If one isn't specified
+then defaults to B<dict.org>.
+
+=item B<-p> I<port> or B<-port> I<port>
+
+Specify the port for connections (default is 2628, from RFC 2229).
+
+=item B<-d> I<dbname> or B<-database> I<dbname>
+
+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<dbname> or B<-info> I<dbname>
+
+Request information on the specified database.
+Typically results in a couple of pages of text.
+
+=item B<-c> I<string> or B<-client> I<string>
+
+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<strategy> or B<-strategy> I<strategy>
+
+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<dict>.
+
+=item B<-version>
+
+Display the version of B<dict>
+
+=item B<-verbose>
+
+Display verbose information as B<dict> runs.
+
+=item B<-debug>
+
+Display debugging information as B<dict> runs.
+Useful mainly for developers.
+
+=back
+
+=head1 KNOWN BUGS AND LIMITATIONS
+
+=over 4
+
+=item *
+
+B<dict> 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<dict> 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 <neil at bowers.com>
+
+=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
+
diff --git a/examples/portuguese.pl b/examples/portuguese.pl
new file mode 100755
index 0000000..84bc6ec
--- /dev/null
+++ b/examples/portuguese.pl
@@ -0,0 +1,69 @@
+#!/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 at 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;
+}
+
diff --git a/examples/simple.pl b/examples/simple.pl
new file mode 100755
index 0000000..bec54da
--- /dev/null
+++ b/examples/simple.pl
@@ -0,0 +1,83 @@
+#!/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 at 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;
+}
diff --git a/lib/Net/Dict.pm b/lib/Net/Dict.pm
new file mode 100644
index 0000000..96b60de
--- /dev/null
+++ b/lib/Net/Dict.pm
@@ -0,0 +1,473 @@
+#
+# Net::Dict.pm
+#
+# Copyright (C) 2001-2003 Neil Bowers <neil at bowers.com>
+# Copyright (c) 1998 Dmitry Rubinstein <dimrub at wisdom.weizmann.ac.il>.
+#
+# 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",
+);
+
+ at 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 <auth.mime> <msgid>
+# The <auth.mime> 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;
+
diff --git a/lib/Net/Dict.pod b/lib/Net/Dict.pod
new file mode 100644
index 0000000..9cbab0f
--- /dev/null
+++ b/lib/Net/Dict.pod
@@ -0,0 +1,394 @@
+
+=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<Net::Dict> is a perl class for looking up words and their
+definitions on network dictionary servers.
+C<Net::Dict> 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<dict.org>, you would write:
+
+ $dict = Net::Dict->new('dict.org');
+
+A DICT server can provide any number of dictionaries,
+which are referred to as I<databases>.
+Each database has a I<name> and a I<title>.
+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 at 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 at 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
+
diff --git a/t/auth.test b/t/auth.test
new file mode 100644
index 0000000..8ccc718
--- /dev/null
+++ b/t/auth.test
@@ -0,0 +1,211 @@
+#!./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 (<DATA>)
+{
+ 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 ====
diff --git a/t/connection.t b/t/connection.t
new file mode 100644
index 0000000..1a4f8fe
--- /dev/null
+++ b/t/connection.t
@@ -0,0 +1,293 @@
+#!./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 (<DATA>)
+{
+ 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 ====
diff --git a/t/database.t b/t/database.t
new file mode 100644
index 0000000..c664c6d
--- /dev/null
+++ b/t/database.t
@@ -0,0 +1,290 @@
+#!./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 (<DATA>) {
+ 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 ====
diff --git a/t/define.t b/t/define.t
new file mode 100644
index 0000000..5c8e17e
--- /dev/null
+++ b/t/define.t
@@ -0,0 +1,454 @@
+#!./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 (<DATA>) {
+ 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 ====
diff --git a/t/lib/Net/Dict/TestConfig.pm b/t/lib/Net/Dict/TestConfig.pm
new file mode 100644
index 0000000..f93855b
--- /dev/null
+++ b/t/lib/Net/Dict/TestConfig.pm
@@ -0,0 +1,10 @@
+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;
diff --git a/t/match.t b/t/match.t
new file mode 100644
index 0000000..0da35d5
--- /dev/null
+++ b/t/match.t
@@ -0,0 +1,537 @@
+#!./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 (<DATA>)
+{
+ 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 ====
diff --git a/tkdict b/tkdict
new file mode 100755
index 0000000..e1b9ec4
--- /dev/null
+++ b/tkdict
@@ -0,0 +1,795 @@
+#!/usr/bin/env perl
+#
+# tkdict - a Perl/Tk DICT client, for accessing network dictionary servers
+#
+# Neil Bowers <neil at bowers.com>
+# 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('<Return>', \&select_server);
+ $server_entry->bind('<FocusIn>',
+ sub { $server_entry->configure(-bg => 'white'); });
+ $server_entry->bind('<FocusOut>',
+ 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('<Return>', \&lookup_word);
+ $word_entry->bind('<FocusIn>',
+ sub { $word_entry->configure(-bg => 'white'); });
+ $word_entry->bind('<FocusOut>',
+ 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('<Control-x><Control-c>', \&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} = <<EOFABOUT;
+
+ $PROGRAM v$VERSION
+
+$PROGRAM is a DICT client, used to access network dictionary
+servers which support the protocol defined in RFC 2229.
+
+This client is using Perl module Net::Dict $Net::Dict::VERSION.
+
+Neil Bowers <neil\@bowers.com>
+Copyright (C) 2001-2002, Neil Bowers
+EOFABOUT
+
+ $helpString{overview} = <<EOFENTRY;
+
+ $PROGRAM $VERSION - Overview
+
+$PROGRAM is a simple Tk tool for looking up entries
+in dictionaries which are accessed using the DICT protocol.
+
+First you must specify a Server (and press RETURN).
+A good one to try is dict.org - it has a number of dictionaries.
+You should get a menu for selecting dictionaries,
+and a text box for entering a word.
+
+Enter a word and press return. By default $PROGRAM will check
+all dictionaries, so you might get a number of definitions.
+
+EOFENTRY
+
+ $helpString{todo} = <<EOFTODO;
+
+ $PROGRAM v$VERSION - ToDo List
+
+ * better formatting of results
+ * more user-oriented user interface
+ * have the inline pod available on Help menu
+ * show one definition at a time
+ with some sort of NEXT and PREV interface
+ * option to specify whether to stay connect or not
+ * haven't done anything to handle connnection timing out
+ * status line at the bottom of the main window
+
+EOFTODO
+}
+
+
+#=======================================================================
+#
+# 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);
+}
+
+__END__
+
+=head1 NAME
+
+tkdict - a perl client for accessing network dictionary servers
+
+=head1 SYNOPSIS
+
+tkdict [OPTIONS]
+
+=head1 DESCRIPTION
+
+B<tkdict> 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<Help> menu
+when running B<tkdict>.
+
+=head1 OPTIONS
+
+=over 4
+
+=item B<-h> I<server> or B<-host> I<server>
+
+The hostname for the DICT server.
+
+=item B<-p> I<port> or B<-port> I<port>
+
+Specify the port for connections (default is 2628, from RFC 2229).
+
+=item B<-c> I<string> or B<-client> I<string>
+
+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<tkdict>.
+
+=item B<-version>
+
+Display the version of B<tkdict>
+
+=item B<-verbose>
+
+Display verbose information as B<tkdict> runs.
+
+=item B<-debug>
+
+Display debugging information as B<tkdict> runs.
+Useful mainly for developers.
+
+=back
+
+=head1 KNOWN BUGS AND LIMITATIONS
+
+=over 4
+
+=item *
+
+B<tkdict> doesn't know how to handle firewalls.
+
+=item *
+
+The authentication aspects of RFC 2229 aren't currently supported.
+
+=item *
+
+See the B<ToDo> page under the B<Help> 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<dict>,
+as well as B<tkdict>.
+
+=back
+
+=head1 VERSION
+
+$Revision: 1.1.1.1 $
+
+=head1 AUTHOR
+
+Neil Bowers <neil at bowers.com>
+
+=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
+
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libnet-dict-perl.git
More information about the Pkg-perl-cvs-commits
mailing list