--- trunk/lib/WebPAC/Input.pm	2006/08/01 13:59:47	606
+++ trunk/lib/WebPAC/Input.pm	2006/09/04 16:15:07	626
@@ -7,8 +7,8 @@
 
 use WebPAC::Common;
 use base qw/WebPAC::Common/;
-use Text::Iconv;
 use Data::Dumper;
+use Encode qw/from_to/;
 
 =head1 NAME
 
@@ -16,11 +16,11 @@
 
 =head1 VERSION
 
-Version 0.09
+Version 0.11
 
 =cut
 
-our $VERSION = '0.09';
+our $VERSION = '0.11';
 
 =head1 SYNOPSIS
 
@@ -159,7 +159,7 @@
 
  $input->open(
  	path => '/path/to/database/file',
-	code_page => '852',
+	code_page => 'cp852',
 	limit => 500,
 	offset => 6000,
 	lookup => $lookup_obj,
@@ -174,7 +174,7 @@
 	},
  );
 
-By default, C<code_page> is assumed to be C<852>.
+By default, C<code_page> is assumed to be C<cp852>.
 
 C<offset> is optional parametar to position at some offset before reading from database.
 
@@ -205,7 +205,7 @@
 		if ($arg->{lookup_coderef} && ref($arg->{lookup_coderef}) ne 'CODE');
 
 	$log->logcroak("need path") if (! $arg->{'path'});
-	my $code_page = $arg->{'code_page'} || '852';
+	my $code_page = $arg->{'code_page'} || 'cp852';
 
 	# store data in object
 	$self->{'input_code_page'} = $code_page;
@@ -213,9 +213,6 @@
 		$self->{$v} = $arg->{$v} if ($arg->{$v});
 	}
 
-	# create Text::Iconv object
-	$self->{iconv} = Text::Iconv->new($code_page,$self->{'encoding'});	## FIXME remove!
-
 	my $filter_ref;
 	my $recode_regex;
 	my $recode_map;
@@ -243,33 +240,13 @@
 
 	my ($db, $size) = $self->{open_db}->( $self, 
 		path => $arg->{path},
-		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);
-
-				## FIXME remove this warning when we are sure that none of API is calling
-				## this wrongly
-				#warn "filter called without field number" unless ($f_nr);
-
-				return $l unless ($rec_regex && $f_nr);
-
-				# 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;
-		},
+#		filter => sub {
+#			my ($l,$f_nr) = @_;
+#			return unless defined($l);
+#			from_to($l, $code_page, $self->{'encoding'});
+#			$l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map);
+#			return $l;
+#		},
 		%{ $arg },
 	);
 
@@ -309,7 +286,34 @@
 
 		$log->debug("position: $pos\n");
 
-		my $rec = $self->{fetch_rec}->($self, $db, $pos );
+		my $rec = $self->{fetch_rec}->($self, $db, $pos, sub {
+				my ($l,$f_nr) = @_;
+#				return unless defined($l);
+#				return $l unless ($rec_regex && $f_nr);
+
+				$log->debug("-=> $f_nr ## $l");
+
+				# codepage conversion and recode_regex
+				from_to($l, $code_page, $self->{'encoding'});
+				$l =~ s/($recode_regex)/$recode_map->{$1}/g if ($recode_regex && $recode_map);
+
+				# 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} }) {
+						my $old_l = $l;
+						eval '$l =~ ' . $r;
+						if ($old_l ne $l) {
+							$log->debug("REGEX on $f_nr eval \$l =~ $r\n## old l: [$old_l]\n## new l: [$l]");
+						}
+						$log->error("error applying regex: $r") if ($@);
+					}
+				}
+
+				$log->debug("<=- $f_nr ## $l");
+				return $l;
+		});
 
 		$log->debug(sub { Dumper($rec) });
 
@@ -331,6 +335,9 @@
 		# update counters for statistics
 		if ($self->{stats}) {
 
+			# fetch clean record with regexpes applied for statistics
+			my $rec = $self->{fetch_rec}->($self, $db, $pos);
+
 			foreach my $fld (keys %{ $rec }) {
 				$self->{_stats}->{fld}->{ $fld }++;
 
@@ -342,6 +349,7 @@
 					if (ref($row) eq 'HASH') {
 
 						foreach my $sf (keys %{ $row }) {
+							next if ($sf eq 'subfields');
 							$self->{_stats}->{sf}->{ $fld }->{ $sf }->{count}++;
 							$self->{_stats}->{sf}->{ $fld }->{ $sf }->{repeatable}++
 									if (ref($row->{$sf}) eq 'ARRAY');