Filename | /usr/local/lib/perl/5.14.2/MongoDB/GridFS/File.pm |
Statements | Executed 11 statements in 501µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 621µs | 4.99ms | BEGIN@27 | MongoDB::GridFS::File::
1 | 1 | 1 | 12µs | 3.34ms | BEGIN@25 | MongoDB::GridFS::File::
1 | 1 | 1 | 8µs | 8µs | BEGIN@26 | MongoDB::GridFS::File::
0 | 0 | 0 | 0s | 0s | |
0 | 0 | 0 | 0s | 0s | slurp | MongoDB::GridFS::File::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # | ||||
2 | # Copyright 2009-2013 MongoDB, 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 | |||||
17 | package MongoDB::GridFS::File; | ||||
18 | { | ||||
19 | 2 | 1µs | $MongoDB::GridFS::File::VERSION = '0.702.2'; | ||
20 | } | ||||
21 | |||||
22 | |||||
23 | # ABSTRACT: A Mongo GridFS file | ||||
24 | |||||
25 | 2 | 33µs | 2 | 6.68ms | # spent 3.34ms (12µs+3.33) within MongoDB::GridFS::File::BEGIN@25 which was called:
# once (12µs+3.33ms) by MongoDB::GridFS::BEGIN@26 at line 25 # spent 3.34ms making 1 call to MongoDB::GridFS::File::BEGIN@25
# spent 3.33ms making 1 call to Moose::Exporter::__ANON__[Moose/Exporter.pm:519] |
26 | 2 | 24µs | 1 | 8µs | # spent 8µs within MongoDB::GridFS::File::BEGIN@26 which was called:
# once (8µs+0s) by MongoDB::GridFS::BEGIN@26 at line 26 # spent 8µs making 1 call to MongoDB::GridFS::File::BEGIN@26 |
27 | 2 | 434µs | 2 | 5.11ms | # spent 4.99ms (621µs+4.37) within MongoDB::GridFS::File::BEGIN@27 which was called:
# once (621µs+4.37ms) by MongoDB::GridFS::BEGIN@26 at line 27 # spent 4.99ms making 1 call to MongoDB::GridFS::File::BEGIN@27
# spent 127µs making 1 call to Exporter::import |
28 | |||||
29 | |||||
30 | 1 | 2µs | 1 | 1.56ms | has _grid => ( # spent 1.56ms making 1 call to Moose::has |
31 | is => 'ro', | ||||
32 | isa => 'MongoDB::GridFS', | ||||
33 | required => 1, | ||||
34 | ); | ||||
35 | |||||
36 | |||||
37 | 1 | 2µs | 1 | 1.46ms | has info => ( # spent 1.46ms making 1 call to Moose::has |
38 | is => 'ro', | ||||
39 | isa => 'HashRef', | ||||
40 | required => 1, | ||||
41 | ); | ||||
42 | |||||
43 | |||||
44 | sub print { | ||||
45 | my ($self, $fh, $length, $offset) = @_; | ||||
46 | $offset ||= 0; | ||||
47 | $length ||= 0; | ||||
48 | my ($written, $pos) = (0, 0); | ||||
49 | my $start_pos = $fh->getpos(); | ||||
50 | |||||
51 | $self->_grid->chunks->ensure_index(Tie::IxHash->new(files_id => 1, n => 1)); | ||||
52 | |||||
53 | my $cursor = $self->_grid->chunks->query({"files_id" => $self->info->{"_id"}})->sort({"n" => 1}); | ||||
54 | |||||
55 | while ((my $chunk = $cursor->next) && (!$length || $written < $length)) { | ||||
56 | my $len = length $chunk->{'data'}; | ||||
57 | |||||
58 | # if we are cleanly beyond the offset | ||||
59 | if (!$offset || $pos >= $offset) { | ||||
60 | if (!$length || $written + $len < $length) { | ||||
61 | $fh->print($chunk->{"data"}); | ||||
62 | $written += $len; | ||||
63 | $pos += $len; | ||||
64 | } | ||||
65 | else { | ||||
66 | $fh->print(substr($chunk->{'data'}, 0, $length-$written)); | ||||
67 | $written += $length-$written; | ||||
68 | $pos += $length-$written; | ||||
69 | } | ||||
70 | next; | ||||
71 | } | ||||
72 | # if the offset goes to the middle of this chunk | ||||
73 | elsif ($pos + $len > $offset) { | ||||
74 | # if the length of this chunk is smaller than the desired length | ||||
75 | if (!$length || $len <= $length-$written) { | ||||
76 | $fh->print(substr($chunk->{'data'}, $offset-$pos, $len-($offset-$pos))); | ||||
77 | $written += $len-($offset-$pos); | ||||
78 | $pos += $len-($offset-$pos); | ||||
79 | } | ||||
80 | else { | ||||
81 | $fh->print(substr($chunk->{'data'}, $offset-$pos, $length)); | ||||
82 | $written += $length; | ||||
83 | $pos += $length; | ||||
84 | } | ||||
85 | next; | ||||
86 | } | ||||
87 | # if the offset is larger than this chunk | ||||
88 | $pos += $len; | ||||
89 | } | ||||
90 | $fh->setpos($start_pos); | ||||
91 | return $written; | ||||
92 | } | ||||
93 | |||||
- - | |||||
96 | sub slurp { | ||||
97 | my ($self,$length,$offset) = @_; | ||||
98 | my $bytes = ''; | ||||
99 | my $fh = new IO::File \$bytes,'+>'; | ||||
100 | my $written = $self->print($fh,$length,$offset); | ||||
101 | |||||
102 | # some machines don't set $bytes | ||||
103 | if ($written and !length($bytes)) { | ||||
104 | my $retval; | ||||
105 | read $fh, $retval, $written; | ||||
106 | return $retval; | ||||
107 | } | ||||
108 | |||||
109 | return $bytes; | ||||
110 | } | ||||
111 | |||||
112 | 1 | 6µs | 1; | ||
113 | |||||
114 | __END__ |