--- trunk2/lib/WebPAC.pm 2004/06/20 15:49:09 373 +++ trunk2/lib/WebPAC.pm 2004/07/24 13:48:08 398 @@ -188,6 +188,8 @@ push @{$self->{'data'}->{$mfn}->{$k}}, $val; } + } else { + push @{$self->{'data'}->{$mfn}->{'000'}}, $mfn; } } @@ -196,9 +198,12 @@ my $rec = $self->{'data'}->{$mfn}; $self->create_lookup($rec, @{$arg->{'lookup'}}); + $self->progress_bar($mfn,$maxmfn); + } $self->{'current_mfn'} = 1; + $self->{'last_pcnt'} = 0; # store max mfn and return it. return $self->{'max_mfn'} = $maxmfn; @@ -226,9 +231,45 @@ return; } + $self->progress_bar($mfn,$self->{'max_mfn'}); + return $self->{'data'}->{$mfn}; } +=head2 progress_bar + +Draw progress bar on STDERR. + + $webpac->progress_bar($current, $max); + +=cut + +sub progress_bar { + my $self = shift; + + my ($curr,$max) = @_; + + my $log = $self->_get_logger(); + + $log->logconfess("no current value!") if (! $curr); + $log->logconfess("no maximum value!") if (! $max); + + if ($curr > $max) { + $max = $curr; + $log->debug("overflow to $curr"); + } + + $self->{'last_pcnt'} ||= 1; + + $self->{'last_pcnt'} = $curr if ($curr < $self->{'last_pcnt'}); + + my $p = int($curr * 100 / $max); + if ($p != $self->{'last_pcnt'}) { + printf STDERR ("%5d / %5d [%-51s] %-2d %% \r",$curr,$max,"=" x ($p/2).">", $p ); + $self->{'last_pcnt'} = $p; + } +} + =head2 open_import_xml Read file from C directory and parse it. @@ -252,17 +293,21 @@ $self->{'tag'} = $type2tag{$type_base}; - $log->debug("using type '",$self->{'type'},"' tag <",$self->{'tag'},">") if ($self->{'debug'}); + $log->info("using type '",$self->{'type'},"' tag <",$self->{'tag'},">"); my $f = "./import_xml/".$self->{'type'}.".xml"; $log->logconfess("import_xml file '$f' doesn't exist!") if (! -e "$f"); - $log->debug("reading '$f'") if ($self->{'debug'}); + $log->info("reading '$f'"); + + $self->{'import_xml_file'} = $f; $self->{'import_xml'} = XMLin($f, ForceArray => [ $self->{'tag'}, 'config', 'format' ], ); + $log->debug("import xml is ",sub { Dumper($self->{'import_xml'}) }); + } =head2 create_lookup @@ -329,6 +374,7 @@ if ($$rec->{$f}) { return '' if (! $$rec->{$f}->[$i]); + no strict 'refs'; if ($sf && $$rec->{$f}->[$i]->{$sf}) { $$found++ if (defined($$found)); return $$rec->{$f}->[$i]->{$sf}; @@ -369,6 +415,9 @@ This function B perform parsing of format to inteligenty skip delimiters before fields which aren't used. +This method will automatically decode UTF-8 string to local code page +if needed. + =cut sub fill_in { @@ -384,6 +433,10 @@ # FIXME remove for speedup? $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o); + if (utf8::is_utf8($format)) { + $format = $self->_x($format); + } + my $found = 0; my $eval_code; @@ -481,7 +534,7 @@ $i = 0 if (! $i); - my $format = $self->{'utf2cp'}->convert($format_utf8) || $log->logconfess("can't convert '$format_utf8' from UTF-8 to ",$self->{'code_page'}); + my $format = $self->_x($format_utf8) || $log->logconfess("can't convert '$format_utf8' from UTF-8 to ",$self->{'code_page'}); my @out; @@ -602,6 +655,10 @@ my @ds = $webpac->data_structure($rec); +This method will also set C<$webpac->{'currnet_filename'}> if there is + tag in C and C<$webpac->{'headline'}> if there is + tag. + =cut sub data_structure { @@ -612,6 +669,9 @@ my $rec = shift; $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o); + undef $self->{'currnet_filename'}; + undef $self->{'headline'}; + my @sorted_tags; if ($self->{tags_by_order}) { @sorted_tags = @{$self->{tags_by_order}}; @@ -643,6 +703,20 @@ } next if (! @v); + # use format? + if ($tag->{'format_name'}) { + @v = map { $self->apply_format($tag->{'format_name'},$tag->{'format_delimiter'},$_) } @v; + } + + if ($field eq 'filename') { + $self->{'current_filename'} = join('',@v); + $log->debug("filename: ",$self->{'current_filename'}); + } elsif ($field eq 'headline') { + $self->{'headline'} .= join('',@v); + $log->debug("headline: ",$self->{'headline'}); + next; # don't return headline in data_structure! + } + # does tag have type? if ($tag->{'type'}) { push @{$row->{$tag->{'type'}}}, @v; @@ -651,11 +725,18 @@ push @{$row->{'swish'}}, @v; } + } if ($row) { $row->{'tag'} = $field; + + # TODO: name_sigular, name_plural + my $name = $self->{'import_xml'}->{'indexer'}->{$field}->{'name'}; + $row->{'name'} = $name ? $self->_x($name) : $field; + push @ds, $row; + $log->debug("row $field: ",sub { Dumper($row) }); } @@ -694,6 +775,47 @@ return $out; } +=head2 apply_format + +Apply format specified in tag with C and +C. + + my $text = $webpac->apply_format($format_name,$format_delimiter,$data); + +Formats can contain C if you need them. + +=cut + +sub apply_format { + my $self = shift; + + my ($name,$delimiter,$data) = @_; + + my $log = $self->_get_logger(); + + if (! $self->{'import_xml'}->{'format'}->{$name}) { + $log->warn(" is not defined in ",$self->{'import_xml_file'}); + return $data; + } + + $log->warn("no delimiter for format $name") if (! $delimiter); + + my $format = $self->_x($self->{'import_xml'}->{'format'}->{$name}->{'content'}) || $log->logdie("can't find format '$name'"); + + my @data = split(/\Q$delimiter\E/, $data); + + my $out = sprintf($format, @data); + $log->debug("using format $name [$format] on $data to produce: $out"); + + if ($out =~ m/$LOOKUP_REGEX/o) { + return $self->lookup($out); + } else { + return $out; + } + +} + + # # # @@ -746,11 +868,36 @@ return $va <=> $vb; } +=head2 _get_logger + +Get C object with a twist: domains are defined for each +method + + my $log = $webpac->_get_logger(); + +=cut + sub _get_logger { my $self = shift; - my @c = caller(1); - return get_logger($c[3]); + my $name = (caller(1))[3] || caller; + return get_logger($name); +} + +=head2 _x + +Convert string from UTF-8 to code page defined in C. + + my $text = $webpac->_x('utf8 text'); + +=cut + +sub _x { + my $self = shift; + my $utf8 = shift || return; + + return $self->{'utf2cp'}->convert($utf8) || + $self->_get_logger()->logwarn("can't convert '$utf8'"); } #