File Coverage

blib/lib/Catmandu/Plugin/Versioning.pm
Criterion Covered Total %
statement 52 60 86.6
branch 8 16 50.0
condition 3 7 42.8
subroutine 17 18 94.4
pod 5 5 100.0
total 85 106 80.1


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 2     2   1226  
  2         5  
  2         12  
4             our $VERSION = '1.2018';
5              
6             use Catmandu::Util qw(is_value is_array_ref check_value check_positive);
7 2     2   13 use Data::Compare;
  2         12  
  2         158  
8 2     2   12 use Moo::Role;
  2         4  
  2         18  
9 2     2   7435 use MooX::Aliases;
  2         4  
  2         12  
10 2     2   669 use namespace::clean;
  2         4  
  2         9  
11 2     2   699  
  2         6  
  2         11  
12             has version_bag_name => (is => 'lazy', init_arg => 'version_bag');
13             has version_bag => (is => 'lazy', init_arg => undef);
14             has version_key => (is => 'lazy', alias => 'version_field');
15              
16             has version_compare_ignore => (
17             is => 'lazy',
18             coerce => sub {
19             my $keys = $_[0];
20             $keys = [@$keys] if is_array_ref $keys;
21             $keys = [split /,/, $keys] if is_value $keys;
22             $keys;
23             },
24             );
25              
26             has version_transfer => (
27             is => 'lazy',
28             coerce => sub {
29             my $keys = $_[0];
30             $keys = [@$keys] if is_array_ref $keys;
31             $keys = [split /,/, $keys] if is_value $keys;
32             $keys;
33             },
34             );
35              
36             $_[0]->name . '_version';
37             }
38 2     2   23  
39             $_[0]->store->bag($_[0]->version_bag_name);
40             }
41              
42 3     3   94 $_[0]->store->key_for('version');
43             }
44              
45             [$_[0]->version_key];
46 4     4   65 }
47              
48             my ($self, $keys) = @_;
49             my $version_key = $self->version_key;
50 2     2   54 push @$keys, $version_key unless grep /^$version_key$/, @$keys;
51             }
52              
53             [];
54 0     0   0 }
55 0         0  
56 0 0       0 my ($self, $id, $version) = @_;
57             "$id.$version";
58             }
59              
60 3     3   46 around add => sub {
61             my ($sub, $self, $data) = @_;
62             my $id_key = $self->id_key;
63             my $version_key = $self->version_key;
64 19     19   33 if (defined $data->{$id_key} and my $d = $self->get($data->{$id_key})) {
65 19         59 $data->{$version_key} = $d->{$version_key} ||= 1;
66             for my $key (@{$self->version_transfer}) {
67             next if exists $data->{$key} || !exists $d->{$key};
68             $data->{$key} = $d->{$key};
69             }
70             return $data
71             if Compare($data, $d,
72             {ignore_hash_keys => $self->version_compare_ignore});
73             my $version_id
74             = $self->_version_id($data->{$id_key}, $data->{$version_key});
75             $self->version_bag->add(
76             {$self->version_bag->id_key => $version_id, data => $d});
77             $data->{$version_key}++;
78             }
79             else {
80             $data->{$version_key} ||= 1;
81             }
82             $sub->($self, $data);
83             };
84              
85             my ($self, $id, %opts) = @_;
86             if (my $data = $self->get($id)) {
87             my $history = [$data];
88             my $version = $data->{$self->version_key} || 1;
89             while (--$version) {
90             push @$history, $self->get_version($id, $version);
91             }
92             return $history;
93             }
94 3     3 1 7 return;
95 3 50       49 }
96 3         8  
97 3   50     44 my ($self, $id, $version) = @_;
98 3         23 check_value($id);
99 3         6 check_positive($version);
100             my $data;
101 3         13 my $version_id = $self->_version_id($id, $version);
102             if ($data = $self->version_bag->get($version_id)) {
103 0         0 return $data->{data};
104             }
105             if ($data = $self->get($id) and $data->{$self->version_key} == $version) {
106             return $data;
107 12     12 1 25 }
108 12         27 return;
109 12         244 }
110 12         43  
111 12         28 my ($self, $id, $version) = @_;
112 12 100       150 if (my $data = $self->get_version($id, $version)) {
113 9         48 return $self->add($data);
114             }
115 3 50 33     68 return;
116 3         31 }
117              
118 0         0 my ($self, $id) = @_;
119             if (my $data = $self->get($id)) {
120             my $version = $data->{$self->version_key} || 1;
121             if ($version > 1) {
122 1     1 1 15 return $self->get_version($id, $version - 1);
123 1 50       9 }
124 1         17 }
125             return;
126 0         0 }
127              
128             my ($self, $id) = @_;
129             if (my $data = $self->get_previous_version($id)) {
130 3     3 1 10 return $self->add($data);
131 3 50       51 }
132 3   50     43 return;
133 3 50       23 }
134 3         8  
135             1;
136              
137 0         0  
138             =pod
139              
140             =head1 NAME
141 1     1 1 4  
142 1 50       4 Catmandu::Plugin::Versioning - Automatically adds versioning to Catmandu::Store records
143 1         17  
144             =head1 SYNOPSIS
145 0            
146             # Using configuration files
147              
148             $ cat catmandu.yml
149             ---
150             store:
151             test:
152             package: MongoDB
153             options:
154             database_name: test
155             bags:
156             data:
157             plugins:
158             - Versioning
159              
160             # Add two version of record 001 to the store
161             $ echo '{"_id":"001",hello":"world"}' | catmandu import JSON to test
162             $ echo '{"_id":"001",hello":"world2"}' | catmandu import JSON to test
163              
164             # In the store we see only the latest version
165             $ catmandu export test to YAML
166             ---
167             _id: '001'
168             _version: 2
169             hello: world2
170              
171             # In the '_version' store we'll find all the previous versions
172             $ catmandu export test --bag data_version to YAML
173             ---
174             _id: '001.1'
175             data:
176             _id: '001'
177             _version: 1
178             hello: world
179              
180             # Or in your Perl program
181             my $store = Catmandu->store('MongoDB',
182             database_name => 'test' ,
183             bags => {
184             data => {
185             plugins => [qw(Versioning)]
186             }
187             });
188              
189             $store->bag->add({ _id => '001' , hello => 'world'});
190             $store->bag->add({ _id => '001' , hello => 'world2'});
191              
192             print "Versions:\n";
193              
194             for (@{$store->bag->get_history('001')}) {
195             print Dumper($_);
196             }
197              
198             =head1 DESCRIPTION
199              
200             The Catmandu::Plugin::Versioning plugin automatically adds a new 'version' bag to your Catmandu::Store
201             containing previous versions of newly created records. The name of the version is created by appending
202             '_version' to your original bag name. E.g. when add the Versioning plugin to a 'test' bag then 'test_version'
203             will contain the previous version of all your records.
204              
205             When using Catmandu::Store-s that don't have dynamic schema's (e.g. Solr , DBI) these new bags need to be
206             predefined (e.g. create new Solr cores or database tables).
207              
208             =head1 CONFIGURATION
209              
210             =over
211              
212             =item version_compare_ignore
213              
214             By default every change to a record with trigger the creation of a new version. Use the version_compare_ignore option
215             to specify fields that should be ignored when testing for new updates. E.g. in the example below we configured the
216             MongoDB store to add versioning to the default 'data' bag. We want to ignore changes to the 'date_updated' field
217             when creating new version records
218              
219             # catmandu.yml
220             ---
221             store:
222             test:
223             package: MongoDB
224             options:
225             database_name: test
226             bags:
227             data:
228             plugins:
229             - Versioning
230             version_compare_ignore:
231             - date_updated
232              
233             # In your perl
234              
235             # First version
236             $store->bag->add({ _id => '001' , name => 'test' , date_updated => '10:00' });
237              
238             # Second version (name has changed)
239             $store->bag->add({ _id => '001' , name => 'test123' , date_updated => '10:00' });
240              
241             # Second version (date_updated has changed but we ignored that in our configuration)
242             $store->bag->add({ _id => '001' , name => 'test123' , date_updated => '10:15' });
243              
244             =item version_transfer
245              
246             This option autmatically copies the configured fields from the previous version of a record to the new version of the
247             record. E.g. in the example below we will create a versioning on the default bag and add a rights statement that can
248             not be deleted.
249              
250             # catmandu.yml
251             ---
252             store:
253             test:
254             package: MongoDB
255             options:
256             database_name: test
257             bags:
258             data:
259             plugins:
260             - Versioning
261             version_transfer:
262             - rights:
263              
264             # In your perl
265              
266             # First version
267             $store->bag->add({ _id => '001' , name => 'test' , rights => 'Acme Corp.' });
268              
269             # Second version we will try you delete rights but this is copied to the new version
270             $store->bag->add({ _id => '001' , name => 'test'});
271              
272             print "Rights: %s\n" , $store->bag->get('001')->{rights}; # Rights: Acme Corp.
273              
274             =item version_bag
275              
276             The name of the bag that stores the versions. Default is the name of the
277             versioned bag with '_version' appended.
278              
279             my $store = Catmandu::Store::MyDB->new(bags => {book => {plugins =>
280             ['Versioning'], version_bag => 'book_history'}});
281             $store->bag('book')->version_bag->name # returns 'book_history'
282              
283             =item version_key
284              
285             Use a custom key to hold the version number in this bag. Default is '_version'
286             unless the store has a custom C<key_prefix>. Also aliased as C<version_field>.
287              
288             =back
289              
290             =head1 METHODS
291              
292             Every bag that is configured with the Catmandu::Plugin::Versioning plugin can use the following methods:
293              
294             =head2 get_version(ID,VERSION)
295              
296             Retrieve a record with identifier ID and version identifier VERSION. E.g.
297              
298             my $obj = $store->bag('test')->get_version('001',1);
299              
300             =head2 get_previous_version(ID)
301              
302             Retrieve the previous version of a record with identifier ID. E.g.
303              
304             =head2 get_history(ID)
305              
306             Returns an ARRAY reference with all the versions of the record with identifier ID.
307              
308             =head2 restore_version(ID,VERSION)
309              
310             Overwrites the current version of the stored record with identifier ID with a version with identifier VERSION.
311              
312             =head2 restore_previous_version(ID)
313              
314             Overwrites the current version of the stored record with identifier ID with its previous version.
315              
316             =head1 SEE ALSO
317              
318             L<Catmandu::Store>, L<Catmandu::Bag>
319              
320             =cut