File Coverage

blib/lib/Text/Xslate/Runner.pm
Criterion Covered Total %
statement 131 158 82.9
branch 38 68 55.8
condition 1 3 33.3
subroutine 18 19 94.7
pod 0 7 0.0
total 188 255 73.7


line stmt bran cond sub pod time code
1             package Text::Xslate::Runner;
2 2     2   49490 use Mouse;
  2         65852  
  2         10  
3 2     2   625 use Mouse::Util::TypeConstraints;
  2         4  
  2         8  
4              
5 2     2   162 use List::Util ();
  2         4  
  2         30  
6 2     2   10 use File::Spec ();
  2         3  
  2         28  
7 2     2   10 use File::Basename ();
  2         4  
  2         30  
8 2     2   2504 use Getopt::Long ();
  2         27625  
  2         90  
9              
10             {
11             package
12             Text::Xslate::Runner::Getopt;
13 2     2   1403 use Mouse::Role;
  2         1944  
  2         8  
14              
15             has cmd_aliases => (
16             is => 'ro',
17             isa => 'ArrayRef[Str]',
18             default => sub { [] },
19             auto_deref => 1,
20             );
21              
22 2     2   635 no Mouse::Role;
  2         4  
  2         10  
23             }
24              
25             my $getopt = Getopt::Long::Parser->new(
26             config => [qw(
27             no_ignore_case
28             bundling
29             no_auto_abbrev
30             )],
31             );
32              
33             my $Pattern = subtype __PACKAGE__ . '.Pattern', as 'RegexpRef';
34             coerce $Pattern => from 'Str' => via { qr/$_/ };
35              
36             my $getopt_traits = ['Text::Xslate::Runner::Getopt'];
37              
38             has cache_dir => (
39             documentation => 'Directory the cache files will be saved in',
40             cmd_aliases => [qw(c)],
41             is => 'ro',
42             isa => 'Str',
43             predicate => 'has_cache_dir',
44             traits => $getopt_traits,
45             );
46              
47             has cache => (
48             documentation => 'Cache level',
49             cmd_aliases => [qw(a)],
50             is => 'ro',
51             isa => 'Int',
52             predicate => 'has_cache',
53             traits => $getopt_traits,
54             );
55              
56             has module => (
57             documentation => 'Modules templates will use (e.g. name=sub1,sub2)',
58             cmd_aliases => [qw(M)],
59             is => 'ro',
60             isa => 'HashRef[Str]',
61             predicate => 'has_module',
62             traits => $getopt_traits,
63             );
64              
65             has input_encoding => (
66             documentation => 'Input encoding (default: UTF-8)',
67             cmd_aliases => [qw(ie)],
68             is => 'rw',
69             isa => 'Str',
70             default => 'UTF-8',
71             predicate => 'has_input_encoding',
72             traits => $getopt_traits,
73             );
74              
75             has output_encoding => (
76             documentation => 'Output encoding (default: UTF-8)',
77             cmd_aliases => [qw(oe)],
78             is => 'rw',
79             isa => 'Str',
80             default => 'UTF-8',
81             predicate => 'has_output_encoding',
82             traits => $getopt_traits,
83             );
84              
85              
86             has path => (
87             documentation => 'Include paths',
88             cmd_aliases => [qw(I)],
89             is => 'ro',
90             isa => 'ArrayRef[Str]',
91             predicate => 'has_path',
92             traits => $getopt_traits,
93             );
94              
95             has syntax => (
96             documentation => 'Template syntax (e.g. TTerse)',
97             cmd_aliases => [qw(s)],
98             is => 'ro',
99             isa => 'Str',
100             predicate => 'has_syntax',
101             traits => $getopt_traits,
102             );
103              
104             has type => (
105             documentation => 'Output content type (html | xml | text)',
106             cmd_aliases => [qw(t)],
107             is => 'ro',
108             isa => 'Str',
109             predicate => 'has_type',
110             traits => $getopt_traits,
111             );
112              
113             has verbose => (
114             documentation => 'Warning level (default: 2)',
115             cmd_aliases => [qw(w)],
116             is => 'ro',
117             isa => 'Str',
118             default => 2,
119             predicate => 'has_verbose',
120             traits => $getopt_traits,
121             );
122              
123             # --ignore=pattern
124             has ignore => (
125             documentation => 'Regular expression the process will ignore',
126             cmd_aliases => [qw(i)],
127             is => 'ro',
128             isa => $Pattern,
129             coerce => 1,
130             traits => $getopt_traits,
131             );
132              
133             # --suffix old=new
134             has suffix => (
135             documentation => 'Output suffix mapping (e.g. tx=html)',
136             cmd_aliases => [qw(x)],
137             is => 'ro',
138             isa => 'HashRef',
139             default => sub { +{} },
140             traits => $getopt_traits,
141             );
142              
143             has dest => (
144             documentation => 'Destination directry',
145             cmd_aliases => [qw(o)],
146             is => 'ro',
147             isa => 'Str', # Maybe[Str]
148             required => 0,
149             traits => $getopt_traits,
150             );
151              
152             has define => (
153             documentation => 'Define template variables (e.g. foo=bar)',
154             cmd_aliases => [qw(D)],
155             is => 'ro',
156             isa => 'HashRef',
157             predicate => 'has_define',
158             traits => $getopt_traits,
159             );
160              
161             has eval => (
162             documentation => 'One line of template code',
163             cmd_aliases => [qw(e)],
164             is => 'ro',
165             isa => 'Str',
166             predicate => 'has_eval',
167             traits => $getopt_traits,
168             );
169              
170             has engine => (
171             documentation => 'Template engine',
172             cmd_aliases => [qw(E)],
173             is => 'ro',
174             isa => 'Str',
175             default => 'Text::Xslate',
176             traits => $getopt_traits,
177             );
178              
179             has debug => (
180             documentation => 'Debugging flags',
181             cmd_aliases => ['d'],
182             is => 'ro',
183             isa => 'Str',
184             predicate => 'has_debug',
185             traits => $getopt_traits,
186             );
187              
188             has version => (
189             documentation => 'Print version information',
190             is => 'ro',
191             isa => 'Bool',
192             traits => $getopt_traits,
193             );
194              
195             has help => (
196             documentation => 'Print this help',
197             is => 'ro',
198             isa => 'Bool',
199             traits => $getopt_traits,
200             );
201              
202             has targets => (
203             is => 'ro',
204             isa => 'ArrayRef[Str]',
205             default => sub { [] },
206             auto_deref => 1,
207             );
208              
209             my @Spec = __PACKAGE__->_build_getopt_spec();
210 5     5 0 36 sub getopt_spec { @Spec }
211              
212             sub _build_getopt_spec {
213 2     2   4 my($self) = @_;
214              
215 2         3 my @spec;
216 2         9 foreach my $attr($self->meta->get_all_attributes) {
217 38 100       433 next unless $attr->does('Text::Xslate::Runner::Getopt');
218              
219 36         1217 my $isa = $attr->type_constraint;
220              
221 36         39 my $type;
222 36 100       84 if($isa->is_a_type_of('Bool')) {
    100          
    50          
    100          
    100          
223 4         32 $type = '';
224             }
225             elsif($isa->is_a_type_of('Int')) {
226 2         65 $type = '=i';
227             }
228             elsif($isa->is_a_type_of('Num')) {
229 0         0 $type = '=f';
230             }
231             elsif($isa->is_a_type_of('ArrayRef')) {
232 2         152 $type = '=s@';
233             }
234             elsif($isa->is_a_type_of('HashRef')) {
235 6         523 $type = '=s%';
236             }
237             else {
238 22         2191 $type = '=s';
239             }
240              
241 36         134 my @names = ($attr->name, $attr->cmd_aliases);
242 36         142 push @spec, join('|', @names) . $type;
243             }
244 2         56 return @spec;
245             }
246              
247             sub new_from {
248 5     5 0 3184 my $class = shift;
249 5         17 local @ARGV = @_;
250 5         7 my %opts;
251 5 50       19 $getopt->getoptions(\%opts, $class->getopt_spec())
252             or die $class->help_message;
253              
254 5         6835 $opts{targets} = [@ARGV];
255 5         110 return $class->new(\%opts);
256             }
257              
258             sub run {
259 13     13 0 5027 my($self, @targets) = @_;
260              
261 13         26 my %args;
262 13         34 foreach my $field (qw(
263             cache_dir cache path syntax
264             type verbose
265             )) {
266 78         129 my $method = "has_$field";
267 78 100       345 $args{ $field } = $self->$field if $self->$method;
268             }
269 13 100       60 if($self->has_module) { # re-mapping
270 1         4 my $mod = $self->module;
271 1         2 my @mods;
272 1         2 foreach my $name(keys %{$mod}) {
  1         4  
273 1         5 push @mods, $name, [ split /,/, $mod->{$name} ];
274             }
275 1         4 $args{module} = \@mods;
276             }
277              
278 13 50       55 if(my $ie = $self->input_encoding) {
279 13         40 $args{input_layer} = ":encoding($ie)";
280             }
281              
282 13 50       53 local $ENV{XSLATE} = $self->debug
283             if $self->has_debug;
284              
285 13         1621 require Text::Xslate;
286              
287 13 100       103 if($self->help) {
    100          
288 1         5 print $self->help_message();
289 1         6 return;
290             }
291             elsif($self->version) {
292 1         5 print $self->version_info();
293 1         8 return;
294             }
295              
296 11         65 Mouse::load_class($self->engine);
297 11         214 my $xslate = $self->engine->new(%args);
298              
299 11 100       56 if($self->has_eval) {
300 7         8 my %vars;
301 7 100       23 if($self->has_define){
302 6         8 %vars = %{$self->define};
  6         92  
303             }
304 7         17 $vars{ARGV} = \@targets;
305 7         16 $vars{ENV} = \%ENV;
306 7         56 print $xslate->render_string($self->eval, \%vars), "\n";
307 7         1733 return;
308             }
309              
310 4         10 foreach my $target (@targets) {
311             # XXX if you have a directory, just pushed that into the list of
312             # path in the xslate object
313 4 50       81 if ( -d $target ) {
314 0         0 local $self->{__process_base} = scalar(File::Spec->splitdir($target));
315 0 0       0 local $xslate->{path} = [ $target, @{ $xslate->{path} || [] } ];
  0         0  
316 0         0 $self->process_tree( $xslate, $target );
317             } else {
318 4         166 my $dirname = File::Basename::dirname($target);
319 4         40 local $self->{__process_base} = scalar(File::Spec->splitdir($dirname));
320 4 50       7 local $xslate->{path} = [ $dirname, @{ $xslate->{path} || [] } ];
  4         23  
321 4         16 $self->process_file( $xslate, $target );
322             }
323             }
324             }
325              
326             sub process_tree {
327 0     0 0 0 my ($self, $xslate, $dir) = @_;
328              
329 0 0       0 opendir( my $fh, $dir ) or die "Could not opendir '$dir': !";
330              
331 0         0 while (my $e = readdir $fh) {
332 0 0       0 next if $e =~ /^\.+$/;
333 0         0 my $target = File::Spec->catfile( $dir, $e );
334 0 0       0 if (-d $target) {
335 0         0 $self->process_tree( $xslate, $target );
336             } else {
337 0         0 $self->process_file( $xslate, $target );
338             }
339             }
340             }
341              
342             sub process_file {
343 4     4 0 6 my ($self, $xslate, $file) = @_;
344              
345 4 50       18 if ( my $ignore = $self->ignore ) {
346 0 0       0 if ($file =~ $ignore) {
347 0         0 return;
348             }
349             }
350              
351 4         13 my $suffix_map = $self->suffix;
352 4         13 my $dest = $self->dest;
353              
354 4         18 my ($suffix) = ($file =~ /\.([^\.]+)$/);
355              
356 4         8 my $filearg = $file;
357 4 50       17 if (my $base = $self->{__process_base}) {
358 4         98 my @comps = File::Spec->splitdir( File::Basename::dirname($file) );
359 4         12 splice @comps, 0, $base;
360 4         119 $filearg = File::Spec->catfile( @comps, File::Basename::basename($file) );
361             }
362              
363 4         8 my $outfile;
364              
365 4 50 33     21 if(defined $dest or exists $suffix_map->{$suffix}) {
366 0         0 $outfile= File::Spec->catfile( $dest, $filearg );
367 0 0       0 if (my $replace = $suffix_map->{ $suffix }) {
368 0         0 $outfile =~ s/$suffix$/$replace/;
369             }
370              
371 0         0 my $dir = File::Basename::dirname( $outfile );
372 0 0       0 if (! -d $dir) {
373 0         0 require File::Path;
374 0 0       0 if (! File::Path::mkpath( $dir )) {
375 0         0 die "Could not create directory $dir: $!";
376             }
377             }
378             }
379              
380 4         51 my $rendered = $xslate->render( $filearg, $self->define );
381 4         16 $rendered = $self->_encode($rendered);
382              
383 4 50       9677 if(defined $outfile) {
384 0         0 my $fh;
385 0 0       0 open( $fh, '>', $outfile )
386             or die "Could not open file $outfile for writing: $!";
387              
388 0         0 print $fh $rendered;
389              
390 0 0       0 close $fh or warn "Could not close file $outfile: $!";
391             }
392             else {
393 4         519 print $rendered;
394             }
395             }
396              
397             sub version_info {
398 1     1 0 2 my($self) = @_;
399 1         62 return sprintf qq{%s (%s) on Text::Xslate/%s, Perl/%vd.\n},
400             File::Basename::basename($0), ref($self),
401             Text::Xslate->VERSION,
402             $^V,
403             ;
404             }
405              
406             sub help_message {
407 1     1 0 2 my($self) = @_;
408 1         2 my @options;
409 1         5 foreach my $attr($self->meta->get_all_attributes) {
410 19 100       72 next unless $attr->does('Text::Xslate::Runner::Getopt');
411              
412 18 100       634 my $name = join ' ', map { length($_) == 1 ? "-$_": "--$_" }
  34         138  
413             ($attr->cmd_aliases, $attr->name);
414              
415 18         79 push @options, [ $name => $attr->documentation ];
416             }
417 1         15 my $max_len = List::Util::max( map { length $_->[0] } @options );
  18         28  
418              
419 1         53 my $message = sprintf "usage: %s [options...] [input-files]\n",
420             File::Basename::basename($0);
421              
422 1         3 foreach my $opt(@options) {
423 18         22 $message .= sprintf " %-*s %s\n", $max_len, @{$opt};
  18         44  
424             }
425              
426 1         6 $message .= <<'EXAMPLE';
427              
428             Examples:
429             xslate -e "Hello, <: $ARGV[0] :> world!" Kolon
430             xslate -s TTerse -e "Hello, [% ARGV.0 %] world!" TTerse
431              
432             EXAMPLE
433 1         11 return $message;
434             }
435              
436             sub _encode {
437 4     4   9 my($self, $str) = @_;
438 4         14 my $oe = $self->output_encoding;
439 4 100       10 if($oe ne 'UTF-8') {
440 3         18 require Encode;
441 3         13 return Encode::encode($oe, $str);
442             }
443             else {
444 1         3 utf8::encode($str);
445 1         3 return $str;
446             }
447             }
448              
449 2     2   5237 no Mouse;
  2         4  
  2         12  
450 2     2   247 no Mouse::Util::TypeConstraints;
  2         4  
  2         12  
451             __PACKAGE__->meta->make_immutable;
452              
453             __END__