File Coverage

blib/lib/Catmandu/Addable.pm
Criterion Covered Total %
statement 30 30 100.0
branch 8 8 100.0
condition 2 3 66.6
subroutine 7 7 100.0
pod 1 2 50.0
total 48 50 96.0


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 41     41   122214  
  41         87  
  41         267  
4             our $VERSION = '1.2019';
5              
6             use Catmandu::Util qw(:is :check);
7 41     41   285 use Moo::Role;
  41         88  
  41         15667  
8 41     41   320 use namespace::clean;
  41         93  
  41         289  
9 41     41   20115  
  41         82  
  41         357  
10             with 'Catmandu::Fixable';
11              
12             requires 'add';
13              
14             has autocommit => (is => 'ro', default => sub {0});
15             has _commit => (is => 'rw', default => sub {0});
16              
17             around add => sub {
18             my ($orig, $self, $data) = @_;
19             return unless defined $data;
20             $data = $self->_fixer->fix($data) if $self->_fixer;
21             $orig->($self, $data) if defined $data;
22             $data;
23             };
24              
25             around commit => sub {
26             my ($orig, $self) = @_;
27             my (@res) = $orig->($self);
28             $self->_commit(1);
29             @res;
30             };
31              
32             my ($self, $many) = @_;
33              
34 44     44 0 2226 if (is_hash_ref($many)) {
35             $self->add($many);
36 44 100       249 return 1;
37 1         22 }
38 1         4  
39             if (is_array_ref($many)) {
40             $self->add($_) for @$many;
41 43 100       172 return scalar @$many;
42 20         408 }
43 20         138  
44             if (is_invocant($many)) {
45             $many = check_able($many, 'generator')->generator;
46 23 100       78 }
47 22         121  
48             check_code_ref($many);
49              
50 22         100 my $data;
51             my $n = 0;
52 22         4778 while (defined($data = $many->())) {
53 22         46 $self->add($data);
54 22         69 $n++;
55 272         17979 }
56 272         2026 $n;
57             }
58 20         353  
59              
60             my ($self) = shift;
61       20 1   $self->commit if $self->autocommit && !$self->_commit;
62             }
63              
64 90     90   23770 1;
65 90 100 66     2725  
66              
67             =pod
68              
69             =head1 NAME
70              
71             Catmandu::Addable - Base class for all Catmandu modules need to implement add
72              
73             =head1 SYNOPSIS
74              
75             package My::Adder;
76              
77             use Moo;
78             use Data::Dumper;
79            
80             with 'Catmandu::Addable';
81              
82             sub add {
83             my ($self,$object) = @_;
84              
85             print "So you want to add:\n";
86             print Dumper($object);
87              
88             1;
89             }
90              
91             sub commit {
92             my $self = shift;
93              
94             print "And now you are done?\n";
95             }
96              
97             package main;
98              
99             my $adder = My::Adder->new(fix => ['upcase(foo)']);
100              
101             # prints foo => BAR
102             $adder->add({ foo => 'bar' });
103            
104             # prints:
105             # foo => BAR
106             # foo => BAR
107             $adder->add_many([ { foo => 'bar' } , { foo => 'bar' }]);
108              
109             # prints a commit statement
110             $adder->commit;
111              
112             =head1 OPTIONS
113              
114             =over
115              
116             =item autocommit
117              
118             Autocommit when the exporter gets out of scope. Default 0.
119              
120             =back
121              
122             =head1 METHODS
123              
124             =head2 add($hash)
125              
126             Receives a Perl hash and should return true or false.
127              
128             =head2 commit
129              
130             This method is usually called at the end of many add or add_many operations.
131              
132             =head1 INHERIT
133              
134             If you provide an 'add' method, then automatically your package gets a add_many
135             method, plus a fix attribute which transforms all Perl hashes provided to the
136             add method.
137              
138             =head1 SEE ALSO
139              
140             L<Catmandu::Fixable>, L<Catmandu::Exporter> , L<Catmandu::Store>
141              
142             =cut