File Coverage

blib/lib/MongoDB/GridFSBucket/DownloadStream.pm
Criterion Covered Total %
statement 30 137 21.9
branch 0 54 0.0
condition 0 13 0.0
subroutine 10 25 40.0
pod 7 8 87.5
total 47 237 19.8


line stmt bran cond sub pod time code
1             # Copyright 2015 - present MongoDB, Inc.
2             #
3             # Licensed under the Apache License, Version 2.0 (the "License");
4             # you may not use this file except in compliance with the License.
5             # You may obtain a copy of the License at
6             #
7             # http://www.apache.org/licenses/LICENSE-2.0
8             #
9             # Unless required by applicable law or agreed to in writing, software
10             # distributed under the License is distributed on an "AS IS" BASIS,
11             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12             # See the License for the specific language governing permissions and
13             # limitations under the License.
14              
15 58     58   390 use strict;
  58         2532  
  58         1688  
16 58     58   305 use warnings;
  58         116  
  58         1969  
17             package MongoDB::GridFSBucket::DownloadStream;
18              
19             # ABSTRACT: File handle abstraction for downloading
20              
21 58     58   292 use version;
  58         152  
  58         369  
22             our $VERSION = 'v2.2.0';
23              
24 58     58   4622 use Moo;
  58         154  
  58         308  
25 58         528 use Types::Standard qw(
26             Str
27             Maybe
28             HashRef
29             InstanceOf
30             FileHandle
31 58     58   21165 );
  58         177  
32 58         408 use MongoDB::_Types qw(
33             Boolish
34             NonNegNum
35 58     58   59475 );
  58         131  
36 58     58   65051 use List::Util qw(max min);
  58         2195  
  58         4684  
37 58     58   2336 use namespace::clean -except => 'meta';
  58         126  
  58         477  
