/[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

revision 45 by dpavlin, Mon Nov 14 16:12:43 2005 UTC revision 376 by dpavlin, Sun Jan 8 22:41:45 2006 UTC
# Line 8  use base qw/WebPAC::Common/; Line 8  use base qw/WebPAC::Common/;
8  use Template;  use Template;
9  use List::Util qw/first/;  use List::Util qw/first/;
10  use Data::Dumper;  use Data::Dumper;
11    use Encode;
12    
13  =head1 NAME  =head1 NAME
14    
# Line 15  WebPAC::Output::TT - use Template Toolki Line 16  WebPAC::Output::TT - use Template Toolki
16    
17  =head1 VERSION  =head1 VERSION
18    
19  Version 0.01  Version 0.07
20    
21  =cut  =cut
22    
23  our $VERSION = '0.01';  our $VERSION = '0.07';
24    
25  =head1 SYNOPSIS  =head1 SYNOPSIS
26    
# Line 44  By default, Template Toolkit will C<EVAL Line 45  By default, Template Toolkit will C<EVAL
45    
46  sub new {  sub new {
47          my $class = shift;          my $class = shift;
48          my $self = {@_};          my $self = {@_};
49          bless($self, $class);          bless($self, $class);
50    
51          my $log = $self->_get_logger;          my $log = $self->_get_logger;
52    
53          # create Template toolkit instance          # create Template toolkit instance
54          $self->{'tt'} = Template->new(          $self->{'tt'} = Template->new(
55                  INCLUDE_PATH => $self->{'include_path'},                  INCLUDE_PATH => $self->{'include_path'},
56                  FILTERS => $self->{'filter'},                  #FILTERS => $self->{'filters'},
57                  EVAL_PERL => 1,                  EVAL_PERL => 1,
58          );          );
59                    
60          $log->logdie("can't create TT object: $Template::ERROR") unless ($self->{'tt'});          $log->logdie("can't create TT object: $Template::ERROR") unless ($self->{'tt'});
61    
62          $log->debug("filters defined: ",Dumper($self->{'filter'}));          $log->debug("filters defined: ",Dumper($self->{'filters'}));
63    
64          $self ? return $self : return undef;          $self ? return $self : return undef;
65  }  }
# Line 70  Create output from in-memory data struct Line 71  Create output from in-memory data struct
71    
72   my $text = $tt->apply(   my $text = $tt->apply(
73          template => 'text.tt',          template => 'text.tt',
74          data => \@ds          data => $ds,
75            record_uri => 'database/prefix/mfn',
76   );   );
77    
78  It also has follwing template toolikit filter routies defined:  It also has follwing template toolikit filter routies defined:
# Line 90  sub apply { Line 92  sub apply {
92    
93  =head3 tt_filter_type  =head3 tt_filter_type
94    
95  filter to return values of specified from @ds  filter to return values of specified from $ds, usage from TT template is in form
96    C<d('FieldName','delimiter')>, where C<delimiter> is optional, like this:
97    
98      [% d('Title') %]
99      [% d('Author',', ' %]
100    
101  =cut  =cut
102    
# Line 109  filter to return values of specified fro Line 115  filter to return values of specified fro
115    
116                          my ($name,$join) = @_;                          my ($name,$join) = @_;
117    
118                          die "no data array" unless ($data->{'data'} && ref($data->{'data'}) eq 'ARRAY');                          die "no data hash" unless ($data->{'data'} && ref($data->{'data'}) eq 'HASH');
119                            # Hm? Should we die here?
120                          my $item = first { $_->{'name'} eq $name } @{ $data->{'data'} };                          return unless ($name);
121    
122                          return unless($item);                          my $item = $data->{'data'}->{$name} || return;
123    
124                          my $v = $item->{$type} || return;                          my $v = $item->{$type} || return;
125    
# Line 124  filter to return values of specified fro Line 130  filter to return values of specified fro
130                                          $join = $default_delimiter->{$type} unless defined($join);                                          $join = $default_delimiter->{$type} unless defined($join);
131                                          $v = join($join, @{$v});                                          $v = join($join, @{$v});
132                                  }                                  }
133                            } else {
134                                    warn("TT filter $type(): field $name values aren't ARRAY, ignoring");
135                          }                          }
136    
137                          return $v;                          return $v;
# Line 131  filter to return values of specified fro Line 139  filter to return values of specified fro
139          }          }
140    
141          $args->{'d'} = tt_filter_type($args, 'display');          $args->{'d'} = tt_filter_type($args, 'display');
142            $args->{'display'} = tt_filter_type($args, 'display');
143    
144    =head3 tt_filter_search
145    
146    filter to return links to search, usage in TT:
147    
148      [% search('FieldToDisplay','FieldToSearch','optional delimiter', 'optional_template.tt') %]
149    
150    =cut
151    
152            sub tt_filter_search {
153    
154                    my ($data) = @_;
155    
156                    die "no data?" unless ($data);
157                    
158                    return sub {
159    
160                            my ($display,$search,$delimiter,$template) = @_;
161                            
162                            # default delimiter
163                            $delimiter ||= '&#182;<br/>',
164    
165                            die "no data hash" unless ($data->{'data'} && ref($data->{'data'}) eq 'HASH');
166                            # Hm? Should we die here?
167                            return unless ($display);
168    
169                            my $item = $data->{'data'}->{$display} || return;
170    
171                            return unless($item->{'display'});
172                            if (! $item->{'search'}) {
173                                    warn "error in TT template: field $display didn't insert anything into search, use d('$display') and not search('$display'...)";
174                                    return;
175                            }
176    
177                            my @warn;
178                            foreach my $type (qw/display search/) {
179                                    push @warn, "field $display type $type values aren't ARRAY" unless (ref($item->{$type}) eq 'ARRAY');
180                            }
181    
182                            if (@warn) {
183                                    warn("TT filter search(): " . join(",", @warn) . ", skipping");
184                                    return;
185                            }
186                            my @html;
187    
188                            my $d_el = $#{ $item->{'display'} };
189                            my $s_el = $#{ $item->{'search'} };
190    
191                            # easy, both fields have same number of elements or there is just
192                            # one search and multiple display
193                            if ( $d_el == $s_el || $s_el == 0 ) {
194    
195                                    foreach my $i ( 0 .. $d_el ) {
196    
197                                            my $s;
198                                            if ($s_el > 0) {
199                                                    $s = $item->{'search'}->[$i];
200                                                    die "can't find value $i for type search in field $search" unless (defined($s));
201                                            } else {
202                                                    $s = $item->{'search'}->[0];
203                                            }
204                                            #$s =~ s/([^\w.-])/sprintf("%%%02X",ord($1))/eg;
205                                            $s = __quotemeta( $s );
206    
207                                            my $d = $item->{'display'}->[$i];
208                                                    die "can't find value $i for type display in field $display" unless (defined($d));
209    
210                                            my $template_arg = '';
211                                            $template_arg = qq{,'$template'} if ($template);
212    
213                                            if ($s && ! $d) {
214                                                    $d = $s;
215                                            } elsif (! $s && $d) {
216                                                    $s = $d;
217                                            }
218    
219                                            push @html, qq{<a href="#" onclick="return search_via_link('$search','$s'${template_arg})">$d</a>} if ($s && $d);
220                                    }
221    
222                                    return join($delimiter, @html);
223                            } else {
224                                    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>};
225                                    my $v = $item->{'display'};
226    
227                                    if ($#{$v} == 0) {
228                                            $html .= $v->[0];
229                                    } else {
230                                            $html .= join($delimiter, @{$v});
231                                    }
232                                    return $html;
233                            }
234                    }
235            }
236    
237            $args->{'search'} = tt_filter_search($args);
238    
239    =head3 load_rec
240    
241    Used mostly for onClick events like this:
242    
243      <a href="#" onClick="[% load_rec( record_uri, 'template_name.tt') %]>foo</a>
244    
245    It will automatically do sanity checking and create correct JavaScript code.
246    
247    =cut
248    
249            $args->{'load_rec'} = sub {
250                    my @errors;
251    
252                    my $record_uri = shift or push @errors, "record_uri missing";
253                    my $template = shift or push @errors, "template missing";
254    
255                    if ($record_uri !~ m#^[^/]+/[^/]+/[^/]+$#) {
256                            push @errors, "invalid format of record_uri: $record_uri";
257                    }
258    
259                    if (@errors) {
260                            return "Logger.error('errors in load_rec: " . join(", ", @errors) . "'); return false;";
261                    } else {
262                            return "load_rec('$record_uri','$template'); return false;";
263                    }
264            };
265    
266    =head3 load_template
267    
268    Used to re-submit search request and load results in different template
269    
270      <a href="#" onClick="[% load_template( 'template_name.tt' ) %]">bar</a>
271    
272    =cut
273    
274            $args->{'load_template'} = sub {
275                    my $template = shift or return "Logger.error('load_template missing template name!'); return false;";
276                    return "load_template($template); return false;";
277            };
278    
279            if ($self->{filters}) {
280                    $args->{f} = $self->{filters};
281                    $log->debug("using f.filters");
282            }
283    
284          my $out;          my $out;
285    
# Line 151  to a file. Line 300  to a file.
300   $tt->to_file(   $tt->to_file(
301          file => 'out.txt',          file => 'out.txt',
302          template => 'text.tt',          template => 'text.tt',
303          data => \@ds          data => $ds
304   );   );
305    
306  =cut  =cut
# Line 178  sub to_file { Line 327  sub to_file {
327  }  }
328    
329    
330    =head2 __quotemeta
331    
332    Helper to quote JavaScript-friendly characters
333    
334    =cut
335    
336    sub __quotemeta {
337            local $_ = shift;
338            $_ = decode('iso-8859-2', $_);
339    
340            s<([\x{0080}-\x{fffd}]+)>{sprintf '\u%0*v4X', '\u', $1}ge if ( Encode::is_utf8($_) );
341            {
342                    use bytes;  
343                    s<((?:[^ \x21-\x7E]|(?:\\(?!u)))+)>{sprintf '\x%0*v2X', '\x', $1}ge;
344            }
345    
346            s/\\x09/\\t/g;
347            s/\\x0A/\\n/g;
348            s/\\x0D/\\r/g;
349            s/"/\\"/g;
350            s/\\x5C/\\\\/g;
351    
352            return $_;
353    }
354    
355  =head1 AUTHOR  =head1 AUTHOR
356    
357  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>  Dobrica Pavlinusic, C<< <dpavlin@rot13.org> >>
Legend:
Removed from v.45  
changed lines
  Added in v.376
  ViewVC Help
Powered by ViewVC 1.1.26