WebPAC/Output/TT.pm

package WebPAC::Output::TT;

use warnings;
use strict;

use base qw/WebPAC::Common/;

use Template;
use List::Util qw/first/;
use Data::Dumper;

=head1 NAME

WebPAC::Output::TT - use Template Toolkit to produce output

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

=head1 SYNOPSIS

Produce output using Template Toolkit.

=head1 FUNCTIONS

=head2 new

Create new instance.

 my $tt = new WebPAC::Output::TT(
        include_path => '/path/to/conf/output/tt',
        filters => {
                filter_1 => sub { uc(shift) },
        },
 );

By default, Template Toolkit will C<EVAL_PERL> if included in templates.

=cut

sub new {
        my $class = shift;
        my $self = {@_};
        bless($self, $class);

        my $log = $self->_get_logger;

        # create Template toolkit instance
        $self->{'tt'} = Template->new(
                INCLUDE_PATH => $self->{'include_path'},
                FILTERS => $self->{'filter'},
                EVAL_PERL => 1,
        );
        
        $log->logdie("can't create TT object: $Template::ERROR") unless ($self->{'tt'});

        $log->debug("filters defined: ",Dumper($self->{'filter'}));

        $self ? return $self : return undef;
}


=head2 apply

Create output from in-memory data structure using Template Toolkit template.

 my $text = $tt->apply(
        template => 'text.tt',
        data => \@ds
 );

=cut

sub apply {
        my $self = shift;

        my $args = {@_};

        my $log = $self->_get_logger();

        foreach my $a (qw/template data/) {
                $log->logconfess("need $a") unless ($args->{$a});
        }

        # filter to return value from @ds

        sub tt_filter_d {

                my ($name,$join) = @_;

print "### name = ",Dumper($name);

                my $item = first { $_->{'name'} eq $name } @{ $args->{'data'} };

                return unless($item);

print "### item = ",Dumper($item);

                my $v = $item->{'display'} || return;

                if (ref($v) eq 'ARRAY') {
                        if ($#{$v} == 0) {
                                $v = $v->[0];
                        } else {
                                $join = '&#182;<br/>' unless defined($join);
                                $v = join($join, @{$v});
                        }
                }
print "### v = $v\n";
                return $v;
        }
        $args->{'d'} = \&tt_filter_d;


        my $out;

        $self->{'tt'}->process(
                $args->{'template'},
                $args,
                \$out
        ) || $log->logconfess( "apply can't process template: ", $self->{'tt'}->error() );

        return $out;
}

=head2 to_file

Create output from in-memory data structure using Template Toolkit template
to a file.

 $tt->to_file(
        file => 'out.txt',
        template => 'text.tt',
        data => \@ds
 );

=cut

sub to_file {
        my $self = shift;

        my $args = {@_};

        my $log = $self->_get_logger();

        my $file = $args->{'file'} || $log->logconfess("need file name");

        $log->debug("creating file ",$file);

        open(my $fh, ">", $file) || $log->logdie("can't open output file '$file': $!");
        print $fh $self->output(
                template => $args->{'template'},
                data => $args->{'data'},
        ) || $log->logdie("print: $!");
        close($fh) || $log->logdie("close: $!");

        return 1;
}


