r494@llin: dpavlin | 2006-02-27 00:22:59 +0100

[webpac2] / lib / WebPAC / Input.pm

diff --git a/lib/WebPAC/Input.pm b/lib/WebPAC/Input.pm
index 1255c22..0d21260 100644 (file)
--- a/lib/WebPAC/Input.pm
+++ b/lib/WebPAC/Input.pm
@@ -14,11 +14,11 @@ WebPAC::Input - read different file formats into WebPAC
 
 =head1 VERSION
 
-Version 0.03
+Version 0.04
 
 =cut
 
-our $VERSION = '0.03';
+our $VERSION = '0.04';
 
 =head1 SYNOPSIS
 
@@ -47,9 +47,10 @@ Perhaps a little code snippet.
     );
 
     $db->open('/path/to/database');
-    print "database size: ",$db->size,"\n";
-    while (my $rec = $db->fetch) {
-    }
+       print "database size: ",$db->size,"\n";
+       while (my $rec = $db->fetch) {
+               # do something with $rec
+       }
 
 
 
@@ -63,6 +64,7 @@ Create new input database object.
        module => 'WebPAC::Input::MARC',
        code_page => 'ISO-8859-2',
        low_mem => 1,
+       recode => 'char pairs',
   );
 
 C<module> is low-level file format module. See L<WebPAC::Input::Isis> and
@@ -183,8 +185,37 @@ sub open {
        # create Text::Iconv object
        $self->{iconv} = Text::Iconv->new($code_page,$self->{'code_page'});
 
+       my $filter_ref;
+
+       if ($self->{recode}) {
+               my @r = split(/\s/, $self->{recode});
+               if ($#r % 2 != 1) {
+                       $log->logwarn("recode needs even number of elements (some number of valid pairs)");
+               } else {
+                       my $recode;
+                       while (@r) {
+                               my $from = shift @r;
+                               my $to = shift @r;
+                               $recode->{$from} = $to;
+                       }
+
+                       my $regex = join '|' => keys %{ $recode };
+
+                       $log->debug("using recode regex: $regex");
+                       
+                       $filter_ref = sub {
+                               my $t = shift;
+                               $t =~ s/($regex)/$recode->{$1}/g;
+                               return $t;
+                       };
+
+               }
+
+       }
+
        my ($db, $size) = $self->{open_db}->( $self, 
                path => $arg->{path},
+               filter => $filter_ref,
        );
 
        unless ($db) {