--- trunk/lib/WebPAC/Common.pm	2005/07/16 11:07:38	3
+++ trunk/lib/WebPAC/Common.pm	2005/07/16 12:37:18	4
@@ -17,6 +17,147 @@
 
 our $VERSION = '0.01';
 
+#my $LOOKUP_REGEX = '\[[^\[\]]+\]';
+#my $LOOKUP_REGEX_SAVE = '\[([^\[\]]+)\]';
+my $LOOKUP_REGEX = 'lookup{[^\{\}]+}';
+my $LOOKUP_REGEX_SAVE = 'lookup{([^\{\}]+)}';
+
+
+=head1 FUNCTIONS
+
+=head2 fill_in
+
+Workhourse of all: takes record from in-memory structure of database and
+strings with placeholders and returns string or array of with substituted
+values from record.
+
+ my $text = $webpac->fill_in($rec,'v250^a');
+
+Optional argument is ordinal number for repeatable fields. By default,
+it's assume to be first repeatable field (fields are perl array, so first
+element is 0).
+Following example will read second value from repeatable field.
+
+ my $text = $webpac->fill_in($rec,'Title: v250^a',1);
+
+This function B<does not> perform parsing of format to inteligenty skip
+delimiters before fields which aren't used.
+
+This method will automatically decode UTF-8 string to local code page
+if needed.
+
+=cut
+
+sub fill_in {
+	my $self = shift;
+
+	my $log = $self->_get_logger();
+
+	my $rec = shift || $log->logconfess("need data record");
+	my $format = shift || $log->logconfess("need format to parse");
+	# iteration (for repeatable fields)
+	my $i = shift || 0;
+
+	$log->logdie("infitite loop in format $format") if ($i > ($self->{'max_mfn'} || 9999));
+
+	# FIXME remove for speedup?
+	$log->logconfess("need HASH as first argument!") if ($rec !~ /HASH/o);
+
+	if (utf8::is_utf8($format)) {
+		$format = $self->_x($format);
+	}
+
+	my $found = 0;
+
+	my $eval_code;
+	# remove eval{...} from beginning
+	$eval_code = $1 if ($format =~ s/^eval{([^}]+)}//s);
+
+	my $filter_name;
+	# remove filter{...} from beginning
+	$filter_name = $1 if ($format =~ s/^filter{([^}]+)}//s);
+
+	# do actual replacement of placeholders
+	# repeatable fields
+	$format =~ s/v(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,$i,\$found)/ges;
+	# non-repeatable fields
+	$format =~ s/s(\d+)(?:\^(\w))?/$self->get_data(\$rec,$1,$2,0,\$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));
+		}
+		if ($filter_name && $self->{'filter'}->{$filter_name}) {
+			$log->debug("filter '$filter_name' for $format");
+			$format = $self->{'filter'}->{$filter_name}->($format);
+			return unless(defined($format));
+			$log->debug("filter result: $format");
+		}
+		# do we have lookups?
+		if ($format =~ /$LOOKUP_REGEX/o) {
+			$log->debug("format '$format' has lookup");
+			return $self->lookup($format);
+		} else {
+			return $format;
+		}
+	} else {
+		return;
+	}
+}
+
+
+=head2 get_data
+
+Returns value from record.
+
+ my $text = $self->get_data(\$rec,$f,$sf,$i,\$found);
+
+Arguments are:
+record reference C<$rec>,
+field C<$f>,
+optional subfiled C<$sf>,
+index for repeatable values C<$i>.
+
+Optinal variable C<$found> will be incremeted if there
+is field.
+
+Returns value or empty string.
+
+=cut
+
+sub get_data {
+	my $self = shift;
+
+	my ($rec,$f,$sf,$i,$found) = @_;
+
+	if ($$rec->{$f}) {
+		return '' if (! $$rec->{$f}->[$i]);
+		no strict 'refs';
+		if ($sf && $$rec->{$f}->[$i]->{$sf}) {
+			$$found++ if (defined($$found));
+			return $$rec->{$f}->[$i]->{$sf};
+		} elsif ($$rec->{$f}->[$i]) {
+			$$found++ if (defined($$found));
+			# it still might have subfield, just
+			# not specified, so we'll dump all
+			if ($$rec->{$f}->[$i] =~ /HASH/o) {
+				my $out;
+				foreach my $k (keys %{$$rec->{$f}->[$i]}) {
+					$out .= $$rec->{$f}->[$i]->{$k}." ";
+				}
+				return $out;
+			} else {
+				return $$rec->{$f}->[$i];
+			}
+		}
+	} else {
+		return '';
+	}
+}
+
+
 =head1 INTERNAL METHODS
 
 Here is a quick list of internal methods, mostly useful to turn debugging