File Coverage

lib/MARC/Loader.pm

Criterion	Covered	Total	%
statement	117	133	87.9
branch	45	68	66.1
condition	27	42	64.2
subroutine	11	12	91.6
pod	1	5	20.0
total	201	260	77.3

# vim: sw=4
package MARC::Loader;
use 5.10.0;
use warnings;
use strict;
use Carp;
use MARC::Record;
use YAML;
use Scalar::Util qw< reftype >;
our $VERSION = '0.004001';
our $DEBUG = 0;
sub debug { $DEBUG and say STDERR @_ }

sub new {
	my ($self,$data) = @_;
	my $r = MARC::Record->new();
	my $orderfields = 0;
	my $ordersubfields = 0;
	my $cleannsb = 0;
	my $lc={};#the controlfield's list
	my $lf={};#the field's list
	my $cf={};#counter where multiple fields with same name
	my $bf={};#bool ok if field have one subfield at least
	if (defined($$data{"ldr"}) and $$data{"ldr"} ne "") {
		$r->leader($$data{"ldr"});
	}
	if ($$data{"orderfields"}) {
		$orderfields=1;
	}
	if ($$data{"ordersubfields"}) {
		$ordersubfields=1;
	}
	if ($$data{"cleannsb"}) {
		$cleannsb=1;
	}
	foreach my $k ( sort {$a cmp $b} keys(%$data) ) {
		if (($k eq "ldr") or ($k eq "orderfields") or ($k eq "ordersubfields") or ($k eq "cleannsb")) {
			next;
		}
		if ( ref( $$data{$k} ) eq "ARRAY" ) {
			foreach my $v ( sort {$a cmp $b} @{$$data{$k}} ) {
				createfield($k,$lc,$lf,$bf,$cf,$v,$cleannsb);
			}
		} else {
			createfield($k,$lc,$lf,$bf,$cf,$$data{$k},$cleannsb);
		}
	}
	foreach my $contk ( sort {$a cmp $b} keys(%$lc) ) {
		if($orderfields) {
			$r->insert_fields_ordered( $$lc{$contk} );
		} else {
			$r->append_fields( $$lc{$contk} );
		}
	}
	foreach my $k ( sort {$a cmp $b} keys(%$lf) ) {
		if ($$bf{$k}==1) {
			$$lf{$k}->delete_subfield(pos => 0);
			if($orderfields) {
				$r->insert_fields_ordered( $$lf{$k} );
			} else {
				$r->append_fields( $$lf{$k} );
			}
		}
	}
	$r;
}

sub createfield {
	my ($k,$lc,$lf,$bf,$cf,$v,$cleannsb) = @_;
	#$k = the hash key that defines the field or subfield name
	#$v = the field or subfield value
	#$lc= the controlfield's list
	#$lf= the field's list
	#$cf= counter where multiple fields with same name
	#$bf= bool ok if field have one subfield at least
	my $prefield="";
	if ($k=~/^((.*)##)?(\D)(\d{3})(\w)$/) {
		$prefield=$1 if $1;
		if (!exists($$lf{$prefield.$4})) {
			if($4<10 and defined($v) and $v ne "") {
				$v=nsbclean($v) if $cleannsb;
				$$lc{$prefield.$4} = MARC::Field->new( "$4", $v );
			} else {
				$$lf{$prefield.$4} = MARC::Field->new( "$4", "", "", 0 => "temp" );
				#$fnoauth = MARC::Field->new( '009', $noauth );
				$$bf{$prefield.$4}=0;
				if (defined($v) and $v ne "") {
					$v=nsbclean($v) if $cleannsb;
					createsubfield($$lf{$prefield.$4},$5,$v,$k);
					$$bf{$prefield.$4}=1;
				}
			}
		} else {
			if (defined($v) and $v ne "") {
				$v=nsbclean($v) if $cleannsb;
				createsubfield($$lf{$prefield.$4},$5,$v,$k);
				$$bf{$prefield.$4}=1;
			}
		}
	} elsif (($k=~/^((.*)##)?(\D)(\d{3})$/) and ( ref( $v ) eq "HASH" )) {
		$prefield=$1 if $1;
		if (!exists($$cf{$prefield.$4})) {
			$$cf{$prefield.$4}=0;
		}
		$$cf{$prefield.$4}++;
		if($4<10){
			foreach my $k ( sort {$a cmp $b} keys(%$v) ) {
				if (defined($$v{$k}) and $$v{$k} ne "") {
					if ($k=~/^((.*)##)?(\D)(\d{3})(\w)$/) {
						$$v{$k}=nsbclean($$v{$k}) if $cleannsb;
						$$lc{$prefield.$4.$$cf{$prefield.$4}} = MARC::Field->new( "$4", $$v{$k} );
						$$bf{$prefield.$4.$$cf{$prefield.$4}}=1;
					} else {
						warn "wrong field name : $k";return;
					}
				}
			}
		}
		else
		{
			$$lf{$prefield.$4.$$cf{$prefield.$4}} = MARC::Field->new( "$4", "", "", 0 => "temp" );
			$$bf{$prefield.$4.$$cf{$prefield.$4}}=0;
			foreach my $k ( sort {$a cmp $b} keys(%$v) ) {
				if (defined($$v{$k}) and $$v{$k} ne "" and ref($$v{$k}) eq "ARRAY" ) {
					foreach my $v ( sort {$a cmp $b} @{$$v{$k}} ) {
						if ($k=~/^((.*)##)?(\D)(\d{3})(\w)$/) {
							$v=nsbclean($v) if $cleannsb;
							createsubfield($$lf{$prefield.$4.$$cf{$prefield.$4}},$5,$v,$k);
							$$bf{$prefield.$4.$$cf{$prefield.$4}}=1;
						} else {
							warn "wrong field name : $k";return;
						}
					}
				} elsif (defined($$v{$k}) and $$v{$k} ne "") {
					if ($k=~/^((.*)##)?(\D)(\d{3})(\w)$/) {
						$$v{$k}=nsbclean($$v{$k}) if $cleannsb;
						createsubfield($$lf{$prefield.$4.$$cf{$prefield.$4}},$5,$$v{$k},$k);
						$$bf{$prefield.$4.$$cf{$prefield.$4}}=1;
					} else {
						warn "wrong field name : $k";return;
					}
				}
			}
		}
	} else {
		warn "wrong field name : $k";return;
	}
}

sub createsubfield {
	my ($f,$s,$v,$k)=@_;
	#$f = the field
	#$s = the subfield name
	#$k = the hash key that defines the subfield name
	#$v = the subfield value
	if ($k=~/^((.*)##)?(i)(\d{3})(\w)$/) {
		my $ind=$5;
		if ( ($5=~/1|2/) and ($v=~/\d|\|/) ) {
			$f->update( "ind$ind" => $v);
		} else {
			warn "wrong ind values : $k=$v";return;
		}
	} else {
		$f->add_subfields( "$s" => $v );
	}
}

sub nsbclean {
    my ($string) = @_ ;
    $_ = $string ;
    s/\x88//g ;# NSB : begin Non Sorting Block
    s/\x89//g ;# NSE : Non Sorting Block end
    s/\x98//g ;# NSB : begin Non Sorting Block
    s/\x9C//g ;# NSE : Non Sorting Block end
    s/\xC2//g ;# What is this char ? It is sometimes left by the regexp after removing NSB / NSE
    $string = $_ ;
    return($string) ;
}
1;
__END__