--- trunk/lib/WebPAC/Normalize.pm	2006/01/08 20:27:11	364
+++ trunk/lib/WebPAC/Normalize.pm	2006/02/15 15:54:12	397
@@ -2,6 +2,8 @@
 
 use warnings;
 use strict;
+use blib;
+use WebPAC::Common;
 use base 'WebPAC::Common';
 use Data::Dumper;
 
@@ -196,13 +198,13 @@
 
 			my @v;
 			if ($self->{'lookup_regex'} && $format =~ $self->{'lookup_regex'}) {
-				@v = $self->fill_in_to_arr($rec,$format);
+				@v = $self->_rec_to_arr($rec,$format,'fill_in');
 			} else {
-				@v = $self->parse_to_arr($rec,$format);
+				@v = $self->_rec_to_arr($rec,$format,'parse');
 			}
 			if (! @v) {
 				$log->debug("$field <",$self->{tag},"> format: $format no values");
-#				next;
+				next;
 			} else {
 				$log->debug("$field <",$self->{tag},"> format: $format values: ", join(",", @v));
 			}
@@ -306,7 +308,7 @@
 sub parse {
 	my $self = shift;
 
-	my ($rec, $format_utf8, $i) = @_;
+	my ($rec, $format_utf8, $i, $rec_size) = @_;
 
 	return if (! $format_utf8);
 
@@ -355,7 +357,7 @@
 		}
 
 		my $found = 0;
-		my $tmp = $self->get_data(\$rec,$3,$4,$r,\$found);
+		my $tmp = $self->get_data(\$rec,$3,$4,$r,\$found,$rec_size);
 
 		if ($found) {
 			$found_any->{$fld_type} += $found;
@@ -408,37 +410,6 @@
 	return $out;
 }
 
-=head2 parse_to_arr
-
-Similar to C<parse>, but returns array of all repeatable fields
-
- my @arr = $webpac->parse_to_arr($rec,'v250^a');
-
-=cut
-
-sub parse_to_arr {
-	my $self = shift;
-
-	my ($rec, $format_utf8) = @_;
-
-	my $log = $self->_get_logger();
-
-	$log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
-	return if (! $format_utf8);
-
-	my $i = 0;
-	my @arr;
-
-	while (my $v = $self->parse($rec,$format_utf8,$i++)) {
-		push @arr, $v;
-	}
-
-	$log->debug("format '$format_utf8' returned ",--$i," elements: ", sub { join(" | ",@arr) }) if (@arr);
-
-	return @arr;
-}
-
-
 =head2 fill_in
 
 Workhourse of all: takes record from in-memory structure of database and
@@ -460,6 +431,11 @@
 This method will automatically decode UTF-8 string to local code page
 if needed.
 
+There is optional parametar C<$record_size> which can be used to get sizes of
+all C<field^subfield> combinations in this format.
+
+ my $text = $webpac->fill_in($rec,'got: v900^a v900^x',0,\$rec_size); 
+
 =cut
 
 sub fill_in {
@@ -467,10 +443,13 @@
 
 	my $log = $self->_get_logger();
 
-	my $rec = shift || $log->logconfess("need data record");
-	my $format = shift || $log->logconfess("need format to parse");
+	my ($rec,$format,$i,$rec_size) = @_;
+
+	$log->logconfess("need data record") unless ($rec);
+	$log->logconfess("need format to parse") unless($format);
+
 	# iteration (for repeatable fields)
-	my $i = shift || 0;
+	$i ||= 0;
 
 	$log->logdie("infitite loop in format $format") if ($i > ($self->{'max_mfn'} || 9999));
 
@@ -492,15 +471,20 @@
 	# remove filter{...} from beginning
 	$filter_name = $1 if ($format =~ s/^filter{([^}]+)}//s);
 
-	# do actual replacement of placeholders
-	# repeatable fields
-	if ($format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found)/ges) {
-		$just_single = 0;
-	}
+	{
+		# fix warnings
+		no warnings 'uninitialized';
+
+		# do actual replacement of placeholders
+		# repeatable fields
+		if ($format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found,$rec_size)/ges) {
+			$just_single = 0;
+		}
 
-	# non-repeatable fields
-	if ($format =~ s/s(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,0,\$found)/ges) {
-		return if ($i > 0 && $just_single);
+		# non-repeatable fields
+		if ($format =~ s/s(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,0,\$found,$rec_size)/ges) {
+			return if ($i > 0 && $just_single);
+		}
 	}
 
 	if ($found) {
@@ -533,31 +517,47 @@
 }
 
 
-=head2 fill_in_to_arr
+=head2 _rec_to_arr
 
