/[Lingua-Spelling-Alternative]/Alternative.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /Alternative.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations)
Mon Feb 11 14:33:42 2002 UTC (22 years, 1 month ago) by dpavlin
Branch: MAIN
Changes since 1.1: +4 -1 lines
DEBUG option to new constructor

1 dpavlin 1.1 # Documentation and Copyright exist after __END__
2    
3     package Lingua::Spelling::Alternative;
4     require 5.001;
5    
6     use strict;
7     use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
8    
9     use Exporter;
10     $VERSION = '0.01';
11     @ISA = ('Exporter');
12    
13     #@EXPORT = qw();
14     @EXPORT_OK = qw(
15     &alternatives
16     &load_affix
17     );
18    
19     #my @affix_regexp;
20     #my @affix_add;
21     #my @affix_sub;
22    
23 dpavlin 1.2 my $debug=0;
24 dpavlin 1.1
25     # stub
26    
27     sub new {
28     my $class = shift;
29     my $self = {};
30     bless($self, $class);
31     $self->{ARGS} = {@_};
32 dpavlin 1.2 $debug = $self->{ARGS}->{DEBUG};
33 dpavlin 1.1 $self ? return $self : return undef;
34     }
35    
36    
37     #
38     # load affix file in internal structures
39     #
40    
41     sub load_affix {
42     my $self = shift;
43     my $filename = shift;
44    
45     my $suffixes=0;
46    
47     my ($regexp,$add,$sub);
48    
49     print STDERR "reading affix file $filename\n" if ($debug);
50    
51     open (A,$filename) || die "Can't open affix file $filename: $!";
52     while(<A>) {
53     chomp;
54     next if (/^#|^[\s\t\n\r]*$/);
55    
56     if (/^suffixes/i) {
57     $suffixes++;
58     next;
59     }
60    
61     next if (! $suffixes);
62    
63     if (/^flag[\s\t]+\*{0,1}(.):/i) {
64     undef $regexp;
65     undef $add;
66     undef $sub;
67     next;
68     }
69    
70     if (/^[\s\t]*([^>#]+)>[\s\t]+-([^\,\s\t]+),([^\s\t]+)/) {
71     $regexp = $1;
72     $add = $2;
73     $sub = $3 if ($3 ne "-");
74     } elsif (/^[\s\t]*([^>#]+)>[\s\t]+([^\s\t\#]+)/) {
75     $regexp = $1;
76     $sub = $2;
77     }
78    
79     sub nuke_s {
80     my $tmp = $_[0];
81     return if (!$tmp);
82     $tmp=~s/^ *//g;
83     $tmp=~s/ *$//g;
84     $tmp=~s/ *//g;
85     return $tmp;
86     }
87    
88     push @{$self->{affix_regexp}},nuke_s($regexp);
89     push @{$self->{affix_add}},nuke_s($add);
90     push @{$self->{affix_sub}},nuke_s($sub);
91     }
92     return 1;
93     }
94    
95     #
96     # function which returns original word and all alternatives
97     #
98    
99     sub alternatives {
100     my $self = shift;
101     my @out;
102     foreach my $word (@_) {
103     push @out,$word; # save original word
104     next if (length($word) < 3); # cludge: preskoci kratke
105     for(my $i=0; $i<=$#{$self->{affix_regexp}}; $i++) {
106     my $regexp = $self->{affix_regexp}[$i];
107     my $add = $self->{affix_add}[$i];
108     my $sub = $self->{affix_sub}[$i];
109     next if length($word) < length($sub);
110     my $tmp_word = $word;
111     if ($sub) {
112     next if ($word !~ m/$sub$/i);
113     if ($add) {
114     $tmp_word =~ s/$sub$/$add/i;
115     } else {
116     $tmp_word =~ s/$sub$//i;
117     }
118     } else {
119     $tmp_word = $word.$add;
120     }
121     if ($tmp_word =~ m/$regexp/ix) {
122     # print "$word -> $tmp_word\t-$sub, +$add, regexp: $regexp\n";
123     push @out,lc($tmp_word);
124     }
125     }
126     }
127     return @out;
128     }
129    
130     ###############################################################################
131     1;
132     __END__
133    
134     =head1 NAME
135    
136     Alternative.pm - see all alternatives of a given word in a given language
137    
138     =head1 SYNOPSIS
139    
140     use Lingua::Spelling:Alternative;
141    
142     my $en = new Alternative;
143     $en->load_affix('/usr/lib/ispell/english.aff') or die $!;
144     print $en->alternatives("cars");
145    
146     =head1 DESCRIPTION
147    
148     This module is designed to return all valid forms of a given word
149     (for example when you want to see all possible forms of some word
150     entered in search engine)
151    
152     =head1 PUBLIC METHODS
153    
154     =over 4
155    
156     =item new
157    
158     The new() constructor (without parameters) create container for new
159     language.
160 dpavlin 1.2 Only parametar it supports is DEBUG which turns on (some) debugging
161     output.
162 dpavlin 1.1
163     =item load_affix
164    
165     Function load_affix loads ispell's affix file.
166    
167     =item alternatives
168    
169     Function alternatives
170    
171     =head1 PRIVATE METHODS
172    
173     Documented as being not documented.
174    
175     =head1 EXAMPLES
176    
177     Please see the test.pl program in distribution which exercises some
178     aspects of Alternative.pm.
179    
180     =head1 BUGS
181    
182     There are no known bugs.
183    
184     =head1 CONTACT AND COPYRIGHT
185    
186     Copyright 2002 Dobrica Pavlinusic (dpavlin@rot13.org). All
187     rights reserved. This program is free software; you can redistribute
188     it and/or modify it under the same terms as Perl itself.
189    
190     =cut

  ViewVC Help
Powered by ViewVC 1.1.26