--- trunk2/lib/WebPAC.pm 2004/06/17 01:44:25 366 +++ trunk2/lib/WebPAC.pm 2004/06/17 20:44:45 371 @@ -1,9 +1,13 @@ package WebPAC; +use warnings; +use strict; + use Carp; use Text::Iconv; use Config::IniFiles; use XML::Simple; +use Template; use Data::Dumper; @@ -57,7 +61,7 @@ # read global.conf # - $self->{global_config_file} = new Config::IniFiles( -file => 'global.conf' ) || croak "can't open 'global.conf'"; + my $config = new Config::IniFiles( -file => 'global.conf' ) || croak "can't open 'global.conf'"; # read global config parametars foreach my $var (qw( @@ -67,8 +71,9 @@ dbi_passwd show_progress my_unac_filter + output_template )) { - $self->{global_config}->{$var} = $self->{global_config_file}->val('global', $var); + $self->{'global_config'}->{$var} = $config->val('global', $var); } # @@ -77,7 +82,18 @@ $self->{indexer_config_file} = new Config::IniFiles( -file => $self->{config_file} ) || croak "can't open '$self->{config_file}'"; + # create UTF-8 convertor for import_xml files $self->{'utf2cp'} = Text::Iconv->new('UTF-8' ,$self->{'code_page'}); + + # create Template toolkit instance + $self->{'tt'} = Template->new( + INCLUDE_PATH => ($self->{'global_config_file'}->{'output_template'} || './output_template'), +# FILTERS => { +# 'foo' => \&foo_filter, +# }, + EVAL_PERL => 1, + ); + return $self; } @@ -97,8 +113,6 @@ If optional parametar C is set, it will read just 500 records from database in example above. -Returns number of last record read into memory (size of database, really). - C argument is an array of lookups to create. Each lookup must have C and C. Optional parametar C is perl code to evaluate before storing value in index. @@ -110,6 +124,8 @@ 'val' => 'v900' }, ] +Returns number of last record read into memory (size of database, really). + =cut sub open_isis { @@ -217,7 +233,7 @@ $self->{'tag'} = $type2tag{$type_base}; - print STDERR "using type ",$self->{'type'}," tag ",$self->{'tag'},"\n" if ($self->{'debug'}); + print STDERR "using type '",$self->{'type'},"' tag <",$self->{'tag'},">\n" if ($self->{'debug'}); my $f = "./import_xml/".$self->{'type'}.".xml"; confess "import_xml file '$f' doesn't exist!" if (! -e "$f"); @@ -229,14 +245,16 @@ ForceContent => 1 ); - print Dumper($self->{'import_xml'}); - } =head2 create_lookup Create lookup from record using lookup definition. + $self->create_lookup($rec, @lookups); + +Called internally by C methods. + =cut sub create_lookup { @@ -267,7 +285,7 @@ Returns value from record. - $self->get_data(\$rec,$f,$sf,$i,\$found); + my $text = $self->get_data(\$rec,$f,$sf,$i,\$found); Arguments are: record reference C<$rec>, @@ -275,7 +293,7 @@ optional subfiled C<$sf>, index for repeatable values C<$i>. -Optinal variable C<$found> will be incremeted if thre +Optinal variable C<$found> will be incremeted if there is field. Returns value or empty string. @@ -286,7 +304,9 @@ my $self = shift; my ($rec,$f,$sf,$i,$found) = @_; + if ($$rec->{$f}) { + return '' if (! $$rec->{$f}->[$i]); if ($sf && $$rec->{$f}->[$i]->{$sf}) { $$found++ if (defined($$found)); return $$rec->{$f}->[$i]->{$sf}; @@ -315,20 +335,33 @@ strings with placeholders and returns string or array of with substituted values from record. - $webpac->fill_in($rec,'v250^a'); + my $text = $webpac->fill_in($rec,'v250^a'); Optional argument is ordinal number for repeatable fields. By default, it's assume to be first repeatable field (fields are perl array, so first element is 0). Following example will read second value from repeatable field. - $webpac->fill_in($rec,'Title: v250^a',1); + my $text = $webpac->fill_in($rec,'Title: v250^a',1); This function B perform parsing of format to inteligenty skip delimiters before fields which aren't used. =cut +# internal function to eval code +sub _eval { + my $self = shift; + + my $code = shift || return; + no strict 'subs'; + my $ret = eval $code; + if ($@) { + print STDERR "problem with eval code [$code]: $@\n"; + } + return $ret; +} + sub fill_in { my $self = shift; @@ -352,10 +385,11 @@ if ($found) { if ($eval_code) { my $eval = $self->fill_in($rec,$eval_code,$i); - return if (! eval $eval); + return if (! $self->_eval($eval)); } # do we have lookups? if ($format =~ /\[[^\[\]]+\]/o) { +print "## probable lookup: $format\n"; return $self->lookup($format); } else { return $format; @@ -369,7 +403,7 @@ Perform lookups on format supplied to it. - my $txt = $self->lookup('[v900]'); + my $text = $self->lookup('[v900]'); Lookups can be nested (like C<[d:[a:[v900]]]>). @@ -382,25 +416,22 @@ if ($tmp =~ /\[[^\[\]]+\]/o) { my @in = ( $tmp ); -#print "##lookup $tmp\n"; +print "## lookup $tmp\n"; my @out; while (my $f = shift @in) { if ($f =~ /\[([^\[\]]+)\]/) { my $k = $1; if ($self->{'lookup'}->{$k}) { -#print "## lookup key = $k\n"; foreach my $nv (@{$self->{'lookup'}->{$k}}) { my $tmp2 = $f; $tmp2 =~ s/\[$k\]/$nv/g; push @in, $tmp2; -#print "## lookup in => $tmp2\n"; } } else { undef $f; } } elsif ($f) { push @out, $f; -#print "## lookup out => $f\n"; } } return @out; @@ -415,7 +446,7 @@ defined. It can also eval code in format starting with C and return output or nothing depending on eval code. - $webpac->parse($rec,'eval{"v901^a" eq "Deskriptor"}descriptor: v250^a', $i); + my $text = $webpac->parse($rec,'eval{"v901^a" eq "Deskriptor"}descriptor: v250^a', $i); =cut @@ -442,9 +473,7 @@ my $prefix; my $all_found=0; -#print "## $format\n"; while ($format =~ s/^(.*?)v(\d+)(?:\^(\w))*//s) { -#print "## [ $1 | $2 | $3 ] $format\n"; my $del = $1 || ''; $prefix ||= $del if ($all_found == 0); @@ -465,21 +494,47 @@ # add prefix if not there $out = $prefix . $out if ($out !~ m/^\Q$prefix\E/); - + if ($eval_code) { my $eval = $self->fill_in($rec,$eval_code,$i); - return if (! eval $eval); + return if (! $self->_eval($eval)); } return $out; } +=head2 parse_to_arr + +Similar to C, but returns array of all repeatable fields + + my @arr = $webpac->parse_to_arr($rec,'v250^a'); + +=cut + +sub parse_to_arr { + my $self = shift; + + my ($rec, $format_utf8) = @_; + + confess("need HASH as first argument!") if ($rec !~ /HASH/o); + return if (! $format_utf8); + + my $i = 0; + my @arr; + + while (my $v = $self->parse($rec,$format_utf8,$i++)) { + push @arr, $v; + } + + return @arr; +} + =head2 data_structure Create in-memory data structure which represents layout from C. It is used later to produce output. - my $ds = $webpac->data_structure($rec); + my @ds = $webpac->data_structure($rec); =cut @@ -510,37 +565,64 @@ $self->{tags_by_order} = \@sorted_tags; } - my $ds; + my @ds; foreach my $field (@sorted_tags) { my $row; - my $i = 0; #print "field $field [",$self->{'tag'},"] = ",Dumper($self->{'import_xml'}->{'indexer'}->{$field}->{$self->{'tag'}}); foreach my $tag (@{$self->{'import_xml'}->{'indexer'}->{$field}->{$self->{'tag'}}}) { + my @v = $self->parse_to_arr($rec,$tag->{'content'}); - my $v = $self->parse($rec,$tag->{'content'},$i); -print "## $i:",$tag->{'content'}," = ",($v || 'null'),"\n"; - - next if (!$v || $v && $v eq ''); + next if (! @v); # does tag have type? if ($tag->{'type'}) { - push @{$row->{$tag->{'type'}}}, $v; + push @{$row->{$tag->{'type'}}}, @v; } else { - push @{$row->{'display'}}, $v; - push @{$row->{'swish'}}, $v; + push @{$row->{'display'}}, @v; + push @{$row->{'swish'}}, @v; } } - push @{$ds->{$field}}, $row if ($row); + if ($row) { + $row->{'tag'} = $field; + push @ds, $row; + } } - print Dumper($ds); + return @ds; + +} +=head2 output + +Create output from in-memory data structure using Template Toolkit template. + +my $text = $webpac->output( template => 'text.tt', data => @ds ); + +=cut + +sub output { + my $self = shift; + + my $args = {@_}; + + confess("need template name") if (! $args->{'template'}); + confess("need data array") if (! $args->{'data'}); + + my $out; + + $self->{'tt'}->process( + $args->{'template'}, + $args, + \$out + ) || confess $self->{'tt'}->error(); + + return $out; } 1;