my $dstore;
my $sfmap;
-my @modlist = qw( multi ignoremulti bib required );
+my @modlist = qw( multi ignoremulti bib required first concatenate );
my %allmods = ();
my $multis = {};
my $reccount;
# fetch our datafield struct and field and mods
my $dataf = $crec->{tags}[-1];
my $field = $sfmap->field($tag, $code);
+ my $sep = $sfmap->sep($field);
$allmods{$field} = $sfmap->mods($field) unless $allmods{$field};
my $mods = $allmods{$field};
# handle multi modifier
if ($mods->{multi}) {
- push @{$dataf->{multi}{$code}}, $sub->text;
$multis->{$tag}{$code} = 1;
+ if ($mods->{concatenate}) {
+ if (exists($dataf->{multi}{$code})) {
+ $dataf->{multi}{$code}[0] .= $sep . $sub->text;
+ } else {
+ push @{$dataf->{multi}{$code}}, $sub->text;
+ }
+ $multis->{$tag}{$code} = 1;
+ } else {
+ push @{$dataf->{multi}{$code}}, $sub->text;
+ }
+ return;
+ }
+
+
+ if ($mods->{concatenate}) {
+ if (exists($dataf->{uni}{$code})) {
+ $dataf->{uni}{$code} .= $sep . $sub->text;
+ } else {
+ $dataf->{uni}{$code} = $sub->text;
+ }
return;
}
sub name { my ($self, $t, $c) = @_; return $sfmap->field($t, $c) }
+=head2 first_only
+
+Returns whether mapped fieldname is to be applied only to first
+item in a bib
+
+=cut
+
+sub first_only {
+ my ($self, $t, $c) = @_;
+ my $field = $sfmap->field($t, $c);
+ my $mods = $sfmap->mods($field);
+ return exists($mods->{first});
+}
+
=head2 get_multis
Returns hashref of C<{tag}{code}> for all mapped multi fields
return $self->{fields}{$field}{filt};
}
+=head2 sep
+
+Returns the separator string set on a mapping. Used only
+if concatenating.
+
+=cut
+
+sub sep {
+ my ($self, $field) = @_;
+ return undef unless $self->has($field);
+ return $self->{fields}{$field}{sep};
+}
+
=head1 MAP CONSTRUCTION METHODS
These methods are not generally accessed from user code.
chomp;
my @tokens = split /\s+/;
- my $map = { mods => [], filt => [] };
+ my $map = { mods => [], filt => [], sep => ' ' };
$map->{field} = shift @tokens;
$map->{tag} = shift @tokens;
while (defined (my $tok = shift @tokens)) {
last if ($tok =~ m/^#/);
- if ($tok =~ m/^[a-z]:'/ and $tok !~ /'$/) {
+ if ($tok =~ m/^[a-z]:'/ and $tok !~ /^'$/) {
$tok .= ' ' . shift @tokens
until ($tokens[0] =~ m/'$/);
$tok .= ' ' . shift @tokens;
{ push @{$map->{filt}}, $tok }
elsif ($tok =~ m/^[a-z0-9]$/)
{ $map->{sub} = $tok }
+ elsif ($tok =~ /^c:(.*)$/)
+ { $map->{sep} = $1 }
else
{ die "Unknown chunk '$tok' at line $.\n" }
}
$self->{fields}{ $map->{field} } = { tag => $map->{tag},
sub => $map->{sub},
mods => $map->{mods},
- filt => $map->{filt}
+ filt => $map->{filt},
+ sep => $map->{sep},
};
# and to the tags hash
$self->{tags}{ $map->{tag} }{ $map->{sub} } = $map->{field};
mapfile => $c->{map},
verbose => 1,
);
+
print "Writing holdings to output file(s)...\n";
# open main holdings file
open HOLDINGS, '>', ($c->{prefix} . "-HOLDINGS.pg");
# now get everything else in the mapping
for my $othertag ( sort keys %{$rec->{tmap}} ) {
next if $othertag eq $c->{holdings}; # ignoring the holdings, o'course
- my $idx = $rec->{tmap}{$othertag}[0]; # get index into tags struct
- unless (defined $idx) {
+ my $test_idx = $rec->{tmap}{$othertag}[0]; # get index into tags struct
+ unless (defined $test_idx) {
push @out, '';
next;
}
- for my $sub ( sort keys %{$rec->{tags}[$idx]{uni}} ) {
- push @out, $rec->{tags}[$idx]{uni}{$sub};
- print HOLDINGS "l_", $m->name($rec->{tags}[$idx]{tag}, $sub), ", "
- unless $j;
+ # handle only first other tag unless it is known to be multi
+ my $limit = 0;
+ if (exists($multis->{$othertag})) {
+ $limit = $#{ $rec->{tmap}{$othertag} };
}
- for my $sub ( sort keys %{$multis->{$othertag}} ) {
- for my $value ( @{$rec->{tags}[$idx]{multi}{$sub}} ) {
- my $fh = $MULTIFILE{"$othertag$sub"};
- print $fh join("\t", $rec->{egid}, $j, $value), "\n";
+ foreach my $idx (0..$limit) {
+ for my $sub ( sort keys %{$rec->{tags}[$idx]{uni}} ) {
+ if ($m->first_only($rec->{tags}[$idx]{tag}, $sub)) {
+ push @out, ($k == 1) ? $rec->{tags}[$idx]{uni}{$sub} : '';
+ } else {
+ push @out, $rec->{tags}[$idx]{uni}{$sub};
+ }
+ print HOLDINGS "l_", $m->name($rec->{tags}[$idx]{tag}, $sub), ", "
+ unless $j;
+ }
+ next unless exists($multis->{$othertag});
+ for my $sub ( sort keys %{$multis->{$othertag}} ) {
+ next if $m->first_only($rec->{tags}[$idx]{tag}, $sub) and ($k > 1);
+ for my $value ( @{$rec->{tags}[$idx]{multi}{$sub}} ) {
+ my $fh = $MULTIFILE{"$othertag$sub"};
+ print $fh join("\t", $rec->{egid}, $j, $value), "\n";
+ }
}
}
}