<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">###########################
#     Match::Gram.pm      #
#      Version 1.01       #
#    (c) Ed Egan 2009     # 
###########################

package Gram;
use strict;
use warnings;

sub new {
    my $class = shift;
    my $charset=shift;
    my $gramlength=shift;
    if (!$charset) {$charset=1;}
    if (!$gramlength) {$gramlength=3;}
    my $self = bless {}, $class;
    $self-&gt;{GRAMLENGTH}=$gramlength;
    $self-&gt;{CHARSETINDEX}=$charset;
    $self-&gt;GetCharSet($self-&gt;{CHARSETINDEX});
    return $self;
}

sub GetCharSet {
    my $self=shift;
    my $code=shift;
    my %CharSet=(
        1=&gt;"ABCDEFGHIJKLMNOPQRSTUVWXYZ",
        2=&gt;"0123456789",
        3=&gt;" "
    );
    $CharSet{4}=$CharSet{1}.$CharSet{2}; #Alphanumeric
    $CharSet{5}=$CharSet{4}.$CharSet{3}; #Alphanumeric plus space
    $CharSet{6}=$CharSet{1}.$CharSet{3}; #Alpha plus space
    $self-&gt;{CHARS}=$CharSet{$code};
    @{$self-&gt;{CHARSET}}=split(//,$self-&gt;{CHARS});
}

sub GetNGrams {
    my $self=shift;
    my $string=shift;
    my $gramset={};
    my $str=uc($string);
    my $pattern=$self-&gt;{CHARS};
    $str=~s/[^$pattern]//ig;
    my @strchars=split("",$str);
    if (scalar (@strchars) &lt; $self-&gt;{GRAMLENGTH}) {$gramset-&gt;{"#"}=1; return $gramset;} #Note the return of the single unmatchable
    while (scalar(@strchars) &gt;= $self-&gt;{GRAMLENGTH}) {
        my $currentgram="";
        for (my $i=0; $i&lt;=($self-&gt;{GRAMLENGTH}-1); $i++) {
            $currentgram=$currentgram.$strchars[$i];
        }
        if (defined($gramset-&gt;{$currentgram})) {$gramset-&gt;{$currentgram}++;}
        else {$gramset-&gt;{$currentgram}=1;}
        shift(@strchars);
    }
    return $gramset;
}
    
sub Score {
    my $self=shift;
    my $left=shift; #takes two hashes left and right
    my $right=shift;
    my $leftscore=0; 
    foreach my $leftkey (keys (%$left)) {
        if (defined($right-&gt;{$leftkey})) {
            my $score=($left-&gt;{$leftkey} &lt;= $right-&gt;{$leftkey} ? $left-&gt;{$leftkey} : $right-&gt;{$leftkey});
            $leftscore=$leftscore+$score;
        }
    }
    return ($leftscore);
}

sub Total {
    my $self=shift;
    my $left=shift; #takes one hash (left)
    my $lefttotal=0;
    foreach my $leftkey (keys (%$left)) {
        $lefttotal=$lefttotal+$left-&gt;{$leftkey};
    }
    return ($lefttotal);
}    

sub BuildGramList {
    my $self=shift;
    undef my @gramset;
    for (my $length=1;$length&lt;=$self-&gt;{GRAMLENGTH};$length++) {
        undef my @tempgramset;
        foreach my $char (@{$self-&gt;{CHARSET}}) {
            if ($length==1) {push @tempgramset,$char;}
            else {foreach (@gramset) {push (@tempgramset,$_.$char);}}
        }
        @gramset=@tempgramset;
    }
    $self-&gt;{GRAMSET}=\@gramset;
    foreach (sort(@{$self-&gt;{GRAMSET}})){$self-&gt;{GRAMCOUNT}-&gt;{$_}=0;}
    return $self;
}

sub Index {
    my $self=shift;
    my $List=shift;
    my $IndexLetter=shift;
    if (!defined $IndexLetter) {$IndexLetter=1;}
    my $IndexName="INDEX_".$IndexLetter;
    foreach my $ListElement (@$List) {
        $self-&gt;{$IndexName}-&gt;{$ListElement}=$self-&gt;GetNGrams($ListElement);
    }
    return $self;
}

sub Lookup {
    my $self=shift;
    my $lookups=shift; #Expects array ref;
    my $IndexLetter=shift;
    if (!defined $IndexLetter) {$IndexLetter=1;}
    my $IndexName="INDEX_".$IndexLetter;
    my $rethash={};
    if (defined $lookups) {
        foreach my $key (@$lookups) {
            if (!defined ($self-&gt;{$IndexName}-&gt;{$key})) {
                $self-&gt;{$IndexName}-&gt;{$key}=$self-&gt;GetNGrams($key);
            }
            $rethash-&gt;{$key}=$self-&gt;{$IndexName}-&gt;{$key};
        }
    }
    return $rethash;
}

sub ReverseIndex {
    my $self=shift;
    my $ref=shift; #expects a ref to an array of keys
    my $IndexLetter=shift;
    if (!defined $IndexLetter) {$IndexLetter=1;}
    my $IndexName="INDEX_REVERSE_".$IndexLetter;
    my $ForwardIndexName="INDEX_".$IndexLetter;
    if (defined ($ref)) {
        foreach my $key (@$ref) {
            my $gramset=undef;
            if (defined ($self-&gt;{$ForwardIndexName}-&gt;{$key})) {
                $gramset=$self-&gt;{$ForwardIndexName}-&gt;{$key};
            }
            else {
                $gramset=$self-&gt;GetNGrams($key);
                $self-&gt;{$ForwardIndexName}-&gt;{$key}=$gramset;
            }
            foreach my $gram (keys (%$gramset)) {
                if (defined ($self-&gt;{$IndexName}-&gt;{$gram})) {
                    push (@{$self-&gt;{$IndexName}-&gt;{$gram}},$key);
                }
                else {
                    @{$self-&gt;{$IndexName}-&gt;{$gram}}=($key);
                }
            }
        }
    }
    return $self;
}

sub ReverseList {
    my $self=shift;
    my $gram=shift;
    my $IndexLetter=shift; if (!defined $IndexLetter) {$IndexLetter=1;}
    my $IndexName="INDEX_REVERSE_".$IndexLetter;
    if (defined($self-&gt;{$IndexName}-&gt;{$gram})){return $self-&gt;{$IndexName}-&gt;{$gram};}
    else {return undef;}
}

1;
</pre></body></html>