File Coverage

blib/lib/Lingua/RU/Preposition.pm
Criterion Covered Total %
statement 22 22 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 28 28 100.0


line stmt bran cond sub pod time code
1             package Lingua::RU::Preposition;
2              
3 4     4   97632 use warnings;
  4         11  
  4         133  
4 4     4   24 use strict;
  4         15  
  4         144  
5 4     4   1158 use utf8;
  4         24  
  4         30  
6              
7             =encoding utf8
8              
9             =head1 NAME
10              
11             Lingua::RU::Preposition - linguistic function for prepositions in Russian.
12              
13             =head1 VERSION
14              
15             Version 0.01
16              
17             =head1 DESCRIPTION
18              
19             Lingua::RU::Preposition is a perl module
20             that provides choosing proper form of varying russian prepositions.
21              
22             =cut
23              
24              
25             BEGIN {
26 4     4   187 use Exporter ();
  4         7  
  4         854  
27 4     4   9 our ($VERSION, $DATE, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
28              
29             # set the version for version checking
30 4         8 $VERSION = 0.01;
31             # date written by hands because git does not process keywords
32 4         9 $DATE = '2011-02-18';
33              
34 4         69 @ISA = qw(Exporter);
35 4         10 @EXPORT = qw(
36             choose_preposition_by_next_word
37             );
38              
39             # exported package globals
40 4         14 @EXPORT_OK = qw(
41             bezo izo ko nado ob obo oto predo peredo podo so vo
42             );
43              
44 4         1778 %EXPORT_TAGS = (
45             'subs' => [ @EXPORT ],
46             'short' => [ @EXPORT_OK ],
47             'all' => [ @EXPORT, @EXPORT_OK ],
48             )
49              
50             }
51              
52             =head1 SYNOPSIS
53              
54             use Lingua::RU::Preposition qw/:all/;
55              
56             # Following string contains cyrillic letters
57             print ob, 'мне'; # prints 'обо' (obo)
58             print choose_preposition_by_next_word 'из', 'огня'; # prints 'из' (iz)
59              
60             =head1 TO DO
61              
62             Check rules by dictionaries and correct if needed.
63              
64             =head1 EXPORT
65              
66             Function C exported by default.
67              
68             Also you can export only short aliases for subs
69              
70             use Lingua::RU::Preposition qw/:short/;
71              
72             Or everything: subs and aliases:
73              
74             use Lingua::RU::Preposition qw/:all/; # or
75             use Lingua::RU::Preposition qw/:subs :short/;
76              
77             =head1 FUNCTIONS
78              
79             =head2 choose_preposition_by_next_word
80              
81             Chooses preposition by next word and returns chosen preposition.
82              
83             Expects 2 arguments: I and I.
84             I should be string with shortest of possible values.
85             Available values of I are:
86             C<'без'>, C<'в'>, C<'из'>, C<'к'>, C<'над'>, C<'о'>, C<'от'>,
87             C<'пред'>, C<'перед'>, C<'под'> and C<'с'>.
88              
89             There is an aliases for calling this subroutine with common preposition:
90              
91             =head3 bezo
92              
93             C is an alias for C
94              
95             This preposition can be used with some words in both forms, they are correct.
96             Example: “без всего” (bez vsego) and “безо всего” (bezo vsego) both are correct.
97             If possible function return long form.
98              
99             =head3 izo
100              
101             C is an alias for C
102              
103             =head3 ko
104              
105             C is an alias for C
106              
107             =head3 nado
108              
109             C is an alias for C
110              
111             =head3 ob and obo
112              
113             C and C are aliases for C
114              
115             =head3 oto
116              
117             C is an alias for C
118              
119             =head3 podo
120              
121             C is an alias for C
122              
123             =head3 predo
124              
125             C is an alias for C
126              
127             =head3 peredo
128              
129             C is an alias for C
130              
131             =head3 so
132              
133             C is an alias for C
134              
135             =head3 vo
136              
137             C is an alias for C
138              
139             These aliases are not exported by default. They can be expored with tags C<:short> or C<:all>.
140              
141             Example of code with these aliases:
142              
143             use Lingua::RU::Preposition qw/:short/;
144              
145             map {
146             print ob, $_;
147             } qw(
148             арбузе баране всём Елене ёлке игле йоде
149             мне многом огне паре ухе юге яблоке
150             );
151              
152             map {
153             print so, $_;
154             } qw(
155             огнём водой
156             зарёй зноем зрением зябликом
157             садом светом слоном спичками ссылкой
158             Стёпой стаканом сухарём сэром топором
159             жарой жбаном жратвой жуком
160             шаром шкафом шлангом шубой
161             );
162              
163             =cut
164              
165             sub choose_preposition_by_next_word ($$) {
166             my $preposition = lc shift or return undef;
167             local $_ = lc shift or return undef;
168              
169             # Nested subroutine
170             local *_check_instrumental = sub {
171             for my $word qw( льдом льном мной мною ) {
172             return $_[0] . 'о' if $word eq $_[1]
173             }
174             return $_[0]
175             }; # _check_instrumental
176              
177             # preposition => function
178             # TODO Check by dictionary
179             my %GRAMMAR = (
180             'без' => sub {
181             for my $word qw( всего всей всех всякого всякой всяких ) {
182             # WARNING
183             # difficult case, both words are OK
184             return 'безо' if $word eq $_
185             }
186             'без'
187             },
188             'в' => sub {
189             for my $word qw( все всём мне мно ) {
190             return 'во' if /^$word/
191             }
192             /^[вф][^аеёиоуыэюя]/
193             ? 'во'
194             : 'в'
195             },
196             'из' => sub {
197             for my $word qw( всех льда ) {
198             return 'изо' if $word eq $_
199             }
200             'из'
201             },
202             'к' => sub {
203             for my $word qw( всем мне мно ) {
204             return 'ко' if /^$word/
205 4     4   28 }
  4         9  
  4         57  
206             'к'
207             },
208             'о' => sub {
209             for my $word qw( всех всем всём мне ) {
210             return 'обо' if $word eq $_
211             }
212             return
213             /^[аиоуыэ]/
214             ? 'об'
215             : 'о'
216             },
217             'от' => sub {
218             for my $word qw( всех ) {
219             return 'ото' if $word eq $_
220             }
221             'от'
222             },
223             'с' => sub {
224             return 'со' if /^мно/;
225             return
226             /^[жзсш][^аеёиоуыэюя]/i
227             ? 'со'
228             : 'с'
229             },
230             # Same rules:
231             'над' => sub { _check_instrumental('над', $_) },
232             'под' => sub { _check_instrumental('под', $_) },
233             'перед' => sub { _check_instrumental('перед', $_) },
234             'пред' => sub { _check_instrumental('пред', $_) },
235             );
236              
237             return undef unless exists $GRAMMAR{$preposition};
238              
239             $GRAMMAR{$preposition}->($_);
240              
241             } # sub choose_preposition_by_next_word
242              
243             # Aliases
244             *bezo = sub { choose_preposition_by_next_word 'без', shift };
245             *izo = sub { choose_preposition_by_next_word 'из', shift };
246             *ko = sub { choose_preposition_by_next_word 'к', shift };
247             *nado = sub { choose_preposition_by_next_word 'над', shift };
248             *ob = sub { choose_preposition_by_next_word 'о', shift };
249             *obo = sub { choose_preposition_by_next_word 'о', shift };
250             *oto = sub { choose_preposition_by_next_word 'от', shift };
251             *predo = sub { choose_preposition_by_next_word 'пред', shift };
252             *peredo = sub { choose_preposition_by_next_word 'перед', shift };
253             *podo = sub { choose_preposition_by_next_word 'под', shift };
254             *so = sub { choose_preposition_by_next_word 'с', shift };
255             *vo = sub { choose_preposition_by_next_word 'в', shift };
256              
257             =head1 AUTHOR
258              
259             Alexander Sapozhnikov, C<< >>
260              
261             =head1 BUGS
262              
263             Please report any bugs or feature requests
264             to C, or through the web interface
265             at L.
266             I will be notified, and then
267             you'll automatically be notified of progress on your bug as I make changes.
268              
269             =head1 SUPPORT
270              
271             You can find documentation for this module with the perldoc command.
272              
273             perldoc Lingua::RU::Preposition
274              
275             You can also look for information at:
276              
277             =over 4
278              
279             =item * RT: CPAN's request tracker
280              
281             L
282              
283             =item * AnnoCPAN: Annotated CPAN documentation
284              
285             L
286              
287             =item * CPAN Ratings
288              
289             L
290              
291             =item * Search CPAN
292              
293             L
294              
295             =back
296              
297             =head1 SEE ALSO
298              
299             Russian translation of this documentation available
300             at F
301              
302             =head1 COPYRIGHT & LICENSE
303              
304             Copyright 2010-2011 Alexander Sapozhnikov.
305              
306             This program is free software; you can redistribute it and/or modify it
307             under the terms of either: the GNU General Public License as published
308             by the Free Software Foundation; or the Artistic License.
309              
310             See http://dev.perl.org/licenses/ for more information.
311              
312             =cut
313              
314             1;