--- trunk2/lib/WebPAC.pm 2004/09/12 20:31:34 431 +++ trunk2/lib/WebPAC.pm 2004/09/15 21:21:36 453 @@ -34,8 +34,8 @@ my $webpac = new WebPAC( config_file => 'name.conf', - [code_page => 'ISO-8859-2',] - [low_mem => 1,] + code_page => 'ISO-8859-2', + low_mem => 1, ); Default C is C. @@ -123,7 +123,7 @@ $log->debug("removed '$db_file' from last run"); } - use DBM::Deep; + require DBM::Deep; my $db = new DBM::Deep $db_file; @@ -185,6 +185,8 @@ $log->logcroak("need filename") if (! $arg->{'filename'}); my $code_page = $arg->{'code_page'} || '852'; + $log->logdie("can't find database ",$arg->{'filename'}) unless (glob($arg->{'filename'}.'.*')); + # store data in object $self->{'isis_filename'} = $arg->{'filename'}; $self->{'isis_code_page'} = $code_page; @@ -207,6 +209,8 @@ if (my $s = $self->{'start_mfn'}) { $log->info("skipping to MFN $s"); $startmfn = $s; + } else { + $self->{'start_mfn'} = $startmfn; } $maxmfn = $startmfn + $self->{limit_mfn} if ($self->{limit_mfn}); @@ -262,7 +266,7 @@ } - $self->{'current_mfn'} = $startmfn; + $self->{'current_mfn'} = -1; $self->{'last_pcnt'} = 0; $log->debug("max mfn: $maxmfn"); @@ -285,7 +289,15 @@ my $log = $self->_get_logger(); - my $mfn = $self->{'current_mfn'}++ || $log->logconfess("it seems that you didn't load database!"); + $log->logconfess("it seems that you didn't load database!") unless ($self->{'current_mfn'}); + + if ($self->{'current_mfn'} == -1) { + $self->{'current_mfn'} = $self->{'start_mfn'}; + } else { + $self->{'current_mfn'}++; + } + + my $mfn = $self->{'current_mfn'}; if ($mfn > $self->{'max_mfn'}) { $self->{'current_mfn'} = $self->{'max_mfn'}; @@ -302,6 +314,19 @@ } } +=head2 mfn + +Returns current record number (MFN). + + print $webpac->mfn; + +=cut + +sub mfn { + my $self = shift; + return $self->{'current_mfn'}; +} + =head2 progress_bar Draw progress bar on STDERR. @@ -333,7 +358,7 @@ if ($p < $self->{'last_pcnt'}) { $self->{'last_pcnt'} = $p; $self->{'last_t'} = time(); - $self->{'last_curr'} = 1; + $self->{'last_curr'} = undef; } if ($p != $self->{'last_pcnt'}) { @@ -752,6 +777,31 @@ return @arr; } +=head2 sort_arr + +Sort array ignoring case and html in data + + my @sorted = $webpac->sort_arr(@unsorted); + +=cut + +sub sort_arr { + my $self = shift; + + my $log = $self->_get_logger(); + + # FIXME add Schwartzian Transformation? + + my @sorted = sort { + $a =~ s#<[^>]+/*>##; + $b =~ s#<[^>]+/*>##; + lc($b) cmp lc($a) + } @_; + $log->debug("sorted values: ",sub { join(", ",@sorted) }); + + return @sorted; +} + =head2 data_structure @@ -808,6 +858,11 @@ } next if (! @v); + if ($tag->{'sort'}) { + @v = $self->sort_arr(@v); + $log->warn("sort within tag is usually not what you want!"); + } + # use format? if ($tag->{'format_name'}) { @v = map { $self->apply_format($tag->{'format_name'},$tag->{'format_delimiter'},$_) } @v; @@ -822,12 +877,35 @@ next; # don't return headline in data_structure! } - # does tag have type? - if ($tag->{'type'}) { - push @{$row->{$tag->{'type'}}}, @v; - } else { - push @{$row->{'display'}}, @v; - push @{$row->{'swish'}}, @v; + # delimiter will join repeatable fields + if ($tag->{'delimiter'}) { + @v = ( join($tag->{'delimiter'}, @v) ); + } + + # default types + my @types = qw(display swish); + # override by type attribute + @types = ( $tag->{'type'} ) if ($tag->{'type'}); + + foreach my $type (@types) { + # append to previous line? + $log->debug("type: $type ",sub { join(" ",@v) }, $row->{'append'} || 'no append'); + if ($tag->{'append'}) { + + # I will delimit appended part with + # delimiter (or ,) + my $d = $tag->{'delimiter'}; + # default delimiter + $d ||= ", "; + + my $last = pop @{$row->{$type}}; + $d = "" if (! $last); + $last .= $d . join($d, @v); + push @{$row->{$type}}, $last; + + } else { + push @{$row->{$type}}, @v; + } } @@ -840,6 +918,11 @@ my $name = $self->{'import_xml'}->{'indexer'}->{$field}->{'name'}; $row->{'name'} = $name ? $self->_x($name) : $field; + # post-sort all values in field + if ($self->{'import_xml'}->{'indexer'}->{$field}->{'sort'}) { + $log->warn("sort at field tag not implemented"); + } + push @ds, $row; $log->debug("row $field: ",sub { Dumper($row) });