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