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   70132 use strict;
  3         14  
  3         91  
4 3     3   16 use warnings;
  3         6  
  3         85  
5              
6              
7 3     3   16 use base 'Template::Preprocessor::TTML::Base';
  3         6  
  3         639  
8              
9             package Template::Preprocessor::TTML::CmdLineProc::Results;
10              
11 3     3   20 use base 'Template::Preprocessor::TTML::Base';
  3         7  
  3         4598  
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   62 my $self = shift;
26 37         109 $self->output_to_stdout(1);
27 37         415 $self->include_path([]);
28 37         396 $self->defines(+{});
29 37         426 $self->include_files([]);
30 37         385 $self->run_mode("regular");
31 37         347 return 0;
32             }
33              
34             sub add_to_inc
35             {
36 14     14   134 my $self = shift;
37 14         24 my $path = shift;
38 14         23 push @{$self->include_path()}, $path;
  14         30  
39             }
40              
41             sub add_to_defs
42             {
43 19     19   206 my ($self, $k, $v) = @_;
44 19         42 $self->defines()->{$k} = $v;
45             }
46              
47             sub add_include_file
48             {
49 4     4   56 my $self = shift;
50 4         8 my $path = shift;
51 4         7 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 61 my $self = shift;
65 37         106 my (%args) = @_;
66 37         141 $self->argv($args{argv});
67              
68 37         518 $self->result(Template::Preprocessor::TTML::CmdLineProc::Results->new());
69 37         361 return 0;
70             }
71              
72             sub _get_next_arg
73             {
74 122     122   1099 my $self = shift;
75 122         183 return shift(@{$self->argv()});
  122         222  
76             }
77              
78             sub _no_args_left
79             {
80 85     85   167 my $self = shift;
81 85         125 return (@{$self->argv()} == 0);
  85         168  
82             }
83              
84             sub _get_run_mode_opts_map
85             {
86             return
87             {
88 65     65   365 "--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   59 "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   97 my ($self, $arg) = @_;
108 49 100       94 if (exists($self->_get_run_mode_opts_map()->{$arg}))
109             {
110 4         57 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   35 my $self = shift;
117 21         34 my $arg_orig = shift;
118 21 100       54 if ($arg_orig eq "--")
119             {
120 1         3 return $self->_handle_no_more_options();
121             }
122 20         53 $self->_handle_middle_run_mode_opt($arg_orig);
123 18         48 my $arg = $arg_orig;
124 18         63 $arg =~ s!^--!!;
125 18         43 my $map = $self->_get_arged_longs_opts_map();
126 18         54 $arg =~ m{^([^=]*)};
127 18         49 my $option = $1;
128 18 100       45 if (exists($map->{$option}))
129             {
130 17         54 my $sub = $self->can($map->{$option});
131 17 100       56 if (length($arg) eq length($option))
132             {
133 10 50       22 if ($self->_no_args_left())
134             {
135 0         0 die "An argument should be specified after \"$arg_orig\"";
136             }
137 10         117 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         10 die "Unknown option!";
149             }
150              
151             sub _handle_no_more_options
152             {
153 1     1   3 my $self = shift;
154 1         3 $self->_assign_filename($self->_get_next_arg());
155             }
156              
157             sub _get_arged_short_opts_map
158             {
159             return
160             {
161 27     27   80 "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   45 my $self = shift;
170 29         48 my $arg_orig = shift;
171              
172 29         75 $self->_handle_middle_run_mode_opt($arg_orig);
173              
174 27         77 my $arg = $arg_orig;
175 27         94 $arg =~ s!^-!!;
176 27         63 my $map = $self->_get_arged_short_opts_map();
177 27         66 my $first_char = substr($arg, 0, 1);
178 27 50       69 if (exists($map->{$first_char}))
179             {
180 27         107 my $sub = $self->can($map->{$first_char});
181 27 100       65 if (length($arg) > 1)
182             {
183 14         48 return $sub->(
184             $self, substr($arg, 1)
185             );
186             }
187             else
188             {
189 13 50       26 if ($self->_no_args_left())
190             {
191 0         0 die "An argument should be specified after \"$arg_orig\"";
192             }
193 13         155 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   66 my $self = shift;
204 7         15 my $filename = shift;
205 7         14 $self->result()->output_to_stdout(0);
206 7         177 $self->result()->output_filename($filename);
207             }
208              
209             sub _process_include_path_opt
210             {
211 14     14   89 my $self = shift;
212 14         33 my $path = shift;
213 14         32 $self->result()->add_to_inc($path);
214             }
215              
216             sub _process_add_includefile_opt
217             {
218 4     4   27 my $self = shift;
219 4         9 my $file = shift;
220 4         13 $self->result()->add_include_file($file);
221             }
222              
223             sub _process_define_opt
224             {
225 19     19   88 my $self = shift;
226 19         82 my $def = shift;
227 19 50       98 if ($def !~ m{^([^=]+)=(.*)$})
228             {
229 0         0 die "Variable definition should contain a \"=\", but instead it is \"$def\"!";
230             }
231 19         63 my ($var, $value) = ($1, $2);
232 19         48 $self->result()->add_to_defs($var, $value);
233             }
234              
235             sub _assign_filename
236             {
237 25     25   65 my ($self, $arg) = @_;
238 25 100       51 if (! $self->_no_args_left())
239             {
240 1         20 die "Junk after filename";
241             }
242             else
243             {
244 24         252 $self->result()->input_filename($arg);
245             }
246             }
247              
248             sub _handle_exclusive_run_mode_opt
249             {
250 36     36   56 my $self = shift;
251 36 100       61 if ((@{$self->argv()} == 1))
  36         71  
252             {
253 10         107 my $opt = $self->argv()->[0];
254 10 100       98 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         75 return 1;
260             }
261             }
262 30         286 return 0;
263             }
264              
265              
266             sub get_result
267             {
268 37     37 1 115 my $self = shift;
269              
270 37 100       83 if ($self->_no_args_left())
271             {
272 1         33 die "Incorrect usage: you need to specify a filename";
273             }
274              
275 36 100       450 if (! $self->_handle_exclusive_run_mode_opt())
276             {
277 30         68 while (defined(my $arg = $self->_get_next_arg()))
278             {
279 74 100       909 if ($arg =~ m{^-})
280             {
281 50 100       123 if ($arg =~ m{^--})
282             {
283 21         49 $self->_handle_long_option($arg);
284             }
285             else
286             {
287 29         66 $self->_handle_short_option($arg);
288             }
289             }
290             else
291             {
292 24         51 $self->_assign_filename($arg);
293             }
294             }
295             }
296 30         276 return $self->result();
297             }
298              
299             1;
300              
301             __END__