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   79611 use Catmandu::Sane;
  2         129407  
  2         16  
3 2     2   862 use Catmandu::Fix::marc_map;
  2         6  
  2         15  
4 2     2   347 use Catmandu::Fix::Condition::exists;
  2         8387  
  2         14  
5 2     2   630 use Catmandu::Fix::set_field;
  2         3500  
  2         9  
6 2     2   322 use Catmandu::Fix::remove_field;
  2         3151  
  2         11  
7 2     2   98 use Moo;
  2         5  
  2         13  
8 2     2   718 use Catmandu::Fix::Has;
  2         32  
  2         12  
9              
10             our $VERSION = '1.21';
11              
12             with 'Catmandu::Fix::Condition';
13              
14             has marc_path => (fix_arg => 1);
15              
16             sub emit {
17 4     4 0 309 my ($self,$fixer,$label) = @_;
18              
19 4         6 my $perl;
20              
21 4         17 my $tmp_var = '_tmp_' . int(rand(9999));
22 4         81 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         462 $perl .= $marc_map->emit($fixer,$label);
29              
30 4 100       105 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         631 my $remove_field = Catmandu::Fix::remove_field->new($tmp_var);
36              
37 4         398 my $pass_fixes = $self->pass_fixes;
38 4         12 my $fail_fixes = $self->fail_fixes;
39              
40 4         14 $all_match->pass_fixes([ @$pass_fixes ]);
41 4         10 $all_match->fail_fixes([ @$fail_fixes ]);
42              
43 4         11 $perl .= $all_match->emit($fixer,$label);
44              
45 4         2248 $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;