--- trunk/lib/WebPAC/Input.pm 2007/04/05 21:53:52 818 +++ trunk/lib/WebPAC/Input.pm 2007/10/30 01:51:20 910 @@ -16,11 +16,11 @@ =head1 VERSION -Version 0.17 +Version 0.18 =cut -our $VERSION = '0.17'; +our $VERSION = '0.18'; =head1 SYNOPSIS @@ -64,6 +64,9 @@ encoding => 'ISO-8859-2', recode => 'char pairs', no_progress_bar => 1, + input_config => { + mapping => [ 'foo', 'bar', 'baz' ], + }, ); C is low-level file format module. See L and @@ -233,6 +236,7 @@ my $ll_db = $class->new( path => $arg->{path}, + input_config => $arg->{input_config} || $self->{input_config}, # filter => sub { # my ($l,$f_nr) = @_; # return unless defined($l); @@ -519,19 +523,26 @@ my $out = join("\n", map { - my $f = $_ || die "no field"; + my $f = $_; + die "no field in ", dump( $s->{fld} ) unless defined( $f ); my $v = $s->{fld}->{$f} || die "no s->{fld}->{$f}"; $max_fld = $v if ($v > $max_fld); my $o = sprintf("%4s %d ~", $f, $v); if (defined($s->{sf}->{$f})) { + my @subfields = keys %{ $s->{sf}->{$f} }; map { $o .= sprintf(" %s:%d%s", $_, $s->{sf}->{$f}->{$_}->{count}, $s->{sf}->{$f}->{$_}->{repeatable} ? '*' : '', ); - } sort keys %{ $s->{sf}->{$f} }; + } ( + # first indicators and other special subfields + sort( grep { length($_) > 1 } @subfields ), + # then subfileds (single char) + sort( grep { length($_) == 1 } @subfields ), + ); } if (my $v_r = $s->{repeatable}->{$f}) { @@ -539,7 +550,7 @@ } $o; - } sort { $a cmp $b } keys %{ $s->{fld} } + } sort { $a <=> $b } keys %{ $s->{fld} } ); $log->debug( sub { dump($s) } ); @@ -558,21 +569,22 @@ return unless $self->{ll_db}; - if ($self->{ll_db}->can('dump_rec')) { + if ($self->{ll_db}->can('dump_ascii')) { return $self->{ll_db}->dump_ascii( $self->{pos} ); } else { return dump( $self->{ll_db}->fetch_rec( $self->{pos} ) ); } } -=head2 modify_record_regexps +=head2 _get_regex -Generate hash with regexpes to be applied using L. +Helper function called which create regexps to be execute on code. - my $regexpes = $input->modify_record_regexps( - 900 => { '^a' => { ' : ' => '^b' } }, - 901 => { '*' => { '^b' => ' ; ' } }, - ); + _get_regex( 900, 'regex:[0-9]+' ,'numbers' ); + _get_regex( 900, '^b', ' : ^b' ); + +It supports perl regexps with C prefix to from value and has +additional logic to skip empty subfields. =cut @@ -589,14 +601,30 @@ $from = '\Q' . $from . '\E'; } if ($sf =~ /^\^/) { + my $need_subfield_data = '*'; # no + # if from is also subfield, require some data in between + # to correctly skip empty subfields + $need_subfield_data = '+' if ($from =~ m/^\\Q\^/); return - 's/\Q'. $sf .'\E([^\^]*?)'. $from .'([^\^]*?)/'. $sf .'$1'. $to .'$2/'; + 's/\Q'. $sf .'\E([^\^]' . $need_subfield_data . '?)'. $from .'([^\^]*?)/'. $sf .'$1'. $to .'$2/'; } else { return 's/'. $from .'/'. $to .'/g'; } } + +=head2 modify_record_regexps + +Generate hash with regexpes to be applied using L. + + my $regexpes = $input->modify_record_regexps( + 900 => { '^a' => { ' : ' => '^b' } }, + 901 => { '*' => { '^b' => ' ; ' } }, + ); + +=cut + sub modify_record_regexps { my $self = shift; my $modify_record = {@_};