1package Text::Xslate::Runner;
2use Mouse;
3use Mouse::Util::TypeConstraints;
4
5use List::Util     ();
6use File::Spec     ();
7use File::Basename ();
8use Getopt::Long   ();
9
10{
11    package
12        Text::Xslate::Runner::Getopt;
13    use Mouse::Role;
14
15    has cmd_aliases => (
16        is         => 'ro',
17        isa        => 'ArrayRef[Str]',
18        default    => sub { [] },
19        auto_deref => 1,
20    );
21
22    no Mouse::Role;
23}
24
25my $getopt = Getopt::Long::Parser->new(
26    config => [qw(
27        no_ignore_case
28        bundling
29        no_auto_abbrev
30    )],
31);
32
33my $Pattern = subtype __PACKAGE__ . '.Pattern', as 'RegexpRef';
34coerce $Pattern => from 'Str' => via { qr/$_/ };
35
36my $getopt_traits = ['Text::Xslate::Runner::Getopt'];
37
38has 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
47has 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
56has 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
65has 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
75has 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
86has 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
95has 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
104has 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
113has 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
124has 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
134has 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
143has dest => (
144    documentation => 'Destination directory',
145    cmd_aliases   => [qw(o)],
146    is            => 'ro',
147    isa           => 'Str', # Maybe[Str]
148    required      => 0,
149    traits        => $getopt_traits,
150);
151
152has 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
161has 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
170has 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
179has 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
188has version => (
189    documentation => 'Print version information',
190    is            => 'ro',
191    isa           => 'Bool',
192    traits        => $getopt_traits,
193);
194
195has help => (
196    documentation => 'Print this help',
197    is            => 'ro',
198    isa           => 'Bool',
199    traits        => $getopt_traits,
200);
201
202has targets => (
203    is         => 'ro',
204    isa        => 'ArrayRef[Str]',
205    default    => sub { [] },
206    auto_deref => 1,
207);
208
209my @Spec = __PACKAGE__->_build_getopt_spec();
210sub getopt_spec { @Spec }
211
212sub _build_getopt_spec {
213    my($self) = @_;
214
215    my @spec;
216    foreach my $attr($self->meta->get_all_attributes) {
217        next unless $attr->does('Text::Xslate::Runner::Getopt');
218
219        my $isa = $attr->type_constraint;
220
221        my $type;
222        if($isa->is_a_type_of('Bool')) {
223            $type = '';
224        }
225        elsif($isa->is_a_type_of('Int')) {
226            $type = '=i';
227        }
228        elsif($isa->is_a_type_of('Num')) {
229            $type = '=f';
230        }
231        elsif($isa->is_a_type_of('ArrayRef')) {
232            $type = '=s@';
233        }
234        elsif($isa->is_a_type_of('HashRef')) {
235            $type = '=s%';
236        }
237        else {
238            $type = '=s';
239        }
240
241        my @names = ($attr->name, $attr->cmd_aliases);
242        push @spec, join('|', @names) . $type;
243    }
244    return @spec;
245}
246
247sub new_from {
248    my $class = shift;
249    local @ARGV = @_;
250    my %opts;
251    $getopt->getoptions(\%opts, $class->getopt_spec())
252        or die $class->help_message;
253
254    $opts{targets} = [@ARGV];
255    return $class->new(\%opts);
256}
257
258sub run {
259    my($self, @targets) = @_;
260
261    my %args;
262    foreach my $field (qw(
263        cache_dir cache path syntax
264        type verbose
265            )) {
266        my $method = "has_$field";
267        $args{ $field } = $self->$field if $self->$method;
268    }
269    if($self->has_module) { # re-mapping
270        my $mod = $self->module;
271        my @mods;
272        foreach my $name(keys %{$mod}) {
273            push @mods, $name, [ split /,/, $mod->{$name} ];
274        }
275        $args{module} = \@mods;
276    }
277
278    if(my $ie = $self->input_encoding) {
279        $args{input_layer} = ":encoding($ie)";
280    }
281
282    local $ENV{XSLATE} = $self->debug
283        if $self->has_debug;
284
285    require Text::Xslate;
286
287    if($self->help) {
288        print $self->help_message();
289        return;
290    }
291    elsif($self->version) {
292        print $self->version_info();
293        return;
294    }
295
296    Mouse::load_class($self->engine);
297    my $xslate = $self->engine->new(%args);
298
299    if($self->has_eval) {
300        my %vars;
301        if($self->has_define){
302            %vars = %{$self->define};
303        }
304        $vars{ARGV} = \@targets;
305        $vars{ENV}  = \%ENV;
306        print $xslate->render_string($self->eval, \%vars), "\n";
307        return;
308    }
309
310    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        if ( -d $target ) {
314            local $self->{__process_base} = scalar(File::Spec->splitdir($target));
315            local $xslate->{path} = [ $target, @{ $xslate->{path} || [] } ];
316            $self->process_tree( $xslate, $target );
317        } else {
318            my $dirname = File::Basename::dirname($target);
319            local $self->{__process_base} = scalar(File::Spec->splitdir($dirname));
320            local $xslate->{path} = [ $dirname, @{ $xslate->{path} || [] } ];
321            $self->process_file( $xslate, $target );
322        }
323    }
324}
325
326sub process_tree {
327    my ($self, $xslate, $dir) = @_;
328
329    opendir( my $fh, $dir ) or die "Could not opendir '$dir': !";
330
331    while (my $e = readdir $fh) {
332        next if $e =~ /^\.+$/;
333        my $target = File::Spec->catfile( $dir, $e );
334        if (-d $target) {
335            $self->process_tree( $xslate, $target );
336        } else {
337            $self->process_file( $xslate, $target );
338        }
339    }
340}
341
342sub process_file {
343    my ($self, $xslate, $file) = @_;
344
345    if ( my $ignore = $self->ignore ) {
346        if ($file =~ $ignore) {
347            return;
348        }
349    }
350
351    my $suffix_map = $self->suffix;
352    my $dest = $self->dest;
353
354    my ($suffix) = ($file =~ /\.([^\.]+)$/);
355
356    my $filearg = $file;
357    if (my $base = $self->{__process_base}) {
358        my @comps = File::Spec->splitdir( File::Basename::dirname($file) );
359        splice @comps, 0, $base;
360        $filearg = File::Spec->catfile( @comps, File::Basename::basename($file) );
361    }
362
363    my $outfile;
364
365    if(defined $dest or exists $suffix_map->{$suffix}) {
366        $outfile= File::Spec->catfile( $dest, $filearg );
367        if (my $replace = $suffix_map->{ $suffix }) {
368            $outfile =~ s/$suffix$/$replace/;
369        }
370
371        my $dir = File::Basename::dirname( $outfile );
372        if (! -d $dir) {
373            require File::Path;
374            if (! File::Path::mkpath( $dir )) {
375                die "Could not create directory $dir: $!";
376            }
377        }
378    }
379
380    my $rendered = $xslate->render( $filearg, $self->define );
381    $rendered = $self->_encode($rendered);
382
383    if(defined $outfile) {
384        my $fh;
385        open( $fh, '>', $outfile )
386            or die "Could not open file $outfile for writing: $!";
387
388        print $fh $rendered;
389
390        close $fh or warn "Could not close file $outfile: $!";
391    }
392    else {
393        print $rendered;
394    }
395}
396
397sub version_info {
398    my($self) = @_;
399    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
406sub help_message {
407    my($self) = @_;
408    my @options;
409    foreach my $attr($self->meta->get_all_attributes) {
410        next unless $attr->does('Text::Xslate::Runner::Getopt');
411
412        my $name  = join ' ', map { length($_) == 1 ? "-$_": "--$_" }
413                                ($attr->cmd_aliases, $attr->name);
414
415        push @options, [ $name => $attr->documentation ];
416    }
417    my $max_len = List::Util::max( map { length $_->[0] } @options );
418
419    my $message = sprintf "usage: %s [options...] [input-files]\n",
420        File::Basename::basename($0);
421
422    foreach my $opt(@options) {
423        $message .= sprintf "    %-*s  %s\n", $max_len, @{$opt};
424    }
425
426    $message .= <<'EXAMPLE';
427
428Examples:
429    xslate -e "Hello, <: $ARGV[0] :> world!" Kolon
430    xslate -s TTerse -e "Hello, [% ARGV.0 %] world!" TTerse
431
432EXAMPLE
433    return $message;
434}
435
436sub _encode {
437    my($self, $str) = @_;
438    my $oe = $self->output_encoding;
439    if($oe ne 'UTF-8') {
440        require Encode;
441        return Encode::encode($oe, $str);
442    }
443    else {
444        utf8::encode($str);
445        return $str;
446    }
447}
448
449no Mouse;
450no Mouse::Util::TypeConstraints;
451__PACKAGE__->meta->make_immutable;
452
453__END__
454
455=head1 NAME
456
457Text::Xslate::Runner - The guts of the xslate(1) command
458
459=head1 DESCRIPTION
460
461This is the guts of C<xslate(1)>.
462
463=head1 AUTHOR
464
465This is originally written by Maki, Daisuke (lestrrat),
466and also maintained by Fuji, Goro (gfx),
467
468=head1 SEE ALSO
469
470L<Text::Xslate>
471
472L<xslate(1)>
473
474=cut
475
476