--- trunk/lib/WebPAC/Normalize.pm 2005/07/17 22:48:25 22 +++ trunk/lib/WebPAC/Normalize.pm 2005/12/19 15:34:47 295 @@ -2,6 +2,7 @@ use warnings; use strict; +use base 'WebPAC::Common'; use Data::Dumper; =head1 NAME @@ -10,11 +11,11 @@ =head1 VERSION -Version 0.01 +Version 0.07 =cut -our $VERSION = '0.01'; +our $VERSION = '0.07'; =head1 SYNOPSIS @@ -46,6 +47,10 @@ code defined as code ref on format after field substitution to producing output +There is one built-in filter called C which can be use like this: + + filter{regex(s/foo/bar/)} + =item * optional C will be then performed. See C. @@ -78,15 +83,21 @@ return length($_); }, ... }, - db => $webpac_db_obj, + db => $db_obj, lookup_regex => $lookup->regex, + lookup => $lookup_obj, + prefix => 'foobar', ); Parametar C defines user supplied snippets of perl code which can be use with C notation. +C is used to form filename for database record (to support multiple +source files which are joined in one database). + Recommended parametar C is used to enable parsing of lookups -in structures. +in structures. If you pass this parametar, you must also pass C +which is C object. =cut @@ -95,6 +106,32 @@ my $self = {@_}; bless($self, $class); + my $r = $self->{'lookup_regex'} ? 1 : 0; + my $l = $self->{'lookup'} ? 1 : 0; + + my $log = $self->_get_logger(); + + # those two must be in pair + if ( ($r & $l) != ($r || $l) ) { + my $log = $self->_get_logger(); + $log->logdie("lookup_regex and lookup must be in pair"); + } + + $log->logdie("lookup must be WebPAC::Lookup object") if ($self->{'lookup'} && ! $self->{'lookup'}->isa('WebPAC::Lookup')); + + $log->warn("no prefix defined. please check that!") unless ($self->{'prefix'}); + + $log->debug("using lookup regex: ", $self->{lookup_regex}) if ($r && $l); + + if (! $self->{filter} || ! $self->{filter}->{regex}) { + $log->debug("adding built-in filter regex"); + $self->{filter}->{regex} = sub { + my ($val, $regex) = @_; + eval "\$val =~ $regex"; + return $val; + }; + } + $self ? return $self : return undef; } @@ -106,13 +143,7 @@ This structures are used to produce output. - my @ds = $webpac->data_structure($rec); - -B - -This method will also set C<< $webpac->{'currnet_filename'} >> if there is -C<< >> tag and C<< $webpac->{'headline'} >> if there is -C<< >> tag. + my $ds = $webpac->data_structure($rec); =cut @@ -124,16 +155,21 @@ my $rec = shift; $log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o); + $log->debug("data_structure rec = ", sub { Dumper($rec) }); + + $log->logdie("need unique ID (mfn) in field 000 of record ", sub { Dumper($rec) } ) unless (defined($rec->{'000'})); + + my $id = $rec->{'000'}->[0] || $log->logdie("field 000 isn't array!"); + my $cache_file; if ($self->{'db'}) { - my @ds = $self->{'db'}->load_ds($rec); - return @ds if (@ds); + my $ds = $self->{'db'}->load_ds( id => $id, prefix => $self->{prefix} ); + $log->debug("load_ds( rec = ", sub { Dumper($rec) }, ") = ", sub { Dumper($ds) }); + return $ds if ($ds); + $log->debug("cache miss, creating"); } - undef $self->{'currnet_filename'}; - undef $self->{'headline'}; - my @sorted_tags; if ($self->{tags_by_order}) { @sorted_tags = @{$self->{tags_by_order}}; @@ -142,7 +178,7 @@ $self->{tags_by_order} = \@sorted_tags; } - my @ds; + my $ds; $log->debug("tags: ",sub { join(", ",@sorted_tags) }); @@ -153,7 +189,10 @@ #print "field $field [",$self->{'tag'},"] = ",Dumper($self->{'import_xml'}->{'indexer'}->{$field}->{$self->{'tag'}}); foreach my $tag (@{$self->{'import_xml'}->{'indexer'}->{$field}->{$self->{'tag'}}}) { - my $format = $tag->{'value'} || $tag->{'content'}; + my $format; + + $log->logdie("expected tag HASH and got $tag") unless (ref($tag) eq 'HASH'); + $format = $tag->{'value'} || $tag->{'content'}; $log->debug("format: $format"); @@ -174,28 +213,19 @@ @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! - } - # delimiter will join repeatable fields if ($tag->{'delimiter'}) { @v = ( join($tag->{'delimiter'}, @v) ); } # default types - my @types = qw(display swish); + my @types = qw(display search); # 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'); + $log->debug("type: $type ",sub { join(" ",@v) }, " ", $row->{'append'} || 'no append'); if ($tag->{'append'}) { # I will delimit appended part with @@ -222,14 +252,14 @@ # TODO: name_sigular, name_plural my $name = $self->{'import_xml'}->{'indexer'}->{$field}->{'name'}; - $row->{'name'} = $name ? $self->_x($name) : $field; + my $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; + $ds->{$row_name} = $row; $log->debug("row $field: ",sub { Dumper($row) }); } @@ -237,12 +267,16 @@ } $self->{'db'}->save_ds( - ds => \@ds, - current_filename => $self->{'current_filename'}, - headline => $self->{'headline'}, + id => $id, + ds => $ds, + prefix => $self->{prefix}, ) if ($self->{'db'}); - return @ds; + $log->debug("ds: ", sub { Dumper($ds) }); + + $log->logconfess("data structure returned is not array any more!") if wantarray; + + return $ds; } @@ -254,8 +288,18 @@ my $text = $webpac->parse($rec,'eval{"v901^a" eq "Deskriptor"}descriptor: v250^a', $i); +Filters are implemented here. While simple form of filters looks like this: + + filter{name_of_filter} + +but, filters can also have variable number of parametars like this: + + filter{name_of_filter(param,param,param)} + =cut +my $warn_once; + sub parse { my $self = shift; @@ -325,11 +369,21 @@ return if (! $self->_eval($eval)); } - if ($filter_name && $self->{'filter'}->{$filter_name}) { - $log->debug("about to filter{$filter_name} format: $out"); - $out = $self->{'filter'}->{$filter_name}->($out); - return unless(defined($out)); - $log->debug("filter result: $out"); + if ($filter_name) { + my @filter_args; + if ($filter_name =~ s/(\w+)\((.*)\)/$1/) { + @filter_args = split(/,/, $2); + } + if ($self->{'filter'}->{$filter_name}) { + $log->debug("about to filter{$filter_name} format: $out with arguments: ", join(",", @filter_args)); + unshift @filter_args, $out; + $out = $self->{'filter'}->{$filter_name}->(@filter_args); + return unless(defined($out)); + $log->debug("filter result: $out"); + } elsif (! $warn_once->{$filter_name}) { + $log->warn("trying to use undefined filter $filter_name"); + $warn_once->{$filter_name}++; + } } return $out; @@ -438,7 +492,13 @@ } # do we have lookups? if ($self->{'lookup'}) { - return $self->lookup($format); + if ($self->{'lookup'}->can('lookup')) { + my @lookup = $self->{lookup}->lookup($format); + $log->debug("lookup $format", join(", ", @lookup)); + return @lookup; + } else { + $log->warn("Have lookup object but can't invoke lookup method"); + } } else { return $format; } @@ -511,7 +571,7 @@ if ($sf && $$rec->{$f}->[$i]->{$sf}) { $$found++ if (defined($$found)); return $$rec->{$f}->[$i]->{$sf}; - } elsif ($$rec->{$f}->[$i]) { + } elsif (! $sf && $$rec->{$f}->[$i]) { $$found++ if (defined($$found)); # it still might have subfield, just # not specified, so we'll dump all @@ -524,6 +584,8 @@ } else { return $$rec->{$f}->[$i]; } + } else { + return ''; } } else { return ''; @@ -564,7 +626,7 @@ $log->debug("using format $name [$format] on $data to produce: $out"); if ($self->{'lookup_regex'} && $out =~ $self->{'lookup_regex'}) { - return $self->lookup($out); + return $self->{'lookup'}->lookup($out); } else { return $out; } @@ -647,4 +709,4 @@ =cut -1; # End of WebPAC::DB +1; # End of WebPAC::Normalize