--- trunk/lib/WebPAC/Normalize.pm	2006/06/30 18:48:33	550
+++ trunk/lib/WebPAC/Normalize.pm	2006/07/02 16:14:41	562
@@ -3,13 +3,17 @@
 @EXPORT = qw/
 	_set_rec _set_lookup
 	_get_ds _clean_ds
+	_debug
 
 	tag search display
 	marc marc_indicators marc_repeatable_subfield
+	marc_compose
 
 	rec1 rec2 rec
 	regex prefix suffix surround
 	first lookup join_with
+
+	split_rec_on
 /;
 
 use warnings;
@@ -29,11 +33,11 @@
 
 =head1 VERSION
 
-Version 0.06
+Version 0.08
 
 =cut
 
-our $VERSION = '0.06';
+our $VERSION = '0.08';
 
 =head1 SYNOPSIS
 
@@ -153,21 +157,38 @@
 
 	$marc->add_fields( WebPAC::Normalize:_get_marc_fields() );
 
-
-
 We are using I<magic> which detect repeatable fields only from
 sequence of field/subfield data generated by normalization.
 
-Repeatable field is created if there is second occurence of same subfield or
-if any of indicators are different. This is sane for most cases except for
-non-repeatable fields with repeatable subfields.
+Repeatable field is created when there is second occurence of same subfield or
+if any of indicators are different.
+
+This is sane for most cases. Something like:
+
+  900a-1 900b-1 900c-1
+  900a-2 900b-2
+  900a-3
+
+will be created from any combination of:
 
-You can change behaviour of that using C<marc_repeatable_subfield>.
+  900a-1 900a-2 900a-3 900b-1 900b-2 900c-1
+
+and following rules:
+
+  marc('900','a', rec('200','a') );
+  marc('900','b', rec('200','b') );
+  marc('900','c', rec('200','c') );
+
+which might not be what you have in mind. If you need repeatable subfield,
+define it using C<marc_repeatable_subfield> like this:
+
+....
 
 =cut
 
 sub _get_marc_fields {
 
+	return if (! $marc_record || ref($marc_record) ne 'ARRAY' || $#{ $marc_record } < 0);
 
 	# first, sort all existing fields 
 	# XXX might not be needed, but modern perl might randomize elements in hash
@@ -175,6 +196,8 @@
 		$a->[0] . $a->[3] cmp $b->[0] . $b->[3]	
 	} @{ $marc_record };
 
+	@sorted_marc_record = @{ $marc_record };	### FIXME disable sorting
+	
 	# output marc fields
 	my @m;
 
@@ -265,6 +288,21 @@
 	return @m;
 }
 
+=head2 _debug
+
+Change level of debug warnings
+
+  _debug( 2 );
+
+=cut
+
+sub _debug {
+	my $l = shift;
+	return $debug unless defined($l);
+	warn "debug level $l" if ($l > 0);
+	$debug = $l;
+}
+
 =head1 Functions to create C<data_structure>
 
 Those functions generally have to first in your normalization file.
@@ -378,6 +416,41 @@
 	@{ $marc_indicators->{$f} } = ($i1,$i2);
 }
 
+=head2 marc_compose
+
+Save values for each MARC subfield explicitly
+
+  marc_compose('900',
+  	'a', rec('200','a')
+  	'b', rec('201','a')
+  	'a', rec('200','b')
+  	'c', rec('200','c')
+  );
+
+=cut
+
+sub marc_compose {
+	my $f = shift or die "marc_compose needs field";
+	die "marc_compose field must be numer" unless ($f =~ /^\d+$/);
+
+	my ($i1,$i2) = defined($marc_indicators->{$f}) ? @{ $marc_indicators->{$f} } : (' ',' ');
+	my $m = [ $f, $i1, $i2 ];
+
+	while (@_) {
+		my $sf = shift or die "marc_compose $f needs subfield";
+		my $v = shift or die "marc_compose $f needs value for subfield $sf";
+
+		next unless (defined($v) && $v !~ /^\s*$/);
+		from_to($v, 'iso-8859-2', $marc_encoding) if ($marc_encoding);
+		push @$m, ( $sf, $v );
+		warn "## ++ marc_compose($f,$sf,$v) ", dump( $m ) if ($debug > 1);
+	}
+
+	warn "## marc_compose(d) ", dump( $m ) if ($debug > 1);
+
+	push @{ $marc_record }, $m;
+}
+
 
 =head1 Functions to extract data from input
 
@@ -547,5 +620,39 @@
 	return join($d, grep { defined($_) && $_ ne '' } @_);
 }
 
+=head2 split_rec_on
+
+Split record subfield on some regex and take one of parts out
+
+  $a_before_semi_column =
+  	split_rec_on('200','a', /\s*;\s*/, $part);
+
+C<$part> is optional number of element. First element is
+B<1>, not 0!
+
+If there is no C<$part> parameter or C<$part> is 0, this function will
+return all values produced by splitting.
+
+=cut
+
+sub split_rec_on {
+	die "split_rec_on need (fld,sf,regex[,part]" if ($#_ < 2);
+
+	my ($fld, $sf, $regex, $part) = @_;
+	warn "### regex ", ref($regex), $regex if ($debug > 2);
+
+	my @r = rec( $fld, $sf );
+	my $v = shift @r;
+	warn "### first rec($fld,$sf) = ",dump($v) if ($debug > 2);
+
+	my @s = split( $regex, $v );
+	warn "## split_rec_on($fld,$sf,$regex,$part) = ",dump(@s) if ($debug > 1);
+	if ($part > 0) {
+		return $s[ $part - 1 ];
+	} else {
+		return @s;
+	}
+}
+
 # END
 1;