File Coverage

blib/lib/Catmandu/Fix/Condition/marc_has_many.pm
Criterion Covered Total %
statement 34 34 100.0
branch 2 2 100.0
condition n/a
subroutine 8 8 100.0
pod 0 1 0.0
total 44 45 97.7


line stmt bran cond sub pod time code
1             package Catmandu::Fix::Condition::marc_has_many;
2 2     2   81827 use Catmandu::Sane;
  2         164583  
  2         19  
3 2     2   959 use Catmandu::Fix::marc_map;
  2         7  
  2         16  
4 2     2   537 use Catmandu::Fix::Condition::exists;
  2         12551  
  2         13  
5 2     2   504 use Catmandu::Fix::set_field;
  2         5332  
  2         15  
6 2     2   516 use Catmandu::Fix::remove_field;
  2         5928  
  2         13  
7 2     2   109 use Moo;
  2         4  
  2         12  
8 2     2   692 use Catmandu::Fix::Has;
  2         34  
  2         16  
9              
10             our $VERSION = '1.19';
11              
12             with 'Catmandu::Fix::Condition';
13              
14             has marc_path => (fix_arg => 1);
15              
16             sub emit {
17 4     4 0 284 my ($self,$fixer,$label) = @_;
18              
19 4         8 my $perl;
20              
21 4         14 my $tmp_var = '_tmp_' . int(rand(9999));
22 4         70 my $marc_map = Catmandu::Fix::marc_map->new(
23             $self->marc_path ,
24             "$tmp_var" ,
25             -split=>1 ,
26             -nested_arrays=>1
27             );
28 4         430 $perl .= $marc_map->emit($fixer,$label);
29              
30 4 100       80 my $all_match =
31             $self->marc_path =~ m{^...(\/[0-9]+-[0-9]+)?$} ?
32             Catmandu::Fix::Condition::exists->new("$tmp_var.1") :
33             Catmandu::Fix::Condition::exists->new("$tmp_var.0.1");
34              
35 4         488 my $remove_field = Catmandu::Fix::remove_field->new($tmp_var);
36              
37 4         453 my $pass_fixes = $self->pass_fixes;
38 4         13 my $fail_fixes = $self->fail_fixes;
39              
40 4         22 $all_match->pass_fixes([ @$pass_fixes ]);
41 4         17 $all_match->fail_fixes([ @$fail_fixes ]);
42              
43 4         17 $perl .= $all_match->emit($fixer,$label);
44              
45 4         2361 $perl;
46             }
47              
48             =head1 NAME
49              
50             Catmandu::Fix::Condition::marc_has_many - Test if a MARC has more than one (sub)field
51              
52             =head1 SYNOPSIS
53              
54             # marc_has_many(MARC_PATH)
55              
56             if marc_has_many('245')
57             add_field('error.$append','more than one 245!')
58             end
59              
60             =head1 DESCRIPTION
61              
62             Evaluate the enclosing fixes only if the MARC has more than one (sub)field.
63              
64             =head1 METHODS
65              
66             =head2 marc_has_many(MARC_PATH)
67              
68             Evaluates to true when the MARC has more than one (sub)field, false otherwise.
69              
70             =head1 SEE ALSO
71              
72             L<Catmandu::Fix::marc_has>
73              
74             =cut
75              
76             1;