File Coverage

blib/lib/Catmandu/Bag.pm
Criterion Covered Total %
statement 39 39 100.0
branch 2 2 100.0
condition 2 3 66.6
subroutine 15 15 100.0
pod 3 5 60.0
total 61 64 95.3


line stmt bran cond sub pod time code
1             package Catmandu::Bag;
2              
3 20     20   17017 use Catmandu::Sane;
  20         50  
  20         145  
4              
5             our $VERSION = '1.2020';
6              
7 20     20   162 use Catmandu::Util qw(:check is_string require_package now);
  20         51  
  20         5889  
8 20     20   9012 use Catmandu::Bag::IdGenerator::UUID;
  20         73  
  20         675  
9 20     20   141 use Moo::Role;
  20         42  
  20         90  
10 20     20   18121 use MooX::Aliases;
  20         62452  
  20         140  
11 20     20   8642 use namespace::clean;
  20         56  
  20         122  
12              
13             with 'Catmandu::Logger';
14             with 'Catmandu::Pluggable';
15             with 'Catmandu::Iterable';
16             with 'Catmandu::Addable';
17              
18             requires 'get';
19             requires 'delete';
20             requires 'delete_all';
21              
22             has store => (is => 'ro', required => 1);
23             has name => (is => 'ro', required => 1);
24             has id_key => (is => 'lazy', alias => 'id_field');
25             has id_generator => (
26             is => 'lazy',
27             coerce => sub {
28             if (is_string($_[0])) {
29             require_package($_[0], 'Catmandu::Bag::IdGenerator')->new;
30             }
31             else {
32             $_[0];
33             }
34             },
35             );
36              
37             sub _build_id_key {
38 30     30   972 $_[0]->store->id_key;
39             }
40              
41             sub _build_id_generator {
42 4     4   210 state $uuid = Catmandu::Bag::IdGenerator::UUID->new;
43             }
44              
45             before get => sub {
46             check_value($_[1]);
47             };
48              
49             before add => sub {
50             my ($self, $data) = @_;
51             check_hash_ref($data);
52             check_value($data->{$self->id_key} //= $self->generate_id($data));
53             };
54              
55             before delete => sub {
56             check_value($_[1]);
57             };
58              
59             around delete_all => sub {
60             my ($orig, $self) = @_;
61             $orig->($self);
62             return;
63             };
64              
65             sub generate_id {
66 12     12 0 2960 my ($self) = @_;
67 12         208 $self->id_generator->generate($self);
68             }
69              
70             sub exists {
71 2     2 1 1445 my ($self, $id) = @_;
72 2 100       54 defined $self->get($id) ? 1 : 0;
73             }
74              
75             sub get_or_add {
76 3     3 1 23 my ($self, $id, $data) = @_;
77 3         14 check_value($id);
78 3         504 check_hash_ref($data);
79 3   66     518 $self->get($id) // do {
80 1         19 $data->{$self->id_key} = $id;
81 1         21 $self->add($data);
82             };
83             }
84              
85             sub to_hash {
86 1     1 0 6 my ($self) = @_;
87             $self->reduce(
88             {},
89             sub {
90 1     1   5 my ($hash, $data) = @_;
91 1         24 $hash->{$data->{$self->id_key}} = $data;
92 1         11 $hash;
93             }
94 1         12 );
95             }
96              
97             sub touch {
98 2     2 1 17 my ($self, $key, $format) = @_;
99 2     1   21 $self->add_many($self->tap(sub {$_[0]->{$key} = now($format)}));
  1         8  
100 2         64 $self->commit;
101             }
102              
103             1;
104              
105             __END__
106              
107             =pod
108              
109             =head1 NAME
110              
111             Catmandu::Bag - A Catmandu::Store compartment to persist data
112              
113             =head1 SYNOPSIS
114              
115             my $store = Catmandu::Store::DBI->new(data_source => 'DBI:mysql:database=test');
116              
117             my $store = Catmandu::Store::DBI->new(
118             data_source => 'DBI:mysql:database=test',
119             bags => { journals => {
120             fix => [ ... ] ,
121             autocommit => 1 ,
122             plugins => [ ... ] ,
123             id_generator => Catmandu::IdGenerator::UUID->new ,
124             }
125             },
126             bag_class => Catmandu::Bag->with_plugins('Datestamps')
127             );
128              
129             # Use the default bag...
130             my $bag = $store->bag;
131              
132             # Or a named bag...
133             my $bag = $store->bag('journals');
134              
135             # Every bag is an iterator...
136             $bag->each(sub { ... });
137             $bag->take(10)->each(sub { ... });
138              
139             $bag->add($hash);
140             $bag->add_many($iterator);
141             $bag->add_many([ $hash, $hash , ...]);
142              
143             # Commit changes...
144             $bag->commit;
145              
146             if ($bag->exists($id)) {
147             # ...
148             }
149              
150             my $obj = $bag->get($id);
151             $bag->delete($id);
152              
153             $bag->delete_all;
154              
155             =head1 CONFIGURATION
156              
157             =over
158              
159             =item fix
160              
161             Contains an array of fixes (or Fix files) to be applied before importing data into the bag.
162              
163             =item plugins
164              
165             An array of Catmandu::Pluggable to apply to the bag items.
166              
167             =item autocommit
168              
169             When set to a true value an commit automatically gets executed when the bag
170             goes out of scope.
171              
172             =item id_generator
173              
174             A L<Catmandu::IdGenerator> or name of an IdGenerator class.
175             By default L<Catmandu::IdGenerator::UUID> is used.
176              
177             =item id_key
178              
179             Use a custom key to hold id's in this bag. See L<Catmandu::Store> for the
180             default or store wide value. Also aliased as C<id_field>.
181              
182             =back
183              
184             =head1 METHODS
185              
186             =head2 add($hash)
187              
188             Add a hash to the bag or updates an existing hash by using its '_id' key. Returns
189             the stored hash on success or undef on failure.
190              
191             =head2 add_many($array)
192              
193             =head2 add_many($iterator)
194              
195             Add or update one or more items to the bag.
196              
197             =head2 get($id)
198              
199             Retrieves the item with identifier $id from the bag.
200              
201             =head2 exists($id)
202              
203             Returns C<1> if the item with identifier $id exists in the bag.
204              
205             =head2 get_or_add($id, $hash)
206              
207             Retrieves the item with identifier $id from the store or adds C<$hash> with _id
208             C<$id> if it's not found.
209              
210             =head2 delete($id)
211              
212             Deletes the item with C<$id> from the bag.
213              
214             =head2 delete_all
215              
216             Clear the bag.
217              
218             =head2 touch($key, $format)
219              
220             Add the current datetime to each record.
221              
222             $bag->touch('date_updated', 'iso_date_time');
223              
224             See L<Catmandu::Util::now> for possible format values.
225              
226             =head2 commit
227              
228             Commit changes.
229              
230             =head2 log
231              
232             Return the current logger.
233              
234             =head1 CLASS METHODS
235              
236             =head2 with_plugins($plugin)
237              
238             =head2 with_plugins(\@plugins)
239              
240             Plugins are a kind of fixes that should be available for each bag. E.g. the Datestamps plugin will
241             automatically store into each bag item the fields 'date_updated' and 'date_created'. The with_plugins
242             accept one or an array of plugin classnames and returns a subclass of the Bag with the plugin
243             methods implemented.
244              
245             =head1 SEE ALSO
246              
247             L<Catmandu::Iterable>, L<Catmandu::Searchable>, L<Catmandu::Fix>, L<Catmandu::Pluggable>
248              
249             =cut