--- trunk2/lib/WebPAC.pm 2004/06/17 12:05:01 367 +++ trunk2/lib/WebPAC.pm 2004/06/19 18:16:20 372 @@ -7,6 +7,8 @@ use Text::Iconv; use Config::IniFiles; use XML::Simple; +use Template; +use Log::Log4perl qw(get_logger :levels); use Data::Dumper; @@ -52,6 +54,11 @@ my $self = {@_}; bless($self, $class); + my $log_file = $self->{'log'} || "log.conf"; + Log::Log4perl->init($log_file); + + my $log = $self->_get_logger(); + # fill in default values # output codepage $self->{'code_page'} = 'ISO-8859-2' if (! $self->{'code_page'}); @@ -59,8 +66,9 @@ # # read global.conf # + $log->debug("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' ) || $log->logcroak("can't open 'global.conf'"); # read global config parametars foreach my $var (qw( @@ -70,17 +78,29 @@ 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); } # # read indexer config file # - $self->{indexer_config_file} = new Config::IniFiles( -file => $self->{config_file} ) || croak "can't open '$self->{config_file}'"; + $self->{indexer_config_file} = new Config::IniFiles( -file => $self->{config_file} ) || $log->logcroak("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; } @@ -119,7 +139,9 @@ my $self = shift; my $arg = {@_}; - croak "need filename" if (! $arg->{'filename'}); + my $log = $self->_get_logger(); + + $log->logcroak("need filename") if (! $arg->{'filename'}); my $code_page = $arg->{'code_page'} || '852'; use OpenIsis; @@ -129,7 +151,7 @@ # create Text::Iconv object my $cp = Text::Iconv->new($code_page,$self->{'code_page'}); - print STDERR "reading ISIS database '",$arg->{'filename'},"'\n" if ($self->{'debug'}); + $log->info("reading ISIS database '",$arg->{'filename'},"'"); my $isis_db = OpenIsis::open($arg->{'filename'}); @@ -137,7 +159,7 @@ $maxmfn = $self->{limit_mfn} if ($self->{limit_mfn}); - print STDERR "processing $maxmfn records...\n" if ($self->{'debug'}); + $log->info("processing $maxmfn records..."); # read database for (my $mfn = 1; $mfn <= $maxmfn; $mfn++) { @@ -189,7 +211,9 @@ sub fetch_rec { my $self = shift; - my $mfn = $self->{'current_mfn'}++ || confess "it seems that you didn't load database!"; + my $log = $self->_get_logger(); + + my $mfn = $self->{'current_mfn'}++ || $log->logconfess("it seems that you didn't load database!"); if ($mfn > $self->{'max_mfn'}) { $self->{'current_mfn'} = $self->{'max_mfn'}; @@ -210,8 +234,10 @@ sub open_import_xml { my $self = shift; + my $log = $self->_get_logger(); + my $arg = {@_}; - confess "need type to load file from import_xml/" if (! $arg->{'type'}); + $log->logconfess("need type to load file from import_xml/") if (! $arg->{'type'}); $self->{'type'} = $arg->{'type'}; @@ -220,20 +246,18 @@ $self->{'tag'} = $type2tag{$type_base}; - print STDERR "using type ",$self->{'type'}," tag ",$self->{'tag'},"\n" if ($self->{'debug'}); + $log->debug("using type '",$self->{'type'},"' tag <",$self->{'tag'},">") if ($self->{'debug'}); my $f = "./import_xml/".$self->{'type'}.".xml"; - confess "import_xml file '$f' doesn't exist!" if (! -e "$f"); + $log->logconfess("import_xml file '$f' doesn't exist!") if (! -e "$f"); - print STDERR "reading '$f'\n" if ($self->{'debug'}); + $log->debug("reading '$f'") if ($self->{'debug'}); $self->{'import_xml'} = XMLin($f, ForceArray => [ $self->{'tag'}, 'config', 'format' ], ForceContent => 1 ); - print Dumper($self->{'import_xml'}); - } =head2 create_lookup @@ -249,8 +273,10 @@ sub create_lookup { my $self = shift; - my $rec = shift || confess "need record to create lookup"; - confess("need HASH as first argument!") if ($rec !~ /HASH/o); + my $log = $self->_get_logger(); + + my $rec = shift || $log->logconfess("need record to create lookup"); + $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o); foreach my $i (@_) { if ($i->{'eval'}) { @@ -341,13 +367,15 @@ sub fill_in { my $self = shift; - my $rec = shift || confess "need data record"; - my $format = shift || confess "need format to parse"; + my $log = $self->_get_logger(); + + my $rec = shift || $log->logconfess("need data record"); + my $format = shift || $log->logconfess("need format to parse"); # iteration (for repeatable fields) my $i = shift || 0; # FIXME remove for speedup? - confess("need HASH as first argument!") if ($rec !~ /HASH/o); + $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o); my $found = 0; @@ -361,9 +389,10 @@ 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? + $log->debug("test format '$format' for lookups"); if ($format =~ /\[[^\[\]]+\]/o) { return $self->lookup($format); } else { @@ -387,10 +416,15 @@ sub lookup { my $self = shift; - my $tmp = shift || confess "need format"; + my $log = $self->_get_logger(); + + my $tmp = shift || $log->logconfess("need format"); if ($tmp =~ /\[[^\[\]]+\]/o) { my @in = ( $tmp ); + + $log->debug("lookup for: ",$tmp); + my @out; while (my $f = shift @in) { if ($f =~ /\[([^\[\]]+)\]/) { @@ -431,12 +465,14 @@ return if (! $format_utf8); - confess("need HASH as first argument!") if ($rec !~ /HASH/o); - confess("need utf2cp Text::Iconv object!") if (! $self->{'utf2cp'}); + my $log = $self->_get_logger(); + + $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o); + $log->logconfess("need utf2cp Text::Iconv object!") if (! $self->{'utf2cp'}); $i = 0 if (! $i); - my $format = $self->{'utf2cp'}->convert($format_utf8) || confess("can't convert '$format_utf8' from UTF-8 to ",$self->{'code_page'}); + my $format = $self->{'utf2cp'}->convert($format_utf8) || $log->logconfess("can't convert '$format_utf8' from UTF-8 to ",$self->{'code_page'}); my @out; @@ -471,7 +507,8 @@ if ($eval_code) { my $eval = $self->fill_in($rec,$eval_code,$i); - return if (! eval $eval); + $log->debug("about to eval ",$eval," [$out]"); + return if (! $self->_eval($eval)); } return $out; @@ -490,7 +527,9 @@ my ($rec, $format_utf8) = @_; - confess("need HASH as first argument!") if ($rec !~ /HASH/o); + my $log = $self->_get_logger(); + + $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o); return if (! $format_utf8); my $i = 0; @@ -508,28 +547,17 @@ 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 -# private method _sort_by_order -# sort subrouting using order="" attribute -sub _sort_by_order { - my $self = shift; - - my $va = $self->{'import_xml'}->{'indexer'}->{$a}->{'order'} || - $self->{'import_xml'}->{'indexer'}->{$a}; - my $vb = $self->{'import_xml'}->{'indexer'}->{$b}->{'order'} || - $self->{'import_xml'}->{'indexer'}->{$b}; - - return $va <=> $vb; -} - sub data_structure { my $self = shift; + my $log = $self->_get_logger(); + my $rec = shift; - confess("need HASH as first argument!") if ($rec !~ /HASH/o); + $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o); my @sorted_tags; if ($self->{tags_by_order}) { @@ -539,7 +567,7 @@ $self->{tags_by_order} = \@sorted_tags; } - my $ds; + my @ds; foreach my $field (@sorted_tags) { @@ -561,12 +589,123 @@ } } - push @{$ds->{$field}}, $row if ($row); + if ($row) { + $row->{'tag'} = $field; + push @ds, $row; + } + + } + + 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 = {@_}; + + my $log = $self->_get_logger(); + + $log->logconfess("need template name") if (! $args->{'template'}); + $log->logconfess("need data array") if (! $args->{'data'}); + my $out; + + $self->{'tt'}->process( + $args->{'template'}, + $args, + \$out + ) || confess $self->{'tt'}->error(); + + return $out; +} + +# +# +# + +=head1 INTERNAL METHODS + +Here is a quick list of internal methods, mostly useful to turn debugging +on them (see L below for explanation). + +=cut + +=head2 _eval + +Internal function to eval code without C. + +=cut + +sub _eval { + my $self = shift; + + my $code = shift || return; + + my $log = $self->_get_logger(); + + no strict 'subs'; + my $ret = eval $code; + if ($@) { + $log->error("problem with eval code [$code]: $@"); } - print "data_structure => ",Dumper($ds); + $log->debug("eval: ",$code," [",$ret,"]"); + + return $ret || 0; +} + +=head2 _sort_by_order + +Sort xml tags data structure accoding to C attribute. +=cut + +sub _sort_by_order { + my $self = shift; + + my $va = $self->{'import_xml'}->{'indexer'}->{$a}->{'order'} || + $self->{'import_xml'}->{'indexer'}->{$a}; + my $vb = $self->{'import_xml'}->{'indexer'}->{$b}->{'order'} || + $self->{'import_xml'}->{'indexer'}->{$b}; + + return $va <=> $vb; } +sub _get_logger { + my $self = shift; + + my @c = caller(1); + return get_logger($c[3]); +} + +# +# +# + +=head1 LOGGING + +Logging in WebPAC is performed by L with config file +C. + +Methods defined above have different levels of logging, so +it's descriptions will be useful to turn (mostry B logging) on +or off to see why WabPAC isn't perforing as you expect it (it might even +be a bug!). + +B. To repeat, you can +also use method names, and not only classes (which are just few) +to filter logging. + +=cut + 1;