comment on

This is an implementation of a dictionary class. One could simply do this with a hash, but that would result in ugly code (not that I'm claiming that the code below isn't uglu, BTW).

An additional and important benefit is that one can have as many dictionaries (i.e. instances of the class Dicitonary) as one needs.

Hope this helps, -gjb-

Example follows:

package Dictionary;
#****c* Example/Dictionary
# NAME
#   Dictionary.pm -- package that implements a dictionary for translat
+ions
# 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 re
+gular
#   expression;  a translation can be a literal translation, or a subs
+titution
#   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 ope
+n 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 transl
+ation
#   or substitution pattern
# ARGUMENTS
#   str         -- string or pattern to add to the dictionary
#   translation -- string or pattern that is the translation or substi
+tution
#                  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 th
+e
#   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 suitab
+le
#   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;
[download]

Edited: ~Fri Oct 18 21:26:30 2002 (GMT) by footpad: Added <readmore> tag, per Consideration

In reply to Re: Real life OO examples by gjb
in thread Real life OO examples by kbeen

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Come for the quick hacks, stay for the epiphanies.
	PerlMonks