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 =cut
  77
  78 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         # 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 = '&#182;<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         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 }
 129
 130 =head2 to_file
 131
 132 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         data => \@ds
 139  );
 140
 141 =cut
 142
 143 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 }
 163
 164
 165 =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 1; # End of WebPAC::Output::TT