21 |
split_rec_on |
split_rec_on |
22 |
|
|
23 |
get set |
get set |
24 |
|
count |
25 |
/; |
/; |
26 |
|
|
27 |
use warnings; |
use warnings; |
42 |
|
|
43 |
=head1 VERSION |
=head1 VERSION |
44 |
|
|
45 |
Version 0.24 |
Version 0.26 |
46 |
|
|
47 |
=cut |
=cut |
48 |
|
|
49 |
our $VERSION = '0.24'; |
our $VERSION = '0.26'; |
50 |
|
|
51 |
=head1 SYNOPSIS |
=head1 SYNOPSIS |
52 |
|
|
167 |
|
|
168 |
=cut |
=cut |
169 |
|
|
170 |
my ($out, $marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators, $leader); |
my ($out, $marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators, $marc_leader); |
171 |
my ($marc_record_offset, $marc_fetch_offset) = (0, 0); |
my ($marc_record_offset, $marc_fetch_offset) = (0, 0); |
172 |
|
|
173 |
sub _get_ds { |
sub _get_ds { |
184 |
|
|
185 |
sub _clean_ds { |
sub _clean_ds { |
186 |
my $a = {@_}; |
my $a = {@_}; |
187 |
($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators, $leader) = (); |
($out,$marc_record, $marc_encoding, $marc_repeatable_subfield, $marc_indicators, $marc_leader) = (); |
188 |
($marc_record_offset, $marc_fetch_offset) = (0,0); |
($marc_record_offset, $marc_fetch_offset) = (0,0); |
189 |
$marc_encoding = $a->{marc_encoding}; |
$marc_encoding = $a->{marc_encoding}; |
190 |
} |
} |
490 |
my ($offset,$value) = @_; |
my ($offset,$value) = @_; |
491 |
|
|
492 |
if ($offset) { |
if ($offset) { |
493 |
$leader->{ $offset } = $value; |
$marc_leader->{ $offset } = $value; |
494 |
} else { |
} else { |
495 |
return $leader; |
return $marc_leader; |
496 |
} |
} |
497 |
} |
} |
498 |
|
|
638 |
|
|
639 |
This will erase field C<200> or C<200^a> from current MARC record. |
This will erase field C<200> or C<200^a> from current MARC record. |
640 |
|
|
641 |
|
marc_remove('*'); |
642 |
|
|
643 |
|
Will remove all fields in current MARC record. |
644 |
|
|
645 |
This is useful after calling C<marc_duplicate> or on it's own (but, you |
This is useful after calling C<marc_duplicate> or on it's own (but, you |
646 |
should probably just remove that subfield definition if you are not |
should probably just remove that subfield definition if you are not |
647 |
using C<marc_duplicate>). |
using C<marc_duplicate>). |
659 |
|
|
660 |
warn "### marc_remove before = ", dump( $marc ), $/ if ($debug > 2); |
warn "### marc_remove before = ", dump( $marc ), $/ if ($debug > 2); |
661 |
|
|
662 |
my $i = 0; |
if ($f eq '*') { |
663 |
foreach ( 0 .. $#{ $marc } ) { |
|
664 |
last unless (defined $marc->[$i]); |
delete( $marc_record->[ $marc_record_offset ] ); |
665 |
warn "#### working on ",dump( @{ $marc->[$i] }), $/ if ($debug > 3); |
warn "## full marc_record = ", dump( @{ $marc_record }), $/ if ($debug > 1); |
666 |
if ($marc->[$i]->[0] eq $f) { |
|
667 |
if (! defined $sf) { |
} else { |
668 |
# remove whole field |
|
669 |
splice @$marc, $i, 1; |
my $i = 0; |
670 |
warn "#### slice \@\$marc, $i, 1 = ",dump( @{ $marc }), $/ if ($debug > 3); |
foreach ( 0 .. $#{ $marc } ) { |
671 |
$i--; |
last unless (defined $marc->[$i]); |
672 |
} else { |
warn "#### working on ",dump( @{ $marc->[$i] }), $/ if ($debug > 3); |
673 |
foreach my $j ( 0 .. (( $#{ $marc->[$i] } - 3 ) / 2) ) { |
if ($marc->[$i]->[0] eq $f) { |
674 |
my $o = ($j * 2) + 3; |
if (! defined $sf) { |
675 |
if ($marc->[$i]->[$o] eq $sf) { |
# remove whole field |
676 |
# remove subfield |
splice @$marc, $i, 1; |
677 |
splice @{$marc->[$i]}, $o, 2; |
warn "#### slice \@\$marc, $i, 1 = ",dump( @{ $marc }), $/ if ($debug > 3); |
678 |
warn "#### slice \@{\$marc->[$i]}, $o, 2 = ", dump( @{ $marc }), $/ if ($debug > 3); |
$i--; |
679 |
# is record now empty? |
} else { |
680 |
if ($#{ $marc->[$i] } == 2) { |
foreach my $j ( 0 .. (( $#{ $marc->[$i] } - 3 ) / 2) ) { |
681 |
splice @$marc, $i, 1; |
my $o = ($j * 2) + 3; |
682 |
warn "#### slice \@\$marc, $i, 1 = ", dump( @{ $marc }), $/ if ($debug > 3); |
if ($marc->[$i]->[$o] eq $sf) { |
683 |
$i--; |
# remove subfield |
684 |
}; |
splice @{$marc->[$i]}, $o, 2; |
685 |
|
warn "#### slice \@{\$marc->[$i]}, $o, 2 = ", dump( @{ $marc }), $/ if ($debug > 3); |
686 |
|
# is record now empty? |
687 |
|
if ($#{ $marc->[$i] } == 2) { |
688 |
|
splice @$marc, $i, 1; |
689 |
|
warn "#### slice \@\$marc, $i, 1 = ", dump( @{ $marc }), $/ if ($debug > 3); |
690 |
|
$i--; |
691 |
|
}; |
692 |
|
} |
693 |
} |
} |
694 |
} |
} |
695 |
} |
} |
696 |
|
$i++; |
697 |
} |
} |
|
$i++; |
|
|
} |
|
698 |
|
|
699 |
warn "### marc_remove($f", $sf ? ",$sf" : "", ") after = ", dump( $marc ), $/ if ($debug > 2); |
warn "### marc_remove($f", $sf ? ",$sf" : "", ") after = ", dump( $marc ), $/ if ($debug > 2); |
700 |
|
|
701 |
$marc_record->[ $marc_record_offset ] = $marc; |
$marc_record->[ $marc_record_offset ] = $marc; |
702 |
|
} |
703 |
|
|
704 |
warn "## full marc_record = ", dump( @{ $marc_record }), $/ if ($debug > 1); |
warn "## full marc_record = ", dump( @{ $marc_record }), $/ if ($debug > 1); |
705 |
} |
} |
1273 |
|
|
1274 |
sub set { |
sub set { |
1275 |
my ($k,$v) = @_; |
my ($k,$v) = @_; |
1276 |
warn "## set ( $k => ", dump($v), " )", $/; |
warn "## set ( $k => ", dump($v), " )", $/ if ( $debug ); |
1277 |
$hash->{$k} = $v; |
$hash->{$k} = $v; |
1278 |
}; |
}; |
1279 |
|
|
1286 |
sub get { |
sub get { |
1287 |
my $k = shift || return; |
my $k = shift || return; |
1288 |
my $v = $hash->{$k}; |
my $v = $hash->{$k}; |
1289 |
warn "## get $k = ", dump( $v ), $/; |
warn "## get $k = ", dump( $v ), $/ if ( $debug ); |
1290 |
return $v; |
return $v; |
1291 |
} |
} |
1292 |
|
|
1293 |
|
=head2 count |
1294 |
|
|
1295 |
|
if ( count( @result ) == 1 ) { |
1296 |
|
# do something if only 1 result is there |
1297 |
|
} |
1298 |
|
|
1299 |
|
=cut |
1300 |
|
|
1301 |
|
sub count { |
1302 |
|
warn "## count ",dump(@_),$/ if ( $debug ); |
1303 |
|
return @_ . ''; |
1304 |
|
} |
1305 |
|
|
1306 |
# END |
# END |
1307 |
1; |
1; |