package Dictionary;
#****c* Example/Dictionary
# NAME
#   Dictionary.pm -- package that implements a dictionary for translations
# AUTHOR
#   Geert Jan Bex
# CREATION DATE
#   13/12/2000
# FUNCTION
#   a dictionary can be used for lookup and translation operations;
#   a lookup can be literal, or it can be a match with respect to a regular
#   expression;  a translation can be a literal translation, or a substitution
#   based on a regular expression
# USES
#   strict, Carp
#***
# ------------------------------------------------
use strict;
use Carp;
# ------------------------------------------------
#****m* Dictionary/new
# NAME
#   new
# FUNCTION
#   constructor for a dictionary resource
# ARGUMENTS
#   pkg  -- package name, not to be passed explicitely
#   name -- name of the dictionary
#   file -- optional file or list of files to add to the dictionary
# USAGE
#   $dict = new Dictionary('us-en');
#   $dict = new Dictionary('us-en','file.txt');
#   $dict = new Dictionary('us-en',['file1.txt','file2.txt']);
#***
# ------------------------------------------------
sub new {
	my ($pkg, $name, $file) = @_;
	my $dict = {
		'_name' => $name
	};
	bless $dict, $pkg;
	if ($file) {
		$dict->addFile($file);
	}
	return $dict;
}
# ------------------------------------------------
#****m* Dictionary/addFile
# NAME
#   addFile
# FUNCTION
#   adds a file or a list of files to the dictionary
# ARGUMENTS
#   file -- optional file or list of files to add to the dictionary
# USAGE
#   $dict->addFile('file.txt');
#   $dict->addFile(['file1.txt','file2.txt']);
#***
# ------------------------------------------------
sub addFile {
	my ($dict, $file) = @_;
	if (!ref($file)) {
		open (IN,$file) || croak ("COLUMBO_DICTIONARY_E_001: Can't open dictionary '$file'\n");
		while (<IN>) {
			chomp($_);
			my ($str, $translation) = split(/\s+/,$_,2);
			$dict->insert($str,$translation);
		}
		close (IN);
	} elsif (ref($file) eq 'ARRAY') {
		foreach my $f (@$file) {
			$dict->addFile($f);
		}
	}
}
# ------------------------------------------------
#****m* Dictionary/getName
# NAME
#   getName
# FUNCTION
#   returns the name of the dictionary
# RETURNS
#   name of the dictionary
# USAGE
#   $name = $dict->getName;

#***
# ------------------------------------------------
sub getName {
	my ($dict) = @_;
	return $dict->{'_name'};
}
# ------------------------------------------------
#****m* Dictionary/insert
# NAME
#   insert
# FUNCTION
#   adds a string or a pattern to the dictionary as well as its translation
#   or substitution pattern
# ARGUMENTS
#   str         -- string or pattern to add to the dictionary
#   translation -- string or pattern that is the translation or substitution
#                  for str
# USAGE
#   $dict->insert('file','txt');
#***
# ------------------------------------------------
sub insert {
	my ($dict, $str, $translation) = @_;
	$dict->{$str} = $translation;
}
# ------------------------------------------------
#****m* Dictionary/contains
# NAME
#   contains
# FUNCTION
#   checks whether a word or a pattern occurs in the dictionary
# ARGUMENTS
#   str -- string or pattern to check
# RETURNS
#   true if the string or pattern occurs in the dictionary, false
#   otherwise
# USAGE
#   $boolean = $dict->contains('test');
#***
# ------------------------------------------------
sub contains {
	my ($dict, $str) = @_;
	return exists $dict->{$str};
}
# ------------------------------------------------
#****m* Dictionary/match
# NAME
#   match
# FUNCTION
#   performs a match with the specified string
# ARGUMENTS
#   str -- pattern to check
# RETURNS
#   true if the pattern matches in the dictionary, false otherwise
# USAGE
#   $boolean = $dict->match('test');
#***
# ------------------------------------------------
sub match {
	my ($dict, $str) = @_;
	foreach my $pattern (keys %$dict) {
		return 1 if ($str =~ /$pattern/);
	}
	return 0;
}
# ------------------------------------------------
#****m* Dictionary/lookup
# NAME
#   lookup
# FUNCTION
#   performs a lookup in the dictionary, returns the translation of the
#   string specified
# ARGUMENTS
#   str -- string or pattern to translate
# RETURNS
#   string that represents the translation of the given string
# USAGE
#   $translation = $dict->lookup('test');
#***
# ------------------------------------------------
sub lookup {
	my ($dict, $str) = @_;
	return $dict->{$str};
}
# ------------------------------------------------
#****m* Dictionary/substitute
# NAME
#   substitute
# FUNCTION
#   performs a substitution for the specified string
# ARGUMENTS
#   str -- pattern to substitute
# RETURNS
#   the regular expression substitution of the string
# USAGE
#   $str = $dict->match('test');
#***
# ------------------------------------------------
sub substitute {
	my ($dict, $str) = @_;
	my @list;
	my ($pattern, $alternative);
	while (($pattern, $alternative) = each(%$dict)) {
		if ($str =~ /$pattern/) {
			my @alt = split(/\s+/,$alternative);
			foreach my $alt (@alt) {
				my $tmpStr = $str;
				my $evalStr = '$tmpStr =~ s/' . $pattern . '/' . $alt . '/';
				eval($evalStr);
				push(@list, $tmpStr);
			}
		}
	}
	if (scalar(@list) > 0) {
		return \@list;
	} else {
		return 0;
	}
}
# ------------------------------------------------
#****m* Dictionary/toString
# NAME
#   toString
# FUNCTION
#   converts the dictionary object to its string representation suitable
#   for persistent storage
# RETURNS
#   string representation of the dictionary
# USAGE
#   $strRep = $dict->toString;
#***
sub toString {
	my ($dict) = @_;
	my $str = '';
	foreach my $word (sort keys %$dict) {
		$str .= sprintf "%s\t%s\n", ($word, $dict->lookup($word))
			unless $word =~ /^\_/;
	}
	return $str;
}
# ------------------------------------------------
# Don't remove, signals end of package
1;