42 |
|
|
43 |
=head1 VERSION |
=head1 VERSION |
44 |
|
|
45 |
Version 0.28 |
Version 0.29 |
46 |
|
|
47 |
=cut |
=cut |
48 |
|
|
49 |
our $VERSION = '0.28'; |
our $VERSION = '0.29'; |
50 |
|
|
51 |
=head1 SYNOPSIS |
=head1 SYNOPSIS |
52 |
|
|
542 |
my $old = $_->[1]; |
my $old = $_->[1]; |
543 |
if (length($old) < $pos) { |
if (length($old) < $pos) { |
544 |
$_->[1] .= ' ' x ( $pos - length($old) ) . $val; |
$_->[1] .= ' ' x ( $pos - length($old) ) . $val; |
545 |
warn "## marc_fixed($f,$pos,'$val') append '$old' -> '$_->[1]'\n"; |
warn "## marc_fixed($f,$pos,'$val') append '$old' -> '$_->[1]'\n" if ($debug > 1); |
546 |
} else { |
} else { |
547 |
$_->[1] = substr($old, 0, $pos) . $val . substr($old, $pos + length($val)); |
$_->[1] = substr($old, 0, $pos) . $val . substr($old, $pos + length($val)); |
548 |
warn "## marc_fixed($f,$pos,'$val') update '$old' -> '$_->[1]'\n"; |
warn "## marc_fixed($f,$pos,'$val') update '$old' -> '$_->[1]'\n" if ($debug > 1); |
549 |
} |
} |
550 |
$update++; |
$update++; |
551 |
} |
} |
554 |
if (! $update) { |
if (! $update) { |
555 |
my $v = ' ' x $pos . $val; |
my $v = ' ' x $pos . $val; |
556 |
push @{ $marc_record->[ $marc_record_offset ] }, [ $f, $v ]; |
push @{ $marc_record->[ $marc_record_offset ] }, [ $f, $v ]; |
557 |
warn "## marc_fixed($f,$pos,'val') created '$v'\n"; |
warn "## marc_fixed($f,$pos,'val') created '$v'\n" if ($debug > 1); |
558 |
} |
} |
559 |
} |
} |
560 |
|
|
872 |
|
|
873 |
my ($h,$include_subfields) = @_; |
my ($h,$include_subfields) = @_; |
874 |
|
|
875 |
|
# sanity and ease of use |
876 |
|
return $h if (ref($h) ne 'HASH'); |
877 |
|
|
878 |
if ( defined($h->{subfields}) ) { |
if ( defined($h->{subfields}) ) { |
879 |
my $sfs = delete $h->{subfields} || die "no subfields?"; |
my $sfs = delete $h->{subfields} || die "no subfields?"; |
880 |
my @out; |
my @out; |
1024 |
=cut |
=cut |
1025 |
|
|
1026 |
sub prefix { |
sub prefix { |
1027 |
my $p = shift or return; |
my $p = shift; |
1028 |
|
return @_ unless defined( $p ); |
1029 |
return map { $p . $_ } grep { defined($_) } @_; |
return map { $p . $_ } grep { defined($_) } @_; |
1030 |
} |
} |
1031 |
|
|
1038 |
=cut |
=cut |
1039 |
|
|
1040 |
sub suffix { |
sub suffix { |
1041 |
my $s = shift or die "suffix needs string as first argument"; |
my $s = shift; |
1042 |
|
return @_ unless defined( $s ); |
1043 |
return map { $_ . $s } grep { defined($_) } @_; |
return map { $_ . $s } grep { defined($_) } @_; |
1044 |
} |
} |
1045 |
|
|
1052 |
=cut |
=cut |
1053 |
|
|
1054 |
sub surround { |
sub surround { |
1055 |
my $p = shift or die "surround need prefix as first argument"; |
my $p = shift; |
1056 |
my $s = shift or die "surround needs suffix as second argument"; |
my $s = shift; |
1057 |
|
$p = '' unless defined( $p ); |
1058 |
|
$s = '' unless defined( $s ); |
1059 |
return map { $p . $_ . $s } grep { defined($_) } @_; |
return map { $p . $_ . $s } grep { defined($_) } @_; |
1060 |
} |
} |
1061 |
|
|