--- trunk/lib/WebPAC/Input.pm	2006/09/06 18:08:30	634
+++ trunk/lib/WebPAC/Input.pm	2006/09/06 19:25:22	636
@@ -16,11 +16,11 @@
 
 =head1 VERSION
 
-Version 0.11
+Version 0.12
 
 =cut
 
-our $VERSION = '0.11';
+our $VERSION = '0.12';
 
 =head1 SYNOPSIS
 
@@ -172,6 +172,7 @@
 		900 => { '^a' => { ' : ' => '^b' } },
 		901 => { '*' => { '^b' => ' ; ' } },
 	},
+	modify_file => 'conf/modify/mapping.map',
  );
 
 By default, C<code_page> is assumed to be C<cp852>.
@@ -189,6 +190,10 @@
 delimiters to subfields, as well as oprations on fields (if subfield is
 defined as C<*>.
 
+C<modify_file> is alternative for C<modify_records> above which preserves order and offers
+(hopefully) simplier sintax than YAML or perl (see L</modify_file_regex>). This option
+overrides C<modify_records> if both exists for same input.
+
 Returns size of database, regardless of C<offset> and C<limit>
 parametars, see also C<size>.
 
@@ -235,8 +240,15 @@
 
 	}
 
-	my $rec_regex = $self->modify_record_regexps(%{ $arg->{modify_records} });
-	$log->debug("rec_regex: ", Dumper($rec_regex));
+	my $rec_regex;
+	if (my $p = $arg->{modify_file}) {
+		$log->debug("using modify_file $p");
+		$rec_regex = $self->modify_file_regexps( $p );
+	} elsif (my $h = $arg->{modify_records}) {
+		$log->debug("using modify_records ", Dumper( $h ));
+		$rec_regex = $self->modify_record_regexps(%{ $h });
+	}
+	$log->debug("rec_regex: ", Dumper($rec_regex)) if ($rec_regex);
 
 	my ($db, $size) = $self->{open_db}->( $self, 
 		path => $arg->{path},
@@ -536,7 +548,7 @@
 
 =head2 modify_record_regexps
 
-Generate hash with regexpes to be applied using L<filter>.
+Generate hash with regexpes to be applied using l<filter>.
 
   my $regexpes = $input->modify_record_regexps(
 		900 => { '^a' => { ' : ' => '^b' } },
@@ -545,6 +557,17 @@
 
 =cut
 
+sub _get_regex {
+	my ($sf,$from,$to) = @_;
+	if ($sf =~ /^\^/) {
+		return
+			's/\Q'. $sf .'\E([^\^]*?)\Q'. $from .'\E([^\^]*?)/'. $sf .'$1'. $to .'$2/';
+	} else {
+		return
+			's/\Q'. $from .'\E/'. $to .'/g';
+	}
+}
+
 sub modify_record_regexps {
 	my $self = shift;
 	my $modify_record = {@_};
@@ -564,22 +587,73 @@
 				#die "no field?" unless defined($to);
 				$log->debug("transform: |$from| -> |$to|");
 
-				if ($sf =~ /^\^/) {
-					my $regex = 
-						's/\Q'. $sf .'\E(.*?)\Q'. $from .'\E(.*?)/'. $sf .'$1'. $to .'$2/g';
-					push @{ $regexpes->{$f} }, $regex;
-					$log->debug(">>>>> $regex [sf]");
-				} else {
-					my $regex =
-						's/\Q'. $from .'\E/'. $to .'/g';
-					push @{ $regexpes->{$f} }, $regex;
-					$log->debug(">>>>> $regex [global]");
-				}
-
+				my $regex = _get_regex($sf,$from,$to);
+				push @{ $regexpes->{$f} }, $regex;
+				$log->debug("regex: $regex");
 			}
 		}
 	}
 
+	return $regexpes;
+}
+
+=head2 modify_file_regexps
+
+Generate hash with regexpes to be applied using l<filter> from
+pseudo hash/yaml format for regex mappings.
+
+It should be obvious:
+
+	200
+	  '^a'
+	    ' : ' => '^e'
+	    ' = ' => '^d'
+
+In field I<200> find C<'^a'> and then C<' : '>, and replace it with C<'^e'>.
+In field I<200> find C<'^a'> and then C<' = '>, and replace it with C<'^d'>.
+
+  my $regexpes = $input->modify_file_regexps( 'conf/modify/common.pl' );
+
+On undef path it will just return.
+
+=cut
+
+sub modify_file_regexps {
+	my $self = shift;
+
+	my $modify_path = shift || return;
+
+	my $log = $self->_get_logger();
+
+	my $regexpes;
+
+	CORE::open(my $fh, $modify_path) || $log->die("can't open modify file $modify_path: $!");
+
+	my ($f,$sf);
+
+	while(<$fh>) {
+		chomp;
+		next if (/^#/ || /^\s*$/);
+
+		if (/^\s*(\d+)\s*$/) {
+			$f = $1;
+			$log->debug("field: $f");
+			next;
+		} elsif (/^\s*'([^']*)'\s*$/) {
+			$sf = $1;
+			$log->die("can't define subfiled before field in: $_") unless ($f);
+			$log->debug("subfield: $sf");
+		} elsif (/^\s*'([^']*)'\s*=>\s*'([^']*)'\s*$/) {
+			my ($from,$to) = ($1, $2);
+
+			$log->debug("transform: |$from| -> |$to|");
+
+			my $regex = _get_regex($sf,$from,$to);
+			push @{ $regexpes->{$f} }, $regex;
+			$log->debug("regex: $regex");
+		}
+	}
+
 	return $regexpes;
 }