File Coverage

blib/lib/Locale/Babelfish/Phrase/Parser.pm
Criterion Covered Total %
statement 117 124 94.3
branch 45 52 86.5
condition 15 18 83.3
subroutine 13 13 100.0
pod 4 4 100.0
total 194 211 91.9


line stmt bran cond sub pod time code
1             package Locale::Babelfish::Phrase::Parser;
2              
3             # ABSTRACT: Babelfish syntax parser.
4              
5 3     3   107222 use utf8;
  3         14  
  3         13  
6 3     3   72 use strict;
  3         6  
  3         48  
7 3     3   12 use warnings;
  3         4  
  3         72  
8              
9 3     3   698 use Locale::Babelfish::Phrase::Literal ();
  3         7  
  3         54  
10 3     3   690 use Locale::Babelfish::Phrase::Variable ();
  3         7  
  3         55  
11 3     3   726 use Locale::Babelfish::Phrase::PluralForms ();
  3         7  
  3         59  
12 3     3   585 use Locale::Babelfish::Phrase::PluralFormsParser ();
  3         10  
  3         90  
13              
14 3     3   54 use parent qw( Locale::Babelfish::Phrase::ParserBase );
  3         7  
  3         23  
15              
16             our $VERSION = '2.003'; # VERSION
17              
18             __PACKAGE__->mk_accessors( qw( locale mode pieces escape pf0 ) );
19              
20             use constant {
21 3         2510 LITERAL_MODE => 'Locale::Babelfish::Phrase::Literal',
22             VARIABLE_MODE => 'Locale::Babelfish::Phrase::Variable',
23             PLURALS_MODE => 'Locale::Babelfish::Phrase::PluralForms',
24             VARIABLE_RE => qr/^[a-zA-Z0-9_\.]+$/,
25 3     3   296 };
  3         6  
