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
 );

It also has follwing template toolikit filter routies defined:

=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});
        }

=head3 tt_filter_type

filter to return values of specified from @ds

=cut

        sub tt_filter_type {
                my ($data,$type) = @_;
                
                die "no data?" unless ($data);
                $type ||= 'display';

                my $default_delimiter = {
                        'display' => '&#182;<br/>',
                        'index' => '\n',
                };

                return sub {

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

                        die "no data array" unless ($data->{'data'} && ref($data->{'data'}) eq 'ARRAY');
                        # Hm? Should we die here?
                        return unless ($name);

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

                        return unless($item);

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

                        if (ref($v) eq 'ARRAY') {
                                if ($#{$v} == 0) {
                                        $v = $v->[0];
                                } else {
                                        $join = $default_delimiter->{$type} unless defined($join);
                                        $v = join($join, @{$v});
                                }
                        }

                        return $v;
                }
        }

        $args->{'d'} = tt_filter_type($args, 'display');

        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	package WebPAC::Output::TT;
2
3	use warnings;
4	use strict;
5
6	use base qw/WebPAC::Common/;
7
8	use Template;
9	use List::Util qw/first/;
10	use Data::Dumper;
11
12	=head1 NAME
13
14	WebPAC::Output::TT - use Template Toolkit to produce output
15
16	=head1 VERSION
17
18	Version 0.01
19
20	=cut
21
22	our $VERSION = '0.01';
23
24	=head1 SYNOPSIS
25
26	Produce output using Template Toolkit.
27
28	=head1 FUNCTIONS
29
30	=head2 new
31
32	Create new instance.
33
34	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
41	By default, Template Toolkit will C<EVAL_PERL> if included in templates.
42
43	=cut
44
45	sub new {
46	my $class = shift;
47	my $self = {@_};
48	bless($self, $class);
49
50	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	my $text = $tt->apply(
72	template => 'text.tt',
73	data => \@ds
74	);
75
76	It also has follwing template toolikit filter routies defined:
77
78	=cut
79
80	sub apply {
81	my $self = shift;
82
83	my $args = {@_};
84
85	my $log = $self->_get_logger();
86
87	foreach my $a (qw/template data/) {
88	$log->logconfess("need $a") unless ($args->{$a});
89	}
90
91	=head3 tt_filter_type
92
93	filter to return values of specified from @ds
94
95	=cut
96
97	sub tt_filter_type {
98	my ($data,$type) = @_;
99
100	die "no data?" unless ($data);
101	$type \|\|= 'display';
102
103	my $default_delimiter = {
104	'display' => '¶<br/>',
105	'index' => '\n',
106	};
107
108	return sub {
109
110	my ($name,$join) = @_;
111
112	die "no data array" unless ($data->{'data'} && ref($data->{'data'}) eq 'ARRAY');
113	# Hm? Should we die here?
114	return unless ($name);
115
116	my $item = first { $_->{'name'} eq $name } @{ $data->{'data'} };
117
118	return unless($item);
119
120	my $v = $item->{$type} \|\| return;
121
122	if (ref($v) eq 'ARRAY') {
123	if ($#{$v} == 0) {
124	$v = $v->[0];
125	} else {
126	$join = $default_delimiter->{$type} unless defined($join);
127	$v = join($join, @{$v});
128	}
129	}
130
131	return $v;
132	}
133	}
134
135	$args->{'d'} = tt_filter_type($args, 'display');
136
137	my $out;
138
139	$self->{'tt'}->process(
140	$args->{'template'},
141	$args,
142	\$out
143	) \|\| $log->logconfess( "apply can't process template: ", $self->{'tt'}->error() );
144
145	return $out;
146	}
147
148	=head2 to_file
149
150	Create output from in-memory data structure using Template Toolkit template
151	to a file.
152
153	$tt->to_file(
154	file => 'out.txt',
155	template => 'text.tt',
156	data => \@ds
157	);
158
159	=cut
160
161	sub to_file {
162	my $self = shift;
163
164	my $args = {@_};
165
166	my $log = $self->_get_logger();
167
168	my $file = $args->{'file'} \|\| $log->logconfess("need file name");
169
170	$log->debug("creating file ",$file);
171
172	open(my $fh, ">", $file) \|\| $log->logdie("can't open output file '$file': $!");
173	print $fh $self->output(
174	template => $args->{'template'},
175	data => $args->{'data'},
176	) \|\| $log->logdie("print: $!");
177	close($fh) \|\| $log->logdie("close: $!");
178
179	return 1;
180	}
181
182
183	=head1 AUTHOR
184
185	Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
186
187	=head1 COPYRIGHT & LICENSE
188
189	Copyright 2005 Dobrica Pavlinusic, All Rights Reserved.
190
191	This program is free software; you can redistribute it and/or modify it
192	under the same terms as Perl itself.
193
194	=cut
195
196	1; # End of WebPAC::Output::TT