#!/usr/bin/perl

use strict;
use warnings;
use Compress::Zlib;
use Getopt::Long;
use Pod::Usage;

my $VERSION = 0.7;
my $dictfile = 'dict.gz';

#  Process command-line options

my $help = '';
my $man = '';
my $version = '';
my $token_debug = '';
my $glossary_output = '';
my $dictionary_output = '';

GetOptions( 'help|?' => \$help, 'version' => \$version, 'man' => \$man
+, 'token-debug' => \$token_debug, 'glossary' => \$glossary_output, 'd
+ictionary' => \$dictionary_output );

print "This is version $VERSION of $0.\n" if $version;
exit(0) if ($version);
pod2usage(1) if $help;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;

my $file = shift;
my %dictionary = readdict(\$dictfile);
my %glossary;

findwords();

printlexicon(\%dictionary) if $dictionary_output;
printlexicon(\%glossary) if $glossary_output;


#  Readdict reads in the dictionary file defined above using
#  the Compress:Zlib CPAN module.  It returns a hash that is
#  used for all further dictionary operations.
#
sub readdict {
    my $dict = shift;
    my %dicthash;

    my $gz = gzopen($$dict, "rb") or die "Cannot open $$dict: $gzerrno
+\n" ;
    while ($gz->gzreadline($_) > 0) {
        chomp;
        $dicthash{lc($_)} = 0;
    }
    die "Error reading from $$dict: $gzerrno\n" if $gzerrno != Z_STREA
+M_END ;
    return %dicthash;
}

#  findwords() reads in a file and compares words found in the file
#  with the contents of the dictionary read in by the readdict
#  function.  It assigns counts to the elements of %dictionary and
#  creates %glossary elements and increases its values according to
#  the number of matches.
#
sub findwords {
    open my $if, "<", $file || die "Could not open $file: $!";
    while (<$if>) {
        chomp;
        my @elements = split(/[ ']/,$_);
        foreach my $element (@elements) {
            next if $element =~ /[^A-Za-zĄ-’]/; #  Don't need digits
            $element = lc($element);
            $element =~ s/[\s\,\!\?\.\-\_\;\)\(\"\']//g;
            next if $element eq '';
            print "[$element]\n" if $token_debug;
            #  If the word matches a word in the dictionary, increase
            #  the match count by one, otherwise assign it to the
            #  glossary of words not found in the dictionary and up
            #  the glossary count.
            if ( exists $dictionary{$element} ) {
                $dictionary{$element}++;
            } else {
                $glossary{$element}++;
            }
        }
    }
}

#  Showmatches reads in a lexicon hash via a reference and prints all 
+words out 
#  that have been seen in the findwords() function along with a freque
+ncy count.
#
sub  printlexicon {
    my $lexicon = shift;
    my $counter = 0;
    foreach my $key (sort keys %$lexicon) {
        if ( $$lexicon{$key} > 0 ) {
            print $key . " : " . $$lexicon{$key} . "\n";
            $counter++;
        }
    }
    print "\n$counter entries total\n";
}

__END__

=pod

=head1 dict-compare

A generic script for building dictionaries by comparing them to real-w
+orld texts.

=head1 SYNOPSIS

C<dict-compare [--glossary --dictionary] [--token-debug] file > output
+_file>

=head1 DESCRIPTION

This program compares the words in a given text file to a list of word
+s from
a dictionary file.  It is capable of outputting lists of words that oc
+cur or
do not occur in a given dictionary file, along with their frequency in
+ the
text.  Debugging output using token tag marks is also available.

=head2 Command-Line Options

=over 12

=item C<--help,-h,-?>

Prints a usage help screen.

=item C<--man,-m>

Prints out the manual entry for $0

=item C<--version,-v>

Prints out the program version.

=item C<--glossary>

Prints a glossary of words not found in the dictionary file and the nu
+mber of
times they occur.

=item C<--dictionary>

Prints out the words from the text that had a dictionary match, along 
+with
their respective frequencies.

=item C<--token-debug>

Prints tags around each token in the text to help sound out strange to
+kens.

=back

=head1 EXAMPLE

C<dict-compare --glossary myfile.txt>

This command reads in the text contained in myfile.txt and prints out 
+a list
of words not found in the dictionary and their frequencies.

=back

=head1 AUTHOR

Damon "allolex" Davison - <allolex@sdf.freeshell.org>

=head1 LICENSE

This code is released under the same terms as Perl itself.

=cut
[download]