File Coverage

blib/lib/MongoDBx/Tiny/GridFS.pm
Criterion Covered Total %
statement 24 78 30.7
branch 0 38 0.0
condition n/a
subroutine 8 26 30.7
pod 7 7 100.0
total 39 149 26.1


line stmt bran cond sub pod time code
1             package MongoDBx::Tiny::GridFS;
2 2     2   3141 use strict;
  2         2  
  2         50  
3 2     2   5 use warnings;
  2         2  
  2         47  
4              
5             =head1 NAME
6              
7             MongoDBx::Tiny::GridFS - wrapper class of MongoDB::GridFS
8              
9             =cut
10              
11 2     2   5 use Carp qw(confess);
  2         3  
  2         68  
12 2     2   7 use MongoDB::GridFS;
  2         2  
  2         36  
13 2     2   5 use Params::Validate;
  2         2  
  2         887  
14              
15             =head1 SUBROUTINES/METHODS
16              
17             =head2 new
18              
19             $gridfs = MongoDBx::Tiny::GridFS->new(
20             $database->get_gridfs,$fields_name
21             );
22              
23             =cut
24              
25             sub new {
26 0     0 1   my $class = shift;
27 0 0         my $gridfs = shift or confess q/no gridfs/;
28 0 0         my $field = shift or confess q/no field/;
29              
30 0           return bless { _gridfs => $gridfs, _field => $field }, $class;
31             }
32              
33             =head2 gridfs, fields
34              
35             # get Mongodb::GridFS
36             $gridfs_raw = $gridfs->gridfs;
37              
38             # get fields name
39             $gridfs_field_name = $gridfs->field;
40              
41             =cut
42              
43 0     0 1   sub gridfs { shift->{_gridfs} }
44              
45 0     0 1   sub field { shift->{_field} }
46              
47             =head2 put
48              
49             $gridfs->put('/tmp/foo.txt', {"filename" => 'foo.txt' });
50             $gridfs->put('/tmp/bar.txt','bar.txt');
51            
52             $fh = IO::File->new('/tmp/baz.txt','r');
53             $gridfs->put($fh,'baz.txt');
54              
55             =cut
56              
57             sub put {
58 0     0 1   my $self = shift;
59 0 0         my $proto = shift or confess q/no filepath or filehandle/;
60 0 0         my $opt = shift or confess q/no gridfs filepath or opt/;
61 0           my $fh;
62              
63 0 0         if (ref $proto) {
64 0           $fh = $proto;
65             } else {
66 0           require IO::File;
67 0           $fh = IO::File->new($proto,'r');
68             }
69              
70 0 0         if (ref $opt ne 'HASH') {
71             # just a gridfs path
72 0           $opt = { $self->field => $opt };
73             }
74              
75 0           my $no_exists_check = delete $opt->{no_exists_check};
76              
77 0           my %meta = Params::Validate::validate_with(
78             params => $opt,
79             spec => {
80             $self->field => 1,
81             }
82             );
83              
84 0 0         unless ($no_exists_check) {
85             # xxx
86 0 0         return if $self->exists_file( $meta{$self->field} );
87             }
88              
89 0           my $oid = $self->gridfs->insert($fh, \%meta, { safe => 1 });
90 0           $self->get($oid);
91             }
92              
93             =head2 get
94              
95             # MongoDBx::Tiny::GridFS::File
96             $gridfs_file = $gridfs->get({ filename => 'foo.txt' });
97             $foo_txt = $gridfs_file->slurp;
98              
99             $bar_txt = $gridfs->get('bar.txt')->slurp;
100              
101             =cut
102              
103             sub get {
104 0     0 1   my $self = shift;
105 0 0         my $proto = shift or confess /no id or query/; # $oid,$query
106              
107 0 0         my $query = ref $proto eq 'HASH' ? $proto
    0          
108             : ref $proto eq 'MongoDB::OID' ? { _id => $proto }
109             : { $self->field => $proto };
110 0           my $gridfs_object = $self->gridfs->find_one($query);
111 0 0         return unless $gridfs_object;
112 0           return MongoDBx::Tiny::GridFS::File->new( $gridfs_object, $self->field );
113             }
114              
115             =head2 remove
116              
117             $gridfs->remove({ filename => 'foo.txt' });
118             $gridfs->remove('bar.txt');
119              
120             =cut
121              
122             sub remove {
123 0     0 1   my $self = shift;
124 0 0         my $proto = shift or confess /no id or query/; # $oid,$query
125              
126 0 0         my $query = ref $proto eq 'HASH' ? $proto
    0          
127             : ref $proto eq 'MongoDB::OID' ? { _id => $proto }
128             : { $self->field => $proto };
129              
130 0           $self->gridfs->remove( $query, {safe => 1, just_one => 1} );
131             }
132              
133             =head2 exists_file
134              
135             $gridfs->exists_file({ filename => 'foo.txt' });
136             $gridfs->exists_file('bar.txt');
137              
138             =cut
139              
140             sub exists_file {
141 0     0 1   my $self = shift;
142 0           my $field = $self->field;
143              
144 0 0         my $val = shift or confess qq/no $field value/;
145 0           return $self->gridfs->find_one({ $field => $val },{ _id => 1 });
146             }
147              
148              
149             =head1 MongoDBx::Tiny::GridFS::File
150              
151             wrapper class of MongoDB::GridFS::File
152              
153             =cut
154              
155             package MongoDBx::Tiny::GridFS::File;
156 2     2   9 use strict;
  2         3  
  2         39  