26              
27              
28             sub new {
29 5     5 1 2208 my ( $class, $phrase, $locale ) = @_;
30 5         36 my $self = $class->SUPER::new( $phrase );
31 5 50       13 $self->locale( $locale ) if $locale;
32 5         12 return $self;
33             }
34              
35              
36             sub init {
37 79     79 1 137 my ( $self, $phrase ) = @_;
38 79         228 $self->SUPER::init( $phrase );
39 79         1227 $self->mode( LITERAL_MODE );
40 79         1446 $self->pieces( [] );
41 79         1551 $self->pf0( undef ); # plural forms without name yet
42 79         425 return $self;
43             }
44              
45              
46             sub finalize_mode {
47 77     77 1 151 my ( $self ) = @_;
48 77 100       1121 if ( $self->mode eq LITERAL_MODE ) {
    50          
    50          
49 69         1301 push @{ $self->pieces }, LITERAL_MODE->new( text => $self->piece )
50 72 100 100     1241 if length($self->piece) || scalar(@{ $self->pieces }) == 0;
  4         78  
51             }
52             elsif ( $self->mode eq VARIABLE_MODE ) {
53 0         0 $self->throw( "Variable definition not ended with \"}\": ". $self->piece );
54             }
55             elsif ( $self->mode eq PLURALS_MODE ) {
56 5 50       276 $self->throw( "Plural forms definition not ended with \"))\": ". $self->piece )
57             unless defined $self->pf0;
58 5         27 push @{ $self->pieces }, PLURALS_MODE->new( forms => $self->pf0, name => $self->piece, locale => $self->locale, );
  5         73  
59             }
60             else {
61 0         0 $self->throw( "Logic broken, unknown parser mode: ". $self->mode );
62             }
63             }
64              
65              
66             sub parse {
67 80     80 1 47332 my ( $self, $phrase, $locale ) = @_;
68              
69 80         278 $self->SUPER::parse( $phrase );
70 79 100       507 $self->locale( $locale ) if $locale;
71              
72 79         294 my $plurals_parser = Locale::Babelfish::Phrase::PluralFormsParser->new();
73              
74 79         114 while ( 1 ) {
75 1258         9169 my $char = $self->to_next_char;
76              
77 1258 100       26002 unless ( length $char ) {
78 77         225 $self->finalize_mode;
79 77         1181 return $self->pieces;
80             }
81              
82 1181 100       17091 if ( $self->mode eq LITERAL_MODE ) {
83 646 100       10903 if ( $self->escape ) {
84 4         24 $self->add_to_piece( $char );
85 4         84 $self->escape(0);
86 4         20 next;
87             }
88              
89 642 100       2830 if ( $char eq "\\" ) {
90 4         59 $self->escape( 1 );
91 4         22 next;
92             }
93              
94 638 100 66     1199 if ( $char eq '#' && $self->next_char eq '{' ) {
95 20 100       722 if ( length $self->piece ) {
96 16         85 push @{ $self->pieces }, LITERAL_MODE->new( text => $self->piece );
  16         221  
97 16         265 $self->piece('');
98             }
99 20         136 $self->to_next_char; # skip "{"
100 20         684 $self->mode( VARIABLE_MODE );
101 20         155 next;
102             }
103              
104 618 100 100     1164 if ( $char eq '(' && $self->next_char eq '(' ) {
105 17 50       649 if ( length $self->piece ) {
106 17         101 push @{ $self->pieces }, LITERAL_MODE->new( text => $self->piece );
  17         254  
107 17         264 $self->piece('');
108             }
109 17         117 $self->to_next_char; # skip second "("
110 17         552 $self->mode( PLURALS_MODE );
111 17         99 next;
112             }
113             }
114              
115 1136 100       17414 if ( $self->mode eq VARIABLE_MODE ) {
116 119 50       2035 if ( $self->escape ) {
117 0         0 $self->add_to_piece( $char );
118 0         0 $self->escape(0);
119 0         0 next;
120             }
121              
122 119 50       534 if ( $char eq "\\" ) {
123 0         0 $self->escape( 1 );
124 0         0 next;
125             }
126              
127 119 100       200 if ( $char eq '}' ) {
128 20         286 my $name = $self->trim( $self->piece );
129 20 100       62 unless ( length $name ) {
130 1         5 $self->throw( "No variable name given." );
131             }
132 19 100       85 if ( $name !~ VARIABLE_RE ) {
133 1         8 $self->throw( "Variable name doesn't meet conditions: $name." );
134             }
135 18         30 push @{ $self->pieces }, VARIABLE_MODE->new( name => $name );
  18         285  
136 18         283 $self->piece('');
137 18         343 $self->mode( LITERAL_MODE );
138 18         107 next;
139             }
140             }
141              
142 1116 100       18194 if ( $self->mode eq PLURALS_MODE ) {
143 416 100       6942 if ( defined $self->pf0 ) {
144 62 100 66     484 if ( $char =~ VARIABLE_RE && ($char ne '.' || $self->next_char =~ VARIABLE_RE) ) {
      100        
145 54         164 $self->add_to_piece( $char );
146 54         449 next;
147             }
148             else {
149 8         52 push @{ $self->pieces }, PLURALS_MODE->new( forms => $self->pf0, name => $self->piece, locale => $self->locale, );
  8         119  
150 8         126 $self->pf0( undef );
151 8         144 $self->mode( LITERAL_MODE );
152 8         177 $self->piece('');
153 8         70 $self->backward;
154 8         327 next;
155             }
156             }
157 354 100 66     1665 if ( $char eq ')' && $self->next_char eq ')' ) {
158 17         590 $self->pf0( $plurals_parser->parse( $self->piece ) );
159 17         874 $self->piece('');
160 17         101 $self->to_next_char; # skip second ")"
161 17 100       357 if ( $self->next_char eq ':' ) {
162 13         304 $self->to_next_char; # skip ":"
163 13         286 next;
164             }
165 4         87 push @{ $self->pieces }, PLURALS_MODE->new( forms => $self->pf0, name => 'count', locale => $self->locale, );
  4         58  
166 4         64 $self->pf0( undef );
167 4         70 $self->mode( LITERAL_MODE );
168 4         27 next;
169             }
170             }
171 1037         4101 $self->add_to_piece( $char );
172             } # while ( 1 )
173             }
174              
175             1;
176              
177             __END__
178              
179             =pod
180              
181             =encoding UTF-8
182              
183             =head1 NAME
184              
185             Locale::Babelfish::Phrase::Parser - Babelfish syntax parser.
186              
187             =head1 VERSION
188              
189             version 2.003
190              
191             =head1 METHODS
192              
193             =head2 new
194              
195             $class->new()
196             $class->new( $phrase )
197              
198             Instantiates parser.
199              
200             =head2 init
201              
202             Initializes parser. Should not be called directly.
203              
204             =head2 finalize_mode
205              
206             Finalizes all operations after phrase end.
207              
208             =head2 parse
209              
210             $parser->parse()
211             $parser->parse( $phrase )
212              
213             Parses specified phrase.
214              
215             =head1 AUTHORS
216              
217             =over 4
218              
219             =item *
220              
221             Akzhan Abdulin <akzhan@cpan.org>
222              
223             =item *
224              
225             Igor Mironov <grif@cpan.org>
226              
227             =item *
228              
229             Victor Efimov <efimov@reg.ru>
230              
231             =item *
232              
233             REG.RU LLC
234              
235             =back
236              
237             =head1 COPYRIGHT AND LICENSE
238              
239             This software is Copyright (c) 2014 by REG.RU LLC.
240              
241             This is free software, licensed under:
242              
243             The MIT (X11) License
244              
245             =cut