--- trunk2/lib/WebPAC.pm	2004/06/19 18:16:20	372
+++ trunk2/lib/WebPAC.pm	2004/06/20 15:49:09	373
@@ -12,6 +12,11 @@
 
 use Data::Dumper;
 
+#my $LOOKUP_REGEX = '\[[^\[\]]+\]';
+#my $LOOKUP_REGEX_SAVE = '\[([^\[\]]+)\]';
+my $LOOKUP_REGEX = 'lookup{[^\{\}]+}';
+my $LOOKUP_REGEX_SAVE = 'lookup{([^\{\}]+)}';
+
 =head1 NAME
 
 WebPAC - base class for WebPAC
@@ -217,6 +222,7 @@
 
 	if ($mfn > $self->{'max_mfn'}) {
 		$self->{'current_mfn'} = $self->{'max_mfn'};
+		$log->debug("at EOF");
 		return;
 	}
 
@@ -255,7 +261,6 @@
 
 	$self->{'import_xml'} = XMLin($f,
 		ForceArray => [ $self->{'tag'}, 'config', 'format' ],
-		ForceContent => 1
 	);
 
 }
@@ -284,12 +289,14 @@
 			my $key = $self->fill_in($rec,$i->{'key'});
 			my @val = $self->fill_in($rec,$i->{'val'});
 			if ($key && @val && eval $eval) {
+				$log->debug("stored $key = ",sub { join(" | ",@val) });
 				push @{$self->{'lookup'}->{$key}}, @val;
 			}
 		} else {
 			my $key = $self->fill_in($rec,$i->{'key'});
 			my @val = $self->fill_in($rec,$i->{'val'});
 			if ($key && @val) {
+				$log->debug("stored $key = ",sub { join(" | ",@val) });
 				push @{$self->{'lookup'}->{$key}}, @val;
 			}
 		}
@@ -384,16 +391,17 @@
 	$eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
 
 	# do actual replacement of placeholders
-	$format =~ s/v(\d+)(?:\^(\w))*/$self->get_data(\$rec,$1,$2,$i,\$found)/ges;
+	$format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found)/ges;
 
 	if ($found) {
+		$log->debug("format: $format");
 		if ($eval_code) {
 			my $eval = $self->fill_in($rec,$eval_code,$i);
 			return if (! $self->_eval($eval));
 		}
 		# do we have lookups?
-		$log->debug("test format '$format' for lookups");
-		if ($format =~ /\[[^\[\]]+\]/o) {
+		if ($format =~ /$LOOKUP_REGEX/o) {
+			$log->debug("format '$format' has lookup");
 			return $self->lookup($format);
 		} else {
 			return $format;
@@ -420,19 +428,19 @@
 
 	my $tmp = shift || $log->logconfess("need format");
 
-	if ($tmp =~ /\[[^\[\]]+\]/o) {
+	if ($tmp =~ /$LOOKUP_REGEX/o) {
 		my @in = ( $tmp );
 
 		$log->debug("lookup for: ",$tmp);
 
 		my @out;
 		while (my $f = shift @in) {
-			if ($f =~ /\[([^\[\]]+)\]/) {
+			if ($f =~ /$LOOKUP_REGEX_SAVE/o) {
 				my $k = $1;
 				if ($self->{'lookup'}->{$k}) {
 					foreach my $nv (@{$self->{'lookup'}->{$k}}) {
 						my $tmp2 = $f;
-						$tmp2 =~ s/\[$k\]/$nv/g;
+						$tmp2 =~ s/lookup{$k}/$nv/g;
 						push @in, $tmp2;
 					}
 				} else {
@@ -442,6 +450,7 @@
 				push @out, $f;
 			}
 		}
+		$log->logconfess("return is array and it's not expected!") unless wantarray;
 		return @out;
 	} else {
 		return $tmp;
@@ -476,6 +485,8 @@
 
 	my @out;
 
+	$log->debug("format: $format");
+
 	my $eval_code;
 	# remove eval{...} from beginning
 	$eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
@@ -483,7 +494,7 @@
 	my $prefix;
 	my $all_found=0;
 
-	while ($format =~ s/^(.*?)v(\d+)(?:\^(\w))*//s) {
+	while ($format =~ s/^(.*?)v(\d+)(?:\^(\w))?//s) {
 
 		my $del = $1 || '';
 		$prefix ||= $del if ($all_found == 0);
@@ -500,14 +511,21 @@
 
 	return if (! $all_found);
 
-	my $out = join('',@out) . $format;
+	my $out = join('',@out);
+
+	if ($out) {
+		# add rest of format (suffix)
+		$out .= $format;
 
-	# add prefix if not there
-	$out = $prefix . $out if ($out !~ m/^\Q$prefix\E/);
+		# add prefix if not there
+		$out = $prefix . $out if ($out !~ m/^\Q$prefix\E/);
+
+		$log->debug("result: $out");
+	}
 
 	if ($eval_code) {
 		my $eval = $self->fill_in($rec,$eval_code,$i);
-		$log->debug("about to eval ",$eval," [$out]");
+		$log->debug("about to eval{",$eval,"} format: $out");
 		return if (! $self->_eval($eval));
 	}
 
@@ -539,9 +557,44 @@
 		push @arr, $v;
 	}
 
+	$log->debug("format '$format_utf8' returned ",--$i," elements: ", sub { join(" | ",@arr) }) if (@arr);
+
 	return @arr;
 }
 
+=head2 fill_in_to_arr
+
+Similar to 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.
+
+ my @arr = $webpac->fill_in_to_arr($rec,'[v900];;[v250^a]');
+
+=cut
+
+sub fill_in_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->fill_in($rec,$format_utf8,$i++)) {
+		push @arr, @v;
+	}
+
+	$log->debug("format '$format_utf8' returned ",--$i," elements: ", sub { join(" | ",@arr) }) if (@arr);
+
+	return @arr;
+}
+
+
 =head2 data_structure
 
 Create in-memory data structure which represents layout from C<import_xml>.
@@ -569,6 +622,8 @@
 
 	my @ds;
 
+	$log->debug("tags: ",sub { join(", ",@sorted_tags) });
+
 	foreach my $field (@sorted_tags) {
 
 		my $row;
@@ -576,8 +631,16 @@
 #print "field $field [",$self->{'tag'},"] = ",Dumper($self->{'import_xml'}->{'indexer'}->{$field}->{$self->{'tag'}});
 
 		foreach my $tag (@{$self->{'import_xml'}->{'indexer'}->{$field}->{$self->{'tag'}}}) {
-			my @v = $self->parse_to_arr($rec,$tag->{'content'});
+			my $format = $tag->{'value'} || $tag->{'content'};
 
+			$log->debug("format: $format");
+
+			my @v;
+			if ($format =~ /$LOOKUP_REGEX/o) {
+				@v = $self->fill_in_to_arr($rec,$format);
+			} else {
+				@v = $self->parse_to_arr($rec,$format);
+			}
 			next if (! @v);
 
 			# does tag have type?
@@ -587,11 +650,13 @@
 				push @{$row->{'display'}}, @v;
 				push @{$row->{'swish'}}, @v;
 			}
+
 		}
 
 		if ($row) {
 			$row->{'tag'} = $field;
 			push @ds, $row;
+			$log->debug("row $field: ",sub { Dumper($row) });
 		}
 
 	}