File Coverage

blib/lib/Catmandu/Fix/Inlineable.pm
Criterion Covered Total %
statement 31 32 96.8
branch 4 6 66.6
condition 3 8 37.5
subroutine 7 7 100.0
pod n/a
total 45 53 84.9


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 114     114   139809  
  114         298  
  114         741  
4             our $VERSION = '1.2019';
5              
6             use Clone qw(clone);
7 114     114   777 use Moo::Role;
  114         215  
  114         5139  
8 114     114   650 use namespace::clean;
  114         267  
  114         702  
9 114     114   39197  
  114         263  
  114         706  
10             requires 'fix';
11              
12             my $target = caller;
13             my ($pkg, %opts) = @_;
14 99     99   5337  
15 99         1646 if (my $sym = $opts{as}) {
16             $opts{cache} //= 1;
17 99 100       4770  
18 2   50     14 my $sub = sub {
19             my $data = shift;
20             my $fixer;
21 2     2   4382  
22 2         4 state $cache = {};
23             if ($opts{cache}) {
24 2         5 my $key = join('--', @_);
25 2 50       9 $fixer = $cache->{$key} ||= $pkg->new(@_);
26 2         6 }
27 2   33     34  
28             $fixer ||= $pkg->new(@_);
29              
30 2   33     37 if ($opts{clone}) {
31             $data = clone($data);
32 2 50       7 }
33 0         0  
34             $fixer->fix($data);
35             };
36 2         7 no strict 'refs';
37 2         9 *{"${target}::$sym"} = $sub;
38 114     114   56979 }
  114         238  
  114         10501  
39 2         4 }
  2         11  
40              
41             1;
42              
43              
44             =pod
45              
46             =head1 NAME
47              
48             Catmandu::Fix::Inlineable - Role for all Catmandu fixes that can be inlined
49              
50             =head1 SYNOPSIS
51              
52             package Catmandu::Fix::my_fix1;
53              
54             use Catmandu::Sane;
55             use Moo;
56              
57             with 'Catmandu::Fix::Inlineable';
58              
59             sub fix {
60             my ($self, $data) = @_;
61             ....FIXER GENERATING CODE....
62             $data
63             }
64              
65             package Catmandu::Fix::my_fix2;
66              
67             use Catmandu::Sane;
68             use Moo;
69              
70             # Catmandu::Fix::Base automatically is Inlineable
71             with 'Catmandu::Fix::Base';
72              
73             sub emit {
74             my ($self, $fixer) = @_;
75             ....FIXER GENERATING CODE....
76             }
77              
78             package main;
79              
80             use Catmandu::Fix::my_fix1 as => 'my_fix1';
81             # disabling caching may be desirable with fixes that have side effects like
82             # writing to a file, the downside is that a new instance of the fix will be
83             # created with each invocation
84             use Catmandu::Fix::my_fix2 as => 'my_fix2', cache => 0;
85              
86             my $data = {};
87              
88             $data = my_fix1($data);
89             $data = my_fix2($data);
90              
91             =head1 SEE ALSO
92              
93             For more information how to create fixes read the following two blog posts:
94              
95             http://librecat.org/catmandu/2014/03/14/create-a-fixer.html
96             http://librecat.org/catmandu/2014/03/26/creating-a-fixer-2.html
97              
98             =cut