--- trunk/lib/WebPAC/Output/html.pm 2005/06/25 20:23:23 1 +++ trunk/lib/WebPAC/Output/TT.pm 2005/12/23 22:52:48 318 @@ -1,65 +1,316 @@ -package WebPAC::Output::html; +package WebPAC::Output::TT; use warnings; use strict; +use base qw/WebPAC::Common/; + +use Template; +use List::Util qw/first/; +use Data::Dumper; +use URI::Escape qw/uri_escape_utf8/; + =head1 NAME -WebPAC::Output::html - The great new WebPAC::Output::html! +WebPAC::Output::TT - use Template Toolkit to produce output =head1 VERSION -Version 0.01 +Version 0.06 =cut -our $VERSION = '0.01'; +our $VERSION = '0.06'; =head1 SYNOPSIS -Quick summary of what the module does. +Produce output using Template Toolkit. -Perhaps a little code snippet. +=head1 FUNCTIONS - use WebPAC::Output::html; +=head2 new - my $foo = WebPAC::Output::html->new(); - ... +Create new instance. -=head1 EXPORT + my $tt = new WebPAC::Output::TT( + include_path => '/path/to/conf/output/tt', + filters => { + filter_1 => sub { uc(shift) }, + }, + ); -A list of functions that can be exported. You can delete this section -if you don't export anything, such as for a purely object-oriented module. +By default, Template Toolkit will C if included in templates. -=head1 FUNCTIONS +=cut -=head2 function1 +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'}); -=cut + $log->debug("filters defined: ",Dumper($self->{'filter'})); -sub function1 { + $self ? return $self : return undef; } -=head2 function2 + +=head2 apply + +Create output from in-memory data structure using Template Toolkit template. + + my $text = $tt->apply( + template => 'text.tt', + data => $ds, + record_uri => 'database/prefix/mfn', + ); + +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, usage from TT template is in form +C, where C is optional, like this: + + [% d('Title') %] + [% d('Author',', ' %] + +=cut + + sub tt_filter_type { + my ($data,$type) = @_; + + die "no data?" unless ($data); + $type ||= 'display'; + + my $default_delimiter = { + 'display' => '¶
', + 'index' => '\n', + }; + + return sub { + + my ($name,$join) = @_; + + die "no data hash" unless ($data->{'data'} && ref($data->{'data'}) eq 'HASH'); + # Hm? Should we die here? + return unless ($name); + + my $item = $data->{'data'}->{$name} || return; + + 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}); + } + } else { + warn("TT filter $type(): field $name values aren't ARRAY, ignoring"); + } + + return $v; + } + } + + $args->{'d'} = tt_filter_type($args, 'display'); + $args->{'display'} = tt_filter_type($args, 'display'); + +=head3 tt_filter_search + +filter to return links to search, usage in TT: + + [% search('FieldToDisplay','FieldToSearch','optional delimiter') %] =cut -sub function2 { + sub tt_filter_search { + + my ($data) = @_; + + die "no data?" unless ($data); + + return sub { + + my ($display,$search,$delimiter) = @_; + + # default delimiter + $delimiter ||= '¶
', + + die "no data hash" unless ($data->{'data'} && ref($data->{'data'}) eq 'HASH'); + # Hm? Should we die here? + return unless ($display); + + my $item = $data->{'data'}->{$display} || return; + + return unless($item->{'display'}); + die "error in TT template: field $display didn't insert anything into search, use d('$display') and not search('$display'...)" unless($item->{'search'}); + + my @warn; + foreach my $type (qw/display search/) { + push @warn, "field $display type $type values aren't ARRAY" unless (ref($item->{$type}) eq 'ARRAY'); + } + + if (@warn) { + warn("TT filter search(): " . join(",", @warn) . ", skipping"); + return; + } + my @html; + + my $d_el = $#{ $item->{'display'} }; + my $s_el = $#{ $item->{'search'} }; + + # easy, both fields have same number of elements or there is just + # one search and multiple display + if ( $d_el == $s_el || $s_el == 0 ) { + + foreach my $i ( 0 .. $d_el ) { + + my $s; + if ($s_el > 0) { + $s = $item->{'search'}->[$i] || die "can't find value $i for type search in field $search"; + } else { + $s = $item->{'search'}->[0]; + } + #$s =~ s/([^\w.-])/sprintf("%%%02X",ord($1))/eg; + $s = uri_escape_utf8( $s ); + + my $d = $item->{'display'}->[$i] || die "can't find value $i for type display in field $display"; + + push @html, qq{$d}; + } + + return join($delimiter, @html); + } else { + my $html = qq{
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
}; + my $v = $item->{'display'}; + + if ($#{$v} == 0) { + $html .= $v->[0]; + } else { + $html .= join($delimiter, @{$v}); + } + return $html; + } + } + } + + $args->{'search'} = tt_filter_search($args); + +=head3 load_rec + +Used mostly for onClick events like this: + + bar + +=cut + + $args->{'load_template'} = sub { + my $template = shift or return "Logger.error('load_template missing template name!'); return false;"; + return "load_template($template); return false;"; + }; + + my $out; + + $self->{'tt'}->process( + $args->{'template'}, + $args, + \$out + ) || $log->logconfess( "apply can't process template: ", $self->{'tt'}->error() ); + + return $out; } -=head1 AUTHOR +=head2 to_file -Dobrica Pavlinusic, C<< >> +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 -=head1 BUGS +sub to_file { + my $self = shift; -Please report any bugs or feature requests to -C, or through the web interface at -L. -I will be notified, and then you'll automatically be notified of progress on -your bug as I make changes. + my $args = {@_}; -=head1 ACKNOWLEDGEMENTS + 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<< >> =head1 COPYRIGHT & LICENSE @@ -70,4 +321,4 @@ =cut -1; # End of WebPAC::Output::html +1; # End of WebPAC::Output::TT