--- trunk/lib/WebPAC/Input.pm	2006/07/09 15:22:39	593
+++ trunk/lib/WebPAC/Input.pm	2006/07/13 11:54:33	597
@@ -39,15 +39,14 @@
 
 Perhaps a little code snippet.
 
-    use WebPAC::Input;
+	use WebPAC::Input;
 
-    my $db = WebPAC::Input->new(
-    	module => 'WebPAC::Input::ISIS',
-		config => $config,
+	my $db = WebPAC::Input->new(
+		module => 'WebPAC::Input::ISIS',
 		low_mem => 1,
-    );
+	);
 
-    $db->open('/path/to/database');
+	$db->open( path => '/path/to/database' );
 	print "database size: ",$db->size,"\n";
 	while (my $rec = $db->fetch) {
 		# do something with $rec
@@ -69,7 +68,7 @@
 	no_progress_bar => 1,
   );
 
-C<module> is low-level file format module. See L<WebPAC::Input::Isis> and
+C<module> is low-level file format module. See L<WebPAC::Input::ISIS> and
 L<WebPAC::Input::MARC>.
 
 Optional parametar C<encoding> specify application code page (which will be
@@ -169,6 +168,10 @@
 		my ($k,$v) = @_;
 		# store lookup $k => $v
 	},
+	modify_records => {
+		900 => { '^a' => { ' : ' => '^b' } },
+		901 => { '*' => { '^b' => ' ; ' } },
+	},
  );
 
 By default, C<code_page> is assumed to be C<852>.
@@ -179,9 +182,13 @@
 
 C<stats> create optional report about usage of fields and subfields
 
-C<lookup_coderef> is closure to call when adding key => $value combinations to
+C<lookup_coderef> is closure to call when adding C<< key => 'value' >> combinations to
 lookup.
 
+C<modify_records> specify mapping from subfields to delimiters or from
+delimiters to subfields, as well as oprations on fields (if subfield is
+defined as C<*>.
+
 Returns size of database, regardless of C<offset> and C<limit>
 parametars, see also C<size>.
 
@@ -210,36 +217,55 @@
 	$self->{iconv} = Text::Iconv->new($code_page,$self->{'encoding'});	## FIXME remove!
 
 	my $filter_ref;
+	my $recode_regex;
+	my $recode_map;
 
 	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;
+				$recode_map->{$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;
-			};
+			$recode_regex = join '|' => keys %{ $recode_map };
 
+			$log->debug("using recode regex: $recode_regex");
 		}
 
 	}
 
+	my $rec_regex = $self->modify_record_regexps(%{ $arg->{modify_records} });
+	$log->debug("rec_regex: ", Dumper($rec_regex));
+
 	my ($db, $size) = $self->{open_db}->( $self, 
 		path => $arg->{path},
-		filter => $filter_ref,
+		filter => sub {
+				my ($l,$f_nr) = @_;
+				return unless defined($l);
+
+				## FIXME remove iconv!
+				$l = $self->{iconv}->convert($l) if ($self->{iconv});
+	
+				$l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map);
+
+				return $l unless ($rec_regex);
+
+				# apply regexps
+				if ($rec_regex && defined($rec_regex->{$f_nr})) {
+					$log->logconfess("regexps->{$f_nr} must be ARRAY") if (ref($rec_regex->{$f_nr}) ne 'ARRAY');
+					my $c = 0;
+					foreach my $r (@{ $rec_regex->{$f_nr} }) {
+						while ( eval '$l =~ ' . $r ) { $c++ };
+					}
+					warn "## field $f_nr triggered $c regexpes\n" if ($c && $self->{debug});
+				}
+
+				return $l;
+		},
 		%{ $arg },
 	);
 
@@ -496,6 +522,51 @@
 	return $out;
 }
 
+=head1 modify_record_regexps
+
+Generate hash with regexpes to be applied using L<filter>.
+
+  my $regexpes = $input->modify_record_regexps(
+		900 => { '^a' => { ' : ' => '^b' } },
+		901 => { '*' => { '^b' => ' ; ' } },
+  );
+
+=cut
+
+sub modify_record_regexps {
+	my $self = shift;
+	my $modify_record = {@_};
+
+	my $regexpes;
+
+	foreach my $f (keys %$modify_record) {
+warn "--- f: $f\n";
+		foreach my $sf (keys %{ $modify_record->{$f} }) {
+warn "---- sf: $sf\n";
+			foreach my $from (keys %{ $modify_record->{$f}->{$sf} }) {
+				my $to = $modify_record->{$f}->{$sf}->{$from};
+				#die "no field?" unless defined($to);
+warn "----- transform: |$from| -> |$to|\n";
+
+				if ($sf =~ /^\^/) {
+					my $regex = 
+						's/\Q'. $sf .'\E([^\^]+)\Q'. $from .'\E([^\^]+)/'. $sf .'$1'. $to .'$2/g';
+					push @{ $regexpes->{$f} }, $regex;
+warn ">>>>> $regex [sf]\n";
+				} else {
+					my $regex =
+						's/\Q'. $from .'\E/'. $to .'/g';
+					push @{ $regexpes->{$f} }, $regex;
+warn ">>>>> $regex [global]\n";
+				}
+
+			}
+		}
+	}
+
+	return $regexpes;
+}
+
 =head1 MEMORY USAGE
 
 C<low_mem> options is double-edged sword. If enabled, WebPAC