1use strict; use warnings;
2package Template::Toolkit::Simple;
3our $VERSION = '0.31';
4
5use Encode;
6use Getopt::Long;
7use Template;
8use Template::Constants qw( :debug );
9use YAML::XS;
10
11use base 'Exporter';
12our @EXPORT = qw(tt);
13
14sub tt {
15    return Template::Toolkit::Simple->new();
16}
17
18my $default = {
19    data => undef,
20    config => undef,
21    output => undef,
22
23    encoding => 'utf8',
24    include_path => undef,
25    eval_perl => 0,
26    start_tag => quotemeta('[' . '%'),
27    end_tag => quotemeta('%' . ']'),
28    tag_style => 'template',
29    pre_chomp => 0,
30    post_chomp => 0,
31    trim => 0,
32    interpolate => 0,
33    anycase => 0,
34    delimiter => ':',
35    absolute => 0,
36    relative => 0,
37    strict => 0,
38    default => undef,
39    blocks => undef,
40    auto_reset => 1,
41    recursion => 0,
42    pre_process => undef,
43    post_process => undef,
44    process_template => undef,
45    error_template => undef,
46    output_path => undef,
47    debug => 0,
48    cache_size => undef,
49    compile_ext => undef,
50    compile_dir => undef,
51};
52
53my $abbreviations = {
54    data => 'd',
55    include_path => 'path|i',
56    output => 'o',
57    config => 'c',
58};
59
60sub new {
61    my $class = shift;
62    return bless shift || {%$default}, $class;
63}
64
65sub field {
66    my ($name, $value) = @_;
67    return sub {
68        my $self = shift;
69        $self->{$name} = @_ ? shift : $value;
70        return $self;
71    };
72}
73
74{
75    for my $name (keys %$default) {
76        next if $name =~ /^(data|config)/;
77        my $value = $default->{$name};
78        if (defined $value) {
79            $value = 1 - $value if $value =~/^[01]$/;
80            $value = [] if $name eq 'include_path';
81        }
82        no strict 'refs';
83        *{__PACKAGE__ . '::' . $name} = field($name, $value);
84    }
85}
86
87{
88    no warnings 'once';
89    *path = \&include_path;
90}
91
92sub render {
93    my $self = shift;
94    my $template = shift
95      or die "render method requires a template name";
96    if ($template =~ qr{//}) {
97        my $path;
98        ($path, $template) = split '//', $template, 2;
99        $self->include_path($path);
100    }
101    $self->data(shift(@_)) if @_;
102    $self->output(shift(@_)) if @_;
103
104    if ($self->{output}) {
105        $self->process($template, $self->{data}, $self->{output})
106            or $self->croak;
107        return '';
108    }
109
110    my $output = '';
111    $self->process($template, $self->{data}, \$output)
112        or $self->croak;
113    return Encode::encode_utf8($output);
114}
115
116sub usage {
117    return <<'...'
118Usage:
119
120    tt-render --path=path/to/templates/ --data=data.yaml foo.tt2
121
122...
123}
124
125sub croak {
126    my $self = shift;
127    require Carp;
128    my $error = $self->{tt}->error;
129    chomp $error;
130    Carp::croak($error . "\n");
131};
132
133sub process {
134    my $self = shift;
135
136    $self->{tt} = Template->new(
137        ENCODING            => $self->{encoding},
138        INCLUDE_PATH        => $self->{include_path},
139        EVAL_PERL           => $self->{eval_perl},
140        START_TAG           => $self->{start_tag},
141        END_TAG             => $self->{end_tag},
142        PRE_CHOMP           => $self->{pre_chomp},
143        POST_CHOMP          => $self->{post_chomp},
144        TRIM                => $self->{trim},
145        INTERPOLATE         => $self->{interpolate},
146        ANYCASE             => $self->{anycase},
147        DELIMITER           => $self->{delimiter},
148        ABSOLUTE            => $self->{absolute},
149        STRICT              => $self->{strict},
150        DEFAULT             => $self->{default},
151        BLOCKS              => $self->{blocks},
152        AUTO_RESET          => $self->{auto_reset},
153        RECURSION           => $self->{recursion},
154        PRE_PROCESS         => $self->{pre_process},
155        POST_PROCESS        => $self->{post_process},
156        PROCESS_TEMPLATE    => $self->{process_template},
157        ERROR_TEMPLATE      => $self->{error_template},
158        OUTPUT_PATH         => $self->{output_path},
159        DEBUG               =>
160            ($self->{debug} && DEBUG_ALL ^ DEBUG_CALLER ^ DEBUG_CONTEXT),
161        CACHE_SIZE          => $self->{cache_size},
162        COMPILE_EXT         => $self->{compile_ext},
163        COMPILE_DIR         => $self->{compile_dir},
164    );
165
166    return $self->{tt}->process(@_);
167}
168
169sub data {
170    my $self = shift;
171    $self->{data} = $self->_file_to_hash(@_);
172    return $self;
173}
174
175sub config {
176    my $self = shift;
177    $self = {
178        %$self,
179        $self->_file_to_hash(@_)
180    };
181    return $self;
182}
183
184sub _file_to_hash {
185    my $self = shift;
186    my $file_name = shift;
187    return
188        (ref($file_name) eq 'HASH')
189        ? $file_name
190        : ($file_name =~ /\.(?:yaml|yml)$/i)
191        ? $self->_load_yaml($file_name)
192        : ($file_name =~ /\.json$/i)
193        ? $self->_load_json($file_name)
194        : ($file_name =~ /\.xml$/i)
195        ? $self->_load_xml($file_name)
196        : die "Expected '$file_name' to end with .yaml, .json or .xml";
197}
198
199sub _load_yaml {
200    my $self = shift;
201    YAML::XS::LoadFile(shift);
202}
203
204sub _load_json {
205    my $self = shift;
206    require JSON::XS;
207    my $json = do { local $/; open my $json, '<', shift; <$json> };
208    JSON::XS::decode_json($json);
209}
210
211sub _load_xml {
212    my $self = shift;
213    require XML::Simple;
214    XML::Simple::XMLin(shift);
215}
216
217sub _run_command {
218    my $class = shift;
219    my $self = $class->new($default);
220    local @ARGV = @_;
221    my $template = pop or do {
222        print STDERR $self->usage();
223        return;
224    };
225    my $setter = sub {
226        my ($name, $value) = @_;
227        my $method = lc($name);
228        $method =~ s/-/_/g;
229        $value = quotemeta($value)
230            if $method =~ /_tag$/;
231        $self->$method($value);
232    };
233    GetOptions(
234        map {
235            my $option = $_;
236            my $option2 = $option;
237            $option .= "|$option2" if $option2 =~ s/_/-/g;
238            $option .= "|$abbreviations->{$_}"
239                if defined $abbreviations->{$_};
240            $option .= ((not defined $default->{$_} or $option =~/\-tag$/) ? '=s' : '');
241            ($option, $setter);
242        } keys %$default
243    );
244
245    print STDOUT $self->render($template);
246}
247
2481;
249