File Coverage

blib/lib/Catmandu/Store.pm
Criterion Covered Total %
statement 39 39 100.0
branch 2 2 100.0
condition 16 23 69.5
subroutine 12 12 100.0
pod 3 4 75.0
total 72 80 90.0


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 19     19   111728  
  19         42  
  19         122  
4             our $VERSION = '1.2018';
5              
6             use Hash::Util::FieldHash qw(fieldhash);
7 19     19   608 use Catmandu::Util qw(require_package);
  19         837  
  19         998  
8 19     19   99 use Moo::Role;
  19         141  
  19         739  
9 19     19   94 use MooX::Aliases;
  19         44  
  19         120  
10 19     19   7179 use namespace::clean;
  19         2739  
  19         145  
11 19     19   7391  
  19         51  
  19         117  
12             with 'Catmandu::Logger';
13              
14             has bag_class => (is => 'ro', default => sub {ref($_[0]) . '::Bag'},);
15              
16             has default_bag => (is => 'lazy');
17             has default_plugins => (is => 'ro', default => sub {[]},);
18             has default_options => (is => 'ro', default => sub {+{}},);
19             has bag_options => (is => 'ro', init_arg => 'bags', default => sub {+{}},);
20             has key_prefix => (is => 'lazy', default => sub {'_'},);
21             has id_key => (is => 'lazy', alias => 'id_field');
22              
23             $_[0]->key_prefix . $_[1];
24             }
25 30     30 1 478  
26             $_[0]->key_for('id');
27             }
28              
29 26     26   260 'data';
30             }
31              
32             my ($self, $name, $opts) = @_;
33 30     30   978 $opts ||= {};
34             $opts->{store} = $self;
35             $opts->{name} = $name // $self->default_bag;
36             my $default_opts = $self->default_options;
37 43     43 0 116 my $bag_opts = $self->bag_options->{$opts->{name}} //= {};
38 43   50     180 $opts = {%$default_opts, %$bag_opts, %$opts};
39 43         93  
40 43   33     134 my $pkg = require_package(delete($opts->{class}) // $self->bag_class);
41 43         108 my $default_plugins = $self->default_plugins;
42 43   100     223 my $plugins = delete($opts->{plugins}) // [];
43 43         207 if (@$default_plugins || @$plugins) {
44             $pkg = $pkg->with_plugins(@$default_plugins, @$plugins);
45 43   33     282 }
46 43         111 $pkg->new($opts);
47 43   100     171 }
48 43 100 100     212  
49 14         64 {
50             fieldhash my %bag_instances;
51 43         12275  
52             my ($self) = @_;
53             $bag_instances{$self} ||= {};
54             }
55              
56             my ($self, $name) = @_;
57             $name ||= $self->default_bag;
58 149     149 1 251 $self->bags->{$name} ||= $self->new_bag($name);
59 149   100     2000 }
60             }
61              
62             1;
63 149     149 1 2010521  
64 149   66     2217  
65 149   66     866 =pod
66              
67             =head1 NAME
68              
69             Catmandu::Store - Namespace for packages that can make data persistent
70              
71             =head1 SYNOPSIS
72              
73             # From the command line
74              
75             $ catmandu import JSON into MongoDB --database_name 'bibliography' < data.json
76              
77             $ catmandu export MongoDB --database_name 'bibliography' to YAML
78             $ catmandu export MongoDB --database_name 'bibliography' --query '{"PublicationYear": "1937"}'
79             $ catmandu count MongoDB --database_name 'bibliography' --query '{"PublicationYear": "1937"}'
80              
81             # From Perl
82             use Catmandu;
83              
84             my $store = Catmandu->store('MongoDB',database_name => 'bibliography');
85              
86             my $obj1 = $store->bag->add({ name => 'Patrick' });
87              
88             printf "obj1 stored as %s\n" , $obj1->{_id};
89              
90             # Force an id in the store
91             my $obj2 = $store->bag->add({ _id => 'test123' , name => 'Nicolas' });
92              
93             my $obj3 = $store->bag->get('test123');
94              
95             $store->bag->delete('test123');
96              
97             $store->bag->delete_all;
98              
99             # Some stores can be searched
100             my $hits = $store->bag->search(query => 'name:Patrick');
101              
102             =head1 DESCRIPTION
103              
104             A Catmandu::Store is a stub for Perl packages that can store data into
105             databases or search engines. The database as a whole is called a 'store'.
106             Databases also have compartments (e.g. tables) called L<Catmandu::Bag>-s.
107             Some stores can be searched using L<Catmandu::Searchable> methods.
108              
109             =head1 CONFIGURATION
110              
111             =over
112              
113             =item default_plugins
114              
115             Specify plugins that will be applied to every bag in the store.
116              
117             my $store = Catmandu::Store::MyDB->new(default_plugins => ['Datestamps']);
118              
119             =item default_bag
120              
121             The name of the bag to use if no explicit bag is given. Default is 'data'.
122              
123             my $store = Catmandu::Store::MyDB->new(default_bag => 'stuff');
124             # this will return the stuff bag
125             my $bag = $store->bag;
126              
127             =item bags
128              
129             Specify configuration for individual bags.
130              
131             my $store = Catmandu::Store::Hash->new(
132             bags => {stuff => {plugins => ['Datestamps']}});
133             # this bag will use the L<Catmandu::Plugin::Datestamps> role
134             $store->bag('stuff')
135             # this bag won't
136             $store->bag('otherbag')
137              
138             =item bag_class
139              
140             An optional custom class to use for bags. Default is C<Bag> in the store's
141             namespace. This class should consume the L<Catmandu::Bag> role.
142              
143             # this will use the Catmandu::Store::MyDB::Bag class for bags
144             Catmandu::Store::MyDB->new()
145             # this will use MyBag
146             Catmandu::Store::MyDB->new(bag_class => 'MyBag')
147              
148             =item key_prefix
149              
150             Use a custom prefix to mark the reserved or special keys that the store uses.
151             By default an underscore gets prependend. The only special key in a normal
152             store is '_id'. L<Catmandu::Plugin::Versioning> will also use '_version'. Other
153             plugins or stores may add their own special keys.
154              
155             # this store will use the my_id key to hold id's
156             Catmandu::Store::MyDB->new(key_prefix => 'my_')
157              
158             =item id_key
159              
160             Define a custom key to hold id's for all bags of this store. See C<key_prefix>
161             for the default value. Also aliased as C<id_field>. Note that this can also be
162             overriden on a per bag basis.
163              
164             =back
165              
166             =head1 METHODS
167              
168             =head2 bag($name)
169              
170             Create or retieve a bag with name C<$name>. Returns a L<Catmandu::Bag>.
171              
172             =head2 key_for($key)
173              
174             Helper method that applies C<key_prefix> to the C<$key> given.
175              
176             =head2 log
177              
178             Return the current logger. Can be used when creating your own Stores.
179              
180             E.g.
181              
182             package Catmandu::Store::Hash;
183              
184             ...
185              
186             sub generator {
187             my ($self) = @_;
188              
189             $self->log->debug("generating record");
190             ...
191             }
192              
193             See also: L<Catmandu> for activating the logger in your main code.
194              
195             =head1 SEE ALSO
196              
197             L<Catmandu::Bag>, L<Catmandu::Searchable>
198              
199             =cut