-Similar to C<fill_in>, but returns array of all repeatable fields. Usable
+Similar to C<parse> and C<fill_in>, but returns array of all repeatable fields. Usable
 for fields which have lookups, so they shouldn't be parsed but rather
-C<fill_id>ed.
+C<paste>d or C<fill_id>ed. Last argument is name of operation: C<paste> or C<fill_in>.
 
- my @arr = $webpac->fill_in_to_arr($rec,'[v900];;[v250^a]');
+ my @arr = $webpac->fill_in_to_arr($rec,'[v900];;[v250^a]','paste');
 
 =cut
 
-sub fill_in_to_arr {
+sub _rec_to_arr {
 	my $self = shift;
 
-	my ($rec, $format_utf8) = @_;
+	my ($rec, $format_utf8, $code) = @_;
 
 	my $log = $self->_get_logger();
 
 	$log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
 	return if (! $format_utf8);
 
+	$log->debug("using $code on $format_utf8");
+
 	my $i = 0;
+	my $max = 0;
 	my @arr;
+	my $rec_size = {};
 
-	while (my $v = $self->fill_in($rec,$format_utf8,$i++)) {
-		push @arr, $v;
+	while ($i <= $max) {
+		my @v = $self->$code($rec,$format_utf8,$i++,\$rec_size);
+		if ($rec_size) {
+			foreach my $f (keys %{ $rec_size }) {
+				$max = $rec_size->{$f} if ($rec_size->{$f} > $max);
+			}
+			$log->debug("max set to $max");
+			undef $rec_size;
+		}
+		if (@v) {
+			push @arr, @v;
+		} else {
+			push @arr, '' if ($max > $i);
+		}
 	}
 
 	$log->debug("format '$format_utf8' returned ",--$i," elements: ", sub { join(" | ",@arr) }) if (@arr);
@@ -570,51 +570,76 @@
 
 Returns value from record.
 
- my $text = $self->get_data(\$rec,$f,$sf,$i,\$found);
+ my $text = $self->get_data(\$rec,$f,$sf,$i,\$found,\$rec_size);
+
+Required arguments are:
+
+=over 8
+
+=item C<$rec>
+
+record reference
+
+=item C<$f>
+
+field
+
+=item C<$sf>
+
+optional subfield
 
-Arguments are:
-record reference C<$rec>,
-field C<$f>,
-optional subfiled C<$sf>,
-index for repeatable values C<$i>.
+=item C<$i>
 
-Optinal variable C<$found> will be incremeted if there
-is field.
+index offset for repeatable values ( 0 ... $rec_size->{'400^a'} )
 
-Returns value or empty string.
+=item C<$found>
+
+optional variable that will be incremeted if preset
+
+=item C<$rec_size>
+
+hash to hold maximum occurances of C<field^subfield> combinations
+(which can be accessed using keys in same format)
+
+=back
+
+Returns value or empty string, updates C<$found> and C<rec_size>
+if present.
 
 =cut
 
 sub get_data {
 	my $self = shift;
 
-	my ($rec,$f,$sf,$i,$found) = @_;
+	my ($rec,$f,$sf,$i,$found,$cache) = @_;
+
+	return '' unless ($$rec->{$f} && ref($$rec->{$f}) eq 'ARRAY');
 
-	if ($$rec->{$f}) {
-		return '' if (! $$rec->{$f}->[$i]);
+	if (defined($$cache)) {
+		$$cache->{ $f . ( $sf ? '^' . $sf : '' ) } ||= scalar @{ $$rec->{$f} };
+	}
+
+	return '' unless ($$rec->{$f}->[$i]);
+
+	{
 		no strict 'refs';
-		if ($sf && $$rec->{$f}->[$i]->{$sf}) {
-			$$found++ if (defined($$found));
+		if (defined($sf)) {
+			$$found++ if (defined($$found) && $$rec->{$f}->[$i]->{$sf});
 			return $$rec->{$f}->[$i]->{$sf};
-		} elsif (! $sf && $$rec->{$f}->[$i]) {
+		} else {
 			$$found++ if (defined($$found));
-			# it still might have subfield, just
-			# not specified, so we'll dump all
+			# it still might have subfields, just
+			# not specified, so we'll dump some debug info
 			if ($$rec->{$f}->[$i] =~ /HASH/o) {
 				my $out;
 				foreach my $k (keys %{$$rec->{$f}->[$i]}) {
-					my $v = $$rec->{$f}->[$i]->{$k};
-					$out .= "$v " if ($v);
+					$out .= '$' . $k .':' . $$rec->{$f}->[$i]->{$k}." ";
 				}
 				return $out;
 			} else {
 				return $$rec->{$f}->[$i];
 			}
-		} else {
-			return '';
 		}
-	} else {
-		return '';
 	}
 }