MARC-Transform-0.003009/lib/MARC/Transform.pm0000644000175000017500000034447413741025471020513 0ustar reiveunereiveune# vim: sw=4 package MARC::Transform; use 5.10.0; use warnings; use strict; use Carp; use MARC::Record; use YAML; use Scalar::Util qw< reftype >; our $VERSION = '0.003009'; our $DEBUG = 0; sub debug { $DEBUG and say STDERR @_ } my %fields; my $globalcondition; my $record; our $mth; my $globalsubs; my $verbose=0; my @errors; my $global_LUT; our $this=""; sub new { my ($self,$recordsource,$yaml,$mthsource,$verb,$yamlencode) = @_; my @yaml; no warnings 'redefine'; no warnings 'newline'; my $yamltoload; if ( -e $yaml ) { my $yamls; if(defnonull($yamlencode)){ open $yamls, "<:encoding($yamlencode)", $yaml or die "can't open file: $!"; } else { open $yamls, "< $yaml" or die "can't open file: $!"; } my $yamlline; while ($yamlline = <$yamls>){ $yamltoload.=$yamlline; } close $yamls; #@yaml = YAML::LoadFile($yamls); } else { $yamltoload=$yaml; #@yaml = YAML::Load($yaml); } $yamltoload=~s/#_dollars_#/\\#_dollars_\\#/g; $yamltoload=~s/#_dbquote_#/\\#_dbquote_\\#/g; @yaml = YAML::Load($yamltoload); #warn "================". Data::Dumper::Dumper (\@yaml)."------------------"; $record=$recordsource; $mth=$mthsource; $$mth{"_defaultLUT_to_mth_"}={} if $mth; ReplaceAllInRecord("before"); $verbose = 1 if ($verb); foreach my $rulesub(@yaml) { if ( ref($rulesub) eq "HASH" ) { if ( defnonull ( $$rulesub{'global_subs'} ) ) { $globalsubs = $$rulesub{'global_subs'}; eval ($globalsubs); } if ( defnonull ( $$rulesub{'global_LUT'} ) ) { if (ref($$rulesub{'global_LUT'}) eq "HASH") { $global_LUT=$$rulesub{'global_LUT'}; } } } } foreach my $rule(@yaml) { #print Data::Dumper::Dumper ($rule); if ( ref($rule) eq "ARRAY" ) { my $subs=""; foreach my $rul ( @$rule ) { if ( defnonull ( $$rul{'subs'} ) ) { $subs.=$$rul{'subs'}; } if ( defnonull ( $$rul{'LUT'} ) ) { $$global_LUT{"lookuptableforthis"}=$$rul{'LUT'};#warn Data::Dumper::Dumper $global_LUT; } } foreach my $rul ( @$rule ) { my ($actionsin, $actionsinter, $actionsout)= parseactions($rul);#warn Data::Dumper::Dumper ($rul); my $boolcondition = testrule($rul, $actionsin, $actionsinter, $actionsout, $subs); #warn $boolcondition;warn "actionsin : ".$actionsin;warn "actionsout : ".$actionsout; if ($boolcondition) { last; } } } elsif ( ref($rule) eq "HASH" ) { my $subs=""; if ( defnonull ( $$rule{'subs'} ) ) { $subs.=$$rule{'subs'}; } if ( defnonull ( $$rule{'LUT'} ) ) { $$global_LUT{"lookuptableforthis"}=$$rule{'LUT'}; } my ($actionsin, $actionsinter, $actionsout)= parseactions($rule); my $boolcondition = testrule($rule, $actionsin, $actionsinter, $actionsout, $subs); } else { push(@errors, 'Invalid yaml : you try to use a scalar rule.'); #error } } foreach my $error (@errors) { print "\n$error"; } ReplaceAllInRecord("after"); $record; } sub defnonull { my $var = shift; if (defined $var and $var ne "") { return 1; } else { return 0; } } sub LUT { my ( $inLUT, $type ) = @_; if (!defined($type)) { $type = "lookuptableforthis"; } my $outLUT=$inLUT; my $boolnocor = 1; if ( ref($global_LUT) eq "HASH") { if (exists($$global_LUT{$type})) { my $correspondance=$$global_LUT{$type}; if ( ref($correspondance) eq "HASH") { foreach my $cor (keys(%$correspondance)) { if ($inLUT eq $cor) { $outLUT=$$correspondance{$cor}; $boolnocor = 0; } } if ($boolnocor) { $outLUT=$$correspondance{"_default_value_"} if (defnonull($$correspondance{"_default_value_"})); push (@{$$mth{"_defaultLUT_to_mth_"}->{"$type"}} , $inLUT) if $mth; } } } } return $outLUT; } sub update { my ($field,$subfields)=@_; transform ("update",$field,$subfields); return 1; } sub forceupdate { my ($field,$subfields)=@_; transform ("forceupdate",$field,$subfields); return 1; } sub updatefirst { my ($field,$subfields)=@_; transform ("updatefirst",$field,$subfields); return 1; } sub forceupdatefirst { my ($field,$subfields)=@_; transform ("forceupdatefirst",$field,$subfields); return 1; } sub create { my ($field,$subfields)=@_; transform ("create",$field,$subfields); return 1; } sub transform { my ($ttype,$field,$subfields)=@_; #print "\n------------$ttype------------ : \n".Data::Dumper::Dumper (@_); if ($ttype eq "forceupdate" or $ttype eq "forceupdatefirst" ) { if (ref($field) eq "" or ref($field) eq "SCALAR") { if (!defined $record->field($field) ) {$ttype="create"} } } if (ref($field) eq "MARC::Field") { #print "\n------------$ttype------------ : \n".Data::Dumper::Dumper ($subfields); foreach my $tag(keys(%$subfields)) { if ( $tag eq 'i1' or $tag eq 'µ') { #print "\n------------$ttype------------ : \n"; $this=$field->indicator(1); my $finalvalue=parsestringactions($$subfields{$tag}); $field->update( ind1 => $finalvalue ) if ( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ); } elsif ( $tag eq 'i2' or $tag eq '£') { $this=$field->indicator(2); my $finalvalue=parsestringactions($$subfields{$tag}); $field->update( ind2 => $finalvalue ) if ( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ); } else { if( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ) { if($field->is_control_field()) { $this=$field->data(); my $finalvalue=parsestringactions($$subfields{$tag}); $field->update($finalvalue); } else { if ($ttype eq "create") { $this=""; my $finalvalue=parsestringactions($$subfields{$tag}); $field->add_subfields( $tag => $finalvalue ); } elsif ($ttype eq "updatefirst") { if ( defined $field->subfield( $tag ) ) { $this=$field->subfield( $tag ); my $finalvalue=parsestringactions($$subfields{$tag}); $field->update( $tag => $finalvalue ); } #warn $tag.$$subfields{$tag}; } elsif ($ttype eq "forceupdatefirst") { if ( defined $field->subfield( $tag ) ) { $this=$field->subfield( $tag ); my $finalvalue=parsestringactions($$subfields{$tag}); $field->update( $tag => $finalvalue ); } else { $this=""; my $finalvalue=parsestringactions($$subfields{$tag}); $field->add_subfields( $tag => $finalvalue ); } } } } elsif( ref($$subfields{$tag}) eq "ARRAY" ) { if(!$field->is_control_field()) { foreach my $subfield(@{$$subfields{$tag}}) { if ($ttype eq "create") { $this=""; my $finalvalue=parsestringactions($subfield); $field->add_subfields( $tag => $finalvalue ); } elsif ($ttype eq "updatefirst") { if ( defined $field->subfield( $tag ) ) { $this=$field->subfield( $tag ); my $finalvalue=parsestringactions($subfield); $field->update( $tag => $finalvalue ); } } elsif ($ttype eq "forceupdatefirst") { if ( defined $field->subfield( $tag ) ) { $this=$field->subfield( $tag ); my $finalvalue=parsestringactions($subfield); $field->update( $tag => $finalvalue ); } else { $this=""; my $finalvalue=parsestringactions($subfield); $field->add_subfields( $tag => $finalvalue ); } } } } else { push(@errors, 'Invalid yaml : you try to use an array to '.$ttype.' in existing condition\'s controlfield value.'); #error } } } } if((!$field->is_control_field()) and ($ttype eq "update" or $ttype eq "forceupdate" )) { my @usubfields; foreach my $subfield ( $field->subfields() ) { if ( exists($$subfields{$$subfield[0]}) ) { #implementation de l'eval des fonctions et de $this $this=$$subfield[1]; my $finalvalue=parsestringactions($$subfields{$$subfield[0]}); push @usubfields, ( $$subfield[0],$finalvalue ); } else { push @usubfields, ( $$subfield[0], $$subfield[1] ); } } my $newfield = MARC::Field->new( $field->tag(), $field->indicator(1), $field->indicator(2), @usubfields ); foreach my $tag(keys(%$subfields)) { if($tag ne 'i1' and $tag ne 'µ' and $tag ne 'i2' and $tag ne '£' and !defined($newfield->subfield( $tag )) ) { if( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ) { $this=""; my $finalvalue=parsestringactions($$subfields{$tag}); $newfield->add_subfields( $tag => $finalvalue ) if $ttype eq "forceupdate"; } else { push(@errors, 'Invalid yaml : you try to use a non-scalar value to '.$ttype.' in existing condition\'s field value.'); #error } } } $field->replace_with($newfield); } } elsif (ref($field) eq "" or ref($field) eq "SCALAR") { #print "\n------------$ttype------------ : \n".Data::Dumper::Dumper (@_); if ($ttype eq "update" or $ttype eq "updatefirst" or $ttype eq "forceupdate" or $ttype eq "forceupdatefirst") { if ( defined $record->field($field) ) { for my $updatefield ( $record->field($field) ) { foreach my $tag(keys(%$subfields)) { if ( $tag eq 'i1' or $tag eq 'µ') { $this=$updatefield->indicator(1); my $finalvalue=parsestringactions($$subfields{$tag}); $updatefield->update( ind1 => $finalvalue ) if ( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ); } elsif ( $tag eq 'i2' or $tag eq '£') { $this=$updatefield->indicator(2); my $finalvalue=parsestringactions($$subfields{$tag}); $updatefield->update( ind2 => $finalvalue ) if ( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ); } elsif( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ) { if($updatefield->is_control_field()) { $this=$updatefield->data(); my $finalvalue=parsestringactions($$subfields{$tag}); $updatefield->update($finalvalue); } elsif ( $ttype eq "updatefirst" ) { if ( defined $updatefield->subfield( $tag ) ) { $this=$updatefield->subfield( $tag ); my $finalvalue=parsestringactions($$subfields{$tag}); $updatefield->update( $tag => $finalvalue ); } } elsif ($ttype eq "forceupdatefirst") { if ( defined $updatefield->subfield( $tag ) ) { $this=$updatefield->subfield( $tag ); my $finalvalue=parsestringactions($$subfields{$tag}); $updatefield->update( $tag => $finalvalue ); } else { $this=""; my $finalvalue=parsestringactions($$subfields{$tag}); $updatefield->add_subfields( $tag => $finalvalue ); } } } else { push(@errors, 'Invalid yaml : you try to use a non-scalar value to '.$ttype.' field.');#error } } if((!$updatefield->is_control_field()) and ($ttype eq "update" or $ttype eq "forceupdate" )) { my @usubfields; foreach my $subfield ( $updatefield->subfields() ) { if ( exists($$subfields{$$subfield[0]}) ) { $this=$$subfield[1]; my $finalvalue=parsestringactions($$subfields{$$subfield[0]}); push @usubfields, ( $$subfield[0],$finalvalue ); } else { push @usubfields, ( $$subfield[0], $$subfield[1] ); } } my $newfield = MARC::Field->new( $updatefield->tag(), $updatefield->indicator(1), $updatefield->indicator(2), @usubfields ); foreach my $tag(keys(%$subfields)) { if($tag ne 'i1' and $tag ne 'µ' and $tag ne 'i2' and $tag ne '£' and !defined($newfield->subfield( $tag )) ) { if( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ) { $this=""; my $finalvalue=parsestringactions($$subfields{$tag}); $newfield->add_subfields( $tag => $finalvalue ) if $ttype eq "forceupdate"; } else { push(@errors, 'Invalid yaml : you try to use a non-scalar value to '.$ttype.' field.');#error } } } $updatefield->replace_with($newfield); } } } } elsif ($ttype eq "create") { my $newfield; $this=""; if ($field < "010" ) { $newfield = MARC::Field->new( $field, 'temp'); } else { $newfield = MARC::Field->new( $field, '', '', '0'=>'temp'); } foreach my $tag(keys(%$subfields)) { if ( $tag eq 'i1' or $tag eq 'µ') { my $finalvalue=parsestringactions($$subfields{$tag}); $newfield->update( ind1 => $finalvalue ) if ( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ); } elsif ( $tag eq 'i2' or $tag eq '£') { my $finalvalue=parsestringactions($$subfields{$tag}); $newfield->update( ind2 => $finalvalue ) if ( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ); } else { if( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ) { if($newfield->is_control_field()) { my $finalvalue=parsestringactions($$subfields{$tag}); $newfield->update($finalvalue); } else { my $finalvalue=parsestringactions($$subfields{$tag}); $newfield->add_subfields( $tag => $finalvalue ); } } elsif( ref($$subfields{$tag}) eq "ARRAY" ) { if(!$newfield->is_control_field()) { foreach my $subfield(@{$$subfields{$tag}}) { my $finalvalue=parsestringactions($subfield); $newfield->add_subfields( $tag => $finalvalue ); } } } } } if (!$newfield->is_control_field()) { $newfield->delete_subfield(pos => '0'); } $record->insert_fields_ordered($newfield); } } else { push(@errors, 'Invalid yaml : you try to use an array or hash value to '.$ttype.' field.');#error } return 1; } sub parsestringactions { my $subfieldtemp=shift; $subfieldtemp=~s/tempnameforcurrentvalueofthissubfield/\$this/g; $subfieldtemp=~s/temporarycallfunction/\\&/g; my $finalvalue; if ($subfieldtemp=~/\\&/) { $subfieldtemp=~s/\\&/&/g; $finalvalue = eval ($subfieldtemp); } else { $finalvalue = eval '"'.$subfieldtemp.'"'; } return $finalvalue; } sub parseactions { my $rul = shift; my $actionsintemp=""; my $actionsin=""; my $actionsinter=""; my $actionsouttemp=""; my $actionsout=""; #print "\n".Data::Dumper::Dumper $rul; #create duplicatefield forceupdate forceupdatefirst update updatefirst execute delete if ( defnonull ( $$rul{'create'} ) ) { ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'create'},'create'); $actionsin.=$actionsintemp; $actionsout.=$actionsouttemp; } if ( defnonull ( $$rul{'duplicatefield'} ) ) { ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'duplicatefield'},'duplicatefield'); $actionsinter.=$actionsintemp; $actionsout.=$actionsouttemp; } if ( defnonull ( $$rul{'forceupdate'} ) ) { ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'forceupdate'},'forceupdate'); $actionsin.=$actionsintemp; $actionsout.=$actionsouttemp; } if ( defnonull ( $$rul{'forceupdatefirst'} ) ) { ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'forceupdatefirst'},'forceupdatefirst'); $actionsin.=$actionsintemp; $actionsout.=$actionsouttemp; } if ( defnonull ( $$rul{'update'} ) ) { ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'update'},'update'); $actionsin.=$actionsintemp; $actionsout.=$actionsouttemp; } if ( defnonull ( $$rul{'updatefirst'} ) ) { ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'updatefirst'},'updatefirst'); $actionsin.=$actionsintemp; $actionsout.=$actionsouttemp; } if ( defnonull ( $$rul{'execute'} ) ) { ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'execute'},'execute'); $actionsin.=$actionsintemp; $actionsout.=$actionsouttemp; } if ( defnonull ( $$rul{'delete'} ) ) { ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'delete'},'delete'); $actionsin.=$actionsintemp; $actionsout.=$actionsouttemp; } #print "\n----------------------actionsin---------------------- : \n$actionsin\n\n----------------------actionsout---------------------- : \n$actionsout\n----------------------actionsend----------------------"; return ($actionsin, $actionsinter, $actionsout) } sub parsesubaction { my ($intaction,$type)=@_; my $actionsin=""; my $actionsout=""; my $boolin=0; my $specaction=""; my $currentaction="";#warn ref($intaction); $specaction=" $type"; #print "\n".Data::Dumper::Dumper $intaction; if ($type eq "create" or $type eq "forceupdate" or $type eq "update" or $type eq "forceupdatefirst" or $type eq "updatefirst") { if ( ref($intaction) eq "HASH" ) { foreach my $kint (keys(%$intaction)) { if( ref($$intaction{$kint}) eq "HASH" ) { my $ftag; $currentaction=""; $boolin=0; if($kint=~/^\$f(\d{3})$/) { $boolin=1; $ftag=$kint; } elsif($kint=~/^f(\d{3})$/) { $ftag='"'.$1.'"'; } else { push(@errors, 'Invalid yaml : your field reference is not valid in '.$type.' action.');#error next; } $currentaction.=$specaction.'('.$ftag.',{'; my $subint=$$intaction{$kint}; foreach my $k (keys(%$subint)) { if( ref($$subint{$k}) eq "" or ref($$subint{$k}) eq "SCALAR" ) { $$subint{$k}=~s/"/\\"/g; $boolin=1 if($$subint{$k}=~/\$f/);#print $k." eq. ".$$subint{$k}."\n"; $$subint{$k}=~s/\$this/tempnameforcurrentvalueofthissubfield/g; $$subint{$k}=~s/\\&/temporarycallfunction/g; $currentaction.='"'.$k.'"=> "'.$$subint{$k}.'",'; } elsif( ref($$subint{$k}) eq "ARRAY" ) { $currentaction.='"'.$k.'"=>['; foreach my $ssubint(@{$$subint{$k}}) { $ssubint=~s/"/\\"/g; $boolin=1 if($ssubint=~/\$f/); $ssubint=~s/\$this/tempnameforcurrentvalueofthissubfield/g; $ssubint=~s/\\&/temporarycallfunction/g; $currentaction.='"'.$ssubint.'",'; } $currentaction.='],'; } else { push(@errors, 'Invalid yaml : you try to use a hash inside another hash in '.$type.' action.');#error } } $currentaction.='});'."\n"; if ($boolin) { $actionsin.=$currentaction; } else { $actionsout.=$currentaction; } } elsif( ref($$intaction{$kint}) eq "" or ref($$intaction{$kint}) eq "SCALAR" ) { $currentaction=""; $boolin=0; my $ftag; my $stag; if($kint=~/^\$f(\d{3})(\w)$/) { $boolin=1; $ftag='$f'.$1; $stag=$2; } elsif($kint=~/^\$i(\d{3})(\w)$/) { $boolin=1; $ftag='$f'.$1; $stag='µ'; $stag='µ' if($2 eq "1"); $stag='£' if($2 eq "2"); } elsif($kint=~/^f(\d{3})(\w)$/) { $ftag='"'.$1.'"'; $stag=$2; } elsif($kint=~/^i(\d{3})(\w)$/) { $ftag='"'.$1.'"'; $stag='µ'; $stag='µ' if($2 eq "1"); $stag='£' if($2 eq "2"); } elsif($kint=~/^i(\d)$/) { $ftag='$$currentfield'; $stag='µ'; $stag='µ' if($1 eq "1"); $stag='£' if($1 eq "2"); $boolin=1; } elsif($kint=~/^(\w)$/) { $ftag='$$currentfield'; $boolin=1; $stag=$kint; } else { push(@errors, 'Invalid yaml : your field reference is not valid in '.$type.' action.');#error next; } $$intaction{$kint}=~s/"/\\"/g; $boolin=1 if($$intaction{$kint}=~/\$f/); $$intaction{$kint}=~s/\$this/tempnameforcurrentvalueofthissubfield/g; $$intaction{$kint}=~s/\\&/temporarycallfunction/g; $currentaction.=$specaction.'('.$ftag.',{"'.$stag.'"=>"'.$$intaction{$kint}.'"});'."\n"; if ($boolin) { $actionsin.=$currentaction; } else { $actionsout.=$currentaction; } } elsif( ref($$intaction{$kint}) eq "ARRAY" ) { $currentaction=""; $boolin=0; my $ftag; my $stag; if($kint=~/^\$f(\d{3})(\w)$/) { $boolin=1; $ftag='$f'.$1; $stag=$2; } elsif($kint=~/^\$i(\d{3})(\w)$/) { $boolin=1; $ftag='$f'.$1; $stag='µ'; $stag='µ' if($2 eq "1"); $stag='£' if($2 eq "2"); } elsif($kint=~/^f(\d{3})(\w)$/) { $ftag='"'.$1.'"'; $stag=$2; } elsif($kint=~/^i(\d{3})(\w)$/) { $ftag='"'.$1.'"'; $stag='µ'; $stag='µ' if($2 eq "1"); $stag='£' if($2 eq "2"); } elsif($kint=~/^(\w)$/) { $ftag='$$currentfield'; $boolin=1; $stag=$kint; } else { push(@errors, 'Invalid yaml : your field reference is not valid in '.$type.' action.');#error next; } $currentaction.=$specaction.'('.$ftag.',{"'.$stag.'"=>['; foreach my $sintaction(@{$$intaction{$kint}}) { $sintaction=~s/"/\\"/g; $boolin=1 if($sintaction=~/\$f/); $sintaction=~s/\$this/tempnameforcurrentvalueofthissubfield/g; $sintaction=~s/\\&/temporarycallfunction/g; $currentaction.='"'.$sintaction.'",'; } $currentaction.=']});'."\n"; if ($boolin) { $actionsin.=$currentaction; } else { $actionsout.=$currentaction; } } } } else { push(@errors, 'Invalid yaml : you try to use non hash context in '.$type.' action.');#error } } elsif ($type eq "duplicatefield") { if ( ref($intaction) eq "ARRAY" ) { foreach my $vint (@$intaction) { if( ref($vint) eq "" or ref($vint) eq "SCALAR" ) { if($vint=~/^\$f(\d{3})\s?>\s?f(\d{3})$/) { if ($1 < "010" and $2 < "010" ) { $actionsin.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $f'.$1.'->data() ) );'; } elsif ($1 >= "010" and $2 >= "010" ) { $actionsin.='my @dsubfields; foreach my $subfield ( $f'.$1.'->subfields() ) { push @dsubfields, ( $$subfield[0], $$subfield[1] );}'."\n"; $actionsin.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $f'.$1.'->indicator(1), $f'.$1.'->indicator(2), @dsubfields ) );'; } else { push(@errors, 'Invalid yaml : you want to duplicate a controlfield with a non-controlfield ');#error } } elsif($vint=~/^f(\d{3})\s?>\s?f(\d{3})$/) { if ($1 < "010" and $2 < "010" ) { $actionsout.=' for my $fielddup($record->field("'.$1.'")){'; $actionsout.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $fielddup->data() ) );'; $actionsout.='}'."\n"; } elsif ($1 >= "010" and $2 >= "010" ) { $actionsout.=' for my $fielddup($record->field("'.$1.'")){'; $actionsout.='my @dsubfields; foreach my $subfield ( $fielddup->subfields() ) { push @dsubfields, ( $$subfield[0], $$subfield[1] );}'."\n"; $actionsout.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $fielddup->indicator(1), $fielddup->indicator(2), @dsubfields ) );'; $actionsout.='}'."\n"; } else { push(@errors, 'Invalid yaml : you want to duplicate a controlfield with a non-controlfield ');#error } } else { push(@errors, 'Invalid yaml : your field reference is not valid in '.$type.' action.');#error } } else { push(@errors, 'Invalid yaml : you try to use non scalar value in '.$type.' action.');#error } } } elsif ( ref($intaction) eq "" or ref($intaction) eq "SCALAR" ) { my $vint=$intaction; if($vint=~/^\$f(\d{3})\s?>\s?f(\d{3})$/) { if ($1 < "010" and $2 < "010" ) { $actionsin.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $f'.$1.'->data() ) );'; } elsif ($1 >= "010" and $2 >= "010" ) { $actionsin.='my @dsubfields; foreach my $subfield ( $f'.$1.'->subfields() ) { push @dsubfields, ( $$subfield[0], $$subfield[1] );}'."\n"; $actionsin.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $f'.$1.'->indicator(1), $f'.$1.'->indicator(2), @dsubfields ) );'; } else { push(@errors, 'Invalid yaml : you want to duplicate a controlfield with a non-controlfield ');#error } } elsif($vint=~/^f(\d{3})\s?>\s?f(\d{3})$/) { if ($1 < "010" and $2 < "010" ) { $actionsout.=' for my $fielddup($record->field("'.$1.'")){'; $actionsout.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $fielddup->data() ) );'; $actionsout.='}'."\n"; } elsif ($1 >= "010" and $2 >= "010" ) { $actionsout.=' for my $fielddup($record->field("'.$1.'")){'; $actionsout.='my @dsubfields; foreach my $subfield ( $fielddup->subfields() ) { push @dsubfields, ( $$subfield[0], $$subfield[1] );}'."\n"; $actionsout.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $fielddup->indicator(1), $fielddup->indicator(2), @dsubfields ) );'; $actionsout.='}'."\n"; } else { push(@errors, 'Invalid yaml : you want to duplicate a controlfield with a non-controlfield ');#error } } else { push(@errors, 'Invalid yaml : your field reference is not valid in '.$type.' action.');#error } } else { push(@errors, 'Invalid yaml : you try to use a hash value in '.$type.' action.');#error } } elsif ($type eq "delete") { if ( ref($intaction) eq "ARRAY" ) { foreach my $vint (@$intaction) { if( ref($vint) eq "" or ref($vint) eq "SCALAR" ) { #print "$vint\n"; if($vint=~/^\$f(\d{3})(\w)$/) { $actionsin.=' if ( defined $f'.$1.'->subfield("'.$2.'") ) { if (scalar($f'.$1.'->subfields())==1) { $record->delete_field($f'.$1.'); } else { $f'.$1.'->delete_subfield(code => "'.$2.'"); } }'."\n"; } elsif($vint=~/^\$f(\d{3})$/) { $actionsin.=' $record->delete_field('.$vint.');'."\n"; } elsif($vint=~/^f(\d{3})(\w)$/) { $actionsout.=' for my $fieldel($record->field("'.$1.'")){if ( defined $fieldel->subfield("'.$2.'") ) { if (scalar($fieldel->subfields())==1) { $record->delete_field($fieldel); } else { $fieldel->delete_subfield(code => "'.$2.'"); } }}'."\n"; } elsif($vint=~/^f(\d{3})$/) { $actionsout.=' $record->delete_fields($record->field("'.$1.'"));'."\n"; } elsif($vint=~/^(\w)$/) { $actionsin.=' if ( defined $$currentfield->subfield("'.$vint.'") ) { if (scalar($$currentfield->subfields())==1) { $record->delete_field($$currentfield); } else { $$currentfield->delete_subfield(code => "'.$vint.'"); } }'."\n"; } else { push(@errors, 'Invalid yaml : your field reference is not valid in '.$type.' action.');#error } } else { push(@errors, 'Invalid yaml : you try to use non scalar value in '.$type.' action.');#error } } } elsif ( ref($intaction) eq "" or ref($intaction) eq "SCALAR" ) { my $vint=$intaction; if($vint=~/^\$f(\d{3})(\w)$/) { $actionsin.=' if ( defined $f'.$1.'->subfield("'.$2.'") ) { if (scalar($f'.$1.'->subfields())==1) { $record->delete_field($f'.$1.'); } else { $f'.$1.'->delete_subfield(code => "'.$2.'"); } }'."\n"; } elsif($vint=~/^\$f(\d{3})$/) { $actionsin.=' $record->delete_field('.$vint.');'."\n"; } elsif($vint=~/^f(\d{3})(\w)$/) { $actionsout.=' for my $fieldel($record->field("'.$1.'")){if ( defined $fieldel->subfield("'.$2.'") ) { if (scalar($fieldel->subfields())==1) { $record->delete_field($fieldel); } else { $fieldel->delete_subfield(code => "'.$2.'"); } }}'."\n"; } elsif($vint=~/^f(\d{3})$/) { $actionsout.=' $record->delete_fields($record->field("'.$1.'"));'."\n"; } elsif($vint=~/^(\w)$/) { $actionsin.=' if ( defined $$currentfield->subfield("'.$vint.'") ) { if (scalar($$currentfield->subfields())==1) { $record->delete_field($$currentfield); } else { $$currentfield->delete_subfield(code => "'.$vint.'"); } }'."\n"; } else { push(@errors, 'Invalid yaml : your field reference is not valid in '.$type.' action.');#error } } else { push(@errors, 'Invalid yaml : you try to use a hash value in '.$type.' action.');#error } } elsif ($type eq "execute") { if( ref($intaction) eq "" or ref($intaction) eq "SCALAR" ) { if($intaction=~/\$(f|i)(\d{3})/) { $actionsin.=' eval ('.$intaction.');'; } else { $actionsout.=' eval ('.$intaction.');'; } } elsif( ref($intaction) eq "ARRAY" ) { foreach my $sintaction(@$intaction) { if($sintaction=~/\$(f|i)(\d{3})/) { $actionsin.=' eval ('.$sintaction.');'; } else { $actionsout.=' eval ('.$sintaction.');'; } } } else { push(@errors, 'Invalid yaml : you try to use a hash value in '.$type.' action.');#error } } else { push(@errors, 'Invalid yaml : this action : '.$type.' is not valid.');#error } return ($actionsin,$actionsout); } sub testrule { my ($rul, $actionsin, $actionsinter, $actionsout, $subs) = @_; $globalcondition=""; $subs="no warnings 'redefine';".$subs if $subs ne ""; my $globalconditionstart='{ '."\n".$subs."\n".'my $boolcond=0;my $boolcondint=0;my $currentfield;no warnings \'substr\';no warnings \'uninitialized\';no warnings \'portable\';'."\n"; my $globalconditionint=""; my $globalconditionend="";#print Data::Dumper::Dumper ($rul); if ( defnonull ( $$rul{'condition'} ) ) { my @listconditiontags=grep( $_ , map({ $_=~/^(f|i)(\d{3})(.*)$/;$2 } (split(/\$/,$$rul{'condition'}))));#print $$rul{'condition'}; my @listconditionsubtags=grep( $_ , map({ if($_=~/^(f)(\d{3}\w)(.*)$/){$2}elsif($_=~/^(i)(\d{3})(.*)$/){$2} } (split(/\$/,$$rul{'condition'})))); my %tag_names = map( { $_ => 1 } @listconditiontags); my %tag_list; @listconditiontags = keys(%tag_names); foreach my $tag(@listconditiontags) { $tag_list{$tag}=[]; foreach my $subtag(@listconditionsubtags) { if (substr($subtag,0,3) eq $tag) { if(length($subtag) == 3) { push (@{$tag_list{$tag}}, "tempvalueforcurrentfield"); } else { push (@{$tag_list{$tag}}, substr($subtag,3,1)); } } } } my $condition=$$rul{'condition'}; $condition=~s/(\$ldr(\d{1,2}))/\(substr\(\$record->leader\(\),$2,1)\)/g; $condition=~s/(\$ldr)/(\$record->leader\(\)\)/g; $condition=~s/(\$f\d{3})(\w)/defined($1$2) and $1$2/g; $condition=~s/(\$f\d{3})(\w)(\d{1,2})/\(substr($1$2,$3,1\)\)/g; $condition=~s/(\$f\d{3})(\w)/$1$2/g;#I can't remember why I did this $condition=~s/(\$i(\d{3}))(\d)/\(\$f$2->indicator\($3\)\)/g; my $booltagrule=0; my $boolsubtagrule=0; foreach my $tag (sort {$a cmp $b} keys(%tag_list)) { my %tag_listtag = map { $_, 1 } @{$tag_list{$tag}}; $boolsubtagrule=0; my @tag_listtagunique = keys %tag_listtag; $globalconditionstart.='my $f'.$tag.';'; foreach my $subtag (@tag_listtagunique) { my $matchdelaration='my \$f'.$tag.$subtag.';'; $globalconditionstart.='my $f'.$tag.$subtag.';' if $globalconditionstart!~$matchdelaration; } if ( defined $record->field($tag) ) { $booltagrule=1; $globalconditionint.="\n".'for $f'.$tag.' ( $record->field("'.$tag.'") ) {'."\n".'$currentfield=\$f'.$tag.';'."\n"; foreach my $subtag (@tag_listtagunique) { $boolsubtagrule=1; if ($subtag ne "tempvalueforcurrentfield" and $tag >= "010") { $globalconditionint.='for $f'.$tag.$subtag.' ( $f'.$tag.'->subfield("'.$subtag.'"), my $tmpintesta=1 ) { my $tmpintestb=0; if ($tmpintesta==1) { $tmpintesta=undef;$tmpintestb=1; }'."\n"; $globalconditionint.='if ('.$condition.') {$boolcond=1;$boolcondint=1; eval{'.$actionsin.'}}else{$boolcondint=0 unless (!defined($tmpintesta) and $tmpintestb==0 );}'."\n"; $globalconditionend.='}'."\n"; } elsif ($subtag ne "tempvalueforcurrentfield") { $globalconditionint.='$f'.$tag.$subtag.' = $f'.$tag.'->data(); '."\n"; $globalconditionint.='if ('.$condition.') {$boolcond=1;$boolcondint=1; eval{'.$actionsin.'}}else{$boolcondint=0;}'."\n"; } } $globalconditionint.='if ('.$condition.')'."\n".'{$boolcond=1;$boolcondint=1; eval{'.$actionsin.'}}else{$boolcondint=0;}' unless $boolsubtagrule; $globalconditionend.='if ($boolcondint){ eval{'.$actionsinter.'};}}'."\n"; }#else { $globalconditionint.='if ('.$condition.') {$boolcond=1;$boolcondint=1; eval{'.$actionsin.'}}else{$boolcondint=0;}'."\n"; } } $globalconditionint.='if ('.$condition.')'."\n".'{$boolcond=1;$boolcondint=1; eval{'.$actionsin.'}}else{$boolcondint=0;}' unless $booltagrule; $globalconditionend.="\n".' if ($boolcond){eval{'.$actionsout.'}}'."\n".' return $boolcond;}';#if ($boolcond or ('.$condition.')) $globalcondition=$globalconditionstart.$globalconditionint.$globalconditionend; print "\n--------globalcondition----------\n$globalcondition\n---------globalcondition---------\n" if $verbose; return eval($globalcondition); } else { print "\n--------actionsout----------\n$globalconditionstart$actionsout}\n---------actionsout---------\n" if $verbose; eval($globalconditionstart.$actionsout.'}'); return 1; } return 1; } sub ReplaceAllInRecord { my ($pos) = @_; return unless ( $record && $record->fields() ); foreach my $field ( $record->fields() ) { my @subfields; if(!$field->is_control_field()) { if (scalar($field->subfields()) > 0) { foreach my $subfield ( $field->subfields() ) { my $newval=$$subfield[1]; if ($pos eq "before") { #$newval=~s/\$/#_dollarsd_#/g;#to force warn $newval=~s/\$/#_dollars_#/g; $newval=~s/"/#_dbquote_#/g; } elsif ($pos eq "after") { $newval=~s/#_dollars_#/\$/g; $newval=~s/#_dbquote_#/"/g; } push @subfields, ( $$subfield[0], $newval ); } my $newfield = MARC::Field->new( $field->tag(), $field->indicator(1), $field->indicator(2), @subfields ); $field->replace_with($newfield); } } else { my $newval=$field->data(); if ($pos eq "before") { $newval=~s/\$/#_dollars_#/g; $newval=~s/"/#_dbquote_#/g; } elsif ($pos eq "after") { $newval=~s/#_dollars_#/\$/g; $newval=~s/#_dbquote_#/"/g; } $field->update($newval); } } } 1; __END__ =head1 NAME =encoding utf8 MARC::Transform - Perl module to transform a MARC record using a YAML configuration file =head1 VERSION Version 0.003009 =head1 SYNOPSIS B use MARC::Transform; # For this synopsis, we create a small record: my $record = MARC::Record->new(); $record->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo', 'b' => '1', 'c' => 'bar', 'd' => 'bor' ) ); print "--init record--\n". $record->as_formatted ."\n"; # We transform our record with our YAML configuration file # with its absolute path (or relative if called # from the right path ) : $record = MARC::Transform->new ( $record, "/path/conf.yaml" ); # You can also define your YAML into a variable: my $yaml="delete : f501d\n"; # and use it to transform the record: $record = MARC::Transform->new ( $record, $yaml ); print "\n--transformed record--\n". $record->as_formatted ."\n"; B --- condition : $f501a eq "foo" create : f502a : New 502a subfield's value update : $f501b : \&LUT("$this") LUT : 1 : first 2 : second value in this LUT (LookUp Table) --- delete : f501c B (with C<< $record->as_formatted >>): --init record-- LDR 501 _afoo _b1 _cbar _dbor --transformed record-- LDR 501 _afoo _bfirst 502 _aNew 502a subfield's value =head1 DESCRIPTION This is a Perl module to transform a MARC record using a YAML configuration file. It allows you to B , B , B , B fields and subfields of a record. You can also use B and B. You can specify B to execute these actions. All conditions, actions, functions and lookup tables are B. MARC::Transform use MARC::Record. =head1 METHOD =head2 new() $record = MARC::Transform->new($record, "/path/conf.yaml" ); This is the only method you'll use. It takes a MARC::Record object and a YAML path as arguments. You can also define your YAML into a variable and use it to transform the record like this : my $yaml="delete : f501d\n"; $record = MARC::Transform->new ( $record, $yaml ); =head3 Optional hash reference As we will see in more detail below, it is possible to add a hash reference (named $mth into yaml) as the third optional argument. my $record = MARC::Record->new(); my $hashref = {'var' => 'foo'}; my $yaml = 'create : f500a : $$mth{"var"} '; $record = MARC::Transform->new($record,$yaml,$hashref); #the new 500$a subfield's value is "foo" =head3 Verbose mode Each YAML rule (see basis below to understand what is a rule) generates a script that is evaluated, in the record, for each field and subfield specified in the condition (If there is a condition). By adding a fourth optional argument B<1> to the method, it displays the generated script. This can be useful to understand what is happening: $record = MARC::Transform->new($record,"/path/conf.yaml",0,1); =head3 Define YAML configuration file encoding You can force use of a specific encoding to open YAML configuration file by specifying it in the fifth optional argument like this (e.g. for an UTF-8 file) $record = MARC::Transform->new($record,"/path/conf.yaml",0,0,"UTF-8"); or like this (e.g. for an Latin1 file) $record = MARC::Transform->new($record,"/path/conf.yaml",0,0,"Latin1"); =head1 YAML =head2 Basis - B (separated by --- ), each rule is executed one after the other, rules whithout condition will allways be executed: --- condition : $f501a eq "foo" create : f600a : new field value --- delete : f501c --- - B, which allows great flexibility. They must be defined with C condition : ($f501a=~/foo/ and $f503a=~/bar/) or ($f102a eq "bib") # if a 501$a and 503$a contain foo and bar, or if a 102$a = bib - Conditions test records B (only for fields defined in the condition) For example, this means, that if we have more '501' fields in the record, if our condition is C<$f501a eq "foo" and $f501b eq "bar">, that condition will be true only if a '501' field has a 'a' subfield = "foo" AND a 'b' subfield = 'bar' (it will be false if there is a '501' field with a 'a' subfield = "foo" and ANOTHER '501' field with a 'b' subfield = "bar"). - It's possible to run more than one different actions in a single rule: --- condition : $f501a eq "foo" create : f600a : new field value delete : f501c --- - The order in which actions are written does not matter. Actions will always be executed in the following order: =over 4 =item * create =item * duplicatefield =item * forceupdate =item * forceupdatefirst =item * update =item * updatefirst =item * execute =item * delete =back - B (separated by - ) similar to 'if,elsif' or 'switch,case' scripts. If the first sub-rule's condition is false, the following sub-rule's condition is tested. When the sub-rule's condition is true (or if a sub-rule has no condition), the following sub-rules are not read. --- - condition : $f501a eq "foo" create : f502a : value if foo - condition : $f501a eq "bar" create : f502a : value elsif bar - create : f502a : value else --- # It is obvious that if a sub-rule has no condition, it will be # considered as an 'else' (following sub-rules will not be read) - It is not allowed to define more than one similar action into a single (sub-)rule. However, it remains possible to execute a similar action several times in a single rule (refer to the specific syntax of each action in order to see how to do this): . this is B allowed: --- delete : f501b delete : f501c . it works: --- delete : - f501b - f501c =head3 a small script to test your rules - B. You can create a script (e.g. C<< test.pl >>) with the contents below (that you will adapt to test your rules) and run it with C<< perl ./test.pl >> : #!/usr/bin/perl use MARC::Transform; my $record = MARC::Record->new(); $record->leader('optional leader'); $record->insert_fields_ordered( MARC::Field->new('005', 'controlfield_content')); $record->insert_fields_ordered( MARC::Field->new('501', '', '', 'a' => 'foo', 'b' => 'bar') ); print "\n--init record--\n". $record->as_formatted ."\n"; my $yaml='--- condition : $f501a eq "foo" create : f502a : condition is true '; $record = MARC::Transform->new($record,$yaml); print "\n--transformed record--\n". $record->as_formatted ."\n"; =head2 Field's and subfield's naming convention =head3 In actions - Field's and subfield's names are very important: =over 4 =item * They must begin with the letter B followed by the B<3-digit> field name (e.g. f099), followed, for the subfields, by their B (e.g. B). =item * Controlfields names begin with the letter B followed by B<3-digit lower than 010> followed by B (e.g. B). =item * B must begin with the letter B, followed by the B<3-digit> field name followed by the indicator's position (B<1 or 2>) (e.g. B). =item * In actions, you can define B (or an indicator with i1 or i2). Depending on context, it refers to the condition's field (if we define only one field to be tested in the condition), or to the field currently being processed in action: --- condition : $f501a eq "foo" create : b : new 'b' subfield's value in unique condition's field (501) f600 : i1 : 1 a : new subfield (a) in this new 600 field --- =back =head3 In conditions =over 4 =item * In conditions, Field's and subfield's naming convention follow the B, but they must be B (e.g. C<$f110c> for a subfield or C<$i0991> for an indicator). =item * The record leader can be defined with B<$ldr>. =item * It's possible to test only one character's value in subfields or leader. To do this, you have to add the B: #to test the 3rd char. in leader and the 12e char. in '501$a': condition : $ldr2 eq "t" and $f501a11 eq "z" =back =head3 Run actions only on the condition's fields We have already seen that to refers to the condition's field in actions, it is possible to define subfields directly. It works only if we define only one field to be tested in the condition. If we ve'got more than one field in condition, their B to refer them (it works also with a unique field in condition). For example, if you test $f501a value's in condition: - this will delete 'c' subfields only in the '501' field which is true in the condition: condition : $f501a eq "foo" and defined $f501b delete : $f501c - this will delete 'c' subfields in all '501' fields: condition : $f501a eq "foo" and defined $f501b delete : f501c - this will create a new '701' field with a 'c' subfield containing '501$a' subfield's value defined in the condition: condition : defined $f501a create : f701c : $f501a B: To get B the condition's fields, these subfields must be defined in the condition: - it B work: condition : $f501a eq "foo" create : f701a : $f501c - it works (create a new '701' field with a subfield 'a' containing the condition's '501$c' subfield's value ): condition : $f501a eq "foo" and defined $f501c create : f701a : $f501c - this restriction is true only for the subfield's values, but isn't true to specify the fields affected by an action: the example below will create a new 'c' subfield B. condition : $f501a eq "foo" and $f110a == 2 create : $f501c : new subfield value # If there are multiple '501' fields, only the one with a # subfield 'a'='foo' will have a new 'c' subfield created =head2 Actions =head3 create =over 4 =item * As the name suggests, this action allows you to create new fields and subfields. =item * Syntax: # basic: create : : # to create two subfields (in one field) with same name: create : : - - # advanced: create : : : - - : =item * Example: --- condition : $f501a eq "foo" create : b : new subfield's value on the condition's field f502a : this is the subfield's value of a new 502 field f502b : - this is the first 'b' value of another new 502 - this is the 2nd 'b' value of this another new 502 f600 : a : - first 'a' subfield of this new 600 field - second 'a' subfield of this new 600 field b : the 600b value result (with C<< $record->as_formatted >>): --init record-- LDR 501 _afoo _b1 _cbar --transformed record-- LDR 501 _afoo _b1 _cbar _bnew subfield's value on the condition's field 502 _bthis is the first 'b' value of another new 502 _bthis is the 2nd 'b' value of this another new 502 502 _athis is the subfield's value of a new 502 field 600 _afirst 'a' subfield of this new 600 field _asecond 'a' subfield of this new 600 field _bthe 600b value =item * be careful: You need to use lists to create several subfields with the same name in a field: # does not work: create : f502b : value f502b : value =back =head3 update =over 4 =item * This action allows you to update B fields. This action updates all the specified subfields of all specified fields (if the specified field is a condition's field, it will be the only one to be updated) =item * Syntax: # basic: update : : # advanced: update : : : : : : =item * Example: --- condition : $f502a eq "second a" update : b : updated value of all 'b' subfields in the condition field f502c : updated value of all 'c' subfields into all '502' fields f501 : a : updated value of all 'a' subfields into all '501' fields b : $f502a is the 502a condition's field's value result (with C<< $record->as_formatted >>): --init record-- LDR 501 _afoo _b1 _cbar 502 _afirst a _asecond a _bbbb _cccc1 _cccc2 502 _apoto 502 _btruc _cbidule --transformed record-- LDR 501 _aupdated value of all 'a' subfields into all '501' fields _bsecond a is the 502a condition's field's value _cbar 502 _afirst a _asecond a _bupdated value of all 'b' subfields in the condition field _cupdated value of all 'c' subfields into all '502' fields _cupdated value of all 'c' subfields into all '502' fields 502 _apoto 502 _btruc _cupdated value of all 'c' subfields into all '502' fields =back =head3 updatefirst =over 4 =item * This action is B, except that it updates only the B subfield of the specified fields =item * B: except for the action's name, it's the B's syntax =item * Example: --- condition : $f502a eq "second a" updatefirst : b : updated value of first 'b' subfields in the condition's field f502c : updated value of first 'c' subfields into all '502' fields f501 : a : updated value of first 'a' subfields into all '501' fields b : $f502a is the value of 502a conditionnal field result (with C<< $record->as_formatted >>): --init record-- LDR 501 _afoo _b1 _cbar 502 _afirst a _asecond a _bbbb _cccc1 _cccc2 502 _apoto 502 _btruc _cbidule --transformed record-- LDR 501 _aupdated value of first 'a' subfields into all '501' fields _bsecond a is the value of 502a conditionnal field _cbar 502 _afirst a _asecond a _bupdated value of first 'b' subfields in the condition's field _cupdated value of first 'c' subfields into all '502' fields _cccc2 502 _apoto 502 _btruc _cupdated value of first 'c' subfields into all '502' fields =back =head3 forceupdate and forceupdatefirst =over 4 =item * If the specified B: these actions are identical to the B and the updatefirst actions =item * If the specified B: these actions are identical to the B action =item * B: except for the action's name, it's the B's syntax =item * Example: --- condition : $f502a eq "second a" forceupdate : b : 'b' subfield's value in the condition's field f502c : '502c' value's f503 : a : '503a' value's b : $f502a is the 502a condition's value result (with C<< $record->as_formatted >>): --init record-- LDR 501 _afoo _b1 _cbar 502 _btruc _cbidule 502 _apoto 502 _afirst a _asecond a _bbbb _ccc1 _ccc2 --transformed record-- LDR 501 _afoo _b1 _cbar 502 _btruc _c'502c' value's 502 _apoto _c'502c' value's 502 _afirst a _asecond a _b'b' subfield's value in the condition's field _c'502c' value's _c'502c' value's 503 _a'503a' value's _bsecond a is the 502a condition's value --transformed record if we had used forceupdatefirst-- LDR 501 _afoo _b1 _cbar 502 _btruc _c'502c' value's 502 _apoto _c'502c' value's 502 _afirst a _asecond a _b'b' subfield's value in the condition's field _c'502c' value's _ccc2 503 _a'503a' value's _bsecond a is the value of 502a conditionnal field =back =head3 delete =over 4 =item * As the name suggests, this action allows you to delete fields and subfields. =item * Syntax: # basic: delete : # advanced: delete : - - =item * Example: --- condition : $f501a eq "foo" delete : $f501 --- condition : $f501a eq "bar" delete : b --- delete : f502 --- delete : - f503 - f504a result (with C<< $record->as_formatted >>): --init record-- LDR 501 _abar _bbb1 _bbb2 501 _afoo 502 _apata 502 _apoto 503 _apata 504 _aata1 _aata2 _btbbt --transformed record-- LDR 501 _abar 504 _btbbt =back =head3 duplicatefield =over 4 =item * As the name suggests, this action allows you to duplicate entire fields. =item * Syntax: # basic: duplicatefield : > # advanced: duplicatefield : - > - > =item * Example: --- condition : $f008_ eq "controlfield_contentb" duplicatefield : $f008 > f007 --- condition : $f501a eq "bar" duplicatefield : $f501 > f400 --- condition : $f501a eq "foo" duplicatefield : - f501 > f401 - $f501 > f402 - f005 > f006 result (with C<< $record->as_formatted >>): --init record-- LDR 005 controlfield_content2 005 controlfield_content1 008 controlfield_contentb 008 controlfield_contenta 501 _afoo 501 12 _abar _bbb1 _bbb2 --transformed record-- LDR 005 controlfield_content2 005 controlfield_content1 006 controlfield_content1 006 controlfield_content2 007 controlfield_contentb 008 controlfield_contentb 008 controlfield_contenta 400 12 _abar _bbb1 _bbb2 401 12 _abar _bbb1 _bbb2 401 _afoo 402 _afoo 501 _afoo 501 12 _abar _bbb1 _bbb2 =back =head3 execute =over 4 =item * This action allows you to to define Perl code that will be run with C<< eval >> You can run functions written directly in the YAML ( for details on writing perl subs in the YAML, refer to next chapter: Use Perl functions and LookUp Tables ). =item * Syntax: # basic: execute : # advanced: execute : - - =item * Example: --- condition : $f501a eq "bar" execute : - warn("f501a eq $f501a") - warn("barbar") --- - condition : $f501a eq "foo" execute : \&warnfoo("f501a eq $f501a") - subs : > sub warnfoo { my $string = shift;warn $string; } result (in stderr): f501a eq bar at (eval 30) line 6, <$yamls> line 1. barbar at (eval 30) line 7, <$yamls> line 1. f501a eq foo at (eval 33) line 2, <$yamls> line 1. =back =head2 Use Perl functions and LookUp Tables You can use Perl functions (B) and lookup tables (B) to define with greater flexibility values that will be created or updated by the actions: create, forceupdate, forceupdatefirst, update and updatefirst. These functions (and lookup tables) can be B (in this case they can be used only by this rule) B ( after the last ---, can be used in all rules: B and B ). =head3 Variables Four types of variables can be used: =head4 $this, and condition's elements =over 4 =item * variables pointing on the condition's subfield's values are those we have already seen in Chapter 'Run actions only on condition fields' (e.g. B<$f110c>) =item * B<$this>: this is the variable to use to pointing to the B. $this can also be used outside a sub or a LUT. Example (N.B.: sub 'fromo2e' converts 'o' to 'e'): --- - condition : $f501a eq "foo" create : c : \&fromo2e("$f501a") update : d : this 501d value's is $this b : \&fromo2e("$this") - subs: > sub fromo2e { my $string=shift; $string =~ s/o/e/g; $string; } result (with C<< $record->as_formatted >>): --init record-- LDR 501 _afoo _bboo _ddoo --transformed record-- LDR 501 _afoo _bbee _d this 501d value's is doo _cfee =back =head4 $mth B<$mth> is the optional hashref add as third optional argument. It can be used in writing (into subs and global_subs) and reading. This allows interaction with the script that calls MARC::Transform. =over 4 =item * Syntaxe: B<$$mth{foo}> =item * Example in a perl script : my $record = MARC::Record->new(); $record->leader('optional leader'); print "--init record--\n". $record->as_formatted; my %mth; $mth{"inc"}=1; $mth{"var"}="a string"; my $yaml = ' --- condition : $$mth{"var"} eq "a string" forceupdate : f500a : $$mth{"var"} --- - execute : \&testa() - subs: > sub testa { $$mth{"inc"}++; } --- forceupdate : f600a : \&testb() --- global_subs: > sub testb { $$mth{"inc"}++;$$mth{"inc"}; } '; $record = MARC::Transform->new($record,$yaml,\%mth); print "\n--transformed record-- ".$mth{"inc"}." : \n". $record->as_formatted ."\n"; result : --init record-- LDR optional leader --transformed record-- 3 : LDR optional leader 500 _aa string 600 _a3 =back =head4 $record B<$record> is the current MARC::Record object. =head3 subs =head4 Internal rules =over 4 =item * Syntax: #full rule: --- - - subs: > --- # method invocation syntax: \&("") =item * Example: --- - condition : $f501a eq "foo" and defined $f501d update : b : \&convertbaddate("$this") c : \&trim("$f501d") - subs: > sub convertbaddate { #this function convert date like "21/2/98" to "1998-02-28" my $in = shift; if ($in =~/^(\d{1,2})\/(\d{1,2})\/(\d{2}).*/) { my $day=$1; my $month=$2; my $year=$3; if ($day=~m/^\d$/) {$day="0".$day;} if ($month=~m/^\d$/) {$month="0".$month;} if (int($year)>12) {$year="19".$year;} else {$year="20".$year;} return "$year-$month-$day"; } else { return $in; } } sub trim { # This function removes ",00" at the end of a string my $in = shift; $in=~s/,00$//; return $in; } result (with C<< $record->as_formatted >>): --init record-- LDR 501 _afoo _b8/12/10 _cboo _d40,00 --transformed record-- LDR 501 _afoo _b2010-12-08 _c40 _d40,00 =back =head4 global_subs =over 4 =item * Syntax: --- global_subs: > # method invocation syntax: \&("") =item * Example: --- condition : $f501a eq "foo" update : b : \&return_record_encoding() c : \&trim("$this") --- global_subs: > sub return_record_encoding { $record->encoding(); } sub trim { # This function removes ",00" at the end of a string my $in = shift; $in=~s/,00$//; return $in; } result (with C<< $record->as_formatted >> ): --init record-- LDR 501 _afoo _bbar _c40,00 --transformed record-- LDR 501 _afoo _bMARC-8 _c40 =back =head3 LUT If a value has no match in a LookUp Table, it isn't modified. (unless you have defined a default value with C<< _default_value_ >> ). If you want to use more than one LookUp Table in a rule, you must use a global_LUT because it differentiates tables with titles. =head4 Internal rules =over 4 =item * Syntax: #full rule: --- - - LUT : : : _default_value_ : optional default value --- # LUT invocation syntax: \&LUT("") =item * Example: --- - condition : $f501b eq "bar" create : f604a : \&LUT("$f501b") update : c : \&LUT("$this") - LUT : 1 : first 2 : second bar : openbar result (with C<< $record->as_formatted >> ): --init record-- LDR 501 _bbar _c1 --transformed record-- LDR 501 _bbar _cfirst 604 _aopenbar =back =head4 global_LUT =over 4 =item * Syntax: --- global_LUT: : : : _default_value_ : valeur par défaut optionnelle : : : # global_LUT invocation syntax: \&LUT("","") =item * Example: --- update : f501a : \&LUT("$this","numbers") f501b : \&LUT("$this","cities") f501c : \&LUT("$this","cities") --- global_LUT: cities: NY : New York SF : San Fransisco TK : Tokyo _default_value_ : unknown city numbers: 1 : one 2 : two result (with C<< $record->as_formatted >> ): --init record-- LDR 501 _a1 _a3 _bfoo _cSF --transformed record-- LDR 501 _aone _a3 _bunknown city _cSan Fransisco =back =head4 $$mth{"_defaultLUT_to_mth_"} =over 4 =item * Bif you call MARC::Transform with the third parameter, the module filled its key named C<< _defaultLUT_to_mth_ >> in case you want to keep, in the calling script, track of the values and types (named C<< lookuptableforthis >> for non-global's LUT) unmatched. C<< $$mth{"_defaultLUT_to_mth_"} >> is cleared each time MARC::Transform->new is called. =item * If we recall the above example with : my %mth; $record = MARC::Transform->new($record,$yaml,\%mth); print $mth{"_defaultLUT_to_mth_"}->{"cities"}[0]; print "\n".Data::Dumper::Dumper $mth{"_defaultLUT_to_mth_"}; will return in stdout : foo $VAR1 = { 'numbers' => [ '3' ], 'cities' => [ 'foo' ] }; try this if you want to get the content of $mth{"_defaultLUT_to_mth_"} instead of the line containing Data::Dumper::Dumper : foreach my $k (keys(%{$mth{"_defaultLUT_to_mth_"}})) { foreach my $value(@{$mth{"_defaultLUT_to_mth_"}->{"$k"}}) { print "$k : $value \n"; } } =back =head1 Latest tips and a big YAML example's =over 4 =item * If your script return an error like "YAML Error: Stream does not end with newline character", it's easy to fix. If you define your YAML into a variable, it must end with a new blank line. If you give a path to your YAML file, it is probably not good : try with an absolut path. =item * Restriction: the specific case of double-quotes (") and dollar signs ($): In YAML, these characters are interpreted differently. To use them in string context, you will need to replace them in YAML by C<#_dbquote_#> (for ") and C<#_dollars_#> (for $): . Example: --- condition : $f501a eq "I want #_dbquote_##_dollars_##_dbquote_#" create : f604a : "#_dbquote_#$f501a#_dbquote_# contain a #_dollars_# sign" . result (with C<< $record->as_formatted >> ): --init record-- LDR 501 _aI want "$" --transformed record-- LDR 501 _aI want "$" 604 _a"I want "$"" contain a $ sign =item * Restriction: You can test if a field or subfield exists, but it is inadvisable to test its absence. =item * Example: feel free to copy the examples in this documentation. Be aware that I have added four space characters at the beginning of each example's line to make them better displayed by the POD interpreter. If you copy / paste them into your YAML configuration file, Be sure to remove the first four characters of each line (e.g. with vim, C<:%s/^\s\s\s\s//g> ). =item * This yaml was called like this: C<< my %mth; $mth{"var"}="a string"; $record = MARC::Transform->new($record,$yaml,\%mth); >> --- condition : $f501a eq "foo" create : f502a : this is the value of a subfield of a new 502 field --- condition : $f401a=~/foo/ create : b : new value of the 401 condition's field f600 : a : - first a subfield of this new 600 field - second a subfield of this new 600 field - $$mth{"var"} b : the 600b value execute : \&reencodeRecordtoUtf8() --- - condition : $f501a =~/foo/ and $f503a =~/bar/ forceupdate : $f503b : mandatory b in condition's field f005_ : mandatory 005 f006_ : \&return_record_encoding() f700 : a : the a subfield of this mandatory 700 field b : \&sub1("$f503a") forceupdatefirst : $f501b : update only the first b in condition's field 501 - condition : $f501a =~/foo/ execute : \&warnfoo("f501a contain foo") - subs : > sub return_record_encoding { $record->encoding(); } sub sub1 {my $string=shift;$string =~ s/a/e/g;return $string;} sub warnfoo { my $string = shift;warn $string; } --- - condition : $f501b2 eq "o" update : c : updated value of all c in condition's field f504a : updated value of all 504a if exists f604 : b : \&LUT("$this") c : \&LUT("NY","cities") updatefirst : f604a : update only the first a in 604 - condition : $f501c eq "1" delete : $f501 - LUT : 1 : first 2 : second bar : openbar --- delete : - f401a - f005 --- condition : $ldr2 eq "t" execute : \&SetRecordToLowerCase($record) --- condition : $f008_ eq "controlfield_content8b" duplicatefield : - $f008 > f007 - f402 > f602 delete : f402 --- global_subs: > sub reencodeRecordtoUtf8 { $record->encoding( 'UTF-8' ); } sub warnfee { my $string = shift;warn $string; } global_LUT: cities: NY : New York SF : San Fransisco numbers: 1 : one 2 : two result (with C<< $record->as_formatted >> ) : --init record-- LDR optional leader 005 controlfield_content 008 controlfield_content8a 008 controlfield_content8b 106 _aVaLuE 401 _aafooa 402 2 _aa402a2 402 1 _aa402a1 501 _c1 501 _afoo _afoao _b1 _bbaoar _cbig 503 _afee _ababar 504 _azut _asisi 604 _afoo _afoo _bbar _ctruc --transformed record-- LDR optional leader 006 UTF-8 007 controlfield_content8b 008 controlfield_content8a 008 controlfield_content8b 106 _aVaLuE 401 _bnew value of the 401 condition's field 501 _c1 501 _afoo _afoao _bupdate only the first b in condition's field 501 _bbaoar _cupdated value of all c in condition's field 502 _athis is the value of a subfield of a new 502 field 503 _afee _ababar _bmandatory b in condition's field 504 _aupdated value of all 504a if exists _aupdated value of all 504a if exists 600 _aa string _afirst a subfield of this new 600 field _asecond a subfield of this new 600 field _bthe 600b value 602 1 _aa402a1 602 2 _aa402a2 604 _aupdate only the first a in 604 _afoo _bopenbar _cNew York 700 _athe a subfield of this mandatory 700 field _bbeber =back =head1 SEE ALSO =over 4 =item * MARC::Record (L) =item * MARC::Field (L) =item * MARC::Loader (L) =item * YAML (L) =item * Library Of Congress MARC pages (L) The definitive source for all things MARC. =back =head1 AUTHOR Stephane Delaune, (delaune.stephane at gmail.com) =head1 COPYRIGHT Copyright 2011-2020 Stephane Delaune for Biblibre.com, all rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 ===========> DOCUMENTATION FRANCAISE =head1 - NOM =encoding utf8 MARC::Transform - Module Perl pour transformer une notice MARC en utilisant un fichier de configuration YAML =head1 - VERSION Version 0.003009 =head1 - SYNOPSIS B use MARC::Transform; # Pour ce synopsis, nous créons une petite notice: my $record = MARC::Record->new(); $record->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo', 'b' => '1', 'c' => 'bar', 'd' => 'bor' ) ); print "--notice d'origine--\n". $record->as_formatted ."\n"; # Nous transformons notre notice avec notre fichier de # configuration YAML avec son chemin absolu ( ou # relatif si il est appelé depuis le bon endroit) : $record = MARC::Transform->new ( $record, "/path/conf.yaml" ); # Vous pouvez aussi écrire votre YAML dans une variable: my $yaml="delete : f501d\n"; # et l'utiliser pour transformer la notice: $record = MARC::Transform->new ( $record, $yaml ); print "\n--notice transformée--\n". $record->as_formatted ."\n"; B --- condition : $f501a eq "foo" create : f502a : New 502a subfield's value update : $f501b : \&LUT("$this") LUT : 1 : first 2 : second value in this LUT (LookUp Table) --- delete : f501c B (avec C<< $record->as_formatted >>): --notice d'origine-- LDR 501 _afoo _b1 _cbar _dbor --notice transformée-- LDR 501 _afoo _bfirst 502 _aNew 502a subfield's value =head1 - DESCRIPTION C'est un module Perl pour transformer une notice MARC en utilisant un fichier de configuration YAML. Il permet de B , B , B , B les champs et les sous-champs d'une notice. Vous pouvez aussi utiliser des B et des B. Vous pouvez préciser des B pour executer ces actions. Toutes les conditions, actions, fonctions et tables de correspondance sont B. MARC::Transform utilise MARC::Record. =head1 - METHODE =head2 - new() $record = MARC::Transform->new($record, "/path/conf.yaml" ); C'est la seule méthode que vous utiliserez. Elle prend un objet MARC::Record et le chemin vers un YAML comme arguments. Vous pouvez aussi écrire votre YAML dans une variable et l'utiliser pour transformer la notice comme ceci : my $yaml="delete : f501d\n"; $record = MARC::Transform->new ( $record, $yaml ); =head3 - Référence à un hash optionnel Comme nous allons le voir plus en détail plus bas, il est possible d'ajouter comme troisième argument une référence à un hash (nommé $mth dans le yaml). my $record = MARC::Record->new(); my $hashref = {'var' => 'foo'}; my $yaml = 'create : f500a : $$mth{"var"} '; $record = MARC::Transform->new($record,$yaml,$hashref); #la valeur du nouveau sous-champ 500$a est "foo" =head3 - Mode verbeux Chaque règle du YAML (voir les bases plus bas pour comprendre ce qu'est une règle) génère un script qui est évalué, dans la notice, pour chaque champ et sous-champ spécifié dans la condition (si il y a une condition). En ajoutant un quatrième argument optionnel B<1> à la méthode, elle affiche le script généré. Cela peut être utile pour comprendre ce qu'il se passe: $record = MARC::Transform->new($record,"/path/conf.yaml",0,1); =head3 - Définir l'encodage du fichier de configuration YAML Vous pouvez forcer l'ouverture du fichier de configuration YAML dans un encodage spécifique en le précisant dans le cinquième argument facultatif comme ceci (pour un fichier UTF-8) $record = MARC::Transform->new($record,"/path/conf.yaml",0,0,"UTF-8"); ou comme ceci (pour un fichier Latin1) $record = MARC::Transform->new($record,"/path/conf.yaml",0,0,"Latin1"); =head1 - YAML =head2 - Bases - B (séparées par --- ), chaque règle est exécutée l'une après l'autre, les règles sans condition sont toujours exécutées: --- condition : $f501a eq "foo" create : f600a : new field value --- delete : f501c --- - B, ce qui permet une grande flexibilité. Elles doivent être définies avec C condition : ($f501a=~/foo/ and $f503a=~/bar/) or ($f102a eq "bib") # si un 501$a et un 503$a contiennent foo et bar, ou si un 102$a = bib - Les conditions testent les notices B (uniquement sur les champs définis dans la condition) Cela signifie, par exemple, que si nous avons plusieurs champs '501' dans la notice, si notre condition est C<$f501a eq "foo" and $f501b eq "bar">, cette condition sera vrai uniquement si un champ '501' a un sous-champ 'a' = "foo" ET un sous-champ 'b' = 'bar' (elle sera fausse si il y a un champ '501' avec un sous-champ 'a' = "foo" et UN AUTRE champ '501' avec un sous-champ 'b' = "bar"). - Il est possible de lancer plusieurs actions différentes dans une seule règle: --- condition : $f501a eq "foo" create : f600a : new field value delete : f501c --- - L'ordre dans lequel les actions sont écrites n'a pas d'importance. Les actions seront toujours exécutée dans l'ordre suivant: =over 4 =item * create =item * duplicatefield =item * forceupdate =item * forceupdatefirst =item * update =item * updatefirst =item * execute =item * delete =back - B (séparées par - ) similaires à un 'if,elsif' ou un script 'switch,case'. Si la condition de la première sous-règle est fausse, la condition de la sous-règle suivante est testée. Lorsque la condition d'une sous-règle est vraie (ou si un sous-règle n'a pas de condition), les sous-règles suivantes ne sont pas lues. --- - condition : $f501a eq "foo" create : f502a : value if foo - condition : $f501a eq "bar" create : f502a : value elsif bar - create : f502a : value else --- # Si une sous-règle n'a pas de condition, elle sera considérée # comme un 'else' (les sous-règles suivantes ne seront pas lues) - Il n'est pas permis de définir plus d'une action similaire dans une seule (sous-)règle. Cependant, il reste possible d'exécuter une action similaire plusieurs fois dans une seule règle (se référer à la syntaxe spécifique à chaque action pour voir comment faire cela): . Cela n'est B permis: --- delete : f501b delete : f501c . cela fonctionne: --- delete : - f501b - f501c =head3 - un petit script pour tester vos règles - B. Vous pouvez créer un script (par exemple C<< test.pl >>) avec le contenu ci-dessous (que vous adapterez pour tester vos règles) et le lancer avec C<< perl ./test.pl >> : #!/usr/bin/perl use MARC::Transform; my $record = MARC::Record->new(); $record->leader('optional leader'); $record->insert_fields_ordered( MARC::Field->new('005', 'controlfield_content')); $record->insert_fields_ordered( MARC::Field->new('501', '', '', 'a' => 'foo', 'b' => 'bar') ); print "\n--init record--\n". $record->as_formatted ."\n"; my $yaml='--- condition : $f501a eq "foo" create : f502a : condition is true '; $record = MARC::Transform->new($record,$yaml); print "\n--transformed record--\n". $record->as_formatted ."\n"; =head2 - Convention de nommage des champs et des sous-champs =head3 - Dans les actions - Les noms des champs et des sous-champs sont très importants: =over 4 =item * Ils doivent commencer par la lettre B suivi des B<3 chiffres> du nom du champ (par exemple f099), suivi, pour les sous-champs, par leur B (par exemple B). =item * Les noms des champs de contrôle commencent par la lettre B suivi par B<3 chiffres inférieur à 010> suivi par B (par exemple B). =item * B doivent commencer par la lettre B, suivi des B<3 chiffres> du nom du champ suivi par la position de l'indicateur(B<1 or 2>) (par exemple B). =item * Dans les actions, vous pouvez définir B (ou un indicateur avec i1 ou i2). Selon le contexte, il se réfère au champ de la condition (si nous n'avons défini qu'un seul champ à tester dans la condition), ou au champ en cours de traitement dans l'action: --- condition : $f501a eq "foo" create : b : new 'b' subfield's value in unique condition's field (501) f600 : i1 : 1 a : new subfield (a) in this new 600 field --- =back =head3 - Dans les conditions =over 4 =item * Dans les conditions la convention de nommage des champs et des sous-champs suit les B, mais ils doivent être B (par exemple C<$f110c> pour un sous-champ ou C<$i0991> pour un indicateur). =item * Le leader de la notice peut être défini avec B<$ldr>. =item * Il est possible de tester la valeur d'un seul caractère dans les sous-champs ou le leader. Pour faire cela, vous devez ajouter la B: #pour tester le 3e caractère du leader et le 12e dans le 501$a: condition : $ldr2 eq "t" and $f501a11 eq "z" =back =head3 - Lancer des actions uniquement sur les champs de la condition Nous avons déjà vu que pour se référer au champ de la condition dans les actions, il est possible de définir les sous-champs directement. Cela fonctionne uniquement si nous avons définis seulement un champ à tester dans la condition. Si nous avons plus d'un champ dans la condition, pour s'y référer, leurs B (cela fonctionne également avec un champ unique dans la condition). Par exemple, si vous testez la valeur du $f501a dans la condition: - cela va supprimer les sous-champs 'c' uniquement dans le champ '501' qui est vrai dans la condition: condition : $f501a eq "foo" and defined $f501b delete : $f501c - cela va supprimer les sous-champs 'c' dans tous les champs '501': condition : $f501a eq "foo" and defined $f501b delete : f501c - cela va créer un nouveau champ '701' avec un sous-champ 'c' contenant la valeur du sous-champ 501$a défini dans la condition: condition : defined $f501a create : f701c : $f501a B: Pour avoir B des sous-champs des champs de la condition, ces sous-champs doivent être définis dans la condition: - cela ne fonctionne B: condition : $f501a eq "foo" create : f701a : $f501c - cela fonctionne (crée un nouveau champ '701' avec un sous-champ 'a' contenant la valeur du sous-champ 501$c de la condition): condition : $f501a eq "foo" and defined $f501c create : f701a : $f501c - Cette restriction est vrai uniquement pour les valeurs des sous-champs mais pas pour spécifier les champs affectés par une action : l'exemple ci-dessous va créer un nouveau sous-champ 'c' B. condition : $f501a eq "foo" and $f110a == 2 create : $f501c : new subfield value # Si il y a de multiples champs '501', seuls ceux ayant un # sous-champ 'a'='foo' auront un nouveau sous-champ 'c' créé =head2 - Actions =head3 - create =over 4 =item * Comme son nom l'indique, cette action vous permet de créer de nouveaux champs et sous-champs. =item * Syntaxe: # basique: create : : # pour créer deux sous-champs (dans un champ) avec le même nom: create : : - - # avancée: create : : : - - : =item * Exemple: --- condition : $f501a eq "foo" create : b : new subfield's value on the condition's field f502a : this is the subfield's value of a new 502 field f502b : - this is the first 'b' value of another new 502 - this is the 2nd 'b' value of this another new 502 f600 : a : - first 'a' subfield of this new 600 field - second 'a' subfield of this new 600 field b : the 600b value résultat (avec C<< $record->as_formatted >>): --notice d'origine-- LDR 501 _afoo _b1 _cbar --notice transformée-- LDR 501 _afoo _b1 _cbar _bnew subfield's value on the condition's field 502 _bthis is the first 'b' value of another new 502 _bthis is the 2nd 'b' value of this another new 502 502 _athis is the subfield's value of a new 502 field 600 _afirst 'a' subfield of this new 600 field _asecond 'a' subfield of this new 600 field _bthe 600b value =item * faites attention: vous devez utilisez des listes pour créer plusieurs sous-champs avec le même nom dans un champ: # ne fonctionne pas: create : f502b : value f502b : value =back =head3 - update =over 4 =item * Cette action vous permet de mettre à jour les champs B. Cette action met à jour tous les sous-champs spécifiés de tous les champs spécifiés (si le champ spécifié est un champ de la condition, il sera le seul à être mis à jour ) =item * Syntaxe: # basique: update : : # avancée: update : : : : : : =item * Exemple: --- condition : $f502a eq "second a" update : b : updated value of all 'b' subfields in the condition field f502c : updated value of all 'c' subfields into all '502' fields f501 : a : updated value of all 'a' subfields into all '501' fields b : $f502a is the 502a condition's field's value résultat (avec C<< $record->as_formatted >>): --notice d'origine-- LDR 501 _afoo _b1 _cbar 502 _afirst a _asecond a _bbbb _cccc1 _cccc2 502 _apoto 502 _btruc _cbidule --notice transformée-- LDR 501 _aupdated value of all 'a' subfields into all '501' fields _bsecond a is the 502a condition's field's value _cbar 502 _afirst a _asecond a _bupdated value of all 'b' subfields in the condition field _cupdated value of all 'c' subfields into all '502' fields _cupdated value of all 'c' subfields into all '502' fields 502 _apoto 502 _btruc _cupdated value of all 'c' subfields into all '502' fields =back =head3 - updatefirst =over 4 =item * Cette action est B, excepté qu'elle met à jour seulement le B sous-champ des champs spécifiés =item * B: excepté pour le nom de l'action, c'est la B =item * Exemple: --- condition : $f502a eq "second a" updatefirst : b : updated value of first 'b' subfields in the condition's field f502c : updated value of first 'c' subfields into all '502' fields f501 : a : updated value of first 'a' subfields into all '501' fields b : $f502a is the value of 502a conditionnal field résultat (avec C<< $record->as_formatted >>): --notice d'origine-- LDR 501 _afoo _b1 _cbar 502 _afirst a _asecond a _bbbb _cccc1 _cccc2 502 _apoto 502 _btruc _cbidule --notice transformée-- LDR 501 _aupdated value of first 'a' subfields into all '501' fields _bsecond a is the value of 502a conditionnal field _cbar 502 _afirst a _asecond a _bupdated value of first 'b' subfields in the condition's field _cupdated value of first 'c' subfields into all '502' fields _cccc2 502 _apoto 502 _btruc _cupdated value of first 'c' subfields into all '502' fields =back =head3 - forceupdate et forceupdatefirst =over 4 =item * Si le B: ces actions sont identiques aux actions B et updatefirst =item * Si le B: ces actions sont identiques à l'action B =item * B: excepté pour le nom de l'action, c'est la B =item * Exemple: --- condition : $f502a eq "second a" forceupdate : b : 'b' subfield's value in the condition's field f502c : '502c' value's f503 : a : '503a' value's b : $f502a is the 502a condition's value résultat (avec C<< $record->as_formatted >>): --notice d'origine-- LDR 501 _afoo _b1 _cbar 502 _btruc _cbidule 502 _apoto 502 _afirst a _asecond a _bbbb _ccc1 _ccc2 --notice transformée-- LDR 501 _afoo _b1 _cbar 502 _btruc _c'502c' value's 502 _apoto _c'502c' value's 502 _afirst a _asecond a _b'b' subfield's value in the condition's field _c'502c' value's _c'502c' value's 503 _a'503a' value's _bsecond a is the 502a condition's value --notice transformée si nous avions utilisé forceupdatefirst-- LDR 501 _afoo _b1 _cbar 502 _btruc _c'502c' value's 502 _apoto _c'502c' value's 502 _afirst a _asecond a _b'b' subfield's value in the condition's field _c'502c' value's _ccc2 503 _a'503a' value's _bsecond a is the value of 502a conditionnal field =back =head3 - delete =over 4 =item * Comme son nom l'indique, cette action vous permet de supprimer des champs et sous-champs. =item * Syntaxe: # basique: delete : # avancée: delete : - - =item * Exemple: --- condition : $f501a eq "foo" delete : $f501 --- condition : $f501a eq "bar" delete : b --- delete : f502 --- delete : - f503 - f504a résultat (avec C<< $record->as_formatted >>): --notice d'origine-- LDR 501 _abar _bbb1 _bbb2 501 _afoo 502 _apata 502 _apoto 503 _apata 504 _aata1 _aata2 _btbbt --notice transformée-- LDR 501 _abar 504 _btbbt =back =head3 - duplicatefield =over 4 =item * Comme son nom l'indique, cette action vous permet de dupliquer des champs entiers. =item * Syntaxe: # basique: duplicatefield : > # avancée: duplicatefield : - > - > =item * Exemple: --- condition : $f008_ eq "controlfield_contentb" duplicatefield : $f008 > f007 --- condition : $f501a eq "bar" duplicatefield : $f501 > f400 --- condition : $f501a eq "foo" duplicatefield : - f501 > f401 - $f501 > f402 - f005 > f006 résultat (avec C<< $record->as_formatted >>): --notice d'origine-- LDR 005 controlfield_content2 005 controlfield_content1 008 controlfield_contentb 008 controlfield_contenta 501 _afoo 501 12 _abar _bbb1 _bbb2 --notice transformée-- LDR 005 controlfield_content2 005 controlfield_content1 006 controlfield_content1 006 controlfield_content2 007 controlfield_contentb 008 controlfield_contentb 008 controlfield_contenta 400 12 _abar _bbb1 _bbb2 401 12 _abar _bbb1 _bbb2 401 _afoo 402 _afoo 501 _afoo 501 12 _abar _bbb1 _bbb2 =back =head3 - execute =over 4 =item * Cette action vous permet de définir du code Perl qui sera exécuté avec C<< eval >> Vous pouvez executer des fonctions écrites directement dans le YAML ( pour des détails sur l'écriture de subs perl dans le YAML, référez vous au chapitre suivant: Utiliser des fonctions Perl et des tables des correspondance) =item * Syntaxe: # basique: execute : # avancée: execute : - - =item * Exemple: --- condition : $f501a eq "bar" execute : - warn("f501a eq $f501a") - warn("barbar") --- - condition : $f501a eq "foo" execute : \&warnfoo("f501a eq $f501a") - subs : > sub warnfoo { my $string = shift;warn $string; } résultat (dans stderr): f501a eq bar at (eval 30) line 6, <$yamls> line 1. barbar at (eval 30) line 7, <$yamls> line 1. f501a eq foo at (eval 33) line 2, <$yamls> line 1. =back =head2 - Utiliser des fonctions Perl et des tables des correspondance Vous pouvez utiliser des fonctions Perl (B) et des tables de correspondance (B pour LookUp Tables) pour définir avec une plus grande flexibilité les valeurs qui vont être créées ou mises à jour avec les actions: create, forceupdate, forceupdatefirst, update and updatefirst. Ces fonctions (et tables des correspondance) peuvent être B<écrites dans une règle> (dans ce cas elles ne peuvent être utilisée que par cette règle) B ( après le dernier ---, elles peuvent alors être utilisées dans toutes les règles: B et B ). =head3 - Variables Quatre types de variables peuvent être utilisés: =head4 - $this, et les éléments de la condition =over 4 =item * les variables pointant sur la valeur des sous-champs de la condition sont celles que nous avons déjà vu dans le chapitre 'Lancer des actions uniquement sur les champs de la condition' (par exemple B<$f110c>) =item * B<$this>: c'est la variable à utiliser pour pointer sur la B. $this peut aussi être utilisée dans une sub ou une LUT. Exemple (N.B.: la sub 'fromo2e' convertit les 'o' en 'e'): --- - condition : $f501a eq "foo" create : c : \&fromo2e("$f501a") update : d : this 501d value's is $this b : \&fromo2e("$this") - subs: > sub fromo2e { my $string=shift; $string =~ s/o/e/g; $string; } résultat (avec C<< $record->as_formatted >>): --notice d'origine-- LDR 501 _afoo _bboo _ddoo --notice transformée-- LDR 501 _afoo _bbee _d this 501d value's is doo _cfee =back =head4 - $mth B<$mth> est l'éventuel hashref passé comme troisième argument. Il est utilisable en écriture (dans les subs et les global_subs) et en lecture. Cela permet d'intéragir avec le script qui appelle MARC::Transform. =over 4 =item * Syntaxe: B<$$mth{foo}> =item * Exemple dans un script perl : my $record = MARC::Record->new(); $record->leader('optional leader'); print "--init record--\n". $record->as_formatted; my %mth; $mth{"inc"}=1; $mth{"var"}="a string"; my $yaml = ' --- condition : $$mth{"var"} eq "a string" forceupdate : f500a : $$mth{"var"} --- - execute : \&testa() - subs: > sub testa { $$mth{"inc"}++; } --- forceupdate : f600a : \&testb() --- global_subs: > sub testb { $$mth{"inc"}++;$$mth{"inc"}; } '; $record = MARC::Transform->new($record,$yaml,\%mth); print "\n--transformed record-- ".$mth{"inc"}." : \n". $record->as_formatted ."\n"; résultat : --init record-- LDR optional leader --transformed record-- 3 : LDR optional leader 500 _aa string 600 _a3 =back =head4 - $record B<$record> est l'objet MARC::Record en cours de traitement. =head3 - subs =head4 - A l'intérieur des règles =over 4 =item * Syntaxe: #règle entière: --- - - subs: > --- # syntaxe d'invocation de la méthode: \&("") =item * Exemple: --- - condition : $f501a eq "foo" and defined $f501d update : b : \&convertbaddate("$this") c : \&trim("$f501d") - subs: > sub convertbaddate { #convertit les dates du type "21/2/98" en "1998-02-28" my $in = shift; if ($in =~/^(\d{1,2})\/(\d{1,2})\/(\d{2}).*/) { my $day=$1; my $month=$2; my $year=$3; if ($day=~m/^\d$/) {$day="0".$day;} if ($month=~m/^\d$/) {$month="0".$month;} if (int($year)>12) {$year="19".$year;} else {$year="20".$year;} return "$year-$month-$day"; } else { return $in; } } sub trim { # Cette fonction enlève ",00" à la fin d'une chaîne my $in = shift; $in=~s/,00$//; return $in; } résultat (avec C<< $record->as_formatted >>): --notice d'origine-- LDR 501 _afoo _b8/12/10 _cboo _d40,00 --notice transformée-- LDR 501 _afoo _b2010-12-08 _c40 _d40,00 =back =head4 - global_subs =over 4 =item * Syntaxe: --- global_subs: > # syntaxe d'invocation de la méthode \&("") =item * Exemple: --- condition : $f501a eq "foo" update : b : \&return_record_encoding() c : \&trim("$this") --- global_subs: > sub return_record_encoding { $record->encoding(); } sub trim { # Cette fonction enlève ",00" à la fin d'une chaîne my $in = shift; $in=~s/,00$//; return $in; } résultat (avec C<< $record->as_formatted >> ): --notice d'origine-- LDR 501 _afoo _bbar _c40,00 --notice transformée-- LDR 501 _afoo _bMARC-8 _c40 =back =head3 - LUT Si une valeur n'a pas de correspondance dans une table de correspondance, elle n'est pas modifiée (à moins que vous n'ayez définit une valeur par défaut avec C<< _default_value_ >> ). Si vous voulez utiliser plus d'une table de correspondance dans une règle, vous devez utiliser une global_LUT car elle différencie les tables avec des titres. =head4 - A l'intérieur des règles =over 4 =item * Syntaxe: #règle entière: --- - - LUT : : : _default_value_ : valeur par défaut optionnelle --- # syntaxe d'invocation de la LUT: \&LUT("") =item * Exemple: --- - condition : $f501b eq "bar" create : f604a : \&LUT("$f501b") update : c : \&LUT("$this") - LUT : 1 : first 2 : second bar : openbar résultat (avec C<< $record->as_formatted >> ): --notice d'origine-- LDR 501 _bbar _c1 --notice transformée-- LDR 501 _bbar _cfirst 604 _aopenbar =back =head4 - global_LUT =over 4 =item * Syntaxe: --- global_LUT: : : : _default_value_ : valeur par défaut optionnelle : : : # syntaxe d'invocation de la global_LUT: \&LUT("","") =item * Exemple: --- update : f501a : \&LUT("$this","numbers") f501b : \&LUT("$this","cities") f501c : \&LUT("$this","cities") --- global_LUT: cities: NY : New York SF : San Fransisco TK : Tokyo _default_value_ : unknown city numbers: 1 : one 2 : two résultat (avec C<< $record->as_formatted >> ): --notice d'origine-- LDR 501 _a1 _a3 _bfoo _cSF --notice transformée-- LDR 501 _aone _a3 _bunknown city _cSan Fransisco =back =head4 - $$mth{"_defaultLUT_to_mth_"} =over 4 =item * Bsi vous appelez MARC::Transform avec le troisième paramètre, le module en rempli la clé nommée C<< _defaultLUT_to_mth_ >> au cas où vous souhaiteriez conserver, dans le script d'appel, une trace des valeurs et types (nommé C<< lookuptableforthis >> pour les LUT non globales) sans correspondance. C<< $$mth{"_defaultLUT_to_mth_"} >> est vidée à chaque fois que MARC::Transform->new est appelé. =item * Si nous rappellons l'exemple ci-dessus avec : my %mth; $record = MARC::Transform->new($record,$yaml,\%mth); print $mth{"_defaultLUT_to_mth_"}->{"cities"}[0]; print "\n".Data::Dumper::Dumper $mth{"_defaultLUT_to_mth_"}; cela renverra sur la sortie standard : foo $VAR1 = { 'numbers' => [ '3' ], 'cities' => [ 'foo' ] }; essayez ceci si vous souhaitez récupérer le contenu de $mth{"_defaultLUT_to_mth_"} à la place de la ligne contenant Data::Dumper::Dumper : foreach my $k (keys(%{$mth{"_defaultLUT_to_mth_"}})) { foreach my $value(@{$mth{"_defaultLUT_to_mth_"}->{"$k"}}) { print "$k : $value \n"; } } =back =head1 - Dernières astuces et un gros exemple de YAML =over 4 =item * Si votre script renvoie une erreur du type "YAML Error: Stream does not end with newline character", c'est simple à corriger. Si vous avez défini votre YAML dans une variable, elle doit se terminer par une nouvelle ligne vide. Si vous avez donner un chemin vers votre fichier, il n'est vraisemblablement pas bon : essayez avec un chemin absolu. =item * Restriction: le cas spécifique des guillemets doubles (") et du symbole dollar ($): Dans le YAML, ces caractères sont interprétés différemment. Pour les utiliser dans un contexte de chaîne de caractère, vous devrez les remplacer dans le YAML par C<#_dbquote_#> (pour ") et C<#_dollars_#> (pour $): . Exemple: --- condition : $f501a eq "I want #_dbquote_##_dollars_##_dbquote_#" create : f604a : "#_dbquote_#$f501a#_dbquote_# contain a #_dollars_# sign" . résultat (avec C<< $record->as_formatted >> ): --notice d'origine-- LDR 501 _aI want "$" --notice transformée-- LDR 501 _aI want "$" 604 _a"I want "$"" contain a $ sign =item * Restriction: Vous pouvez tester si un champ ou sous-champ existe, mais il est déconseillé de tester son absence. =item * Exemple: n'hésitez pas à copier les exemples de cette documentation. Faite attention car j'ai ajouté quatre caractères espace au début de chaque ligne des exemples pour qu'ils soient mieux affichés par l'interpréteur POD. Si vous les copiez / collez dans votre fichier de configuration YAML, n'oubliez pas de supprimer les quatres premier caractères de chaque ligne (par exemple avec vim, C<:%s/^\s\s\s\s//g> ). =item * Ce yaml a été appellé comme ceci: C<< my %mth; $mth{"var"}="a string"; $record = MARC::Transform->new($record,$yaml,\%mth); >> --- condition : $f501a eq "foo" create : f502a : this is the value of a subfield of a new 502 field --- condition : $f401a=~/foo/ create : b : new value of the 401 condition's field f600 : a : - first a subfield of this new 600 field - second a subfield of this new 600 field - $$mth{"var"} b : the 600b value execute : \&reencodeRecordtoUtf8() --- - condition : $f501a =~/foo/ and $f503a =~/bar/ forceupdate : $f503b : mandatory b in condition's field f005_ : mandatory 005 f006_ : \&return_record_encoding() f700 : a : the a subfield of this mandatory 700 field b : \&sub1("$f503a") forceupdatefirst : $f501b : update only the first b in condition's field 501 - condition : $f501a =~/foo/ execute : \&warnfoo("f501a contain foo") - subs : > sub return_record_encoding { $record->encoding(); } sub sub1 {my $string=shift;$string =~ s/a/e/g;return $string;} sub warnfoo { my $string = shift;warn $string; } --- - condition : $f501b2 eq "o" update : c : updated value of all c in condition's field f504a : updated value of all 504a if exists f604 : b : \&LUT("$this") c : \&LUT("NY","cities") updatefirst : f604a : update only the first a in 604 - condition : $f501c eq "1" delete : $f501 - LUT : 1 : first 2 : second bar : openbar --- delete : - f401a - f005 --- condition : $ldr2 eq "t" execute : \&SetRecordToLowerCase($record) --- condition : $f008_ eq "controlfield_content8b" duplicatefield : - $f008 > f007 - f402 > f602 delete : f402 --- global_subs: > sub reencodeRecordtoUtf8 { $record->encoding( 'UTF-8' ); } sub warnfee { my $string = shift;warn $string; } global_LUT: cities: NY : New York SF : San Fransisco numbers: 1 : one 2 : two résultat (avec C<< $record->as_formatted >> ) : --notice d'origine-- LDR optional leader 005 controlfield_content 008 controlfield_content8a 008 controlfield_content8b 106 _aVaLuE 401 _aafooa 402 2 _aa402a2 402 1 _aa402a1 501 _c1 501 _afoo _afoao _b1 _bbaoar _cbig 503 _afee _ababar 504 _azut _asisi 604 _afoo _afoo _bbar _ctruc --notice transformée-- LDR optional leader 006 UTF-8 007 controlfield_content8b 008 controlfield_content8a 008 controlfield_content8b 106 _aVaLuE 401 _bnew value of the 401 condition's field 501 _c1 501 _afoo _afoao _bupdate only the first b in condition's field 501 _bbaoar _cupdated value of all c in condition's field 502 _athis is the value of a subfield of a new 502 field 503 _afee _ababar _bmandatory b in condition's field 504 _aupdated value of all 504a if exists _aupdated value of all 504a if exists 600 _aa string _afirst a subfield of this new 600 field _asecond a subfield of this new 600 field _bthe 600b value 602 1 _aa402a1 602 2 _aa402a2 604 _aupdate only the first a in 604 _afoo _bopenbar _cNew York 700 _athe a subfield of this mandatory 700 field _bbeber =back =head1 - VOIR AUSSI =over 4 =item * MARC::Record (L) =item * MARC::Field (L) =item * MARC::Loader (L) =item * YAML (L) =item * Library Of Congress MARC pages (L) The definitive source for all things MARC. =back =head1 - AUTEUR Stéphane Delaune, (delaune.stephane at gmail.com) =head1 - COPYRIGHT Copyright 2011-2020 Stephane Delaune for Biblibre.com, all rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut MARC-Transform-0.003009/t/test.t0000644000175000017500000007614712435064252016317 0ustar reiveunereiveune#!/usr/bin/perl use strict; use warnings; use lib qw( lib ../lib ); use Cwd; use YAML; use Test::More 'no_plan'; BEGIN { use_ok( 'MARC::Transform' ); } sub recordtostring { my ($record) = @_; my $string=""; my $finalstring=$record->leader; my %tag_names = map( { $$_{_tag} => 1 } $record->fields); my @order = qw/0 1 2 3 4 5 6 7 8 9 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z/; foreach my $tag(sort({ $a cmp $b } keys(%tag_names))) { my @fields=$record->field($tag); foreach my $field(@fields) { $string.="|#f#|$tag:"; if ($field->is_control_field()) { $string.=$field->data(); } else { $string.=$field->indicator(1); $string.=$field->indicator(2); foreach my $key (@order) { foreach my $subfield (sort({ $a cmp $b } $field->subfield($key))) { $string.="|$key:".$subfield; } } } } } my @arec = split(/\|#f#\|/,$string);#warn Data::Dumper::Dumper @arec; foreach my $tempstring (sort({ $a cmp $b } @arec)) { $finalstring.="||$tempstring"; } return $finalstring; } #test 2 my %mtest; $mtest{"var"}="a string"; my $record2a = MARC::Record->new(); $record2a->leader('optionnal leader'); $record2a->insert_fields_ordered( MARC::Field->new( '005', 'controlfield_content' )); $record2a->insert_fields_ordered( MARC::Field->new( '008', 'controlfield_content8b' )); $record2a->insert_fields_ordered( MARC::Field->new( '008', 'controlfield_content8a' )); $record2a->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo', 'a' => 'foao', 'b' => '1', 'b' => 'baoar', 'c' => 'big') ); $record2a->insert_fields_ordered( MARC::Field->new( '501', '', '', 'c' => '1') ); $record2a->insert_fields_ordered( MARC::Field->new( '502', '', '', 'a' => 'I want "$"') ); $record2a->insert_fields_ordered( MARC::Field->new( '106', '', '', 'a' => 'VaLuE') ); $record2a->insert_fields_ordered( MARC::Field->new( '503', '', '', 'a' => 'fee', 'a' => 'babar') ); $record2a->insert_fields_ordered( MARC::Field->new( '504', '', '', 'a' => 'zut', 'a' => 'sisi') ); $record2a->insert_fields_ordered( MARC::Field->new( '604', '', '', 'a' => 'foo', 'a' => 'foo', 'b' => 'bar', 'c' => 'truc') ); $record2a->insert_fields_ordered( MARC::Field->new( '401', '', '', 'a' => 'afooa') ); $record2a->insert_fields_ordered( MARC::Field->new( '402', '1', '', 'a' => 'a402a1') ); $record2a->insert_fields_ordered( MARC::Field->new( '402', '', '2', 'a' => 'a402a2') ); my $record2b = MARC::Record->new(); $record2b->leader('optionnal leader'); $record2b->insert_fields_ordered( MARC::Field->new( '005', 'controlfield_content' )); $record2b->insert_fields_ordered( MARC::Field->new( '008', 'controlfield_content8b' )); $record2b->insert_fields_ordered( MARC::Field->new( '008', 'controlfield_content8a' )); $record2b->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo', 'a' => 'foao', 'b' => '1', 'b' => 'baoar', 'c' => 'big') ); $record2b->insert_fields_ordered( MARC::Field->new( '501', '', '', 'c' => '1') ); $record2b->insert_fields_ordered( MARC::Field->new( '502', '', '', 'a' => 'I want "$"') ); $record2b->insert_fields_ordered( MARC::Field->new( '106', '', '', 'a' => 'VaLuE') ); $record2b->insert_fields_ordered( MARC::Field->new( '503', '', '', 'a' => 'fee', 'a' => 'babar') ); $record2b->insert_fields_ordered( MARC::Field->new( '504', '', '', 'a' => 'zut', 'a' => 'sisi') ); $record2b->insert_fields_ordered( MARC::Field->new( '604', '', '', 'a' => 'foo', 'a' => 'foo', 'b' => 'bar', 'c' => 'truc') ); $record2b->insert_fields_ordered( MARC::Field->new( '401', '', '', 'a' => 'afooa') ); $record2b->insert_fields_ordered( MARC::Field->new( '402', '1', '', 'a' => 'a402a1') ); $record2b->insert_fields_ordered( MARC::Field->new( '402', '', '2', 'a' => 'a402a2') ); #print "--init record--\n". $record1->as_formatted; my $yaml2 = '--- condition : $f501a eq "foo" create : f502a : this is the value of a subfield of a new 502 field --- condition : $f401a=~/foo/ create : b : new value of the 401 conditions field f600 : a : - first a subfield of this new 600 field - second a subfield of this new 600 field - $$mth{"var"} b : the 600b value execute : \&reencodeRecordtoUtf8() --- condition : $f502a eq "I want #_dbquote_##_dollars_##_dbquote_#" create : f605a : "#_dbquote_#$f502a#_dbquote_# contain a #_dollars_# sign" --- - condition : $f501a =~/foo/ and $f503a =~/bar/ forceupdate : $f503b : mandatory b in condition\'s field f005_ : mandatory 005 f006_ : \&return_record_encoding() f700 : a : the a subfield of this mandatory 700 field b : \&sub1("$f503a") forceupdatefirst : $f501b : update only the first b in condition\'s field 501 - condition : $f501a =~/foo/ execute : \&warnfoo("f501a contain foo") - subs : > sub return_record_encoding { $record->encoding(); } sub sub1 { my $string = shift;$string =~ s/a/e/g;return $string; } sub warnfoo { my $string = shift;warn $string; } --- - condition : $f501b2 eq "o" update : c : updated value of all c in condition\'s field f504a : updated value of all 504a if exists f604 : b : \&LUT("$this") c : \&LUT("NY","cities") updatefirst : f604a : update only the first a in 604 - condition : $f501c eq "1" delete : $f501 - LUT : 1 : first 2 : second bar : openbar --- delete : - f401a - f005 --- condition : $ldr2 eq "t" execute : \&SetRecordToLowerCase($record) --- condition : $f008_ eq "controlfield_content8b" duplicatefield : - $f008 > f007 - f402 > f602 delete : f402 --- global_subs: > sub reencodeRecordtoUtf8 { $record->encoding( \'UTF-8\' ); } sub warnfee { my $string = shift;warn $string; } global_LUT: cities: NY : New York SF : San Fransisco numbers: 1 : one 2 : two '; $record2a = MARC::Transform->new($record2a,$yaml2,\%mtest); $record2b = MARC::Transform->new($record2b,$yaml2,\%mtest); #print "\n--transformed record--\n". $record2b->as_formatted ."\n"; my $v2aa=recordtostring($record2a); my $v2ba=recordtostring($record2b); my $v2b='optionnalaleader||||006:UTF-8||007:controlfield_content8b||008:controlfield_content8a||008:controlfield_content8b||106: |a:VaLuE||401: |b:new value of the 401 conditions field||501: |a:foao|a:foo|b:baoar|b:update only the first b in condition\'s field 501|c:updated value of all c in condition\'s field||501: |c:1||502: |a:I want "$"||502: |a:this is the value of a subfield of a new 502 field||503: |a:babar|a:fee|b:mandatory b in condition\'s field||504: |a:updated value of all 504a if exists|a:updated value of all 504a if exists||600: |a:a string|a:first a subfield of this new 600 field|a:second a subfield of this new 600 field|b:the 600b value||602: 2|a:a402a2||602:1 |a:a402a1||604: |a:foo|a:update only the first a in 604|b:openbar|c:New York||605: |a:"I want "$"" contain a $ sign||700: |a:the a subfield of this mandatory 700 field|b:beber'; is( $v2aa.$v2ba, $v2b.$v2b, "" ); #test 3 my $record3 = MARC::Record->new(); $record3->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo') ); #print "--init record--\n". $record3->as_formatted; my $yaml3 = '--- condition : $f501a or $f502a create : f600a : aaa '; $record3 = MARC::Transform->new($record3,$yaml3); #print "\n--transformed record--\n". $record2->as_formatted ."\n"; my $v3a=recordtostring($record3); my $v3b=" ||||501: |a:foo||600: |a:aaa"; is($v3a,$v3b, "" ); #test 4 my $record4 = MARC::Record->new(); $record4->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo', 'b' => '1', 'c' => 'bar') ); #print "--init record--\n". $record4->as_formatted; my $yaml4 = ' --- condition : $f501a eq "foo" create : f502a : value of a new 502a update : $f501b : \&LUT("$this") LUT : 1 : first 2 : second value in this LUT (LookUp Table) --- delete : f501c '; $record4 = MARC::Transform->new($record4,$yaml4); #print "\n--transformed record--\n". $record3->as_formatted ."\n"; my $v4a=recordtostring($record4); my $v4b=" ||||501: |a:foo|b:first||502: |a:value of a new 502a"; is($v4a,$v4b,""); #test 5 my $record5 = MARC::Record->new(); $record5->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo', 'b' => '1', 'c' => 'bar') ); #print "--init record--\n". $record5->as_formatted; my $yaml5 = ' --- condition : $f501a eq "foo" create : b : new subfield value of the conditions field f502a : this is the value of a subfield of a new 502 field f502b : - this is the first value of two \'b\' of another new 502 - this is the 2nd value of two \'b\' of another new 502 f600 : a : - first a subfield of this new 600 field - second a subfield of this new 600 field b : the 600b value '; $record5 = MARC::Transform->new($record5,$yaml5); #print "\n--transformed record--\n". $record5->as_formatted ."\n"; my $v5a=recordtostring($record5); my $v5b=" ||||501: |a:foo|b:1|b:new subfield value of the conditions field|c:bar||502: |a:this is the value of a subfield of a new 502 field||502: |b:this is the 2nd value of two 'b' of another new 502|b:this is the first value of two 'b' of another new 502||600: |a:first a subfield of this new 600 field|a:second a subfield of this new 600 field|b:the 600b value"; is($v5a,$v5b,""); #test 6 my $record6 = MARC::Record->new(); $record6->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo', 'b' => '1', 'c' => 'bar') ); $record6->insert_fields_ordered( MARC::Field->new( '502', '', '', 'b' => 'truc', 'c' => 'bidule') ); $record6->insert_fields_ordered( MARC::Field->new( '502', '', '', 'a' => 'poto') ); $record6->insert_fields_ordered( MARC::Field->new( '502', '', '', 'a' => 'first a', 'a' => 'second a', 'b' => 'bbb', 'c' => 'ccc1', 'c' => 'ccc2') ); #print "--init record--\n". $record6->as_formatted; my $yaml6 = ' --- condition : $f502a eq "second a" update : b : updated value of all \'b\' subfields in the condition field f502c : updated value of all \'c\' subfields into all \'502\' fields f501 : a : updated value of all \'a\' subfields into all \'501\' fields b : $f502a is the value of 502a conditionnal field '; $record6 = MARC::Transform->new($record6,$yaml6); #print "\n--transformed record--\n". $record6->as_formatted ."\n"; my $v6a=recordtostring($record6); my $v6b=" ||||501: |a:updated value of all 'a' subfields into all '501' fields|b:second a is the value of 502a conditionnal field|c:bar||502: |a:first a|a:second a|b:updated value of all 'b' subfields in the condition field|c:updated value of all 'c' subfields into all '502' fields|c:updated value of all 'c' subfields into all '502' fields||502: |a:poto||502: |b:truc|c:updated value of all 'c' subfields into all '502' fields"; is($v6a,$v6b,""); #test 7 my $record7 = MARC::Record->new(); $record7->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo', 'b' => '1', 'c' => 'bar') ); $record7->insert_fields_ordered( MARC::Field->new( '502', '', '', 'b' => 'truc', 'c' => 'bidule') ); $record7->insert_fields_ordered( MARC::Field->new( '502', '', '', 'a' => 'poto') ); $record7->insert_fields_ordered( MARC::Field->new( '502', '', '', 'a' => 'first a', 'a' => 'second a', 'b' => 'bbb', 'c' => 'cc1', 'c' => 'cc2') ); #print "--init record--\n". $record7->as_formatted; my $yaml7 = ' --- condition : $f502a eq "second a" forceupdate : b : value of \'b\' subfields in the condition field f502c : value of \'502c\' f503 : a : value of \'503a\' b : $f502a is the value of 502a conditionnal field '; $record7 = MARC::Transform->new($record7,$yaml7); #print "\n--transformed record--\n". $record7->as_formatted ."\n"; my $v7a=recordtostring($record7); my $v7b=" ||||501: |a:foo|b:1|c:bar||502: |a:first a|a:second a|b:value of 'b' subfields in the condition field|c:value of '502c'|c:value of '502c'||502: |a:poto|c:value of '502c'||502: |b:truc|c:value of '502c'||503: |a:value of '503a'|b:second a is the value of 502a conditionnal field"; is($v7a,$v7b,""); #test 8 my $record8 = MARC::Record->new(); $record8->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo', 'b' => '1', 'c' => 'bar') ); $record8->insert_fields_ordered( MARC::Field->new( '502', '', '', 'b' => 'truc', 'c' => 'bidule') ); $record8->insert_fields_ordered( MARC::Field->new( '502', '', '', 'a' => 'poto') ); $record8->insert_fields_ordered( MARC::Field->new( '502', '', '', 'a' => 'first a', 'a' => 'second a', 'b' => 'bbb', 'c' => 'cc1', 'c' => 'cc2') ); #print "--init record--\n". $record8->as_formatted; my $yaml8 = ' --- condition : $f502a eq "second a" forceupdatefirst : b : value of \'b\' subfields in the condition field f502c : value of \'502c\' f503 : a : value of \'503a\' b : $f502a is the value of 502a conditionnal field '; $record8 = MARC::Transform->new($record8,$yaml8); #print "\n--transformed record--\n". $record8->as_formatted ."\n"; my $v8a=recordtostring($record8); my $v8b=" ||||501: |a:foo|b:1|c:bar||502: |a:first a|a:second a|b:value of 'b' subfields in the condition field|c:cc2|c:value of '502c'||502: |a:poto|c:value of '502c'||502: |b:truc|c:value of '502c'||503: |a:value of '503a'|b:second a is the value of 502a conditionnal field"; is($v8a,$v8b,""); #test 9 my $record9 = MARC::Record->new(); $record9->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'bar', 'b' => 'bb1', 'b' => 'bb2') ); $record9->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo') ); $record9->insert_fields_ordered( MARC::Field->new( '502', '', '', 'a' => 'pata') ); $record9->insert_fields_ordered( MARC::Field->new( '502', '', '', 'a' => 'poto') ); $record9->insert_fields_ordered( MARC::Field->new( '503', '', '', 'a' => 'pata') ); $record9->insert_fields_ordered( MARC::Field->new( '504', '', '', 'a' => 'ata1', 'a' => 'ata2', 'b' => 'tbbt') ); #print "--init record--\n". $record9->as_formatted; my $yaml9 = ' --- condition : $f501a eq "foo" delete : $f501 --- condition : $f501a eq "bar" delete : b --- delete : f502 --- delete : - f503 - f504a '; $record9 = MARC::Transform->new($record9,$yaml9); #print "\n--transformed record--\n". $record9->as_formatted ."\n"; my $v9a=recordtostring($record9); my $v9b=" ||||501: |a:bar||504: |b:tbbt"; is($v9a,$v9b,""); #test 10 my $record10 = MARC::Record->new(); $record10->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo', 'b' => '1', 'c' => 'bar') ); $record10->insert_fields_ordered( MARC::Field->new( '502', '', '', 'b' => 'truc', 'c' => 'bidule') ); $record10->insert_fields_ordered( MARC::Field->new( '502', '', '', 'a' => 'poto') ); $record10->insert_fields_ordered( MARC::Field->new( '502', '', '', 'a' => 'first a', 'a' => 'second a', 'b' => 'bbb', 'c' => 'ccc1', 'c' => 'ccc2') ); #print "--init record--\n". $record10->as_formatted; my $yaml10 = ' --- condition : $f502a eq "second a" updatefirst : b : updated value of first \'b\' subfields in the condition field f502c : updated value of first \'c\' subfields into all \'502\' fields f501 : a : updated value of first \'a\' subfields into all \'501\' fields b : $f502a is the value of 502a conditionnal field '; $record10 = MARC::Transform->new($record10,$yaml10); #print "\n--transformed record--\n". $record10->as_formatted ."\n"; my $v10a=recordtostring($record10); my $v10b=" ||||501: |a:updated value of first 'a' subfields into all '501' fields|b:second a is the value of 502a conditionnal field|c:bar||502: |a:first a|a:second a|b:updated value of first 'b' subfields in the condition field|c:ccc2|c:updated value of first 'c' subfields into all '502' fields||502: |a:poto||502: |b:truc|c:updated value of first 'c' subfields into all '502' fields"; is($v10a,$v10b,""); #test 11 my $record11 = MARC::Record->new(); $record11->insert_fields_ordered( MARC::Field->new( '005', 'controlfield_content1' )); $record11->insert_fields_ordered( MARC::Field->new( '005', 'controlfield_content2' )); $record11->insert_fields_ordered( MARC::Field->new( '008', 'controlfield_contenta' )); $record11->insert_fields_ordered( MARC::Field->new( '008', 'controlfield_contentb' )); $record11->insert_fields_ordered( MARC::Field->new( '501', '1', '2', 'a' => 'bar', 'b' => 'bb1', 'b' => 'bb2') ); $record11->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo') ); #print "--init record--\n". $record11->as_formatted; my $yaml11 = ' --- condition : $f008_ eq "controlfield_contentb" duplicatefield : $f008 > f007 --- condition : $f501a eq "bar" duplicatefield : $f501 > f400 --- condition : $f501a eq "foo" duplicatefield : - f501 > f401 - $f501 > f402 - f005 > f006 '; $record11 = MARC::Transform->new($record11,$yaml11); #print "\n--transformed record--\n". $record11->as_formatted ."\n"; my $v11a=recordtostring($record11); my $v11b=" ||||005:controlfield_content1||005:controlfield_content2||006:controlfield_content1||006:controlfield_content2||007:controlfield_contentb||008:controlfield_contenta||008:controlfield_contentb||400:12|a:bar|b:bb1|b:bb2||401: |a:foo||401:12|a:bar|b:bb1|b:bb2||402: |a:foo||501: |a:foo||501:12|a:bar|b:bb1|b:bb2"; is($v11a,$v11b,""); #test 12 my $record12 = MARC::Record->new(); $record12->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo', 'b' => 'boo', 'd' => 'doo') ); #print "--init record--\n". $record12->as_formatted; my $yaml12 = ' --- - condition : $f501a eq "foo" create : c : \&fromo2e("$f501a") update : d : the value of this 501d is $this b : \&fromo2e("$this") - subs: > sub fromo2e { my $string=shift; $string =~ s/o/e/g; $string; } '; $record12 = MARC::Transform->new($record12,$yaml12); #print "\n--transformed record--\n". $record12->as_formatted ."\n"; my $v12a=recordtostring($record12); my $v12b=" ||||501: |a:foo|b:bee|c:fee|d:the value of this 501d is doo"; is($v12a,$v12b,""); #test 13 my $record13 = MARC::Record->new(); $record13->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo', 'b' => '8/13/10', 'c' => 'boo', 'd' => '40,00') ); #print "--init record--\n". $record13->as_formatted; my $yaml13 = ' --- - condition : $f501a eq "foo" and defined $f501d update : b : \&convertbaddate("$this") c : \&trim("$f501d") - subs: > sub convertbaddate { #this function convert date like "21/2/98" to "1998-02-28" my $in = shift; if ($in =~/^(\d{1,2})\/(\d{1,2})\/(\d{2}).*/) { my $day=$1; my $month=$2; my $year=$3; if ($day=~m/^\d$/) {$day="0".$day;} if ($month=~m/^\d$/) {$month="0".$month;} if (int($year)>13) {$year="19".$year;} else {$year="20".$year;} return "$year-$month-$day"; } else { return $in; } } sub trim { # This function removes ",00" at the end of a string my $in = shift; $in=~s/,00$//; return $in; } '; $record13 = MARC::Transform->new($record13,$yaml13); #print "\n--transformed record--\n". $record13->as_formatted ."\n"; my $v13a=recordtostring($record13); my $v13b=" ||||501: |a:foo|b:2010-13-08|c:40|d:40,00"; is($v13a,$v13b,""); #test 14 my $record14 = MARC::Record->new(); $record14->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo', 'b' => 'bar', 'c' => '40,00') ); #print "--init record--\n". $record14->as_formatted; my $yaml14 = ' --- condition : $f501a eq "foo" update : b : \&areturn_record_encoding() c : \&atrim("$this") --- global_subs: > sub areturn_record_encoding { $record->encoding(); } sub atrim { # This function removes ",00" at the end of a string my $in = shift; $in=~s/,00$//; return $in; } '; $record14 = MARC::Transform->new($record14,$yaml14); #print "\n--transformed record--\n". $record14->as_formatted ."\n"; my $v14a=recordtostring($record14); my $v14b=" ||||501: |a:foo|b:MARC-8|c:40"; is($v14a,$v14b,""); #test 15 my $record15 = MARC::Record->new(); $record15->insert_fields_ordered( MARC::Field->new( '501', '', '', 'b' => 'bar', 'c' => '1') ); #print "--init record--\n". $record15->as_formatted; my $yaml15 = ' --- - condition : $f501b eq "bar" create : f604a : \&LUT("$f501b") update : c : \&LUT("$this") - LUT : 1 : first 2 : second bar : openbar '; $record15 = MARC::Transform->new($record15,$yaml15); #print "\n--transformed record--\n". $record15->as_formatted ."\n"; my $v15a=recordtostring($record15); my $v15b=" ||||501: |b:bar|c:first||604: |a:openbar"; is($v15a,$v15b,""); #test 16 my $record16 = MARC::Record->new(); $record16->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => '1', 'a' => '3', 'b' => 'foo', 'c' => 'SF') ); #print "--init record--\n". $record16->as_formatted; my %mth16; my $yaml16 = ' --- - update : f501a : \&LUT("$this","numbers") f501b : \&LUT("$this","cities") f501c : \&LUT("$this","cities") --- global_LUT: cities: NY : New York SF : San Fransisco TK : Tokyo _default_value_ : unknown city numbers: 1 : one 2 : two '; $record16 = MARC::Transform->new($record16,$yaml16,\%mth16); #print "\n--transformed record--\n". $record16->as_formatted ."\n"; my $v16a=recordtostring($record16); $v16a.=$mth16{"_defaultLUT_to_mth_"}->{"cities"}[0]; my $v16b=" ||||501: |a:3|a:one|b:unknown city|c:San Fransisco"; $v16b.="foo"; is($v16a,$v16b,""); #test 17 my $record17 = MARC::Record->new(); $record17->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'I want "$"') ); #print "--init record--\n". $record17->as_formatted; my $yaml17 = ' --- condition : $f501a eq "I want #_dbquote_##_dollars_##_dbquote_#" create : f604a : "#_dbquote_#$f501a#_dbquote_# contain a #_dollars_# sign" '; $record17 = MARC::Transform->new($record17,$yaml17); #print "\n--transformed record--\n". $record17->as_formatted ."\n"; my $v17a=recordtostring($record17); my $v17b=' ||||501: |a:I want "$"||604: |a:"I want "$"" contain a $ sign'; is($v17a,$v17b,""); #test 18 my $record18 = MARC::Record->new(); $record18->insert_fields_ordered( MARC::Field->new( '995', '', '', 'a' => '1', 'b' => 'foo', 'c' => 'SF') ); $record18->insert_fields_ordered( MARC::Field->new( '995', '', '', 'a' => '2', 'b' => 'foo', 'c' => 'SF') ); $record18->insert_fields_ordered( MARC::Field->new( '995', '', '', 'a' => '1', 'b' => 'foo', 'c' => 'SF') ); #print "--init record--\n". $record18->as_formatted; my $yaml18 = ' --- condition : $f995a eq "2" update : b : updated value of all \'b\' subfields in the condition field $f995a : 3 f995c : updated '; $record18 = MARC::Transform->new($record18,$yaml18); #print "\n--transformed record--\n". $record18->as_formatted ."\n"; my $v18a=recordtostring($record18); my $v18b=" ||||995: |a:1|b:foo|c:updated||995: |a:1|b:foo|c:updated||995: |a:3|b:updated value of all 'b' subfields in the condition field|c:updated"; is($v18a,$v18b,""); #test 19 my $record19 = MARC::Record->new(); $record19->leader('optionnal leader'); $record19->insert_fields_ordered( MARC::Field->new( '500', '', '', 'a' => '0123456789abcd') ); #print "--init record--\n". $record19->as_formatted; my $yaml19 = ' --- condition : $ldr6 eq "n" and $f500a11 eq "b" create : f604a : ok '; $record19 = MARC::Transform->new($record19,$yaml19); #print "\n--transformed record--\n". $record19->as_formatted ."\n"; my $v19a=recordtostring($record19); my $v19b="optionnal leader||||500: |a:0123456789abcd||604: |a:ok"; is($v19a,$v19b,""); #test 20 my $record20 = MARC::Record->new(); $record20->leader('optionnal leader'); #$record20->insert_fields_ordered( MARC::Field->new( '500', '', '', 'a' => 'var') ); #print "--init record--\n". $record20->as_formatted; my %mt; $mt{"inc"}=1; $mt{"var"}="a string"; my $yaml20 = ' --- condition : $$mth{"var"} eq "a string" create : f500a : $$mth{"var"} --- - execute : \&test20a() - subs: > sub test20a { $$mth{"inc"}++; } --- create : f600a : \&test20b() --- global_subs: > sub test20b { $$mth{"inc"}++;$$mth{"inc"}; } '; $record20 = MARC::Transform->new($record20,$yaml20,\%mt); #print "\n--transformed record--\n". $record20->as_formatted ."\n"; #print recordtostring($record20); my $v20a=recordtostring($record20); my $v20b="optionnal leader||||500: |a:a string||600: |a:3"; is( $v20a, $v20b, "" ); #test 21 my $record21 = MARC::Record->new(); $record21->leader('optionnal leader'); $record21->insert_fields_ordered( MARC::Field->new( '327', '', '', 'a' => 'blabla') ); $record21->insert_fields_ordered( MARC::Field->new( '464', '', '', 'a' => 'Bar', 'b' => 'Bbr') ); #print "--init record--\n". $record21->as_formatted; my $yaml21 = ' --- condition : $f327a delete : a --- condition : $f464a delete : $f464a '; $record21 = MARC::Transform->new($record21,$yaml21); #print "\n--transformed record--\n". $record21->as_formatted ."\n"; my $v21a=recordtostring($record21); my $v21b="optionnal leader||||464: |b:Bbr"; is($v21a,$v21b,""); #test 22 my $record22 = MARC::Record->new(); $record22->leader('optionnal leader'); $record22->insert_fields_ordered( MARC::Field->new( '327', '', '', 'a' => 'blabla', 'a' => 'blbl') ); #print "--init record--\n". $record22->as_formatted; my $yaml22 = ' --- condition : $f327a duplicatefield : $f327 > f464 '; $record22 = MARC::Transform->new($record22,$yaml22); #print "\n--transformed record--\n". $record22->as_formatted ."\n"; my $v22a=recordtostring($record22); my $v22b="optionnal leader||||327: |a:blabla|a:blbl||464: |a:blabla|a:blbl"; is($v22a,$v22b,""); #test 23 my $record23 = MARC::Record->new(); $record23->leader('optionnal leader'); $record23->insert_fields_ordered( MARC::Field->new( '105', '', '', 'a' => '0123456789abcd') ); #print "--init record--\n". $record23->as_formatted; my $yaml23 = ' --- condition : $f105a4 ne "m" create : f604a : ok '; $record23 = MARC::Transform->new($record23,$yaml23); #print "\n--transformed record--\n". $record23->as_formatted ."\n"; my $v23a=recordtostring($record23); my $v23b="optionnal leader||||105: |a:0123456789abcd||604: |a:ok"; is($v23a,$v23b,""); #test 24 my $record24 = MARC::Record->new(); $record24->leader('optionnal leader'); #$record24->insert_fields_ordered( MARC::Field->new( '500', '', '', 'a' => 'var') ); #print "--init record--\n". $record24->as_formatted; my %mth24; $mth24{"inc"}=1; $mth24{"var"}="a string"; my $yaml24 = ' --- condition : $$mth{"var"} eq "a string" forceupdate : f500a : $$mth{"var"} --- - execute : \&test24a() - subs: > sub test24a { $$mth{"inc"}++; } --- forceupdate : f600a : \&test24b() --- global_subs: > sub test24b { $$mth{"inc"}++;$$mth{"inc"}; } '; $record24 = MARC::Transform->new($record24,$yaml24,\%mth24); $record24 = MARC::Transform->new($record24,$yaml24,\%mth24); #print "\n--transformed record--\n". $record24->as_formatted ."\n"; #print recordtostring($record24); my $v24a=recordtostring($record24); my $v24b="optionnal leader||||500: |a:a string||600: |a:5"; is( $v24a, $v24b, "" ); #test 25 my $record25 = MARC::Record->new(); $record25->insert_fields_ordered( MARC::Field->new( '501', '', '', 'a' => 'foo', 'a' => 'bar') ); #print "--init record--\n". $record25->as_formatted; my $yaml25 = '--- delete : f501a '; $record25 = MARC::Transform->new($record25,$yaml25); #print "\n--transformed record--\n". $record25->as_formatted ."\n"; my $v25a=recordtostring($record25); my $v25b=" ||||501: "; is($v25a,$v25b, "" ); #test 26 my $record26 = MARC::Record->new(); $record26->leader('012345gs0 2200253 4500'); $record26->insert_fields_ordered( MARC::Field->new( '008', 'd') ); $record26->insert_fields_ordered( MARC::Field->new( '215', '', '', 'v' => 'd') ); $record26->insert_fields_ordered( MARC::Field->new( '099', '', '', 't' => '13', 'v' => 'd') ); $record26->insert_fields_ordered( MARC::Field->new( '115', '', '', 'v' => 'd') ); $record26->insert_fields_ordered( MARC::Field->new( '116', '', '', 'v' => 'd') ); $record26->insert_fields_ordered( MARC::Field->new( '117', '', '', 'v' => 'd') ); $record26->insert_fields_ordered( MARC::Field->new( '135', '', '', 'a' => 'vo') ); $record26->insert_fields_ordered( MARC::Field->new( '463', '', '', 'v' => 'd') ); $record26->insert_fields_ordered( MARC::Field->new( '464', '', '', 'v' => 'd') ); #print "--init record--\n". $record26->as_formatted; my $yaml26 = '--- condition : $ldr6 eq "g" or $f135a1 eq "o" forceupdate : f9950 : test0 --- condition : $f215v eq "d" or $f115a eq "a" forceupdate : f995a : test1 --- condition : $ldr6 eq "g" or $f115a forceupdate : f995b : test2 --- condition : $f115b or $f115v forceupdate : f995c : test3 --- condition : $f215v or $f115v forceupdate : f995d : test4 --- condition : $f115b or $f115v forceupdate : f995e : test5 --- condition : $f116b or $f116v eq "d" forceupdate : f995f : test6 --- condition : $f117b eq "1" or $f117v eq "d" forceupdate : f995g : test7 --- condition : $f463 or $f464 forceupdate : f995h : test8 --- condition : ($f463 or $f464) and $f008_ eq "d" forceupdate : f995i : test9 --- condition : $f099t eq "13" and ($f135a0 eq "v" or $f135a1 eq "o") forceupdate : f995j : test10 --- condition : $f008 or $f009 forceupdate : f995k : test11 --- condition : $f117b and $f117v forceupdate : f995k : testbad --- condition : $f463v eq "d" and $f135 forceupdate : f700a : test0 --- condition : ($f463v eq "d" or $f464v eq "d") or $f008 forceupdate : f463v : test0 '; $record26 = MARC::Transform->new($record26,$yaml26); #print "\n--transformed record--\n". $record26->as_formatted ."\n"; my $v26a=recordtostring($record26); my $v26b="012345gs0 2200253 4500||||008:d||099: |t:13|v:d||115: |v:d||116: |v:d||117: |v:d||135: |a:vo||215: |v:d||463: |v:test0||464: |v:d||700: |a:test0||995: |0:test0|a:test1|b:test2|c:test3|d:test4|e:test5|f:test6|g:test7|h:test8|i:test9|j:test10|k:test11"; is($v26a,$v26b, "" ); #test 27 my $record27 = MARC::Record->new(); $record27->leader('01499nam0 2200301 4500'); $record27->insert_fields_ordered( MARC::Field->new( '008', 'y 7 000yy') ); $record27->insert_fields_ordered( MARC::Field->new( '105', '', '', 'a' => 'y 7 000yy') ); #print "--init record--\n". $record27->as_formatted; my $yaml27 = '--- - condition : ($ldr7 eq "m") and ($ldr6 eq "a" or $ldr6 eq "m" or $ldr6 eq "l") and ($f105a4 ne "m") and ($f105a4 ne "v") and ($f105a4 ne "7") create : f099t : LIV - condition : $f105a4 eq "m" or $f105a4 eq "v" or $f105a4 eq "7" create : f099t : THE - create : f099t : AUT '; $record27 = MARC::Transform->new($record27,$yaml27); #print "\n--transformed record--\n". $record27->as_formatted ."\n"; my $v27a=recordtostring($record27); my $v27b="01499nam0 2200301 4500||||008:y 7 000yy||099: |t:THE||105: |a:y 7 000yy"; is($v27a,$v27b,""); #test 28 my $record28 = MARC::Record->new(); $record28->leader('01499nam0 2200301 4500'); $record28->insert_fields_ordered( MARC::Field->new( '997', '', '', 'a' => 'value') ); $record28->insert_fields_ordered( MARC::Field->new( '998', '', '', 'a' => 'value') ); $record28->insert_fields_ordered( MARC::Field->new( '999', '', '', 'a' => 'value') ); #print "--init record--\n". $record28->as_formatted; my $yaml28='--- condition : defined $f997 update : $f997a : b$this --- condition : defined $f998 create : $f998a : ESC --- condition : defined $f999 create : a : ESC '; $record28 = MARC::Transform->new($record28,$yaml28); #print "\n--transformed record--\n". $record28->as_formatted ."\n"; my $v28a=recordtostring($record28); my $v28b="01499nam0 2200301 4500||||997: |a:bvalue||998: |a:ESC|a:value||999: |a:ESC|a:value"; is($v28a,$v28b,""); MARC-Transform-0.003009/Changes0000644000175000017500000000235013741027164016166 0ustar reiveunereiveuneRevision history for Perl extension MARC::Transform. * 2020-10-12: Version 0.003009 - add an optional argument to define yaml file encoding * 2019-04-17: Version 0.003008 - fix : so that the 010 fields are no longer considered as controlfields * 2018-12-04: Version 0.003007 - fixes to maintain module compatibility with the latest version of YAML Perl module * 2014-11-25: Version 0.003006 - improves field validation defined in the yaml - documentation corrections * 2014-08-26: Version 0.003005 - documentation update * 2013-10-10: Version 0.003004 - fix : prevents interpretation of incorrectly defined fields in the yaml * 2013-09-30: Version 0.003003 - documentation updates * 2013-09-27: Version 0.003002 - fixes : checks the existence of subfields defined in the yaml, prevents misinterpretation of certain characters * 2012-04-12: Version 0.003001 - enhancement : add optional hash reference in third argument * 2011-12-12: Version 0.002004 - fix : no longer displays warnings for undefined fields * 2011-11-02: Versions 0.002002 and 0.002003 - documentation corrections * 2011-11-01: Version 0.002001 - adds support of yaml files * 2011-08-28: Version 0.001001 - first version MARC-Transform-0.003009/Makefile.PL0000644000175000017500000000105111736312404016636 0ustar reiveunereiveune# Note: this file was auto-generated by Module::Build::Compat version 0.3603 use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'MARC::Transform', 'VERSION_FROM' => 'lib/MARC/Transform.pm', 'PREREQ_PM' => { 'MARC::Record' => '0', 'Scalar::Util' => '0', 'Test::More' => 0, 'YAML' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; MARC-Transform-0.003009/Build.PL0000644000175000017500000000104111736312460016161 0ustar reiveunereiveuneuse 5.010000; use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'MARC::Transform' , license => 'perl' , dist_version_from => 'lib/MARC/Transform.pm' , create_makefile_pl => 'traditional' , dist_author => 'Stephane Delaune ' , add_to_cleanup => [ 'MARC-Transform-*' ] , requires => {qw< Scalar::Util 0 MARC::Record 0 >} , build_requires => {qw< Test::More 0 YAML 0 >} ); $builder->create_build_script; MARC-Transform-0.003009/MANIFEST0000644000175000017500000000011511613340214016007 0ustar reiveunereiveuneBuild.PL lib/MARC/Transform.pm MANIFEST META.yml README t/test.t Makefile.PL MARC-Transform-0.003009/META.yml0000644000175000017500000000112613740011002016123 0ustar reiveunereiveune--- abstract: 'Perl module to transform a MARC record with a yaml configuration file' author: - 'Stephane Delaune ' build_requires: Test::More: 0 YAML: 0 configure_requires: Module::Build: 0.36 generated_by: 'Module::Build version 0.3603' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: MARC-Transform provides: MARC::Transform: file: lib/MARC/Transform.pm version: 0.003009 requires: MARC::Record: 0 Scalar::Util: 0 resources: license: http://dev.perl.org/licenses/ version: 0.003009 MARC-Transform-0.003009/README0000644000175000017500000000050113740010757015546 0ustar reiveunereiveuneMARC-Transform INSTALLATION To install this module, run the following commands: perl Build.PL ./Build ./Build test sudo ./Build install COPYRIGHT AND LICENCE Copyright (C) 2011-2020 Stéphane Delaune This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. MARC-Transform-0.003009/lib/MARC/0000775000175000017500000000000013741037166016170 5ustar reiveunereiveuneMARC-Transform-0.003009/lib/0000775000175000017500000000000013741037166015446 5ustar reiveunereiveuneMARC-Transform-0.003009/t/0000775000175000017500000000000013741037166015143 5ustar reiveunereiveuneMARC-Transform-0.003009/0000775000175000017500000000000013741037166014700 5ustar reiveunereiveune