File Coverage

lib/MARC/Transform.pm
Criterion Covered Total %
statement 984 1119 87.9
branch 237 374 63.3
condition 84 171 49.1
subroutine 202 205 98.5
pod 7 29 24.1
total 1514 1898 79.7


line stmt bran cond sub pod time code
1             # vim: sw=4
2             package MARC::Transform;
3 1     1   80178 use 5.10.0;
  1         3  
4 1     1   5 use warnings;
  1         1  
  1         25  
5 1     1   5 use strict;
  1         1  
  1         17  
6 1     1   5 use Carp;
  1         2  
  1         50  
7 1     1   591 use MARC::Record;
  1         7792  
  1         42  
8 1     1   8 use YAML;
  1         2  
  1         49  
9 1     1   6 use Scalar::Util qw< reftype >;
  1         1  
  1         134  
10             our $VERSION = '0.003007';
11             our $DEBUG = 0;
12 0 0   0 0 0 sub debug { $DEBUG and say STDERR @_ }
13              
14             my %fields;
15             my $globalcondition;
16             my $record;
17             our $mth;
18             my $globalsubs;
19             my $verbose=0;
20             my @errors;
21             my $global_LUT;
22             our $this="";
23              
24             sub new {
25 29     29 1 155094 my ($self,$recordsource,$yaml,$mthsource,$verb) = @_;
26 29         58 my @yaml;
27 1     1   6 no warnings 'redefine';
  1         2  
  1         46  
28 1     1   7 no warnings 'newline';
  1         1  
  1         7361  
29             my $yamltoload;
30 29 50       768 if ( -e $yaml ) {
31 0 0       0 open my $yamls, "< $yaml" or die "can't open file: $!";
32 0         0 my $yamlline;
33 0         0 while ($yamlline = <$yamls>){ $yamltoload.=$yamlline; }
  0         0  
34 0         0 close $yamls;
35             #@yaml = YAML::LoadFile($yamls);
36             }
37             else {
38 29         89 $yamltoload=$yaml;
39             #@yaml = YAML::Load($yaml);
40             }
41 29         114 $yamltoload=~s/#_dollars_#/\\#_dollars_\\#/g;
42 29         74 $yamltoload=~s/#_dbquote_#/\\#_dbquote_\\#/g;
43 29         108 @yaml = YAML::Load($yamltoload);
44             #warn "================". Data::Dumper::Dumper (\@yaml)."------------------";
45 29         216752 $record=$recordsource;
46 29         62 $mth=$mthsource;
47 29 100       106 $$mth{"_defaultLUT_to_mth_"}={} if $mth;
48 29         124 ReplaceAllInRecord("before");
49 29 50       420 $verbose = 1 if ($verb);
50 29         63 foreach my $rulesub(@yaml) {
51 79 100       170 if ( ref($rulesub) eq "HASH" ) {
52 67 100       166 if ( defnonull ( $$rulesub{'global_subs'} ) ) {
53 6         11 $globalsubs = $$rulesub{'global_subs'};
54 6     1 0 688 eval ($globalsubs);
  1     1 0 10  
  1     1 0 3  
  1     1 0 3  
  1     1 0 11  
  1     0 0 7  
  1         3  
  1         9  
  1         3  
  1         7  
  0         0  
  0         0  
55             }
56 67 100       185 if ( defnonull ( $$rulesub{'global_LUT'} ) ) {
57 3 50       14 if (ref($$rulesub{'global_LUT'}) eq "HASH") {
58 3         21 $global_LUT=$$rulesub{'global_LUT'};
59             }
60             }
61             }
62             }
63 29         58 foreach my $rule(@yaml) {
64             #print Data::Dumper::Dumper ($rule);
65 79 100       258 if ( ref($rule) eq "ARRAY" ) {
    50          
66 12         25 my $subs="";
67 12         33 foreach my $rul ( @$rule ) {
68 28 100       73 if ( defnonull ( $$rul{'subs'} ) ) {
69 7         24 $subs.=$$rul{'subs'};
70             }
71 28 100       72 if ( defnonull ( $$rul{'LUT'} ) ) {
72 3         13 $$global_LUT{"lookuptableforthis"}=$$rul{'LUT'};#warn Data::Dumper::Dumper $global_LUT;
73             }
74             }
75 12         23 foreach my $rul ( @$rule ) {
76 13         32 my ($actionsin, $actionsinter, $actionsout)= parseactions($rul);#warn Data::Dumper::Dumper ($rul);
77 13         36 my $boolcondition = testrule($rul, $actionsin, $actionsinter, $actionsout, $subs);
78             #warn $boolcondition;warn "actionsin : ".$actionsin;warn "actionsout : ".$actionsout;
79 13 100       46 if ($boolcondition) {
80 12         69 last;
81             }
82             }
83             }
84             elsif ( ref($rule) eq "HASH" ) {
85 67         96 my $subs="";
86 67 50       190 if ( defnonull ( $$rule{'subs'} ) ) {
87 0         0 $subs.=$$rule{'subs'};
88             }
89 67 100       183 if ( defnonull ( $$rule{'LUT'} ) ) {
90 1         4 $$global_LUT{"lookuptableforthis"}=$$rule{'LUT'};
91             }
92 67         149 my ($actionsin, $actionsinter, $actionsout)= parseactions($rule);
93 67         156 my $boolcondition = testrule($rule, $actionsin, $actionsinter, $actionsout, $subs);
94             }
95             else {
96 0         0 push(@errors, 'Invalid yaml : you try to use a scalar rule.'); #error
97             }
98             }
99 29         73 foreach my $error (@errors) {
100 0         0 print "\n$error";
101             }
102 29         74 ReplaceAllInRecord("after");
103 29         521 $record;
104             }
105              
106 1046 100 66 1046 0 1476 sub defnonull { my $var = shift; if (defined $var and $var ne "") { return 1; } else { return 0; } }
  1046         2106  
  165         406  
  881         1716  
