File Coverage

lib/MARC/Transform.pm

Criterion	Covered	Total	%
statement	1224	1362	89.8
branch	237	378	62.7
condition	84	171	49.1
subroutine	282	285	98.9
pod	7	29	24.1
total	1834	2225	82.4

# 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__