File Coverage

blib/lib/Template/Preprocessor/TTML/CmdLineProc.pm
Criterion Covered Total %
statement 116 120 96.6
branch 28 32 87.5
condition n/a
subroutine 25 25 100.0
pod 2 2 100.0
total 171 179 95.5


line stmt bran cond sub pod time code
1             package Template::Preprocessor::TTML::CmdLineProc;
2              
3 3     3   21050 use strict;
  3         6  
  3         80  
4 3     3   15 use warnings;
  3         20  
  3         83  
5              
6              
7 3     3   14 use base 'Template::Preprocessor::TTML::Base';
  3         5  
  3         845  
8              
9             package Template::Preprocessor::TTML::CmdLineProc::Results;
10              
11 3     3   16 use base 'Template::Preprocessor::TTML::Base';
  3         5  
  3         4452  
12              
13             __PACKAGE__->mk_accessors(qw(
14             defines
15             include_files
16             include_path
17             input_filename
18             output_to_stdout
19             output_filename
20             run_mode
21             ));
22              
23             sub initialize
24             {
25 37     37   59 my $self = shift;
26 37         91 $self->output_to_stdout(1);
27 37         395 $self->include_path([]);
28 37         367 $self->defines(+{});
29 37         351 $self->include_files([]);
30 37         356 $self->run_mode("regular");
31 37         344 return 0;
32             }
33              
34             sub add_to_inc
35             {
36 14     14   120 my $self = shift;
37 14         19 my $path = shift;
38 14         20 push @{$self->include_path()}, $path;
  14         33  
39             }
40              
41             sub add_to_defs
42             {
43 19     19   181 my ($self, $k, $v) = @_;
44 19         47 $self->defines()->{$k} = $v;
45             }
46              
47             sub add_include_file
48             {
49 4     4   37 my $self = shift;
50 4         6 my $path = shift;
51 4         8 push @{$self->include_files()}, $path;
  4         10  
52             }
53              
54             package Template::Preprocessor::TTML::CmdLineProc;
55              
56             __PACKAGE__->mk_accessors(qw(
57             argv
58             result
59             ));
60              
61              
62             sub initialize
63             {
64 37     37 1 50 my $self = shift;
65 37         115 my (%args) = @_;
66 37         110 $self->argv($args{argv});
67              
68 37         489 $self->result(Template::Preprocessor::TTML::CmdLineProc::Results->new());
69 37         348 return 0;
70             }
71              
72             sub _get_next_arg
73             {
74 122     122   1038 my $self = shift;
75 122         167 return shift(@{$self->argv()});
  122         296  
76             }
77              
78             sub _no_args_left
79             {
80 85     85   117 my $self = shift;
81 85         107 return (@{$self->argv()} == 0);
  85         206  
82             }
83              
84             sub _get_run_mode_opts_map
85             {
86             return
87             {
88 65     65   424 "--version" => "version",
89             "-V" => "version",
90             "--help" => "help",
91             "-h" => "help",
92             };
93             }
94              
95             sub _get_arged_longs_opts_map
96             {
97             return
98             {
99 18     18   63 "include" => "_process_include_path_opt",
100             "includefile" => "_process_add_includefile_opt",
101             "define" => "_process_define_opt",
102             };
103             }
104              
105             sub _handle_middle_run_mode_opt
106             {
107 49     49   73 my ($self, $arg) = @_;
108 49 100       95 if (exists($self->_get_run_mode_opts_map()->{$arg}))
109             {
110 4         38 die "Option \"$arg\" was specified in the middle of the command line. It should be a standalone option.";
111             }
112             }
113              
114             sub _handle_long_option
115             {
116 21     21   32 my $self = shift;
117 21         30 my $arg_orig = shift;
118 21 100       50 if ($arg_orig eq "--")
119             {
120 1         4 return $self->_handle_no_more_options();
121             }
122 20         44 $self->_handle_middle_run_mode_opt($arg_orig);
123 18         48 my $arg = $arg_orig;
124 18         55 $arg =~ s!^--!!;
125 18         41 my $map = $self->_get_arged_longs_opts_map();
126 18         49 $arg =~ m{^([^=]*)};
127 18         36 my $option = $1;
128 18 100       52 if (exists($map->{$option}))
129             {
130 17         58 my $sub = $self->can($map->{$option});
131 17 100       47 if (length($arg) eq length($option))
132             {
133 10 50       21 if ($self->_no_args_left())
134             {
135 0         0 die "An argument should be specified after \"$arg_orig\"";
136             }
137 10         123 return $sub->(
138             $self, $self->_get_next_arg()
139             );
140             }
141             else
142             {
143 7         25 return $sub->(
144             $self, substr($arg, length($option)+1)
145             );
146             }
147             }
148 1         9 die "Unknown option!";
149             }
150              
151             sub _handle_no_more_options
152             {
153 1     1   1 my $self = shift;
154 1         4 $self->_assign_filename($self->_get_next_arg());
155             }
156              
157             sub _get_arged_short_opts_map
158             {
159             return
160             {
161 27     27   85 "o" => "_process_output_short_opt",
162             "I" => "_process_include_path_opt",
163             "D" => "_process_define_opt",
164             };
165             }
166              
167             sub _handle_short_option
168             {
169 29     29   41 my $self = shift;
170 29         44 my $arg_orig = shift;
171              
172 29         58 $self->_handle_middle_run_mode_opt($arg_orig);
173              
174 27         72 my $arg = $arg_orig;
175 27         78 $arg =~ s!^-!!;
176 27         67 my $map = $self->_get_arged_short_opts_map();
177 27         56 my $first_char = substr($arg, 0, 1);
178 27 50       70 if (exists($map->{$first_char}))
179             {
180 27         100 my $sub = $self->can($map->{$first_char});
181 27 100       63 if (length($arg) > 1)
182             {
183 14         38 return $sub->(
184             $self, substr($arg, 1)
185             );
186             }
187             else
188             {
189 13 50       25 if ($self->_no_args_left())
190             {
191 0         0 die "An argument should be specified after \"$arg_orig\"";
192             }
193 13         157 return $sub->(
194             $self, $self->_get_next_arg()
195             );
196             }
197             }
198 0         0 die "Unknown option \"$arg_orig\"!";
199             }
200              
201             sub _process_output_short_opt
202             {
203 7     7   62 my $self = shift;
204 7         13 my $filename = shift;
205 7         18 $self->result()->output_to_stdout(0);
206 7         112 $self->result()->output_filename($filename);
207             }
208              
209             sub _process_include_path_opt
210             {
211 14     14   72 my $self = shift;
212 14         25 my $path = shift;
213 14         38 $self->result()->add_to_inc($path);
214             }
215              
216             sub _process_add_includefile_opt
217             {
218 4     4   24 my $self = shift;
219 4         10 my $file = shift;
220 4         12 $self->result()->add_include_file($file);
221             }
222              
223             sub _process_define_opt
224             {
225 19     19   78 my $self = shift;
226 19         38 my $def = shift;
227 19 50       83 if ($def !~ m{^([^=]+)=(.*)$})
228             {
229 0         0 die "Variable definition should contain a \"=\", but instead it is \"$def\"!";
230             }
231 19         50 my ($var, $value) = ($1, $2);
232 19         51 $self->result()->add_to_defs($var, $value);
233             }
234              
235             sub _assign_filename
236             {
237 25     25   42 my ($self, $arg) = @_;
238 25 100       51 if (! $self->_no_args_left())
239             {
240 1         17 die "Junk after filename";
241             }
242             else
243             {
244 24         289 $self->result()->input_filename($arg);
245             }
246             }
247              
248             sub _handle_exclusive_run_mode_opt
249             {
250 36     36   44 my $self = shift;
251 36 100       43 if ((@{$self->argv()} == 1))
  36         91  
252             {
253 10         103 my $opt = $self->argv()->[0];
254 10 100       89 if (exists($self->_get_run_mode_opts_map()->{$opt}))
255             {
256             $self->result()->run_mode(
257 6         18 $self->_get_run_mode_opts_map()->{$opt}
258             );
259 6         67 return 1;
260             }
261             }
262 30         281 return 0;
263             }
264              
265              
266             sub get_result
267             {
268 37     37 1 96 my $self = shift;
269              
270 37 100       80 if ($self->_no_args_left())
271             {
272 1         39 die "Incorrect usage: you need to specify a filename";
273             }
274              
275 36 100       414 if (! $self->_handle_exclusive_run_mode_opt())
276             {
277 30         69 while (defined(my $arg = $self->_get_next_arg()))
278             {
279 74 100       793 if ($arg =~ m{^-})
280             {
281 50 100       120 if ($arg =~ m{^--})
282             {
283 21         49 $self->_handle_long_option($arg);
284             }
285             else
286             {
287 29         64 $self->_handle_short_option($arg);
288             }
289             }
290             else
291             {
292 24         52 $self->_assign_filename($arg);
293             }
294             }
295             }
296 30         283 return $self->result();
297             }
298              
299             1;
300              
301             __END__