107              
108             sub LUT {
109 11     11 1 29 my ( $inLUT, $type ) = @_;
110 11 100       26 if (!defined($type)) {
111 5         9 $type = "lookuptableforthis";
112             }
113 11         18 my $outLUT=$inLUT;
114 11         15 my $boolnocor = 1;
115 11 50       36 if ( ref($global_LUT) eq "HASH") {
116 11 50       24 if (exists($$global_LUT{$type})) {
117 11         20 my $correspondance=$$global_LUT{$type};
118 11 50       22 if ( ref($correspondance) eq "HASH") {
119 11         37 foreach my $cor (keys(%$correspondance)) {
120 30 100       58 if ($inLUT eq $cor) {
121 9         17 $outLUT=$$correspondance{$cor};
122 9         14 $boolnocor = 0;
123             }
124             }
125 11 100       25 if ($boolnocor) {
126 2 100       10 $outLUT=$$correspondance{"_default_value_"} if (defnonull($$correspondance{"_default_value_"}));
127 2 50       6 push (@{$$mth{"_defaultLUT_to_mth_"}->{"$type"}} , $inLUT) if $mth;
  2         8  
128             }
129             }
130             }
131             }
132 11         85 return $outLUT;
133             }
134              
135             sub update {
136 24     24 1 55 my ($field,$subfields)=@_;
137 24         58 transform ("update",$field,$subfields);
138 24         368 return 1;
139             }
140             sub forceupdate {
141 29     29 1 72 my ($field,$subfields)=@_;
142 29         64 transform ("forceupdate",$field,$subfields);
143 29         408 return 1;
144             }
145             sub updatefirst {
146 5     5 1 48 my ($field,$subfields)=@_;
147 5         15 transform ("updatefirst",$field,$subfields);
148 5         67 return 1;
149             }
150             sub forceupdatefirst {
151 5     5 1 14 my ($field,$subfields)=@_;
152 5         12 transform ("forceupdatefirst",$field,$subfields);
153 5         72 return 1;
154             }
155             sub create {
156 24     24 1 68 my ($field,$subfields)=@_;
157 24         71 transform ("create",$field,$subfields);
158 24         373 return 1;
159             }
160              
161             sub transform {
162 87     87 0 155 my ($ttype,$field,$subfields)=@_;
163             #print "\n------------$ttype------------ : \n".Data::Dumper::Dumper (@_);
164 87 100 100     308 if ($ttype eq "forceupdate" or $ttype eq "forceupdatefirst" ) {
165 34 100 66     108 if (ref($field) eq "" or ref($field) eq "SCALAR") {
166 28 100       76 if (!defined $record->field($field) ) {$ttype="create"}
  10         728  
167             }
168             }
169 87 100 33     1276 if (ref($field) eq "MARC::Field") {
    50          
170             #print "\n------------$ttype------------ : \n".Data::Dumper::Dumper ($subfields);
171 27         87 foreach my $tag(keys(%$subfields)) {
172 27 50 33     169 if ( $tag eq 'i1' or $tag eq 'µ') {
    50 33        
173             #print "\n------------$ttype------------ : \n";
174 0         0 $this=$field->indicator(1);
175 0         0 my $finalvalue=parsestringactions($$subfields{$tag});
176 0 0 0     0 $field->update( ind1 => $finalvalue ) if ( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" );
177             }
178             elsif ( $tag eq 'i2' or $tag eq '£') {
179 0         0 $this=$field->indicator(2);
180 0         0 my $finalvalue=parsestringactions($$subfields{$tag});
181 0 0 0     0 $field->update( ind2 => $finalvalue ) if ( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" );
182             }
183             else {
184 27 50 33     81 if( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ) {
    0          
185 27 50       64 if($field->is_control_field()) {
186 0         0 $this=$field->data();
187 0         0 my $finalvalue=parsestringactions($$subfields{$tag});
188 0         0 $field->update($finalvalue);
189             }
190             else {
191 27 100       199 if ($ttype eq "create") {
    100          
    100          
192 6         12 $this="";
193 6         15 my $finalvalue=parsestringactions($$subfields{$tag});
194 6         23 $field->add_subfields( $tag => $finalvalue );
195             }
196             elsif ($ttype eq "updatefirst") {
197 1 50       5 if ( defined $field->subfield( $tag ) ) {
198 1         34 $this=$field->subfield( $tag );
199 1         30 my $finalvalue=parsestringactions($$subfields{$tag});
200 1         5 $field->update( $tag => $finalvalue );
201             }
202             #warn $tag.$$subfields{$tag};
203             }
204             elsif ($ttype eq "forceupdatefirst") {
205 3 50       11 if ( defined $field->subfield( $tag ) ) {
206 3         96 $this=$field->subfield( $tag );
207 3         89 my $finalvalue=parsestringactions($$subfields{$tag});
208 3         14 $field->update( $tag => $finalvalue );
209             }
210             else {
211 0         0 $this="";
212 0         0 my $finalvalue=parsestringactions($$subfields{$tag});
213 0         0 $field->add_subfields( $tag => $finalvalue );
214             }
215             }
216             }
217             }
218             elsif( ref($$subfields{$tag}) eq "ARRAY" ) {
219 0 0       0 if(!$field->is_control_field()) {
220 0         0 foreach my $subfield(@{$$subfields{$tag}}) {
  0         0  
221 0 0       0 if ($ttype eq "create") {
    0          
    0          
222 0         0 $this="";
223 0         0 my $finalvalue=parsestringactions($subfield);
224 0         0 $field->add_subfields( $tag => $finalvalue );
225             }
226             elsif ($ttype eq "updatefirst") {
227 0 0       0 if ( defined $field->subfield( $tag ) ) {
228 0         0 $this=$field->subfield( $tag );
229 0         0 my $finalvalue=parsestringactions($subfield);
230 0         0 $field->update( $tag => $finalvalue );
231             }
232             }
233             elsif ($ttype eq "forceupdatefirst") {
234 0 0       0 if ( defined $field->subfield( $tag ) ) {
235 0         0 $this=$field->subfield( $tag );
236 0         0 my $finalvalue=parsestringactions($subfield);
237 0         0 $field->update( $tag => $finalvalue );
238             }
239             else {
240 0         0 $this="";
241 0         0 my $finalvalue=parsestringactions($subfield);
242 0         0 $field->add_subfields( $tag => $finalvalue );
243             }
244             }
245             }
246             }
247             else {
248 0         0 push(@errors, 'Invalid yaml : you try to use an array to '.$ttype.' in existing condition\'s controlfield value.'); #error
249             }
250             }
251             }
252             }
253 27 100 100     305 if((!$field->is_control_field()) and ($ttype eq "update" or $ttype eq "forceupdate" )) {
      66        
254 17         110 my @usubfields;
255 17         37 foreach my $subfield ( $field->subfields() ) {
256 58 100       463 if ( exists($$subfields{$$subfield[0]}) ) {
257             #implementation de l'eval des fonctions et de $this
258 15         26 $this=$$subfield[1];
259 15         55 my $finalvalue=parsestringactions($$subfields{$$subfield[0]});
260 15         53 push @usubfields, ( $$subfield[0],$finalvalue );
261             }
262             else {
263 43         109 push @usubfields, ( $$subfield[0], $$subfield[1] );
264             }
265             }
266 17         73 my $newfield = MARC::Field->new( $field->tag(), $field->indicator(1), $field->indicator(2), @usubfields );
267 17         1309 foreach my $tag(keys(%$subfields)) {
268 17 100 33     148 if($tag ne 'i1' and $tag ne 'µ' and $tag ne 'i2' and $tag ne '£' and !defined($newfield->subfield( $tag )) ) {
      33        
      33        
      66        
269 2 50 33     65 if( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ) {
270 2         5 $this="";
271 2         5 my $finalvalue=parsestringactions($$subfields{$tag});
272 2 50       14 $newfield->add_subfields( $tag => $finalvalue ) if $ttype eq "forceupdate";
273             }
274             else {
275 0         0 push(@errors, 'Invalid yaml : you try to use a non-scalar value to '.$ttype.' in existing condition\'s field value.'); #error
276             }
277             }
278             }
279 17         485 $field->replace_with($newfield);
280             }
281             }
282             elsif (ref($field) eq "" or ref($field) eq "SCALAR") {
283             #print "\n------------$ttype------------ : \n".Data::Dumper::Dumper (@_);
284 60 100 100     390 if ($ttype eq "update" or $ttype eq "updatefirst" or $ttype eq "forceupdate" or $ttype eq "forceupdatefirst") {
    50 100        
      100        
285 32 50       86 if ( defined $record->field($field) ) {
286 32         1775 for my $updatefield ( $record->field($field) ) {
287 42         2280 foreach my $tag(keys(%$subfields)) {
288 46 50 33     368 if ( $tag eq 'i1' or $tag eq 'µ') {
    50 33        
    50 33        
289 0         0 $this=$updatefield->indicator(1);
290 0         0 my $finalvalue=parsestringactions($$subfields{$tag});
291 0 0 0     0 $updatefield->update( ind1 => $finalvalue ) if ( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" );
292             }
293             elsif ( $tag eq 'i2' or $tag eq '£') {
294 0         0 $this=$updatefield->indicator(2);
295 0         0 my $finalvalue=parsestringactions($$subfields{$tag});
296 0 0 0     0 $updatefield->update( ind2 => $finalvalue ) if ( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" );
297             }
298             elsif( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ) {
299 46 100       100 if($updatefield->is_control_field()) {
    100          
    100          
300 2         12 $this=$updatefield->data();
301 2         24 my $finalvalue=parsestringactions($$subfields{$tag});
302 2         9 $updatefield->update($finalvalue);
303             }
304             elsif ( $ttype eq "updatefirst" ) {
305 7 100       51 if ( defined $updatefield->subfield( $tag ) ) {
306 6         163 $this=$updatefield->subfield( $tag );
307 6         153 my $finalvalue=parsestringactions($$subfields{$tag});
308 6         20 $updatefield->update( $tag => $finalvalue );
309             }
310             }
311             elsif ($ttype eq "forceupdatefirst") {
312 3 100       19 if ( defined $updatefield->subfield( $tag ) ) {
313 2         54 $this=$updatefield->subfield( $tag );
314 2         52 my $finalvalue=parsestringactions($$subfields{$tag});
315 2         8 $updatefield->update( $tag => $finalvalue );
316             }
317             else {
318 1         20 $this="";
319 1         2 my $finalvalue=parsestringactions($$subfields{$tag});
320 1         4 $updatefield->add_subfields( $tag => $finalvalue );
321             }
322             }
323             }
324             else {
325 0         0 push(@errors, 'Invalid yaml : you try to use a non-scalar value to '.$ttype.' field.');#error
326             }
327             }
328 42 100 100     502 if((!$updatefield->is_control_field()) and ($ttype eq "update" or $ttype eq "forceupdate" )) {
      100        
329 31         211 my @usubfields;
330 31         59 foreach my $subfield ( $updatefield->subfields() ) {
331 121 100       966 if ( exists($$subfields{$$subfield[0]}) ) {
332 26         41 $this=$$subfield[1];
333 26         55 my $finalvalue=parsestringactions($$subfields{$$subfield[0]});
334 26         84 push @usubfields, ( $$subfield[0],$finalvalue );
335             }
336             else {
337 95         164 push @usubfields, ( $$subfield[0], $$subfield[1] );
338             }
339             }
340 31         106 my $newfield = MARC::Field->new( $updatefield->tag(), $updatefield->indicator(1), $updatefield->indicator(2), @usubfields );
341 31         2298 foreach my $tag(keys(%$subfields)) {
342 34 100 33     401 if($tag ne 'i1' and $tag ne 'µ' and $tag ne 'i2' and $tag ne '£' and !defined($newfield->subfield( $tag )) ) {
      33        
      33        
      66        
343 13 50 33     490 if( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ) {
344 13         22 $this="";
345 13         30 my $finalvalue=parsestringactions($$subfields{$tag});
346 13 100       64 $newfield->add_subfields( $tag => $finalvalue ) if $ttype eq "forceupdate";
347             }
348             else {
349 0         0 push(@errors, 'Invalid yaml : you try to use a non-scalar value to '.$ttype.' field.');#error
350             }
351             }
352             }
353 31         670 $updatefield->replace_with($newfield);
354             }
355             }
356             }
357             }
358             elsif ($ttype eq "create") {
359 28         43 my $newfield;
360 28         43 $this="";
361 28 100       70 if ($field < "010" ) {
362 2         7 $newfield = MARC::Field->new( $field, 'temp');
363             }
364             else {
365 26         94 $newfield = MARC::Field->new( $field, '', '', '0'=>'temp');
366             }
367            
368 28         1706 foreach my $tag(keys(%$subfields)) {
369 35 50 33     289 if ( $tag eq 'i1' or $tag eq 'µ') {
    50 33        
370 0         0 my $finalvalue=parsestringactions($$subfields{$tag});
371 0 0 0     0 $newfield->update( ind1 => $finalvalue ) if ( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" );
372             }
373             elsif ( $tag eq 'i2' or $tag eq '£') {
374 0         0 my $finalvalue=parsestringactions($$subfields{$tag});
375 0 0 0     0 $newfield->update( ind2 => $finalvalue ) if ( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" );
376             }
377             else {
378 35 100 66     113 if( ref($$subfields{$tag}) eq "" or ref($$subfields{$tag}) eq "SCALAR" ) {
    50          
379 31 100       62 if($newfield->is_control_field()) {
380 2         14 my $finalvalue=parsestringactions($$subfields{$tag});
381 2         20 $newfield->update($finalvalue);
382             }
383             else {
384 29         155 my $finalvalue=parsestringactions($$subfields{$tag});
385 29         106 $newfield->add_subfields( $tag => $finalvalue );
386             }
387             }
388             elsif( ref($$subfields{$tag}) eq "ARRAY" ) {
389 4 50       11 if(!$newfield->is_control_field()) {
390 4         22 foreach my $subfield(@{$$subfields{$tag}}) {
  4         15  
391 10         79 my $finalvalue=parsestringactions($subfield);
392 10         31 $newfield->add_subfields( $tag => $finalvalue );
393             }
394             }
395             }
396             }
397             }
398 28 100       395 if (!$newfield->is_control_field()) {
399 26         165 $newfield->delete_subfield(pos => '0');
400             }
401 28         2108 $record->insert_fields_ordered($newfield);
402             }
403             }
404             else {
405 0         0 push(@errors, 'Invalid yaml : you try to use an array or hash value to '.$ttype.' field.');#error
406             }
407 87         3013 return 1;
408             }
409              
410             sub parsestringactions {
411 118     118 0 160 my $subfieldtemp=shift;
412 118         193 $subfieldtemp=~s/tempnameforcurrentvalueofthissubfield/\$this/g;
413 118         202 $subfieldtemp=~s/temporarycallfunction/\\&/g;
414 118         137 my $finalvalue;
415 118 100       259 if ($subfieldtemp=~/\\&/) {
416 24         61 $subfieldtemp=~s/\\&/&/g;
417 24         1380 $finalvalue = eval ($subfieldtemp);
418             }
419             else {
420 94         4163 $finalvalue = eval '"'.$subfieldtemp.'"';
421             }
422 118         478 return $finalvalue;
423             }
424              
425             sub parseactions {
426 80     80 0 101 my $rul = shift;
427 80         102 my $actionsintemp="";
428 80         90 my $actionsin="";
429 80         91 my $actionsinter="";
430 80         84 my $actionsouttemp="";
431 80         88 my $actionsout="";
432             #print "\n".Data::Dumper::Dumper $rul;
433             #create duplicatefield forceupdate forceupdatefirst update updatefirst execute delete
434 80 100       174 if ( defnonull ( $$rul{'create'} ) ) {
435 20         43 ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'create'},'create');
436 20         42 $actionsin.=$actionsintemp; $actionsout.=$actionsouttemp;
  20         29  
437             }
438 80 100       186 if ( defnonull ( $$rul{'duplicatefield'} ) ) {
439 6         15 ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'duplicatefield'},'duplicatefield');
440 6         17 $actionsinter.=$actionsintemp; $actionsout.=$actionsouttemp;
  6         11  
441             }
442 80 100       178 if ( defnonull ( $$rul{'forceupdate'} ) ) {
443 22         52 ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'forceupdate'},'forceupdate');
444 22         36 $actionsin.=$actionsintemp; $actionsout.=$actionsouttemp;
  22         30  
445             }
446 80 100       180 if ( defnonull ( $$rul{'forceupdatefirst'} ) ) {
447 3         11 ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'forceupdatefirst'},'forceupdatefirst');
448 3         8 $actionsin.=$actionsintemp; $actionsout.=$actionsouttemp;
  3         5  
