/[webpac2]/trunk/lib/WebPAC/Output/TT.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/WebPAC/Output/TT.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/lib/WebPAC/Output/html.pm revision 1 by dpavlin, Sat Jun 25 20:23:23 2005 UTC trunk/lib/WebPAC/Output/TT.pm revision 201 by dpavlin, Thu Dec 1 13:58:04 2005 UTC
# Line 1  Line 1 
1  package WebPAC::Output::html;  package WebPAC::Output::TT;
2    
3  use warnings;  use warnings;
4  use strict;  use strict;
5    
6    use base qw/WebPAC::Common/;
7    
8    use Template;
9    use List::Util qw/first/;
10    use Data::Dumper;
11    use URI::Escape qw/uri_escape_utf8/;
12    
13  =head1 NAME  =head1 NAME
14    
15  WebPAC::Output::html - The great new WebPAC::Output::html!  WebPAC::Output::TT - use Template Toolkit to produce output
16    
17  =head1 VERSION  =head1 VERSION
18    
19  Version 0.01  Version 0.03
20    
21  =cut  =cut
22    
23  our $VERSION = '0.01';  our $VERSION = '0.03';
24    
25  =head1 SYNOPSIS  =head1 SYNOPSIS
26    
27  Quick summary of what the module does.  Produce output using Template Toolkit.
28    
29  Perhaps a little code snippet.  =head1 FUNCTIONS
30    
31      use WebPAC::Output::html;  =head2 new
32    
33      my $foo = WebPAC::Output::html->new();  Create new instance.
     ...  
34    
35  =head1 EXPORT   my $tt = new WebPAC::Output::TT(
36            include_path => '/path/to/conf/output/tt',
37            filters => {
38                    filter_1 => sub { uc(shift) },
39            },
40     );
41    
42  A list of functions that can be exported.  You can delete this section  By default, Template Toolkit will C<EVAL_PERL> if included in templates.
 if you don't export anything, such as for a purely object-oriented module.  
