--- trunk2/lib/WebPAC.pm 2004/06/17 20:44:45 371 +++ trunk2/lib/WebPAC.pm 2004/06/19 18:16:20 372 @@ -8,6 +8,7 @@ use Config::IniFiles; use XML::Simple; use Template; +use Log::Log4perl qw(get_logger :levels); use Data::Dumper; @@ -53,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'}); @@ -60,8 +66,9 @@ # # read global.conf # + $log->debug("read 'global.conf'"); - my $config = 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( @@ -80,7 +87,7 @@ # 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'}); @@ -132,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; @@ -142,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'}); @@ -150,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++) { @@ -202,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'}; @@ -223,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'}; @@ -233,12 +246,12 @@ $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' ], @@ -260,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'}) { @@ -349,29 +364,18 @@ =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; - 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; @@ -388,8 +392,8 @@ return if (! $self->_eval($eval)); } # do we have lookups? + $log->debug("test format '$format' for lookups"); if ($format =~ /\[[^\[\]]+\]/o) { -print "## probable lookup: $format\n"; return $self->lookup($format); } else { return $format; @@ -412,11 +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 ); -print "## lookup $tmp\n"; + + $log->debug("lookup for: ",$tmp); + my @out; while (my $f = shift @in) { if ($f =~ /\[([^\[\]]+)\]/) { @@ -457,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; @@ -497,6 +507,7 @@ if ($eval_code) { my $eval = $self->fill_in($rec,$eval_code,$i); + $log->debug("about to eval ",$eval," [$out]"); return if (! $self->_eval($eval)); } @@ -516,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; @@ -538,24 +551,13 @@ =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}) { @@ -611,8 +613,10 @@ my $args = {@_}; - confess("need template name") if (! $args->{'template'}); - confess("need data array") if (! $args->{'data'}); + my $log = $self->_get_logger(); + + $log->logconfess("need template name") if (! $args->{'template'}); + $log->logconfess("need data array") if (! $args->{'data'}); my $out; @@ -625,4 +629,83 @@ 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]: $@"); + } + + $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;