449             }
450 80 100       197 if ( defnonull ( $$rul{'update'} ) ) {
451 11         29 ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'update'},'update');
452 11         23 $actionsin.=$actionsintemp; $actionsout.=$actionsouttemp;
  11         20  
453             }
454 80 100       183 if ( defnonull ( $$rul{'updatefirst'} ) ) {
455 3         30 ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'updatefirst'},'updatefirst');
456 3         6 $actionsin.=$actionsintemp; $actionsout.=$actionsouttemp;
  3         6  
457             }
458 80 100       191 if ( defnonull ( $$rul{'execute'} ) ) {
459 7         23 ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'execute'},'execute');
460 7         12 $actionsin.=$actionsintemp; $actionsout.=$actionsouttemp;
  7         13  
461             }
462 80 100       171 if ( defnonull ( $$rul{'delete'} ) ) {
463 12         28 ($actionsintemp,$actionsouttemp)=parsesubaction ($$rul{'delete'},'delete');
464 12         28 $actionsin.=$actionsintemp; $actionsout.=$actionsouttemp;
  12         16  
465             }
466             #print "\n----------------------actionsin---------------------- : \n$actionsin\n\n----------------------actionsout---------------------- : \n$actionsout\n----------------------actionsend----------------------";
467 80         278 return ($actionsin, $actionsinter, $actionsout)
468             }
469              
470             sub parsesubaction {
471 84     84 0 154 my ($intaction,$type)=@_;
472 84         108 my $actionsin="";
473 84         86 my $actionsout="";
474 84         90 my $boolin=0;
475 84         105 my $specaction="";
476 84         101 my $currentaction="";#warn ref($intaction);
477 84         120 $specaction=" $type";
478             #print "\n".Data::Dumper::Dumper $intaction;
479 84 100 100     499 if ($type eq "create" or $type eq "forceupdate" or $type eq "update" or $type eq "forceupdatefirst" or $type eq "updatefirst") {
    100 100        
    100 100        
    50 100        
480 59 50       125 if ( ref($intaction) eq "HASH" ) {
481 59         197 foreach my $kint (keys(%$intaction)) {
482 89 100 66     281 if( ref($$intaction{$kint}) eq "HASH" ) {
    100          
    50          
483 11         14 my $ftag;
484 11         17 $currentaction="";
485 11         17 $boolin=0;
486 11 50       50 if($kint=~/^\$f(\d{3})$/) {
    50          
487 0         0 $boolin=1;
488 0         0 $ftag=$kint;
489             }
490             elsif($kint=~/^f(\d{3})$/) {
491 11         31 $ftag='"'.$1.'"';
492             }
493             else {
494 0         0 push(@errors, 'Invalid yaml : your field reference is not valid in '.$type.' action.');#error
495 0         0 next;
496             }
497 11         24 $currentaction.=$specaction.'('.$ftag.',{';
498 11         20 my $subint=$$intaction{$kint};
499 11         30 foreach my $k (keys(%$subint)) {
500 22 100 66     74 if( ref($$subint{$k}) eq "" or ref($$subint{$k}) eq "SCALAR" ) {
    50          
501 19         43 $$subint{$k}=~s/"/\\"/g;
502 19 100       63 $boolin=1 if($$subint{$k}=~/\$f/);#print $k." eq. ".$$subint{$k}."\n";
503 19         34 $$subint{$k}=~s/\$this/tempnameforcurrentvalueofthissubfield/g;
504 19         38 $$subint{$k}=~s/\\&/temporarycallfunction/g;
505 19         49 $currentaction.='"'.$k.'"=> "'.$$subint{$k}.'",';
506             }
507             elsif( ref($$subint{$k}) eq "ARRAY" ) {
508 3         10 $currentaction.='"'.$k.'"=>[';
509 3         7 foreach my $ssubint(@{$$subint{$k}}) {
  3         10  
510 8         18 $ssubint=~s/"/\\"/g;
511 8 50       19 $boolin=1 if($ssubint=~/\$f/);
512 8         13 $ssubint=~s/\$this/tempnameforcurrentvalueofthissubfield/g;
513 8         10 $ssubint=~s/\\&/temporarycallfunction/g;
514 8         19 $currentaction.='"'.$ssubint.'",';
515             }
516 3         9 $currentaction.='],';
517             }
518             else {
519 0         0 push(@errors, 'Invalid yaml : you try to use a hash inside another hash in '.$type.' action.');#error
520             }
521             }
522 11         22 $currentaction.='});'."\n";
523 11 100       23 if ($boolin) { $actionsin.=$currentaction; } else { $actionsout.=$currentaction; }
  6         13  
  5         12  
524             }
525             elsif( ref($$intaction{$kint}) eq "" or ref($$intaction{$kint}) eq "SCALAR" ) {
526 77         95 $currentaction="";
527 77         79 $boolin=0;
528 77         108 my $ftag;
529             my $stag;
530 77 100       387 if($kint=~/^\$f(\d{3})(\w)$/) {
    50          
    100          
    50          
    50          
    50          
531 8         14 $boolin=1;
532 8         17 $ftag='$f'.$1;
533 8         14 $stag=$2;
534             }
535             elsif($kint=~/^\$i(\d{3})(\w)$/) {
536 0         0 $boolin=1;
537 0         0 $ftag='$f'.$1;
538 0         0 $stag='µ';
539 0 0       0 $stag='µ' if($2 eq "1");
540 0 0       0 $stag='£' if($2 eq "2");
541             }
542             elsif($kint=~/^f(\d{3})(\w)$/) {
543 50         135 $ftag='"'.$1.'"';
544 50         83 $stag=$2;
545             }
546             elsif($kint=~/^i(\d{3})(\w)$/) {
547 0         0 $ftag='"'.$1.'"';
548 0         0 $stag='µ';
549 0 0       0 $stag='µ' if($2 eq "1");
550 0 0       0 $stag='£' if($2 eq "2");
551             }
552             elsif($kint=~/^i(\d)$/) {
553 0         0 $ftag='$$currentfield';
554 0         0 $stag='µ';
555 0 0       0 $stag='µ' if($1 eq "1");
556 0 0       0 $stag='£' if($1 eq "2");
557 0         0 $boolin=1;
558             }
559             elsif($kint=~/^(\w)$/) {
560 19         33 $ftag='$$currentfield';
561 19         21 $boolin=1;
562 19         24 $stag=$kint;
563             }
564             else {
565 0         0 push(@errors, 'Invalid yaml : your field reference is not valid in '.$type.' action.');#error
566 0         0 next;
567             }
568 77         173 $$intaction{$kint}=~s/"/\\"/g;
569 77 100       172 $boolin=1 if($$intaction{$kint}=~/\$f/);
570 77         133 $$intaction{$kint}=~s/\$this/tempnameforcurrentvalueofthissubfield/g;
571 77         123 $$intaction{$kint}=~s/\\&/temporarycallfunction/g;
572 77         194 $currentaction.=$specaction.'('.$ftag.',{"'.$stag.'"=>"'.$$intaction{$kint}.'"});'."\n";
573 77 100       121 if ($boolin) { $actionsin.=$currentaction; } else { $actionsout.=$currentaction; }
  31         72  
  46         106  
574             }
575             elsif( ref($$intaction{$kint}) eq "ARRAY" ) {
576 1         2 $currentaction="";
577 1         2 $boolin=0;
578 1         3 my $ftag;
579             my $stag;
580 1 50       7 if($kint=~/^\$f(\d{3})(\w)$/) {
    50          
    50          
    0          
    0          
581 0         0 $boolin=1;
582 0         0 $ftag='$f'.$1;
583 0         0 $stag=$2;
584             }
585             elsif($kint=~/^\$i(\d{3})(\w)$/) {
586 0         0 $boolin=1;
587 0         0 $ftag='$f'.$1;
588 0         0 $stag='µ';
589 0 0       0 $stag='µ' if($2 eq "1");
590 0 0       0 $stag='£' if($2 eq "2");
591             }
592             elsif($kint=~/^f(\d{3})(\w)$/) {
593 1         4 $ftag='"'.$1.'"';
594 1         3 $stag=$2;
595             }
596             elsif($kint=~/^i(\d{3})(\w)$/) {
597 0         0 $ftag='"'.$1.'"';
598 0         0 $stag='µ';
599 0 0       0 $stag='µ' if($2 eq "1");
600 0 0       0 $stag='£' if($2 eq "2");
601             }
602             elsif($kint=~/^(\w)$/) {
603 0         0 $ftag='$$currentfield';
604 0         0 $boolin=1;
605 0         0 $stag=$kint;
606             }
607             else {
608 0         0 push(@errors, 'Invalid yaml : your field reference is not valid in '.$type.' action.');#error
609 0         0 next;
610             }
611 1         4 $currentaction.=$specaction.'('.$ftag.',{"'.$stag.'"=>[';
612 1         2 foreach my $sintaction(@{$$intaction{$kint}}) {
  1         2  
613 2         4 $sintaction=~s/"/\\"/g;
614 2 50       8 $boolin=1 if($sintaction=~/\$f/);
615 2         4 $sintaction=~s/\$this/tempnameforcurrentvalueofthissubfield/g;
616 2         4 $sintaction=~s/\\&/temporarycallfunction/g;
617 2         5 $currentaction.='"'.$sintaction.'",';
618             }
619 1         5 $currentaction.=']});'."\n";
620 1 50       3 if ($boolin) { $actionsin.=$currentaction; } else { $actionsout.=$currentaction; }
  0         0  
  1         3  
621             }
622             }
623             }
624             else {
625 0         0 push(@errors, 'Invalid yaml : you try to use non hash context in '.$type.' action.');#error
626             }
627             }
628             elsif ($type eq "duplicatefield") {
629 6 100 33     30 if ( ref($intaction) eq "ARRAY" ) {
    50          
630 3         9 foreach my $vint (@$intaction) {
631 7 50 33     21 if( ref($vint) eq "" or ref($vint) eq "SCALAR" ) {
632 7 100       43 if($vint=~/^\$f(\d{3})\s?>\s?f(\d{3})$/) {
    50          
633 3 100 66     27 if ($1 < "010" and $2 < "010" ) {
    50 33        
634 2         10 $actionsin.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $f'.$1.'->data() ) );';
635             }
636             elsif ($1 >= "010" and $2 >= "010" ) {
637 1         43 $actionsin.='my @dsubfields; foreach my $subfield ( $f'.$1.'->subfields() ) { push @dsubfields, ( $$subfield[0], $$subfield[1] );}'."\n";
638 1         7 $actionsin.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $f'.$1.'->indicator(1), $f'.$1.'->indicator(2), @dsubfields ) );';
639             }
640             else {
641 0         0 push(@errors, 'Invalid yaml : you want to duplicate a controlfield with a non-controlfield ');#error
642             }
643             }
644             elsif($vint=~/^f(\d{3})\s?>\s?f(\d{3})$/) {
645 4 100 66     36 if ($1 < "010" and $2 < "010" ) {
    50 33        
646 1         4 $actionsout.=' for my $fielddup($record->field("'.$1.'")){';
647 1         5 $actionsout.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $fielddup->data() ) );';
648 1         3 $actionsout.='}'."\n";
649             }
650             elsif ($1 >= "010" and $2 >= "010" ) {
651 3         11 $actionsout.=' for my $fielddup($record->field("'.$1.'")){';
652 3         9 $actionsout.='my @dsubfields; foreach my $subfield ( $fielddup->subfields() ) { push @dsubfields, ( $$subfield[0], $$subfield[1] );}'."\n";
653 3         8 $actionsout.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $fielddup->indicator(1), $fielddup->indicator(2), @dsubfields ) );';
654 3         9 $actionsout.='}'."\n";
655             }
656             else {
657 0         0 push(@errors, 'Invalid yaml : you want to duplicate a controlfield with a non-controlfield ');#error
658             }
659             }
660             else {
661 0         0 push(@errors, 'Invalid yaml : your field reference is not valid in '.$type.' action.');#error
662             }
663             }
664             else {
665 0         0 push(@errors, 'Invalid yaml : you try to use non scalar value in '.$type.' action.');#error
666             }
667             }
668             }
669             elsif ( ref($intaction) eq "" or ref($intaction) eq "SCALAR" ) {
670 3         6 my $vint=$intaction;
671 3 50       19 if($vint=~/^\$f(\d{3})\s?>\s?f(\d{3})$/) {
    0          
672 3 100 66     34 if ($1 < "010" and $2 < "010" ) {
    50 33        
673 1         7 $actionsin.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $f'.$1.'->data() ) );';
674             }
675             elsif ($1 >= "010" and $2 >= "010" ) {
676 2         9 $actionsin.='my @dsubfields; foreach my $subfield ( $f'.$1.'->subfields() ) { push @dsubfields, ( $$subfield[0], $$subfield[1] );}'."\n";
677 2         11 $actionsin.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $f'.$1.'->indicator(1), $f'.$1.'->indicator(2), @dsubfields ) );';
678             }
679             else {
680 0         0 push(@errors, 'Invalid yaml : you want to duplicate a controlfield with a non-controlfield ');#error
681             }
682             }
683             elsif($vint=~/^f(\d{3})\s?>\s?f(\d{3})$/) {
684 0 0 0     0 if ($1 < "010" and $2 < "010" ) {
    0 0        
685 0         0 $actionsout.=' for my $fielddup($record->field("'.$1.'")){';
686 0         0 $actionsout.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $fielddup->data() ) );';
687 0         0 $actionsout.='}'."\n";
688             }
689             elsif ($1 >= "010" and $2 >= "010" ) {
690 0         0 $actionsout.=' for my $fielddup($record->field("'.$1.'")){';
691 0         0 $actionsout.='my @dsubfields; foreach my $subfield ( $fielddup->subfields() ) { push @dsubfields, ( $$subfield[0], $$subfield[1] );}'."\n";
692 0         0 $actionsout.='$record->insert_fields_ordered( MARC::Field->new( "'.$2.'", $fielddup->indicator(1), $fielddup->indicator(2), @dsubfields ) );';
693 0         0 $actionsout.='}'."\n";
694             }
695             else {
696 0         0 push(@errors, 'Invalid yaml : you want to duplicate a controlfield with a non-controlfield ');#error
697             }
698             }
699             else {
700 0         0 push(@errors, 'Invalid yaml : your field reference is not valid in '.$type.' action.');#error
701             }
702             }
703             else {
704 0         0 push(@errors, 'Invalid yaml : you try to use a hash value in '.$type.' action.');#error
705             }
706             }
707             elsif ($type eq "delete") {
708 12 100 33     59 if ( ref($intaction) eq "ARRAY" ) {
    50          
709 3         14 foreach my $vint (@$intaction) {
710 6 50 33     25 if( ref($vint) eq "" or ref($vint) eq "SCALAR" ) {
711             #print "$vint\n";
712 6 50       42 if($vint=~/^\$f(\d{3})(\w)$/) {
    50          
    100          
    50          
    0          
713 0         0 $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";
714             }
715             elsif($vint=~/^\$f(\d{3})$/) {
716 0         0 $actionsin.=' $record->delete_field('.$vint.');'."\n";
717             }
718             elsif($vint=~/^f(\d{3})(\w)$/) {
719 3         23 $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";
720             }
721             elsif($vint=~/^f(\d{3})$/) {
722 3         15 $actionsout.=' $record->delete_fields($record->field("'.$1.'"));'."\n";
723             }
724             elsif($vint=~/^(\w)$/) {
725 0         0 $actionsin.=' if ( defined $$currentfield->subfield("'.$vint.'") ) { if (scalar($$currentfield->subfields())==1) { $record->delete_field($$currentfield); } else { $$currentfield->delete_subfield(code => "'.$vint.'"); } }'."\n";
726             }
727             else {
728 0         0 push(@errors, 'Invalid yaml : your field reference is not valid in '.$type.' action.');#error
729             }
730             }
731             else {
732 0         0 push(@errors, 'Invalid yaml : you try to use non scalar value in '.$type.' action.');#error
733             }
734             }
735             }
736             elsif ( ref($intaction) eq "" or ref($intaction) eq "SCALAR" ) {
737 9         17 my $vint=$intaction;
738 9 100       76 if($vint=~/^\$f(\d{3})(\w)$/) {
    100          
    100          
    100          
    50          
739 1         12 $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";
740             }
741             elsif($vint=~/^\$f(\d{3})$/) {
742 1         6 $actionsin.=' $record->delete_field('.$vint.');'."\n";
743             }
744             elsif($vint=~/^f(\d{3})(\w)$/) {
745 2         17 $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";
746             }
747             elsif($vint=~/^f(\d{3})$/) {
748 3         15 $actionsout.=' $record->delete_fields($record->field("'.$1.'"));'."\n";
749             }
750             elsif($vint=~/^(\w)$/) {
751 2         14 $actionsin.=' if ( defined $$currentfield->subfield("'.$vint.'") ) { if (scalar($$currentfield->subfields())==1) { $record->delete_field($$currentfield); } else { $$currentfield->delete_subfield(code => "'.$vint.'"); } }'."\n";
752             }
753             else {
754 0         0 push(@errors, 'Invalid yaml : your field reference is not valid in '.$type.' action.');#error
755             }
756             }
757             else {
758 0         0 push(@errors, 'Invalid yaml : you try to use a hash value in '.$type.' action.');#error
759             }
760             }
761             elsif ($type eq "execute") {
762 7 50 33     23 if( ref($intaction) eq "" or ref($intaction) eq "SCALAR" ) {
    0          
763 7 50       25 if($intaction=~/\$(f|i)(\d{3})/) {
764 0         0 $actionsin.=' eval ('.$intaction.');';
765             }
766             else {
767 7         28 $actionsout.=' eval ('.$intaction.');';
768             }
769             }
770             elsif( ref($intaction) eq "ARRAY" ) {
771 0         0 foreach my $sintaction(@$intaction) {
772 0 0       0 if($sintaction=~/\$(f|i)(\d{3})/) {
773 0         0 $actionsin.=' eval ('.$sintaction.');';
774             }
775             else {
776 0         0 $actionsout.=' eval ('.$sintaction.');';
777             }
778             }
779             }
780             else {
781 0         0 push(@errors, 'Invalid yaml : you try to use a hash value in '.$type.' action.');#error
782             }
783             }
784             else {
785 0         0 push(@errors, 'Invalid yaml : this action : '.$type.' is not valid.');#error
786             }
787 84         252 return ($actionsin,$actionsout);
788             }
789              
790             sub testrule {
791 80     80 0 193 my ($rul, $actionsin, $actionsinter, $actionsout, $subs) = @_;
792 80         119 $globalcondition="";
793 80 100       147 $subs="no warnings 'redefine';".$subs if $subs ne "";
794 80         177 my $globalconditionstart='{ '."\n".$subs."\n".'my $boolcond=0;my $boolcondint=0;my $currentfield;no warnings \'substr\';no warnings \'uninitialized\';'."\n";
795 80         89 my $globalconditionint="";
796 80         94 my $globalconditionend="";#print Data::Dumper::Dumper ($rul);
797 80 100       144 if ( defnonull ( $$rul{'condition'} ) ) {
798 60         206 my @listconditiontags=grep( $_ , map({ $_=~/^(f|i)(\d{3})(.*)$/;$2 } (split(/\$/,$$rul{'condition'}))));#print $$rul{'condition'};
  154         361  
  154         420  
799 60 100       169 my @listconditionsubtags=grep( $_ , map({ if($_=~/^(f)(\d{3}\w)(.*)$/){$2}elsif($_=~/^(i)(\d{3})(.*)$/){$2} } (split(/\$/,$$rul{'condition'}))));
  154 50       464  
  68         215  
  0         0  
800 60         113 my %tag_names = map( { $_ => 1 } @listconditiontags);
  79         209  
801 60         100 my %tag_list;
802 60         123 @listconditiontags = keys(%tag_names);
803 60         97 foreach my $tag(@listconditiontags) {
804 68         125 $tag_list{$tag}=[];
805 68         91 foreach my $subtag(@listconditionsubtags) {
806 88 100       201 if (substr($subtag,0,3) eq $tag) {
807 68 50       112 if(length($subtag) == 3) {
808 0         0 push (@{$tag_list{$tag}}, "tempvalueforcurrentfield");
  0         0  
809             }
810             else {
811 68         79 push (@{$tag_list{$tag}}, substr($subtag,3,1));
  68         205  
812             }
813             }
814             }
815             }
816 60         102 my $condition=$$rul{'condition'};
817 60         148 $condition=~s/(\$ldr(\d{1,2}))/\(substr\(\$record->leader\(\),$2,1)\)/g;
818 60         83 $condition=~s/(\$ldr)/(\$record->leader\(\)\)/g;
819 60         467 $condition=~s/(\$f\d{3})(\w)/defined($1$2) and $1$2/g;
820 60         262 $condition=~s/(\$f\d{3})(\w)(\d{1,2})/\(substr($1$2,$3,1\)\)/g;
821 60         353 $condition=~s/(\$f\d{3})(\w)/$1$2/g;#I can't remember why I did this
822 60         106 $condition=~s/(\$i(\d{3}))(\d)/\(\$f$2->indicator\($3\)\)/g;
823 60         80 my $booltagrule=0;
824 60         79 my $boolsubtagrule=0;
825 60         182 foreach my $tag (sort {$a cmp $b} keys(%tag_list)) {
  14         45  
826 68         93 my %tag_listtag = map { $_, 1 } @{$tag_list{$tag}};
  68         179  
  68         108  
827 68         104 $boolsubtagrule=0;
828 68         126 my @tag_listtagunique = keys %tag_listtag;
829 68         125 $globalconditionstart.='my $f'.$tag.';';
830 68         116 foreach my $subtag (@tag_listtagunique) {
831 63         140 my $matchdelaration='my \$f'.$tag.$subtag.';';
832 63 50       799 $globalconditionstart.='my $f'.$tag.$subtag.';' if $globalconditionstart!~$matchdelaration;
833             }
834 68 100       235 if ( defined $record->field($tag) ) {
835 66         3243 $booltagrule=1;
836 66         194 $globalconditionint.="\n".'for $f'.$tag.' ( $record->field("'.$tag.'") ) {'."\n".'$currentfield=\$f'.$tag.';'."\n";
837 66         133 foreach my $subtag (@tag_listtagunique) {
838 62         68 $boolsubtagrule=1;
839 62 100 66     272 if ($subtag ne "tempvalueforcurrentfield" and $tag > "010") {
    50          
840 58         137 $globalconditionint.='for $f'.$tag.$subtag.' ( $f'.$tag.'->subfield("'.$subtag.'"), my $tmpintesta=1 ) { my $tmpintestb=0; if ($tmpintesta==1) { $tmpintesta=undef;$tmpintestb=1; }'."\n";
841 58         129 $globalconditionint.='if ('.$condition.') {$boolcond=1;$boolcondint=1; eval{'.$actionsin.'}}else{$boolcondint=0 unless (!defined($tmpintesta) and $tmpintestb==0 );}'."\n";
842 58         96 $globalconditionend.='}'."\n";
843             }
844             elsif ($subtag ne "tempvalueforcurrentfield") {
845 4         15 $globalconditionint.='$f'.$tag.$subtag.' = $f'.$tag.'->data(); '."\n";
846 4         15 $globalconditionint.='if ('.$condition.') {$boolcond=1;$boolcondint=1; eval{'.$actionsin.'}}else{$boolcondint=0;}'."\n";
847             }
848             }
849 66 100       154 $globalconditionint.='if ('.$condition.')'."\n".'{$boolcond=1;$boolcondint=1; eval{'.$actionsin.'}}else{$boolcondint=0;}' unless $boolsubtagrule;
850 66         187 $globalconditionend.='if ($boolcondint){ eval{'.$actionsinter.'};}}'."\n";
851             }#else { $globalconditionint.='if ('.$condition.') {$boolcond=1;$boolcondint=1; eval{'.$actionsin.'}}else{$boolcondint=0;}'."\n"; }
852             }
853 60 100       240 $globalconditionint.='if ('.$condition.')'."\n".'{$boolcond=1;$boolcondint=1; eval{'.$actionsin.'}}else{$boolcondint=0;}' unless $booltagrule;
854 60         122 $globalconditionend.="\n".' if ($boolcond){eval{'.$actionsout.'}}'."\n".' return $boolcond;}';#if ($boolcond or ('.$condition.'))
855 60         137 $globalcondition=$globalconditionstart.$globalconditionint.$globalconditionend;
856 60 50       110 print "\n--------globalcondition----------\n$globalcondition\n---------globalcondition---------\n" if $verbose;
857 1 50   1 0 9 return eval($globalcondition);
  1 50   1 0 2  
  1 50   1 0 69  
  1 50   1 0 6  
  1     1 0 1  
  1     1 0 242  
  1     1   7  
  1     1   1  
  1     1   47  
  1     1   6  
  1     1   2  
  1     1   259  
  1     1   6  
  1     1   13  
  1     1   34  
  1     1   14  
  1     1   5  
  1     1   197  
  1     1   6  
  1     1   2  
  1     1   165  
  1     1   7  
  1     1   2  
  1     1   48  
  1     1   7  
  1     1   1  
  1     1   491  
  1     1   7  
  1     1   2  
  1     1   54  
  1     1   10  
  1     1   2  
  1     1   226  
  1     1   6  
  1     1   2  
  1     1   33  
  1     1   7  
  1     1   4  
  1     1   103  
  1     1   6  
  1     1   2  
  1     1   43  
  1     1   5  
  1     1   2  
  1     1   212  
  1     1   11  
  1     1   3  
  1     1   60  
  1     1   5  
  1     1   2  
  1     1   229  
  1     1   7  
  1     1   15  
  1     1   52  
  1     1   6  
  1     1   2  
  1     1   255  
  1     1   7  
  1     1   2  
  1     1   49  
  1     1   6  
  1     1   2  
  1     1   208  
  1     1   7  
  1     1   2  
  1     1   173  
  1     1   7  
  1     1   1  
  1     1   32  
  1     1   4  
  1     1   2  
  1     1   456  
  1     1   6  
  1     1   12  
  1     1   43  
  1     1   7  
  1     1   2  
  1     1   227  
  1     1   9  
  1     1   2  
  1     1   47  
  1     1   6  
  1     1   1  
  1     1   99  
  1     1   14  
  1     1   4  
  1     1   38  
  1     1   5  
  1     1   2  
  1     1   232  
  1     1   8  
  1     1   2  
  1     1   52  
  1     1   5  
  1     1   2  
  1     1   224  
  1     1   16  
  1     1   1  
  1     1   35  
  1     1   6  
  1     1   2  
  1     1   222  
  1     1   7  
  1     1   2  
  1     1   50  
  1     1   6  
  1     1   2  
  1     1   224  
  1     1   7  
  1     1   3  
  1     1   40  
  1     1   5  
  1     1   2  
  1     1   208  
  1     1   7  
  1     1   2  
  1     1   54  
  1     1   9  
  1     1   4  
  1     1   229  
  1     1   17  
  1     1   2  
  1     1   49  
  1     1   7  
  1     1   2  
  1     2   292  
  1     1   9  
  1     1   2  
  1     1   46  
  1     0   6  
  1         1  
  1         196  
  1         12  
  1         3  
  1         35  
  1         7  
  1         2  
  1         198  
  1         10  
  1         3  
  1         52  
  1         6  
  1         3  
  1         231  
  1         8  
  1         3  
  1         36  
  1         5  
  1         3  
  1         163  
  1         7  
  1         3  
  1         54  
  1         9  
  1         2  
  1         222  
  1         7  
  1         9  
  1         41  
  1         17  
  1         1  
  1         358  
  1         7  
  1         2  
  1         128  
  1         7  
  1         2  
  1         43  
  1         6  
  1         2  
  1         234  
  1         10  
  1         2  
  1         312  
  1         28  
  1         2  
  1         34  
  1         6  
  1         2  
  1         337  
  1         9  
  1         2  
  1         52  
  1         8  
  1         3  
  1         195  
  1         7  
  1         3  
  1         35  
  1         14  
  1         2  
  1         218  
  1         8  
  1         2  
  1         36  
  1         7  
  1         5  
  1         210  
  1         7  
  1         9  
  1         39  
  1         7  
  1         1  
  1         207  
  1         7  
  1         3  
  1         35  
  1         4  
  1         2  
  1         205  
  1         7  
  1         2  
  1         51  
  1         6  
  1         17  
  1         118  
  1         7  
  1         2  
  1         36  
  1         4  
  1         2  
  1         212  
  1         13  
  1         2  
  1         71  
  1         6  
  1         2  
  1         239  
  1         22  
  1         3  
  1         53  
  1         7  
  1         11  
  1         1262  
  1         8  
  1         2  
  1         35  
  1         5  
  1         2  
  1         149  
  1         7  
  1         2  
  1         43  
  1         4  
  1         4  
  1         123  
  1         6  
  1         3  
  1         37  
  1         5  
  1         2  
  1         114  
  1         10  
  1         3  
  1         46  
  1         6  
  1         2  
  1         255  
  1         7  
  1         4  
  1         49  
  1         6  
  1         5  
  1         328  
  1         7  
  1         2  
  1         35  
  1         5  
  1         1  
  1         210  
  1         7  
  1         4  
  1         34  
  1         5  
  1         3  
  1         307  
  1         7  
  1         3  
  1         37  
  1         6  
  1         1  
  1         319  
  1         8  
  1         2  
  1         35  
  1         6  
  1         1  
  1         262  
  1         8  
  1         3  
  1         34  
  1         5  
  1         2  
  1         289  
  1         7  
  1         2  
  1         35  
  1         10  
  1         2  
  1         272  
  1         7  
  1         11  
  1         47  
  1         6  
  1         2  
  1         180  
  1         7  
  1         5  
  1         47  
  1         7  
  1         2  
  1         266  
  1         7  
  1         1  
  1         39  
  1         6  
  1         2  
  1         350  
  1         6  
  1         2  
  1         51  
  1         8  
  1         2  
  1         137  
  1         7  
  1         2  
  1         47  
  1         38  
  1         4  
  1         269  
  1         8  
  1         2  
  1         56  
  1         7  
  1         2  
  1         276  
  1         6  
  1         2  
  1         54  
  1         7  
  1         2  
  1         348  
  1         8  
  1         3  
  1         42  
  1         6  
  1         1  
  1         285  
  1         9  
  1         2  
  1         60  
  1         6  
  1         2  
  1         204  
  1         7  
  1         2  
  1         38  
  1         5  
  1         2  
  1         132  
  1         7  
  1         3  
  1         35  
  1         4  
  1         3  
  1         121  
  1         8  
  1         1  
  1         34  
  1         6  
  1         1  
  1         116  
  60         5184  
  1         3  
  1         6  
  1         3  
  1         2  
  1         3  
  1         5  
  1         2  
  1         6  
  0         0  
  1         5  
  0         0  
  1         2  
  1         11  
  0         0  
  2         6  
  2         6  
  2         16  
  1         5  
  1         3  
  1         4  
  1         9  
  1         4  
  1         5  
  1         7  
  0         0  
  0         0  
858             }
859             else {
860 20 50       48 print "\n--------actionsout----------\n$globalconditionstart$actionsout}\n---------actionsout---------\n" if $verbose;
861 1     1 0 7 eval($globalconditionstart.$actionsout.'}');
  1     1 0 8  
  1     1   39  
  1     1   5  
  1     1   2  
  1     1   102  
  1     1   17  
  1     1   3  
  1     1   34  
  1     1   5  
  1     1   4  
  1     1   35  
  1     1   6  
  1     1   2  
  1     1   47  
  1     1   7  
  1     1   2  
  1     1   101  
  1     1   6  
  1     1   2  
  1     1   35  
  1     1   5  
  1     1   3  
  1     1   109  
  1     1   6  
  1     1   2  
  1     1   34  
  1     1   5  
  1     1   2  
  1     1   93  
  1     1   8  
  1     1   1  
  1     1   35  
  1     1   7  
  1     1   14  
  1     1   39  
  1     1   7  
  1     1   2  
  1     1   34  
  1     1   7  
  1     1   1  
  1     1   102  
  1     1   7  
  1     1   2  
  1     1   35  
  1         4  
  1         3  
  1         31  
  1         8  
  1         2  
  1         61  
  1         7  
  1         2  
  1         80  
  1         6  
  1         3  
  1         35  
  1         6  
  1         2  
  1         36  
  1         6  
  1         2  
  1         88  
  1         7  
  1         3  
  1         28  
  1         4  
  1         13  
  1         37  
  1         7  
  1         2  
  1         33  
  1         6  
  1         2  
  1         42  
  1         6  
  1         2  
  1         32  
  1         5  
  1         2  
  1         32  
  1         6  
  1         4  
  1         137  
  1         7  
  1         5  
  1         40  
  1         5  
  1         2  
  1         31  
  1         7  
  1         5  
  1         35  
  1         5  
  1         198  
  1         44  
  1         6  
  1         1  
  1         44  
  1         7  
  1         1  
  1         20  
  1         7  
  1         2  
  1         90  
  1         14  
  1         4  
  1         202  
  1         11  
  1         2  
  1         39  
  1         7  
  1         2  
  1         31  
  1         5  
  1         2  
  1         29  
  1         6  
  1         2  
  1         44  
  1         6  
  1         2  
  1         19  
  1         7  
  1         2  
  1         47  
  1         6  
  1         2  
  1         102  
  20         1484  
  1         62  
  1         47  
862 20         848 return 1;
863             }
864 0         0 return 1;
865             }
866              
867             sub ReplaceAllInRecord {
868 58     58 0 116 my ($pos) = @_;
869 58 100 66     267 return unless ( $record && $record->fields() );
870 56         472 foreach my $field ( $record->fields() ) {
871 207         2069 my @subfields;
872 207 100       423 if(!$field->is_control_field()) {
873 178 100       863 if (scalar($field->subfields()) > 0) {
874 177         3337 foreach my $subfield ( $field->subfields() ) {
875 361         3065 my $newval=$$subfield[1];
876 361 100       638 if ($pos eq "before") {
    50          
877             #$newval=~s/\$/#_dollarsd_#/g;#to force warn
878 153         201 $newval=~s/\$/#_dollars_#/g;
879 153         205 $newval=~s/"/#_dbquote_#/g;
880             }
881             elsif ($pos eq "after") {
882 208         275 $newval=~s/#_dollars_#/\$/g;
883 208         242 $newval=~s/#_dbquote_#/"/g;
884             }
885 361         649 push @subfields, ( $$subfield[0], $newval );
886             }
887 177         440 my $newfield = MARC::Field->new( $field->tag(), $field->indicator(1), $field->indicator(2), @subfields );
888 177         12671 $field->replace_with($newfield);
889             }
890             }
891             else {
892 29         151 my $newval=$field->data();
893 29 100       316 if ($pos eq "before") {
    50          
894 12         22 $newval=~s/\$/#_dollars_#/g;
895 12         19 $newval=~s/"/#_dbquote_#/g;
896             }
897             elsif ($pos eq "after") {
898 17         32 $newval=~s/#_dollars_#/\$/g;
899 17         26 $newval=~s/#_dbquote_#/"/g;
900             }
901 29         59 $field->update($newval);
902             }
903             }
904             }
905              
906             1;
907             __END__