=head1 AUTHOR

Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of WebPAC::Output::TT
1	dpavlin	16	package WebPAC::Output::TT;
2	dpavlin	1
3			use warnings;
4			use strict;
5
6	dpavlin	16	use base qw/WebPAC::Common/;
7
8			use Template;
9	dpavlin	42	use List::Util qw/first/;
10	dpavlin	16	use Data::Dumper;
11
12	dpavlin	1	=head1 NAME
13
14	dpavlin	16	WebPAC::Output::TT - use Template Toolkit to produce output
15	dpavlin	1
16			=head1 VERSION
17
18			Version 0.01
19
20			=cut
21
22			our $VERSION = '0.01';
23
24			=head1 SYNOPSIS
25
26	dpavlin	16	Produce output using Template Toolkit.
27	dpavlin	1
28	dpavlin	16	=head1 FUNCTIONS
29	dpavlin	1
30	dpavlin	16	=head2 new
31	dpavlin	1
32	dpavlin	16	Create new instance.
33	dpavlin	1
34	dpavlin	16	my $tt = new WebPAC::Output::TT(
35			include_path => '/path/to/conf/output/tt',
36			filters => {
37			filter_1 => sub { uc(shift) },
38			},
39			);
40	dpavlin	1
41	dpavlin	16	By default, Template Toolkit will C<EVAL_PERL> if included in templates.
42	dpavlin	1
43	dpavlin	16	=cut
44	dpavlin	1
45	dpavlin	16	sub new {
46			my $class = shift;
47			my $self = {@_};
48			bless($self, $class);
49	dpavlin	1
50	dpavlin	16	my $log = $self->_get_logger;
51
52			# create Template toolkit instance
53			$self->{'tt'} = Template->new(
54			INCLUDE_PATH => $self->{'include_path'},
55			FILTERS => $self->{'filter'},
56			EVAL_PERL => 1,
57			);
58
59			$log->logdie("can't create TT object: $Template::ERROR") unless ($self->{'tt'});
60
61			$log->debug("filters defined: ",Dumper($self->{'filter'}));
62
63			$self ? return $self : return undef;
64			}
65
66
67			=head2 apply
68
69			Create output from in-memory data structure using Template Toolkit template.
70
71	dpavlin	21	my $text = $tt->apply(
72			template => 'text.tt',
73	dpavlin	33	data => \@ds
74	dpavlin	21	);
75	dpavlin	16
76	dpavlin	1	=cut
77
78	dpavlin	16	sub apply {
79			my $self = shift;
80
81			my $args = {@_};
82
83			my $log = $self->_get_logger();
84
85			foreach my $a (qw/template data/) {
86			$log->logconfess("need $a") unless ($args->{$a});
87			}
88
89	dpavlin	42	# filter to return value from @ds
90
91			sub tt_filter_d {
92
93			my ($name,$join) = @_;
94
95			print "### name = ",Dumper($name);
96
97			my $item = first { $_->{'name'} eq $name } @{ $args->{'data'} };
98
99			return unless($item);
100
101			print "### item = ",Dumper($item);
102
103			my $v = $item->{'display'} \|\| return;
104
105			if (ref($v) eq 'ARRAY') {
106			if ($#{$v} == 0) {
107			$v = $v->[0];
108			} else {
109			$join = '¶<br/>' unless defined($join);
110			$v = join($join, @{$v});
111			}
112			}
113			print "### v = $v\n";
114			return $v;
115			}
116			$args->{'d'} = \&tt_filter_d;
117
118
119	dpavlin	16	my $out;
120
121			$self->{'tt'}->process(
122			$args->{'template'},
123			$args,
124			\$out
125			) \|\| $log->logconfess( "apply can't process template: ", $self->{'tt'}->error() );
126
127			return $out;
128	dpavlin	1	}
129
130	dpavlin	16	=head2 to_file
131	dpavlin	1
132	dpavlin	16	Create output from in-memory data structure using Template Toolkit template
133			to a file.
134
135			$tt->to_file(
136			file => 'out.txt',
137			template => 'text.tt',
138	dpavlin	33	data => \@ds
139	dpavlin	16	);
140
141	dpavlin	1	=cut
142
143	dpavlin	16	sub to_file {
144			my $self = shift;
145
146			my $args = {@_};
147
148			my $log = $self->_get_logger();
149
150			my $file = $args->{'file'} \|\| $log->logconfess("need file name");
151
152			$log->debug("creating file ",$file);
153
154			open(my $fh, ">", $file) \|\| $log->logdie("can't open output file '$file': $!");
155			print $fh $self->output(
156			template => $args->{'template'},
157			data => $args->{'data'},
158			) \|\| $log->logdie("print: $!");
159			close($fh) \|\| $log->logdie("close: $!");
160
161			return 1;
162	dpavlin	1	}
163
164	dpavlin	16
165	dpavlin	1	=head1 AUTHOR
166
167			Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
168
169			=head1 COPYRIGHT & LICENSE
170
171			Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
172
173			This program is free software; you can redistribute it and/or modify it
174			under the same terms as Perl itself.
175
176			=cut
177
178	dpavlin	16	1; # End of WebPAC::Output::TT