157 2     2   6 use Carp qw(confess);
  2         2  
  2         139  
158              
159             =head2 new
160              
161             $gf = MongoDBx::Tiny::GridFS::File->new( $gridfs->find_one($query), $self->field );
162              
163             =cut
164              
165             sub new {
166 0     0     my $class = shift;
167 0 0         my $g_file = shift or confess q/no GridFS::File object/;
168 0 0         my $field = shift or confess q/no MongoDBx::Tiny::GridFS::field/;
169             # g_file
170             # bless { _info => {}, _grid => MongoDB::GridFS } MongoDB::GridFS::File
171 0 0         unless ($class->can($field)) {
172             {
173 2     2   8 no strict 'refs';
  2         3  
  2         399  
  0            
174 0     0     *{"${class}::" . $field} = sub { shift->gf->{info}->{$field} };
  0            
  0            
175             }
176             }
177              
178 0           return bless { _gridfs_file => $g_file, _field => $field }, $class;
179             }
180              
181              
182             =head2 gridfs_file, gf
183              
184             # MongoDB::GridFS::File
185             $gf_raw = $gf->gridfs_file;
186              
187             =cut
188              
189 0     0     sub gridfs_file { shift->{_gridfs_file} }
190              
191 0     0     sub gf { shift->gridfs_file }
192              
193             =head2 print
194              
195             # MongoDB::GridFS::File::print
196             $gf->print($fh,$length,$offset);
197              
198             =cut
199              
200 0     0     sub print { shift->gf->print(@_) }
201              
202             =head2 slurp
203              
204             # MongoDB::GridFS::File::slurp
205             $all = $gf->slurp();
206             $buf = $gf->slurp($length,$offset);
207              
208             =cut
209              
210 0     0     sub slurp { shift->gf->slurp(@_) }
211              
212             =head2 field
213              
214             field name. default is "filename"
215              
216             =cut
217              
218             =head2 _id,chunk_size,upload_date,md5
219              
220             MongoDB::GridFS::File attributes
221              
222             =cut
223              
224 0     0     sub field { shift->{_field} }
225              
226 0     0     sub id { shift->gf->{info}->{_id} }
227              
228 0     0     sub chunk_size { shift->gf->{info}->{chunkSize} }
229              
230 0     0     sub upload_date { shift->gf->{info}->{uploadDate} }
231              
232 0     0     sub md5 { shift->gf->{info}->{md5} }
233              
234             1;
235             __END__
236              
237             =head1 AUTHOR
238              
239             Naoto ISHIKAWA, C<< <toona at seesaa.co.jp> >>
240              
241             =head1 LICENSE AND COPYRIGHT
242              
243             Copyright 2013 Naoto ISHIKAWA.
244              
245             This program is free software; you can redistribute it and/or modify it
246             under the terms of either: the GNU General Public License as published
247             by the Free Software Foundation; or the Artistic License.
248              
249             See http://dev.perl.org/licenses/ for more information.
250              
251              
252             =cut
253