← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mongo_pain.pl
  Run on Fri Mar 25 17:00:29 2011
Reported on Fri Mar 25 17:07:09 2011

Filename/usr/local/lib/perl/5.10.1/MongoDB/GridFS.pm
StatementsExecuted 19 statements in 1.59ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11118.9ms156msMongoDB::GridFS::::BEGIN@24MongoDB::GridFS::BEGIN@24
111715µs1.56msMongoDB::GridFS::::BEGIN@23MongoDB::GridFS::BEGIN@23
11115µs416µsMongoDB::GridFS::::BEGIN@22MongoDB::GridFS::BEGIN@22
11114µs43µsMongoDB::GridFS::::BEGIN@25MongoDB::GridFS::BEGIN@25
0000s0sMongoDB::GridFS::::_build_chunksMongoDB::GridFS::_build_chunks
0000s0sMongoDB::GridFS::::_build_filesMongoDB::GridFS::_build_files
0000s0sMongoDB::GridFS::::allMongoDB::GridFS::all
0000s0sMongoDB::GridFS::::deleteMongoDB::GridFS::delete
0000s0sMongoDB::GridFS::::dropMongoDB::GridFS::drop
0000s0sMongoDB::GridFS::::find_oneMongoDB::GridFS::find_one
0000s0sMongoDB::GridFS::::getMongoDB::GridFS::get
0000s0sMongoDB::GridFS::::insertMongoDB::GridFS::insert
0000s0sMongoDB::GridFS::::putMongoDB::GridFS::put
0000s0sMongoDB::GridFS::::removeMongoDB::GridFS::remove
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1#
2# Copyright 2009 10gen, Inc.
3#
4# Licensed under the Apache License, Version 2.0 (the "License");
5# you may not use this file except in compliance with the License.
6# You may obtain a copy of the License at
7#
8# http://www.apache.org/licenses/LICENSE-2.0
9#
10# Unless required by applicable law or agreed to in writing, software
11# distributed under the License is distributed on an "AS IS" BASIS,
12# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13# See the License for the specific language governing permissions and
14# limitations under the License.
15#
16
17package MongoDB::GridFS;
181900nsour $VERSION = '0.42';
19
20# ABSTRACT: A file storage utility
21
22336µs2817µs
# spent 416µs (15+401) within MongoDB::GridFS::BEGIN@22 which was called: # once (15µs+401µs) by MongoDB::Database::BEGIN@23 at line 22
use Any::Moose;
# spent 416µs making 1 call to MongoDB::GridFS::BEGIN@22 # spent 401µs making 1 call to Any::Moose::import
233159µs11.56ms
# spent 1.56ms (715µs+850µs) within MongoDB::GridFS::BEGIN@23 which was called: # once (715µs+850µs) by MongoDB::Database::BEGIN@23 at line 23
use MongoDB::GridFS::File;
# spent 1.56ms making 1 call to MongoDB::GridFS::BEGIN@23
243128µs1156ms
# spent 156ms (18.9+137) within MongoDB::GridFS::BEGIN@24 which was called: # once (18.9ms+137ms) by MongoDB::Database::BEGIN@23 at line 24
use DateTime;
# spent 156ms making 1 call to MongoDB::GridFS::BEGIN@24
2531.24ms271µs
# spent 43µs (14+28) within MongoDB::GridFS::BEGIN@25 which was called: # once (14µs+28µs) by MongoDB::Database::BEGIN@23 at line 25
use Digest::MD5;
# spent 43µs making 1 call to MongoDB::GridFS::BEGIN@25 # spent 28µs making 1 call to Exporter::import
26
27=head1 NAME
28
- -
571300ns$MongoDB::GridFS::chunk_size = 1048576;
58
5914µs1321µshas _database => (
# spent 321µs making 1 call to Mouse::has
60 is => 'ro',
61 isa => 'MongoDB::Database',
62 required => 1,
63);
64
65=head2 prefix
66
- -
7112µs1201µshas prefix => (
# spent 201µs making 1 call to Mouse::has
72 is => 'ro',
73 isa => 'Str',
74 default => 'fs'
75);
76
77=head2 files
78
- -
8412µs1497µshas files => (
# spent 497µs making 1 call to Mouse::has
85 is => 'ro',
86 isa => 'MongoDB::Collection',
87 lazy_build => 1
88);
89sub _build_files {
90 my $self = shift;
91 my $coll = $self->_database->get_collection($self->prefix . '.files');
92 # ensure the necessary index is present (this may be first usage)
93 $coll->ensure_index(Tie::IxHash->new(filename => 1), {"safe" => 1});
94 return $coll;
95}
96
97=head2 chunks
98
- -
10512µs1270µshas chunks => (
# spent 270µs making 1 call to Mouse::has
106 is => 'ro',
107 isa => 'MongoDB::Collection',
108 lazy_build => 1
109);
110sub _build_chunks {
111 my $self = shift;
112 my $coll = $self->_database->get_collection($self->prefix . '.chunks');
113 # ensure the necessary index is present (this may be first usage)
114 $coll->ensure_index(Tie::IxHash->new(files_id => 1, n => 1), {"safe" => 1});
115 return $coll;
116}
117
118=head1 METHODS
119
- -
128sub get {
129 my ($self, $id) = @_;
130
131 return $self->find_one({_id => $id});
132}
133
134=head2 put($fh, $metadata)
135
- -
146sub put {
147 my ($self, $fh, $metadata) = @_;
148
149 return $self->insert($fh, $metadata, {safe => 1});
150}
151
152=head2 delete($id)
153
- -
161sub delete {
162 my ($self, $id) = @_;
163
164 $self->remove({_id => $id}, {safe => 1});
165}
166
167=head2 find_one ($criteria?, $fields?)
168
- -
175sub find_one {
176 my ($self, $criteria, $fields) = @_;
177
178 my $file = $self->files->find_one($criteria, $fields);
179 return undef unless $file;
180 return MongoDB::GridFS::File->new({_grid => $self,info => $file});
181}
182
183=head2 remove ($criteria?, $options?)
184
- -
204sub remove {
205 my ($self, $criteria, $options) = @_;
206
207 my $just_one = 0;
208 my $safe = 0;
209
210 if (defined $options) {
211 if (ref $options eq 'HASH') {
212 $just_one = $options->{just_one} && 1;
213 $safe = $options->{safe} && 1;
214 }
215 elsif ($options) {
216 $just_one = $options && 1;
217 }
218 }
219
220 if ($just_one) {
221 my $meta = $self->files->find_one($criteria);
222 $self->chunks->remove({"files_id" => $meta->{'_id'}}, {safe => $safe});
223 $self->files->remove({"_id" => $meta->{'_id'}}, {safe => $safe});
224 }
225 else {
226 my $cursor = $self->files->query($criteria);
227 while (my $meta = $cursor->next) {
228 $self->chunks->remove({"files_id" => $meta->{'_id'}}, {safe => $safe});
229 }
230 $self->files->remove($criteria, {safe => $safe});
231 }
232}
233
234
235=head2 insert ($fh, $metadata?, $options?)
236
- -
263sub insert {
264 my ($self, $fh, $metadata, $options) = @_;
265 $options ||= {};
266
267 confess "not a file handle" unless $fh;
268 $metadata = {} unless $metadata && ref $metadata eq 'HASH';
269
270 $self->chunks->ensure_index(Tie::IxHash->new(files_id => 1, n => 1),
271 {"safe" => 1});
272
273 my $start_pos = $fh->getpos();
274
275 my $id;
276 if (exists $metadata->{"_id"}) {
277 $id = $metadata->{"_id"};
278 }
279 else {
280 $id = MongoDB::OID->new;
281 }
282
283 my $n = 0;
284 my $length = 0;
285 while ((my $len = $fh->read(my $data, $MongoDB::GridFS::chunk_size)) != 0) {
286 $self->chunks->insert({"files_id" => $id,
287 "n" => $n,
288 "data" => bless(\$data)}, $options);
289 $n++;
290 $length += $len;
291 }
292 $fh->setpos($start_pos);
293
294 # get an md5 hash for the file
295 my $result = $self->_database->run_command({"filemd5", $id,
296 "root" => $self->prefix});
297
298 # compare the md5 hashes
299 if ($options->{safe}) {
300 my $md5 = Digest::MD5->new;
301 $md5->addfile($fh);
302 my $digest = $md5->hexdigest;
303 if ($digest ne $result->{md5}) {
304 # cleanup and die
305 $self->chunks->remove({files_id => $id});
306 die "md5 hashes don't match: database got $result->{md5}, fs got $digest";
307 }
308 }
309
310 my %copy = %{$metadata};
311 $copy{"_id"} = $id;
312 $copy{"md5"} = $result->{"md5"};
313 $copy{"chunkSize"} = $MongoDB::GridFS::chunk_size;
314 $copy{"uploadDate"} = DateTime->now;
315 $copy{"length"} = $length;
316 return $self->files->insert(\%copy, $options);
317}
318
319=head2 drop
320
- -
327sub drop {
328 my ($self) = @_;
329
330 $self->files->drop;
331 $self->chunks->drop;
332}
333
334=head2 all
335
- -
342sub all {
343 my ($self) = @_;
344 my @ret;
345
346 my $cursor = $self->files->query;
347 while (my $meta = $cursor->next) {
348 push @ret, MongoDB::GridFS::File->new(
349 _grid => $self,
350 info => $meta);
351 }
352 return @ret;
353}
354
355117µs1;
356
357=head1 AUTHOR
Report produced by the NYTProf 4.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.