File Coverage

blib/lib/Catmandu/FileStore.pm
Criterion Covered Total %
statement 44 46 95.6
branch 7 8 87.5
condition 14 20 70.0
subroutine 8 9 88.8
pod 1 1 100.0
total 74 84 88.1


line stmt bran cond sub pod time code
1             package Catmandu::FileStore;
2              
3             our $VERSION = '1.16';
4              
5 12     12   76652 use Catmandu::Sane;
  12         194281  
  12         98  
6 12     12   2500 use Moo::Role;
  12         28  
  12         82  
7 12     12   4687 use Catmandu::Util;
  12         25  
  12         563  
8 12     12   75 use namespace::clean;
  12         26  
  12         66  
9              
10             with 'Catmandu::Store';
11              
12             has index_bag => (is => 'ro', default => sub {'index'},);
13             has index_class => (is => 'ro', default => sub {ref($_[0]) . '::Index'},);
14             has index => (is => 'lazy');
15              
16             sub _build_default_bag {
17 1     1   2086 $_[0]->index_bag;
18             }
19              
20             sub _build_index {
21 31     31   912 my ($self) = @_;
22 31         106 my $name = $self->index_bag;
23 31         58 my $inst;
24              
25             try {
26 31     31   2905 my $opts = {store => $self, name => $name};
27 31         106 my $default_opts = $self->default_options;
28 31   100     228 my $bag_opts = $self->bag_options->{$name} //= {};
29 31         175 $opts = {%$default_opts, %$bag_opts, %$opts};
30              
31 31         190 my $pkg = Catmandu::Util::require_package($self->index_class);
32 31         406 my $index_name = $self->index_bag;
33              
34 31         93 my $default_plugins = $self->default_plugins;
35 31   100     193 my $plugins = delete($opts->{plugins}) // [];
36              
37 31 100 100     175 if (@$default_plugins || @$plugins) {
38 4         25 $pkg = $pkg->with_plugins(@$default_plugins, @$plugins);
39             }
40              
41 31         29708 $inst = $pkg->new(%$opts);
42             }
43             catch {
44 0     0   0 $self->log->warn(
45             "no instance of " . $self->index_class . " created : $_");
46 31         309 };
47              
48 31         54965 $inst;
49             }
50              
51             sub bag {
52 120     120 1 66864 my $self = shift;
53 120   66     436 my $name = shift // $self->index_bag;
54 120         331 my $index_name = $self->index_bag;
55              
56             # Return the index when requested
57 120 100       1588 if ($name eq $index_name) {
    100          
58 59         1207 $self->index;
59             }
60              
61             # Otherwise load the container for files
62             elsif ($self->index->exists($name)) {
63 57         315 my $opts = {store => $self, name => $name};
64 57         180 my $default_opts = $self->default_options;
65 57   100     292 my $bag_opts = $self->bag_options->{$name} //= {};
66 57         281 $opts = {%$default_opts, %$bag_opts, %$opts};
67             my $pkg = Catmandu::Util::require_package(delete($opts->{class})
68 57   33     425 // $self->bag_class);
69              
70 57         696 my $default_plugins = $self->default_plugins;
71 57   50     219 my $plugins = delete($opts->{plugins}) // [];
72              
73 57 50 33     254 if (@$default_plugins || @$plugins) {
74 0         0 $pkg = $pkg->with_plugins(@$default_plugins, @$plugins);
75             }
76              
77 57         1295 $pkg->new(%$opts);
78             }
79             else {
80 4         494 return undef;
81             }
82             }
83              
84             1;
85              
86             __END__
87              
88             =pod
89              
90             =head1 NAME
91              
92             Catmandu::FileStore - Namespace for packages that can make files persistent
93              
94             =begin markdown
95              
96             # STATUS
97              
98             [![Build Status](https://travis-ci.org/LibreCat/Catmandu-FileStore.svg?branch=master)](https://travis-ci.org/LibreCat/Catmandu-FileStore)
99             [![Coverage](https://coveralls.io/repos/LibreCat/Catmandu-FileStore/badge.svg?branch=master)](https://coveralls.io/r/LibreCat/Catmandu-FileStore)
100              
101             =end markdown
102              
103             =head1 SYNOPSIS
104              
105             # From the command line
106              
107             # Export a list of all file containers
108             $ catmandu export File::Simple --root t/data to YAML
109              
110             # Export a list of all files in container '1234'
111             $ catmandu export File::Simple --root t/data --bag 1234 to YAML
112              
113             # Add a file to the container '1234'
114             $ catmandu stream /tmp/myfile.txt to File::Simple --root t/data --bag 1234 --id myfile.txt
115              
116             # Download the file 'myfile.txt' from the container '1234'
117             $ catmandu stream File::Simple --root t/data --bag 1234 --id myfile.txt to /tmp/output.txt
118              
119             # Delete the file 'myfile.txt' from the container '1234'
120             $ catmandu delete File::Simple --root t/data --bag 1234 --id myfile.txt
121              
122             # From Perl
123             use Catmandu;
124              
125             my $store = Catmandu->store('File::Simple' , root => 't/data');
126              
127             # List all containers
128             $store->index->each(sub {
129             my $container = shift;
130              
131             print "%s\n" , $container->{_id};
132             });
133              
134             # Add a new container
135             $store->index->add({ _id => '1234' });
136              
137             # Get the container
138             my $files = $store->index->files('1234');
139              
140             # Add a file to the container
141             $files->upload(IO::File->new('<foobar.txt'), 'foobar.txt');
142              
143             my $file = $files->get('foobar.txt');
144              
145             # Stream the contents of a file
146             $files->stream(IO::File->new('>foobar.txt'), $file);
147              
148             # Delete a file
149             $files->delete('foobar.txt');
150              
151             # Delete a container
152             $store->index->delete('1234');
153              
154             =head1 DESCRIPTION
155              
156             Each L<Catmandu::FileStore> is a L<Catmandu::Store> and inherits all its methods,
157              
158             A L<Catmandu::FileStore> is package to store and retrieve binary content in
159             an filesystem, memory or a network. A C<Catmandu::FileStore> contains one or more
160             C<Catmandu::FileBag> which is a kind of folder.
161              
162             Each C<Catmandu::FileBag> contains one or more files.
163              
164             One special C<Catmandu::FileBag> is the C<index> and contains the listing
165             of all C<Catmandu::FileBag> in the C<Catmandu::FileStore>.
166              
167             =head1 CONFIGURATION
168              
169             =over
170              
171             =item index_bag
172              
173             The name of the index bag to use when no bag name is give. The index bag is a
174             bag containing a listing of all C<Catmandu::FileBag>-s in the Store.
175              
176             my $index = $store->index;
177              
178             $index->each(sub {
179             my $bag = shift;
180              
181             printf "%s\n" , $bag->{_id};
182             });
183              
184             =item index_class
185              
186             The default class implementation to use for an index of C<Catmandu::FileBag>-s.
187             By default this is the C<Catmandu::FileStore> implementation with '::Index' added.
188              
189             =back
190              
191             =head1 METHODS
192              
193             =head2 bag($name)
194              
195             Create or retieve a bag with name C<$name>. Returns a L<Catmandu::FileBag>.
196              
197             =head2 index
198              
199             Returns the index L<Catmandu::FileBag> for the L<Catmandu::FileStore>.
200              
201             my $index = $store->index;
202              
203             # Add a new file container
204             $index->add({ _id => '1234'});
205              
206             # Anf use it...
207             my $container = $store->bag('1234');
208              
209             $container->upload(IO::File->new('data.txt') , 'data.txt');
210              
211             =head2 log
212              
213             Return the current logger. Can be used when creating your own Stores.
214              
215             E.g.
216              
217             package Catmandu::Store::Hash;
218              
219             ...
220              
221             sub generator {
222             my ($self) = @_;
223              
224             $self->log->debug("generating record");
225             ...
226             }
227              
228             See also: L<Catmandu> for activating the logger in your main code.
229              
230             =head1 AUTHOR
231              
232             Patrick Hochstenbach, C<< <patrick.hochstenbach at ugent.be> >>
233              
234             Nicolas Steenlant, C<< <nicolas.steenlant at ugent.be> >>
235              
236             Nicolas Franck, C<< <nicolas.franck at ugent.be> >>
237              
238             =head1 SEE ALSO
239              
240             L<Catmandu::Store::File::Simple>,
241             L<Catmandu::Store::File::Memory>,
242             L<Catmandu::FileBag>
243              
244             =head1 LICENSE AND COPYRIGHT
245              
246             This program is free software; you can redistribute it and/or modify it
247             under the terms of either: the GNU General Public License as published
248             by the Free Software Foundation; or the Artistic License.
249              
250             See L<http://dev.perl.org/licenses/> for more information.
251              
252             =cut