43    
44  =head1 FUNCTIONS  =cut
45    
46  =head2 function1  sub new {
47            my $class = shift;
48            my $self = {@_};
49            bless($self, $class);
50    
51            my $log = $self->_get_logger;
52    
53            # create Template toolkit instance
54            $self->{'tt'} = Template->new(
55                    INCLUDE_PATH => $self->{'include_path'},
56                    FILTERS => $self->{'filter'},
57                    EVAL_PERL => 1,
58            );
59            
60            $log->logdie("can't create TT object: $Template::ERROR") unless ($self->{'tt'});
61    
62  =cut          $log->debug("filters defined: ",Dumper($self->{'filter'}));
63    
64  sub function1 {          $self ? return $self : return undef;
65  }  }
66    
67  =head2 function2  
68    =head2 apply
69    
70    Create output from in-memory data structure using Template Toolkit template.
71    
72     my $text = $tt->apply(
73            template => 'text.tt',
74            data => $ds
75     );
76    
77    It also has follwing template toolikit filter routies defined:
78    
79    =cut
80    
81    sub apply {
82            my $self = shift;
83    
84            my $args = {@_};
85    
86            my $log = $self->_get_logger();
87    
88            foreach my $a (qw/template data/) {
89                    $log->logconfess("need $a") unless ($args->{$a});
90            }
91    
92    =head3 tt_filter_type
93    
94    filter to return values of specified from $ds, usage from TT template is in form
95    C<d('FieldName','delimiter')>, where C<delimiter> is optional, like this:
96    
97      [% d('Title') %]
98      [% d('Author',', ' %]
99    
100    =cut
101    
102            sub tt_filter_type {
103                    my ($data,$type) = @_;
104                    
105                    die "no data?" unless ($data);
106                    $type ||= 'display';
107    
108                    my $default_delimiter = {
109                            'display' => '&#182;<br/>',
110                            'index' => '\n',
111                    };
112    
113                    return sub {
114    
115                            my ($name,$join) = @_;
116    
117                            die "no data hash" unless ($data->{'data'} && ref($data->{'data'}) eq 'HASH');
118                            # Hm? Should we die here?
119                            return unless ($name);
120    
121                            my $item = $data->{'data'}->{$name} || return;
122    
123                            my $v = $item->{$type} || return;
124    
125                            if (ref($v) eq 'ARRAY') {
126                                    if ($#{$v} == 0) {
127                                            $v = $v->[0];
128                                    } else {
129                                            $join = $default_delimiter->{$type} unless defined($join);
130                                            $v = join($join, @{$v});
131                                    }
132                            } else {
133                                    warn("TT filter $type(): field $name values aren't ARRAY, ignoring");
134                            }
135    
136                            return $v;
137                    }
138            }
139    
140            $args->{'d'} = tt_filter_type($args, 'display');
141            $args->{'display'} = tt_filter_type($args, 'display');
142    
143    =head3 tt_filter_search
144    
145    filter to return links to search, usage in TT:
146    
147      [% search('FieldToDisplay','FieldToSearch','optional delimiter') %]
148    
149  =cut  =cut
150    
151  sub function2 {          sub tt_filter_search {
152    
153                    my ($data) = @_;
154    
155                    die "no data?" unless ($data);
156                    
157                    return sub {
158    
159                            my ($display,$search,$delimiter) = @_;
160                            
161                            # default delimiter
162                            $delimiter ||= '&#182;<br/>',
163    
164                            die "no data hash" unless ($data->{'data'} && ref($data->{'data'}) eq 'HASH');
165                            # Hm? Should we die here?
166                            return unless ($display);
167    
168                            my $item = $data->{'data'}->{$display} || return;
169    
170                            return unless($item->{'display'});
171                            die "error in TT template: field $display didn't insert anything into search, use d('$display') and not search('$display'...)" unless($item->{'search'});
172    
173                            my @warn;
174                            foreach my $type (qw/display search/) {
175                                    push @warn, "field $display type $type values aren't ARRAY" unless (ref($item->{$type}) eq 'ARRAY');
176                            }
177    
178                            if (@warn) {
179                                    warn("TT filter search(): " . join(",", @warn) . ", skipping");
180                                    return;
181                            }
182                            my @html;
183    
184                            my $d_el = $#{ $item->{'display'} };
185                            my $s_el = $#{ $item->{'search'} };
186    
187                            # easy, both fields have same number of elements or there is just
188                            # one search and multiple display
189                            if ( $d_el == $s_el || $s_el == 0 ) {
190    
191                                    foreach my $i ( 0 .. $d_el ) {
192    
193                                            my $s;
194                                            if ($s_el > 0) {
195                                                    $s = $item->{'search'}->[$i] || die "can't find value $i for type search in field $search";
196                                            } else {
197                                                    $s = $item->{'search'}->[0];
198                                            }
199                                            #$s =~ s/([^\w.-])/sprintf("%%%02X",ord($1))/eg;
200                                            $s = uri_escape_utf8( $s );
201    
202                                            my $d = $item->{'display'}->[$i] || die "can't find value $i for type display in field $display";
203    
204                                            push @html, <<__JS_LINK_SEARCH__
205    <a href="#" onclick="new Ajax.Updater( 'results',  '/search/results?$search=$s', { asynchronous: 1,onLoading: function(request){show_searching();},onLoaded: function(request){hide_searching();} } ) ; return false">$d</a>
206    __JS_LINK_SEARCH__
207                                    }
208    
209                                    return join($delimiter, @html);
210                            } else {
211                                    my $html = qq{<div class="notice">WARNING: we should really support if there is $d_el display elements and $s_el search elements, but currently there is no nice way to do so, so we will just display values</div>};
212                                    my $v = $item->{'display'};
213    
214                                    if ($#{$v} == 0) {
215                                            $html .= $v->[0];
216                                    } else {
217                                            $html .= join($delimiter, @{$v});
218                                    }
219                                    return $html;
220                            }
221                    }
222            }
223    
224            $args->{'search'} = tt_filter_search($args);
225    
226            my $out;
227    
228            $self->{'tt'}->process(
229                    $args->{'template'},
230                    $args,
231                    \$out
232            ) || $log->logconfess( "apply can't process template: ", $self->{'tt'}->error() );
233    
234            return $out;
235  }  }
236    
237  =head1 AUTHOR  =head2 to_file
238    
239  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Create output from in-memory data structure using Template Toolkit template
240    to a file.
241    
242  =head1 BUGS   $tt->to_file(
243            file => 'out.txt',
244            template => 'text.tt',
245            data => $ds
246     );
247    
248  Please report any bugs or feature requests to  =cut
249  C<bug-webpac-output-html@rt.cpan.org>, or through the web interface at  
250  L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=WebPAC>.  sub to_file {
251  I will be notified, and then you'll automatically be notified of progress on          my $self = shift;
252  your bug as I make changes.  
253            my $args = {@_};
254    
255            my $log = $self->_get_logger();
256    
257            my $file = $args->{'file'} || $log->logconfess("need file name");
258    
259            $log->debug("creating file ",$file);
260    
261            open(my $fh, ">", $file) || $log->logdie("can't open output file '$file': $!");
262            print $fh $self->output(
263                    template => $args->{'template'},
264                    data => $args->{'data'},
265            ) || $log->logdie("print: $!");
266            close($fh) || $log->logdie("close: $!");
267    
268  =head1 ACKNOWLEDGEMENTS          return 1;
269    }
270    
271    
272    =head1 AUTHOR
273    
274    Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
275    
276  =head1 COPYRIGHT & LICENSE  =head1 COPYRIGHT & LICENSE
277    
# Line 70  under the same terms as Perl itself. Line 282  under the same terms as Perl itself.
282    
283  =cut  =cut
284    
285  1; # End of WebPAC::Output::html  1; # End of WebPAC::Output::TT
Legend:
Removed from v.1  
changed lines
  Added in v.201
  ViewVC Help
Powered by ViewVC 1.1.26