git.rot13.org Git - webpac2/blob - lib/WebPAC/Output/TT.pm

   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' => '&#182;<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