/[webpac]/trunk2/lib/WebPAC.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

Contents of /trunk2/lib/WebPAC.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 389 - (show annotations)
Tue Jul 20 17:15:48 2004 UTC (15 years, 6 months ago) by dpavlin
File size: 19563 byte(s)
added progress_bar

1 package WebPAC;
2
3 use warnings;
4 use strict;
5
6 use Carp;
7 use Text::Iconv;
8 use Config::IniFiles;
9 use XML::Simple;
10 use Template;
11 use Log::Log4perl qw(get_logger :levels);
12
13 use Data::Dumper;
14
15 #my $LOOKUP_REGEX = '\[[^\[\]]+\]';
16 #my $LOOKUP_REGEX_SAVE = '\[([^\[\]]+)\]';
17 my $LOOKUP_REGEX = 'lookup{[^\{\}]+}';
18 my $LOOKUP_REGEX_SAVE = 'lookup{([^\{\}]+)}';
19
20 =head1 NAME
21
22 WebPAC - base class for WebPAC
23
24 =head1 DESCRIPTION
25
26 This module implements methods used by WebPAC.
27
28 =head1 METHODS
29
30 =head2 new
31
32 This will create new instance of WebPAC using configuration specified by C<config_file>.
33
34 my $webpac = new WebPAC(
35 config_file => 'name.conf',
36 [code_page => 'ISO-8859-2',]
37 );
38
39 Default C<code_page> is C<ISO-8859-2>.
40
41 It will also read configuration files
42 C<global.conf> (used by indexer and Web font-end)
43 and configuration file specified by C<config_file>
44 which describes databases to be indexed.
45
46 =cut
47
48 # mapping between data type and tag which specify
49 # format in XML file
50 my %type2tag = (
51 'isis' => 'isis',
52 # 'excel' => 'column',
53 # 'marc' => 'marc',
54 # 'feed' => 'feed'
55 );
56
57 sub new {
58 my $class = shift;
59 my $self = {@_};
60 bless($self, $class);
61
62 my $log_file = $self->{'log'} || "log.conf";
63 Log::Log4perl->init($log_file);
64
65 my $log = $self->_get_logger();
66
67 # fill in default values
68 # output codepage
69 $self->{'code_page'} = 'ISO-8859-2' if (! $self->{'code_page'});
70
71 #
72 # read global.conf
73 #
74 $log->debug("read 'global.conf'");
75
76 my $config = new Config::IniFiles( -file => 'global.conf' ) || $log->logcroak("can't open 'global.conf'");
77
78 # read global config parametars
79 foreach my $var (qw(
80 dbi_dbd
81 dbi_dsn
82 dbi_user
83 dbi_passwd
84 show_progress
85 my_unac_filter
86 output_template
87 )) {
88 $self->{'global_config'}->{$var} = $config->val('global', $var);
89 }
90
91 #
92 # read indexer config file
93 #
94
95 $self->{indexer_config_file} = new Config::IniFiles( -file => $self->{config_file} ) || $log->logcroak("can't open '",$self->{config_file},"'");
96
97 # create UTF-8 convertor for import_xml files
98 $self->{'utf2cp'} = Text::Iconv->new('UTF-8' ,$self->{'code_page'});
99
100 # create Template toolkit instance
101 $self->{'tt'} = Template->new(
102 INCLUDE_PATH => ($self->{'global_config_file'}->{'output_template'} || './output_template'),
103 # FILTERS => {
104 # 'foo' => \&foo_filter,
105 # },
106 EVAL_PERL => 1,
107 );
108
109 return $self;
110 }
111
112 =head2 open_isis
113
114 Open CDS/ISIS database using OpenIsis module and read all records to memory.
115
116 $webpac->open_isis(
117 filename => '/data/ISIS/ISIS',
118 code_page => '852',
119 limit_mfn => '500',
120 lookup => [ ... ],
121 );
122
123 By default, ISIS code page is assumed to be C<852>.
124
125 If optional parametar C<limit_mfn> is set, it will read just 500 records
126 from database in example above.
127
128 C<lookup> argument is an array of lookups to create. Each lookup must have C<key> and
129 C<val>. Optional parametar C<eval> is perl code to evaluate before storing
130 value in index.
131
132 lookup => [
133 { 'key' => 'd:v900', 'val' => 'v250^a' },
134 { 'eval' => '"v901^a" eq "Podruèje"',
135 'key' => 'pa:v561^4:v562^4:v461^1',
136 'val' => 'v900' },
137 ]
138
139 Returns number of last record read into memory (size of database, really).
140
141 =cut
142
143 sub open_isis {
144 my $self = shift;
145 my $arg = {@_};
146
147 my $log = $self->_get_logger();
148
149 $log->logcroak("need filename") if (! $arg->{'filename'});
150 my $code_page = $arg->{'code_page'} || '852';
151
152 use OpenIsis;
153
154 #$self->{'isis_code_page'} = $code_page;
155
156 # create Text::Iconv object
157 my $cp = Text::Iconv->new($code_page,$self->{'code_page'});
158
159 $log->info("reading ISIS database '",$arg->{'filename'},"'");
160
161 my $isis_db = OpenIsis::open($arg->{'filename'});
162
163 my $maxmfn = OpenIsis::maxRowid( $isis_db ) || 1;
164
165 $maxmfn = $self->{limit_mfn} if ($self->{limit_mfn});
166
167 $log->info("processing $maxmfn records...");
168
169 # read database
170 for (my $mfn = 1; $mfn <= $maxmfn; $mfn++) {
171
172 # read record
173 my $row = OpenIsis::read( $isis_db, $mfn );
174 foreach my $k (keys %{$row}) {
175 if ($k ne "mfn") {
176 foreach my $l (@{$row->{$k}}) {
177 $l = $cp->convert($l);
178 # has subfields?
179 my $val;
180 if ($l =~ m/\^/) {
181 foreach my $t (split(/\^/,$l)) {
182 next if (! $t);
183 $val->{substr($t,0,1)} = substr($t,1);
184 }
185 } else {
186 $val = $l;
187 }
188
189 push @{$self->{'data'}->{$mfn}->{$k}}, $val;
190 }
191 } else {
192 push @{$self->{'data'}->{$mfn}->{'000'}}, $mfn;
193 }
194
195 }
196
197 # create lookup
198 my $rec = $self->{'data'}->{$mfn};
199 $self->create_lookup($rec, @{$arg->{'lookup'}});
200
201 $self->progress_bar($mfn,$maxmfn);
202
203 }
204
205 $self->{'current_mfn'} = 1;
206 $self->{'last_pcnt'} = 0;
207
208 # store max mfn and return it.
209 return $self->{'max_mfn'} = $maxmfn;
210 }
211
212 =head2 fetch_rec
213
214 Fetch next record from database. It will also display progress bar (once
215 it's implemented, that is).
216
217 my $rec = $webpac->fetch_rec;
218
219 =cut
220
221 sub fetch_rec {
222 my $self = shift;
223
224 my $log = $self->_get_logger();
225
226 my $mfn = $self->{'current_mfn'}++ || $log->logconfess("it seems that you didn't load database!");
227
228 if ($mfn > $self->{'max_mfn'}) {
229 $self->{'current_mfn'} = $self->{'max_mfn'};
230 $log->debug("at EOF");
231 return;
232 }
233
234 $self->progress_bar($mfn,$self->{'max_mfn'});
235
236 return $self->{'data'}->{$mfn};
237 }
238
239 =head2 progress_bar
240
241 Draw progress bar on STDERR.
242
243 $webpac->progress_bar($current, $max);
244
245 =cut
246
247 sub progress_bar {
248 my $self = shift;
249
250 my ($curr,$max) = @_;
251
252 my $log = $self->_get_logger();
253
254 $log->logconfess("no current value!") if (! $curr);
255 $log->logconfess("no maximum value!") if (! $max);
256
257 if ($curr > $max) {
258 $max = $curr;
259 $log->debug("overflow to $curr");
260 }
261
262 $self->{'last_pcnt'} ||= 1;
263
264 $self->{'last_pcnt'} = $curr if ($curr < $self->{'last_pcnt'});
265
266 my $p = int($curr * 100 / $max);
267 if ($p != $self->{'last_pcnt'}) {
268 printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$curr,$max,"=" x ($p/2).">", $p );
269 $self->{'last_pcnt'} = $p;
270 }
271 }
272
273 =head2 open_import_xml
274
275 Read file from C<import_xml/> directory and parse it.
276
277 $webpac->open_import_xml(type => 'isis');
278
279 =cut
280
281 sub open_import_xml {
282 my $self = shift;
283
284 my $log = $self->_get_logger();
285
286 my $arg = {@_};
287 $log->logconfess("need type to load file from import_xml/") if (! $arg->{'type'});
288
289 $self->{'type'} = $arg->{'type'};
290
291 my $type_base = $arg->{'type'};
292 $type_base =~ s/_.*$//g;
293
294 $self->{'tag'} = $type2tag{$type_base};
295
296 $log->info("using type '",$self->{'type'},"' tag <",$self->{'tag'},">");
297
298 my $f = "./import_xml/".$self->{'type'}.".xml";
299 $log->logconfess("import_xml file '$f' doesn't exist!") if (! -e "$f");
300
301 $log->info("reading '$f'");
302
303 $self->{'import_xml_file'} = $f;
304
305 $self->{'import_xml'} = XMLin($f,
306 ForceArray => [ $self->{'tag'}, 'config', 'format' ],
307 );
308
309 $log->debug("import xml is ",sub { Dumper($self->{'import_xml'}) });
310
311 }
312
313 =head2 create_lookup
314
315 Create lookup from record using lookup definition.
316
317 $self->create_lookup($rec, @lookups);
318
319 Called internally by C<open_*> methods.
320
321 =cut
322
323 sub create_lookup {
324 my $self = shift;
325
326 my $log = $self->_get_logger();
327
328 my $rec = shift || $log->logconfess("need record to create lookup");
329 $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
330
331 foreach my $i (@_) {
332 if ($i->{'eval'}) {
333 my $eval = $self->fill_in($rec,$i->{'eval'});
334 my $key = $self->fill_in($rec,$i->{'key'});
335 my @val = $self->fill_in($rec,$i->{'val'});
336 if ($key && @val && eval $eval) {
337 $log->debug("stored $key = ",sub { join(" | ",@val) });
338 push @{$self->{'lookup'}->{$key}}, @val;
339 }
340 } else {
341 my $key = $self->fill_in($rec,$i->{'key'});
342 my @val = $self->fill_in($rec,$i->{'val'});
343 if ($key && @val) {
344 $log->debug("stored $key = ",sub { join(" | ",@val) });
345 push @{$self->{'lookup'}->{$key}}, @val;
346 }
347 }
348 }
349 }
350
351 =head2 get_data
352
353 Returns value from record.
354
355 my $text = $self->get_data(\$rec,$f,$sf,$i,\$found);
356
357 Arguments are:
358 record reference C<$rec>,
359 field C<$f>,
360 optional subfiled C<$sf>,
361 index for repeatable values C<$i>.
362
363 Optinal variable C<$found> will be incremeted if there
364 is field.
365
366 Returns value or empty string.
367
368 =cut
369
370 sub get_data {
371 my $self = shift;
372
373 my ($rec,$f,$sf,$i,$found) = @_;
374
375 if ($$rec->{$f}) {
376 return '' if (! $$rec->{$f}->[$i]);
377 no strict 'refs';
378 if ($sf && $$rec->{$f}->[$i]->{$sf}) {
379 $$found++ if (defined($$found));
380 return $$rec->{$f}->[$i]->{$sf};
381 } elsif ($$rec->{$f}->[$i]) {
382 $$found++ if (defined($$found));
383 # it still might have subfield, just
384 # not specified, so we'll dump all
385 if ($$rec->{$f}->[$i] =~ /HASH/o) {
386 my $out;
387 foreach my $k (keys %{$$rec->{$f}->[$i]}) {
388 $out .= $$rec->{$f}->[$i]->{$k}." ";
389 }
390 return $out;
391 } else {
392 return $$rec->{$f}->[$i];
393 }
394 }
395 } else {
396 return '';
397 }
398 }
399
400 =head2 fill_in
401
402 Workhourse of all: takes record from in-memory structure of database and
403 strings with placeholders and returns string or array of with substituted
404 values from record.
405
406 my $text = $webpac->fill_in($rec,'v250^a');
407
408 Optional argument is ordinal number for repeatable fields. By default,
409 it's assume to be first repeatable field (fields are perl array, so first
410 element is 0).
411 Following example will read second value from repeatable field.
412
413 my $text = $webpac->fill_in($rec,'Title: v250^a',1);
414
415 This function B<does not> perform parsing of format to inteligenty skip
416 delimiters before fields which aren't used.
417
418 This method will automatically decode UTF-8 string to local code page
419 if needed.
420
421 =cut
422
423 sub fill_in {
424 my $self = shift;
425
426 my $log = $self->_get_logger();
427
428 my $rec = shift || $log->logconfess("need data record");
429 my $format = shift || $log->logconfess("need format to parse");
430 # iteration (for repeatable fields)
431 my $i = shift || 0;
432
433 # FIXME remove for speedup?
434 $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
435
436 if (utf8::is_utf8($format)) {
437 $format = $self->_x($format);
438 }
439
440 my $found = 0;
441
442 my $eval_code;
443 # remove eval{...} from beginning
444 $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
445
446 # do actual replacement of placeholders
447 $format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found)/ges;
448
449 if ($found) {
450 $log->debug("format: $format");
451 if ($eval_code) {
452 my $eval = $self->fill_in($rec,$eval_code,$i);
453 return if (! $self->_eval($eval));
454 }
455 # do we have lookups?
456 if ($format =~ /$LOOKUP_REGEX/o) {
457 $log->debug("format '$format' has lookup");
458 return $self->lookup($format);
459 } else {
460 return $format;
461 }
462 } else {
463 return;
464 }
465 }
466
467 =head2 lookup
468
469 Perform lookups on format supplied to it.
470
471 my $text = $self->lookup('[v900]');
472
473 Lookups can be nested (like C<[d:[a:[v900]]]>).
474
475 =cut
476
477 sub lookup {
478 my $self = shift;
479
480 my $log = $self->_get_logger();
481
482 my $tmp = shift || $log->logconfess("need format");
483
484 if ($tmp =~ /$LOOKUP_REGEX/o) {
485 my @in = ( $tmp );
486
487 $log->debug("lookup for: ",$tmp);
488
489 my @out;
490 while (my $f = shift @in) {
491 if ($f =~ /$LOOKUP_REGEX_SAVE/o) {
492 my $k = $1;
493 if ($self->{'lookup'}->{$k}) {
494 foreach my $nv (@{$self->{'lookup'}->{$k}}) {
495 my $tmp2 = $f;
496 $tmp2 =~ s/lookup{$k}/$nv/g;
497 push @in, $tmp2;
498 }
499 } else {
500 undef $f;
501 }
502 } elsif ($f) {
503 push @out, $f;
504 }
505 }
506 $log->logconfess("return is array and it's not expected!") unless wantarray;
507 return @out;
508 } else {
509 return $tmp;
510 }
511 }
512
513 =head2 parse
514
515 Perform smart parsing of string, skipping delimiters for fields which aren't
516 defined. It can also eval code in format starting with C<eval{...}> and
517 return output or nothing depending on eval code.
518
519 my $text = $webpac->parse($rec,'eval{"v901^a" eq "Deskriptor"}descriptor: v250^a', $i);
520
521 =cut
522
523 sub parse {
524 my $self = shift;
525
526 my ($rec, $format_utf8, $i) = @_;
527
528 return if (! $format_utf8);
529
530 my $log = $self->_get_logger();
531
532 $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
533 $log->logconfess("need utf2cp Text::Iconv object!") if (! $self->{'utf2cp'});
534
535 $i = 0 if (! $i);
536
537 my $format = $self->_x($format_utf8) || $log->logconfess("can't convert '$format_utf8' from UTF-8 to ",$self->{'code_page'});
538
539 my @out;
540
541 $log->debug("format: $format");
542
543 my $eval_code;
544 # remove eval{...} from beginning
545 $eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
546
547 my $prefix;
548 my $all_found=0;
549
550 while ($format =~ s/^(.*?)v(\d+)(?:\^(\w))?//s) {
551
552 my $del = $1 || '';
553 $prefix ||= $del if ($all_found == 0);
554
555 my $found = 0;
556 my $tmp = $self->get_data(\$rec,$2,$3,$i,\$found);
557
558 if ($found) {
559 push @out, $del;
560 push @out, $tmp;
561 $all_found += $found;
562 }
563 }
564
565 return if (! $all_found);
566
567 my $out = join('',@out);
568
569 if ($out) {
570 # add rest of format (suffix)
571 $out .= $format;
572
573 # add prefix if not there
574 $out = $prefix . $out if ($out !~ m/^\Q$prefix\E/);
575
576 $log->debug("result: $out");
577 }
578
579 if ($eval_code) {
580 my $eval = $self->fill_in($rec,$eval_code,$i);
581 $log->debug("about to eval{",$eval,"} format: $out");
582 return if (! $self->_eval($eval));
583 }
584
585 return $out;
586 }
587
588 =head2 parse_to_arr
589
590 Similar to C<parse>, but returns array of all repeatable fields
591
592 my @arr = $webpac->parse_to_arr($rec,'v250^a');
593
594 =cut
595
596 sub parse_to_arr {
597 my $self = shift;
598
599 my ($rec, $format_utf8) = @_;
600
601 my $log = $self->_get_logger();
602
603 $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
604 return if (! $format_utf8);
605
606 my $i = 0;
607 my @arr;
608
609 while (my $v = $self->parse($rec,$format_utf8,$i++)) {
610 push @arr, $v;
611 }
612
613 $log->debug("format '$format_utf8' returned ",--$i," elements: ", sub { join(" | ",@arr) }) if (@arr);
614
615 return @arr;
616 }
617
618 =head2 fill_in_to_arr
619
620 Similar to C<fill_in>, but returns array of all repeatable fields. Usable
621 for fields which have lookups, so they shouldn't be parsed but rather
622 C<fill_id>ed.
623
624 my @arr = $webpac->fill_in_to_arr($rec,'[v900];;[v250^a]');
625
626 =cut
627
628 sub fill_in_to_arr {
629 my $self = shift;
630
631 my ($rec, $format_utf8) = @_;
632
633 my $log = $self->_get_logger();
634
635 $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
636 return if (! $format_utf8);
637
638 my $i = 0;
639 my @arr;
640
641 while (my @v = $self->fill_in($rec,$format_utf8,$i++)) {
642 push @arr, @v;
643 }
644
645 $log->debug("format '$format_utf8' returned ",--$i," elements: ", sub { join(" | ",@arr) }) if (@arr);
646
647 return @arr;
648 }
649
650
651 =head2 data_structure
652
653 Create in-memory data structure which represents layout from C<import_xml>.
654 It is used later to produce output.
655
656 my @ds = $webpac->data_structure($rec);
657
658 This method will also set C<$webpac->{'currnet_filename'}> if there is
659 <filename> tag in C<import_xml>.
660
661 =cut
662
663 sub data_structure {
664 my $self = shift;
665
666 my $log = $self->_get_logger();
667
668 my $rec = shift;
669 $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
670
671 undef $self->{'currnet_filename'};
672
673 my @sorted_tags;
674 if ($self->{tags_by_order}) {
675 @sorted_tags = @{$self->{tags_by_order}};
676 } else {
677 @sorted_tags = sort { $self->_sort_by_order } keys %{$self->{'import_xml'}->{'indexer'}};
678 $self->{tags_by_order} = \@sorted_tags;
679 }
680
681 my @ds;
682
683 $log->debug("tags: ",sub { join(", ",@sorted_tags) });
684
685 foreach my $field (@sorted_tags) {
686
687 my $row;
688
689 #print "field $field [",$self->{'tag'},"] = ",Dumper($self->{'import_xml'}->{'indexer'}->{$field}->{$self->{'tag'}});
690
691 foreach my $tag (@{$self->{'import_xml'}->{'indexer'}->{$field}->{$self->{'tag'}}}) {
692 my $format = $tag->{'value'} || $tag->{'content'};
693
694 $log->debug("format: $format");
695
696 my @v;
697 if ($format =~ /$LOOKUP_REGEX/o) {
698 @v = $self->fill_in_to_arr($rec,$format);
699 } else {
700 @v = $self->parse_to_arr($rec,$format);
701 }
702 next if (! @v);
703
704 # use format?
705 if ($tag->{'format_name'}) {
706 @v = map { $self->apply_format($tag->{'format_name'},$tag->{'format_delimiter'},$_) } @v;
707 }
708
709 # does tag have type?
710 if ($tag->{'type'}) {
711 push @{$row->{$tag->{'type'}}}, @v;
712 } else {
713 push @{$row->{'display'}}, @v;
714 push @{$row->{'swish'}}, @v;
715 }
716
717 if ($field eq 'filename') {
718 $self->{'current_filename'} = join('',@v);
719 $log->debug("filename: ",$self->{'current_filename'});
720 }
721
722 }
723
724 if ($row) {
725 $row->{'tag'} = $field;
726
727 # TODO: name_sigular, name_plural
728 my $name = $self->{'import_xml'}->{'indexer'}->{$field}->{'name'};
729 $row->{'name'} = $name ? $self->_x($name) : $field;
730
731 push @ds, $row;
732
733 $log->debug("row $field: ",sub { Dumper($row) });
734 }
735
736 }
737
738 return @ds;
739
740 }
741
742 =head2 output
743
744 Create output from in-memory data structure using Template Toolkit template.
745
746 my $text = $webpac->output( template => 'text.tt', data => @ds );
747
748 =cut
749
750 sub output {
751 my $self = shift;
752
753 my $args = {@_};
754
755 my $log = $self->_get_logger();
756
757 $log->logconfess("need template name") if (! $args->{'template'});
758 $log->logconfess("need data array") if (! $args->{'data'});
759
760 my $out;
761
762 $self->{'tt'}->process(
763 $args->{'template'},
764 $args,
765 \$out
766 ) || confess $self->{'tt'}->error();
767
768 return $out;
769 }
770
771 =head2 apply_format
772
773 Apply format specified in tag with C<format_name="name"> and
774 C<format_delimiter=";;">.
775
776 my $text = $webpac->apply_format($format_name,$format_delimiter,$data);
777
778 Formats can contain C<lookup{...}> if you need them.
779
780 =cut
781
782 sub apply_format {
783 my $self = shift;
784
785 my ($name,$delimiter,$data) = @_;
786
787 my $log = $self->_get_logger();
788
789 if (! $self->{'import_xml'}->{'format'}->{$name}) {
790 $log->warn("<format name=\"$name\"> is not defined in ",$self->{'import_xml_file'});
791 return $data;
792 }
793
794 $log->warn("no delimiter for format $name") if (! $delimiter);
795
796 my $format = $self->_x($self->{'import_xml'}->{'format'}->{$name}->{'content'}) || $log->logdie("can't find format '$name'");
797
798 my @data = split(/\Q$delimiter\E/, $data);
799
800 my $out = sprintf($format, @data);
801 $log->debug("using format $name [$format] on $data to produce: $out");
802
803 if ($out =~ m/$LOOKUP_REGEX/o) {
804 return $self->lookup($out);
805 } else {
806 return $out;
807 }
808
809 }
810
811
812 #
813 #
814 #
815
816 =head1 INTERNAL METHODS
817
818 Here is a quick list of internal methods, mostly useful to turn debugging
819 on them (see L<LOGGING> below for explanation).
820
821 =cut
822
823 =head2 _eval
824
825 Internal function to eval code without C<strict 'subs'>.
826
827 =cut
828
829 sub _eval {
830 my $self = shift;
831
832 my $code = shift || return;
833
834 my $log = $self->_get_logger();
835
836 no strict 'subs';
837 my $ret = eval $code;
838 if ($@) {
839 $log->error("problem with eval code [$code]: $@");
840 }
841
842 $log->debug("eval: ",$code," [",$ret,"]");
843
844 return $ret || 0;
845 }
846
847 =head2 _sort_by_order
848
849 Sort xml tags data structure accoding to C<order=""> attribute.
850
851 =cut
852
853 sub _sort_by_order {
854 my $self = shift;
855
856 my $va = $self->{'import_xml'}->{'indexer'}->{$a}->{'order'} ||
857 $self->{'import_xml'}->{'indexer'}->{$a};
858 my $vb = $self->{'import_xml'}->{'indexer'}->{$b}->{'order'} ||
859 $self->{'import_xml'}->{'indexer'}->{$b};
860
861 return $va <=> $vb;
862 }
863
864 =head2 _get_logger
865
866 Get C<Log::Log4perl> object with a twist: domains are defined for each
867 method
868
869 my $log = $webpac->_get_logger();
870
871 =cut
872
873 sub _get_logger {
874 my $self = shift;
875
876 my $name = (caller(1))[3] || caller;
877 return get_logger($name);
878 }
879
880 =head2 _x
881
882 Convert string from UTF-8 to code page defined in C<import_xml>.
883
884 my $text = $webpac->_x('utf8 text');
885
886 =cut
887
888 sub _x {
889 my $self = shift;
890 my $utf8 = shift || return;
891
892 return $self->{'utf2cp'}->convert($utf8) ||
893 $self->_get_logger()->logwarn("can't convert '$utf8'");
894 }
895
896 #
897 #
898 #
899
900 =head1 LOGGING
901
902 Logging in WebPAC is performed by L<Log::Log4perl> with config file
903 C<log.conf>.
904
905 Methods defined above have different levels of logging, so
906 it's descriptions will be useful to turn (mostry B<debug> logging) on
907 or off to see why WabPAC isn't perforing as you expect it (it might even
908 be a bug!).
909
910 B<This is different from normal Log4perl behaviour>. To repeat, you can
911 also use method names, and not only classes (which are just few)
912 to filter logging.
913
914 =cut
915
916 1;

  ViewVC Help
Powered by ViewVC 1.1.26