38              
39             #pod =attr file_doc
40             #pod
41             #pod The file document for the file to be downloaded.
42             #pod
43             #pod Valid file documents typically include the following fields:
44             #pod
45             #pod =for :list
46             #pod * _id – a unique ID for this document, typically a L object.
47             #pod Legacy GridFS files may store this value as a different type.
48             #pod * length – the length of this stored file, in bytes
49             #pod * chunkSize – the size, in bytes, of each full data chunk of this file.
50             #pod * uploadDate – the date and time this file was added to GridFS, stored as a
51             #pod BSON datetime value and inflated per the bucket's
52             #pod L attribute.
53             #pod * filename – the name of this stored file; this does not need to be unique
54             #pod * metadata – any additional application-specific data
55             #pod * md5 – DEPRECATED
56             #pod * contentType – DEPRECATED
57             #pod * aliases – DEPRECATED
58             #pod
59             #pod =cut
60              
61             has file_doc => (
62             is => 'ro',
63             isa => HashRef,
64             required => 1,
65             );
66              
67             has _buffer => (
68             is => 'rwp',
69             isa => Str,
70             default => "",
71             );
72              
73             has _chunk_n => (
74             is => 'rwp',
75             isa => NonNegNum,
76             default => 0,
77             );
78              
79             has _result => (
80             is => 'ro',
81             isa => Maybe [ InstanceOf ['MongoDB::QueryResult'] ],
82             required => 1,
83             );
84              
85             # Currently this is always 0, but may be used to add
86             # optional rewinding in the future.
87             has _offset => (
88             is => 'rwp',
89             isa => NonNegNum,
90             default => 0,
91             );
92              
93             has _closed => (
94             is => 'rwp',
95             isa => Boolish,
96             default => 0,
97             );
98              
99             #pod =method fh
100             #pod
101             #pod my $fh = $downloadstream->fh;
102             #pod while ( <$fh> ) {
103             #pod say($_);
104             #pod }
105             #pod
106             #pod Returns a new Perl file handle tied to this instance of DownloadStream that
107             #pod can be operated on with the built-in functions C, C,
108             #pod C, C, C and C.
109             #pod
110             #pod B:
111             #pod
112             #pod Allowing one of these tied filehandles to fall out of scope will NOT cause
113             #pod close to be called. This is due to the way tied file handles are
114             #pod implemented in Perl. For close to be called implicitly, all tied
115             #pod filehandles and the original object must go out of scope.
116             #pod
117             #pod Each file handle retrieved this way is tied back to the same object, so
118             #pod calling close on multiple tied file handles and/or the original object will
119             #pod have the same effect as calling close on the original object multiple
120             #pod times.
121             #pod
122             #pod =cut
123              
124             sub fh {
125 0     0 1   my ($self) = @_;
126 0           my $fh = IO::Handle->new();
127 0           tie *$fh, 'MongoDB::GridFSBucket::DownloadStream', $self;
128 0           return $fh;
129             }
130              
131             sub _get_next_chunk {
132 0     0     my ($self) = @_;
133              
134 0 0 0       return unless $self->_result && $self->_result->has_next;
135 0           my $chunk = $self->_result->next;
136              
137 0 0         if ( $chunk->{'n'} != $self->_chunk_n ) {
138             MongoDB::GridFSError->throw(
139             sprintf(
140             'ChunkIsMissing: expected chunk %d but got chunk %d',
141 0           $self->_chunk_n, $chunk->{'n'},
142             )
143             );
144             }
145              
146             my $last_chunk_n =
147 0           int( $self->file_doc->{'length'} / $self->file_doc->{'chunkSize'} );
148             my $expected_size =
149             $chunk->{'n'} == $last_chunk_n
150             ? $self->file_doc->{'length'} % $self->file_doc->{'chunkSize'}
151 0 0         : $self->file_doc->{'chunkSize'};
152 0 0         if ( length $chunk->{'data'} != $expected_size ) {
153             MongoDB::GridFSError->throw(
154             sprintf(
155             "ChunkIsWrongSize: chunk %d from file with id %s has incorrect size %d, expected %d",
156             $self->_chunk_n,
157             $self->file_doc->{_id},
158 0           length $chunk->{'data'},
159             $expected_size,
160             )
161             );
162             }
163              
164 0           $self->{_chunk_n} += 1;
165 0           $self->{_buffer} .= $chunk->{data}->{data};
166             }
167              
168             sub _ensure_buffer {
169 0     0     my ($self) = @_;
170 0 0         if ( $self->{_buffer} ) { return length $self->{_buffer} }
  0            
171              
172 0           $self->_get_next_chunk;
173              
174 0           return length $self->{_buffer};
175             }
176              
177             sub _readline_scalar {
178 0     0     my ($self) = @_;
179              
180             # Special case for "slurp" mode
181 0 0         if ( !defined($/) ) {
182 0           return $self->_read_all;
183             }
184              
185 0 0         return unless $self->_ensure_buffer;
186 0           my $newline_index;
187 0           while ( ( $newline_index = index $self->{_buffer}, $/ ) < 0 ) {
188 0 0         last unless $self->_get_next_chunk;
189             }
190 0 0         my $substr_len = $newline_index < 0 ? length $self->{_buffer} : $newline_index + 1;
191 0           return substr $self->{_buffer}, $self->_offset, $substr_len, '';
192             }
193              
194             sub _read_all {
195 0     0     my ($self) = @_;
196              
197 0 0         if ( $self->_closed ) {
198 0           warnings::warnif( 'closed',
199             'read called on a closed MongoDB::GridFSBucket::DownloadStream' );
200 0           return;
201             }
202              
203 0 0         return unless $self->_result;
204              
205 0           my $chunk_size = $self->file_doc->{'chunkSize'};
206 0           my $length = $self->file_doc->{'length'};
207 0           my $last_chunk_n = int( $length / $chunk_size );
208 0           my $last_chunk_size = $length % $chunk_size;
209              
210 0           my @chunks = $self->_result->all;
211              
212 0           for (my $i = 0; $i < @chunks; $i++ ) {
213 0           my $n = $chunks[$i]{n};
214              
215 0 0         if ( $n != $i ) {
216 0           MongoDB::GridFSError->throw(
217             sprintf( 'ChunkIsMissing: expected chunk %d but got chunk %d', $i, $n)
218             );
219             }
220              
221 0 0         my $expected_size = ($n == $last_chunk_n ? $last_chunk_size : $chunk_size);
222 0 0         if ( length $chunks[$i]{data}{data} != $expected_size ) {
223             MongoDB::GridFSError->throw(
224             sprintf(
225             "ChunkIsWrongSize: chunk %d of %d from file with id %s has incorrect size %d, expected %d",
226             $n,
227             $last_chunk_n,
228             $self->file_doc->{_id},
229             length $chunks[$i]{data}{data},
230 0           $expected_size,
231             )
232             );
233             }
234             }
235              
236 0           return join( "", map { $_->{data}{data} } @chunks );
  0            
237             }
238              
239             #pod =method close
240             #pod
241             #pod $stream->close
242             #pod
243             #pod Works like the builtin C.
244             #pod
245             #pod B
246             #pod
247             #pod =for :list
248             #pod * Calling close will also cause any tied file handles created for the
249             #pod stream to also close.
250             #pod * C will be automatically called when a stream object is destroyed.
251             #pod * Calling C repeatedly will warn.
252             #pod
253             #pod =cut
254              
255             sub close {
256 0     0 1   my ($self) = @_;
257 0 0         if ( $self->_closed ) {
258 0           warn 'Attempted to close an already closed MongoDB::GridFSBucket::DownloadStream';
259 0           return;
260             }
261 0           $self->_set__closed(1);
262 0           $self->{_result} = undef;
263 0           $self->{_buffer} = undef;
264 0           $self->_set__chunk_n(0);
265 0           return 1;
266             }
267              
268             #pod =method eof
269             #pod
270             #pod if ( $stream->eof() ) { ... }
271             #pod
272             #pod Works like the builtin C.
273             #pod
274             #pod =cut
275              
276             sub eof {
277 0     0 1   my ($self) = @_;
278 0 0 0       return 1 if $self->_closed || !$self->_ensure_buffer;
279 0           return;
280             }
281              
282             #pod =method fileno
283             #pod
284             #pod if ( $stream->fileno() ) { ... }
285             #pod
286             #pod Works like the builtin C, but it returns -1 if the stream is open
287             #pod and undef if closed.
288             #pod
289             #pod =cut
290              
291             sub fileno {
292 0     0 1   my ($self) = @_;
293 0 0         return if $self->_closed;
294 0           return -1;
295             }
296              
297             #pod =method getc
298             #pod
299             #pod $char = $stream->getc();
300             #pod
301             #pod Works like the builtin C.
302             #pod
303             #pod =cut
304              
305             sub getc {
306 0     0 1   my ($self) = @_;
307 0           my $char;
308 0           $self->read( $char, 1 );
309 0           return $char;
310             }
311              
312             #pod =method read
313             #pod
314             #pod $data = $stream->read($buf, $length, $offset)
315             #pod
316             #pod Works like the builtin C.
317             #pod
318             #pod =cut
319              
320             sub read {
321 0     0 1   my $self = shift;
322 0 0         if ( $self->_closed ) {
323 0           warnings::warnif( 'closed',
324             'read called on a closed MongoDB::GridFSBucket::DownloadStream' );
325 0           return;
326             }
327 0           my $buffref = \$_[0];
328 0           my ( undef, $len, $offset ) = @_;
329 0 0         if ( $len < 0 ) {
330 0           MongoDB::UsageError->throw(
331             'Negative length passed to MongoDB::GridFSBucket::DownloadStream->read');
332             }
333 0   0       $offset ||= 0;
334 0   0       $$buffref ||= '';
335 0           my $bufflen = length $$buffref;
336              
337 0 0         $offset = max( 0, $bufflen + $offset ) if $offset < 0;
338 0 0         if ( $offset > $bufflen ) {
339 0           $$buffref .= ( "\0" x ( $offset - $bufflen ) );
340             }
341             else {
342 0           substr $$buffref, $offset, $bufflen - $offset, '';
343             }
344              
345 0 0         return 0 unless $self->_ensure_buffer;
346              
347 0 0         while ( length $self->{_buffer} < $len ) { last unless $self->_get_next_chunk }
  0            
348 0           my $read_len = min( length $self->{_buffer}, $len );
349 0           $$buffref .= substr $self->{_buffer}, $self->_offset, $read_len, '';
350 0           return $read_len;
351             }
352              
353             #pod =method readline
354             #pod
355             #pod $line = $stream->readline();
356             #pod @lines = $stream->readline();
357             #pod
358             #pod Works like the builtin C.
359             #pod
360             #pod =cut
361              
362             sub readline {
363 0     0 1   my ($self) = @_;
364 0 0         if ( $self->_closed ) {
365 0           warnings::warnif( 'closed',
366             'readline called on a closed MongoDB::GridFSBucket::DownloadStream' );
367 0           return;
368             }
369 0 0         return $self->_readline_scalar unless wantarray;
370              
371 0           my @result = ();
372 0           while ( my $line = $self->_readline_scalar ) {
373 0           push @result, $line;
374             }
375 0           return @result;
376             }
377              
378             sub DEMOLISH {
379 0     0 0   my ($self) = @_;
380 0 0         $self->close unless $self->_closed;
381             }
382              
383             # Magic tie methods
384              
385             sub TIEHANDLE {
386 0     0     my ( $class, $self ) = @_;
387 0           return $self;
388             }
389              
390             sub BINMODE {
391 0     0     my ( $self, $mode ) = @_;
392 0 0 0       if ( !$mode || $mode eq ':raw' ) {
393 0           return 1;
394             }
395 0           $! = "binmode for " . __PACKAGE__ . " only supports :raw mode.";
396             return
397 0           }
398              
399             {
400 58     58   110686 no warnings 'once';
  58         166  
  58         6862  
401             *READ = \&read;
402             *READLINE = \&readline;
403             *CLOSE = \&close;
404             *GETC = \&getc;
405             *EOF = \&eof;
406             *FILENO = \&fileno;
407             }
408              
409             my @unimplemented = qw(
410             PRINT
411             PRINTF
412             SEEK
413             TELL
414             WRITE
415             );
416              
417             for my $u (@unimplemented) {
418 58     58   519 no strict 'refs';
  58         154  
  58         7838  
419             my $l = $u eq 'WRITE' ? 'syswrite' : lc($u);
420             *{$u} = sub {
421 0     0     MongoDB::UsageError->throw( "$l() not available on " . __PACKAGE__ );
422             };
423             }
424              
425             1;
426              
427             __END__