36 |
|
|
37 |
=head1 VERSION |
=head1 VERSION |
38 |
|
|
39 |
Version 0.16 |
Version 0.17 |
40 |
|
|
41 |
=cut |
=cut |
42 |
|
|
43 |
our $VERSION = '0.16'; |
our $VERSION = '0.17'; |
44 |
|
|
45 |
=head1 SYNOPSIS |
=head1 SYNOPSIS |
46 |
|
|
540 |
|
|
541 |
warn "### marc_compose input subfields = ", dump(@_),$/ if ($debug > 2); |
warn "### marc_compose input subfields = ", dump(@_),$/ if ($debug > 2); |
542 |
|
|
543 |
|
if ($#_ % 2 != 1) { |
544 |
|
die "ERROR: marc_compose",dump($f,@_)," not valid (must be even).\nDo you need to add first() or join() around some argument?\n"; |
545 |
|
} |
546 |
|
|
547 |
while (@_) { |
while (@_) { |
548 |
my $sf = shift or die "marc_compose $f needs subfield"; |
my $sf = shift; |
549 |
my $v = shift; |
my $v = shift; |
550 |
|
|
551 |
next unless (defined($v) && $v !~ /^\s*$/); |
next unless (defined($v) && $v !~ /^\s*$/); |
687 |
|
|
688 |
die "field $from doesn't have even number of subfields specifications\n" unless($#sfs % 2 == 1); |
die "field $from doesn't have even number of subfields specifications\n" unless($#sfs % 2 == 1); |
689 |
|
|
690 |
warn "#--> d: ",dump($d), "\n#--> sfs: ",dump(@sfs),$/; |
warn "#--> d: ",dump($d), "\n#--> sfs: ",dump(@sfs),$/ if ($debug > 2); |
691 |
|
|
692 |
my $m = [ $to, $i1, $i2 ]; |
my $m = [ $to, $i1, $i2 ]; |
693 |
|
|
694 |
while (my $sf = shift @sfs) { |
while (my $sf = shift @sfs) { |
695 |
warn "#--> sf: ",dump($sf), $/; |
|
696 |
|
warn "#--> sf: ",dump($sf), $/ if ($debug > 2); |
697 |
my $offset = shift @sfs; |
my $offset = shift @sfs; |
698 |
die "corrupted sufields specification for field $from\n" unless defined($offset); |
die "corrupted sufields specification for field $from\n" unless defined($offset); |
699 |
|
|
714 |
} |
} |
715 |
|
|
716 |
warn "## marc_record = ", dump( $marc_record ),$/ if ($debug > 1); |
warn "## marc_record = ", dump( $marc_record ),$/ if ($debug > 1); |
|
|
|
|
warn "# marc_original_order is partly implemented"; |
|
717 |
} |
} |
718 |
|
|
719 |
|
|
740 |
if (ref($rec->{$f}) eq 'ARRAY') { |
if (ref($rec->{$f}) eq 'ARRAY') { |
741 |
return map { |
return map { |
742 |
if (ref($_) eq 'HASH') { |
if (ref($_) eq 'HASH') { |
743 |
values %{$_}; |
my $h = $_; |
744 |
|
if ( defined($h->{subfields}) ) { |
745 |
|
my $sfs = delete $h->{subfields} || die "no subfields?"; |
746 |
|
my @out; |
747 |
|
while (@$sfs) { |
748 |
|
my $sf = shift @$sfs; |
749 |
|
my $o = shift @$sfs; |
750 |
|
if ($o == 0 && ref( $h->{$sf} ) ne 'ARRAY' ) { |
751 |
|
# single element subfields are not arrays |
752 |
|
push @out, $h->{$sf}; |
753 |
|
} else { |
754 |
|
warn "====> $f $sf $o $#$sfs ", dump( $sfs ), "\n"; |
755 |
|
push @out, $h->{$sf}->[$o]; |
756 |
|
} |
757 |
|
} |
758 |
|
return @out; |
759 |
|
} else { |
760 |
|
# FIXME this should probably be in alphabetical order instead of hash order |
761 |
|
values %{$h}; |
762 |
|
} |
763 |
} else { |
} else { |
764 |
$_; |
$_; |
765 |
} |
} |