File Coverage

blib/lib/Catmandu/Fix/perlcode.pm
Criterion Covered Total %
statement 19 19 100.0
branch n/a
condition 2 3 66.6
subroutine 6 6 100.0
pod 0 1 0.0
total 27 29 93.1


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 1     1   399  
  1         2  
  1         9  
4             our $VERSION = '1.2019';
5              
6             use Moo;
7 1     1   7 use namespace::clean;
  1         2  
  1         5  
8 1     1   252 use Catmandu::Fix::Has;
  1         2  
  1         12  
9 1     1   638  
  1         31  
  1         5  
10             with 'Catmandu::Fix::Base';
11              
12             our %CACHE;
13              
14             has file => (fix_arg => 1);
15              
16             has code => (
17             is => 'lazy',
18             builder => sub {
19             my $file = $_[0]->file;
20 3     3   28 $CACHE{$file} //= do $_[0]->file;
21 3   66     1105 }
22             );
23              
24             my ($self, $fixer) = @_;
25              
26 3     3 0 6 my $code = $fixer->capture($self->code);
27             my $var = $fixer->var;
28 3         51 my $reject = $fixer->capture({});
29 3         41  
30 3         20 "if (${code}->(${var},${reject}) == ${reject}) {"
31             . $fixer->emit_reject . "}";
32 3         14 }
33              
34             1;
35              
36              
37             =pod
38              
39             =head1 NAME
40              
41             Catmandu::Fix::perlcode - execute Perl code as fix function
42              
43             =head1 DESCRIPTION
44              
45             Use this fix in the L<Catmandu> fix language to make use of a Perl script:
46              
47             perlcode(myscript.pl)
48              
49             The script (here C<myscript.pl>) must return a code reference:
50              
51             sub {
52             my $data = shift;
53              
54             $data->{testing} = 1 ; # modify the item
55              
56             return $data; # and return the data
57             }
58              
59             When not using the fix language this
60              
61             my $fixer = Catmandu::Fix->new( fixes => [ do 'myscript.pl' ] );
62             $fixer->fix( $item );
63              
64             is roughly equivalent to:
65              
66             my $code = do 'myscript.pl';
67             $item = $code->( $item )
68              
69             All scripts are cached based on their filename, so using this fix multiple
70             times will only load each given script once.
71              
72             The code reference gets passed a second value to reject selected items such as
73             possible with see L<Catmandu::Fix::reject>:
74              
75             sub {
76             my ($data, $reject) = @_;
77              
78             if ($data->{my_field} eq 'OK') {
79             return $data; # return the data and continue processing
80             }
81             else {
82             return $reject; # return the reject flag to ignore this record
83             }
84             }
85              
86             =head1 SEE ALSO
87              
88             L<Catmandu::Fix::code>, L<Catmandu::Fix::cmd>
89              
90             =cut