File Coverage

blib/lib/Mojo/Asset/File.pm
Criterion Covered Total %
statement 70 70 100.0
branch 24 26 92.3
condition 14 19 73.6
subroutine 16 16 100.0
pod 10 10 100.0
total 134 141 95.0


line stmt bran cond sub pod time code
1             package Mojo::Asset::File;
2 62     62   249556 use Mojo::Base 'Mojo::Asset';
  62         146  
  62         462  
3              
4 62     62   438 use Carp qw(croak);
  62         198  
  62         3306  
5 62     62   417 use Fcntl qw(SEEK_SET);
  62         237  
  62         3348  
6 62     62   5351 use File::Spec::Functions ();
  62         9586  
  62         1900  
7 62     62   4985 use Mojo::File qw(tempfile);
  62         174  
  62         81506  
8              
9             has [qw(cleanup path)];
10             has handle => sub {
11             my $self = shift;
12              
13             # Open existing file
14             my $path = $self->path;
15             return Mojo::File->new($path)->open('<') if defined $path && -e $path;
16              
17             $self->cleanup(1) unless defined $self->cleanup;
18              
19             # Create a specific file
20             return Mojo::File->new($path)->open('+>>') if defined $path;
21              
22             # Create a temporary file
23             my $file = tempfile DIR => $self->tmpdir, TEMPLATE => 'mojo.tmp.XXXXXXXXXXXXXXXX', UNLINK => 0;
24             $self->path($file->to_string);
25             return $file->open('+>>');
26             };
27             has tmpdir => sub { $ENV{MOJO_TMPDIR} || File::Spec::Functions::tmpdir };
28              
29             sub DESTROY {
30 116     116   17563 my $self = shift;
31              
32 116 100 100     547 return unless $self->cleanup && defined(my $path = $self->path);
33 44 50       169 if (my $handle = $self->handle) { close $handle }
  44         701  
34              
35             # Only the process that created the file is allowed to remove it
36 44 100 33     1840 Mojo::File->new($path)->remove if -w $path && ($self->{pid} // $$) == $$;
      66        
37             }
38              
39             sub add_chunk {
40 64     64 1 430 my ($self, $chunk) = @_;
41 64 100 50     183 ($self->handle->syswrite($chunk) // -1) == length $chunk or croak "Can't write to asset: $!";
42 61         7465 return $self;
43             }
44              
45             sub contains {
46 69     69 1 179 my ($self, $str) = @_;
47              
48 69         192 my $handle = $self->handle;
49 69         231 $handle->sysseek($self->start_range, SEEK_SET);
50              
51             # Calculate window size
52 69   100     974 my $end = $self->end_range // $self->size;
53 69         153 my $len = length $str;
54 69 100       168 my $size = $len > 131072 ? $len : 131072;
55 69 100       195 $size = $end - $self->start_range if $size > $end - $self->start_range;
56              
57             # Sliding window search
58 69         115 my $offset = 0;
59 69         254 my $start = $handle->sysread(my $window, $len);
60 69         1340 while ($offset < $end) {
61              
62             # Read as much as possible
63 106         221 my $diff = $end - ($start + $offset);
64 106 100       403 my $read = $handle->sysread(my $buffer, $diff < $size ? $diff : $size);
65 106         5614 $window .= $buffer;
66              
67             # Search window
68 106         11453 my $pos = index $window, $str;
69 106 100       831 return $offset + $pos if $pos >= 0;
70 54 100 66     374 return -1 if $read == 0 || ($offset += $read) == $end;
71              
72             # Resize window
73 39         128 substr $window, 0, $read, '';
74             }
75              
76 2         16 return -1;
77             }
78              
79             sub get_chunk {
80 128     128 1 1747 my ($self, $offset, $max) = @_;
81 128   100     582 $max //= 131072;
82              
83 128         433 $offset += $self->start_range;
84 128         426 my $handle = $self->handle;
85 128         763 $handle->sysseek($offset, SEEK_SET);
86              
87 128         1836 my $buffer;
88 128 100       494 if (defined(my $end = $self->end_range)) {
89 32 100       174 return '' if (my $chunk = $end + 1 - $offset) <= 0;
90 23 100       96 $handle->sysread($buffer, $chunk > $max ? $max : $chunk);
91             }
92 96         386 else { $handle->sysread($buffer, $max) }
93              
94 119         3545 return $buffer;
95             }
96              
97 76     76 1 2929 sub is_file {1}
98              
99             sub move_to {
100 4     4 1 826 my ($self, $to) = @_;
101              
102             # Windows requires that the handle is closed
103 4         16 close $self->handle;
104 4         122 delete $self->{handle};
105              
106             # Move file and prevent clean up
107 4         22 Mojo::File->new($self->path)->move_to($to);
108 4         30 return $self->path($to)->cleanup(0);
109             }
110              
111 64     64 1 2222 sub mtime { (stat shift->handle)[9] }
112              
113             sub new {
114 117     117 1 58960 my $file = shift->SUPER::new(@_);
115 117         568 $file->{pid} = $$;
116 117         571 return $file;
117             }
118              
119 116     116 1 378 sub size { -s shift->handle }
120              
121             sub slurp {
122 34     34 1 944 my $handle = shift->handle;
123 34         291 $handle->sysseek(0, SEEK_SET);
124 34         472 my $ret = my $content = '';
125 34         228 while ($ret = $handle->sysread(my $buffer, 131072, 0)) { $content .= $buffer }
  38         2583  
126 34 50       1039 return defined $ret ? $content : croak "Can't read from asset: $!";
127             }
128              
129 2     2 1 30 sub to_file {shift}
130              
131             1;
132              
133             =encoding utf8
134              
135             =head1 NAME
136              
137             Mojo::Asset::File - File storage for HTTP content
138              
139             =head1 SYNOPSIS
140              
141             use Mojo::Asset::File;
142              
143             # Temporary file
144             my $file = Mojo::Asset::File->new;
145             $file->add_chunk('foo bar baz');
146             say 'File contains "bar"' if $file->contains('bar') >= 0;
147             say $file->slurp;
148              
149             # Existing file
150             my $file = Mojo::Asset::File->new(path => '/home/sri/foo.txt');
151             $file->move_to('/yada.txt');
152             say $file->slurp;
153              
154             =head1 DESCRIPTION
155              
156             L is a file storage backend for HTTP content.
157              
158             =head1 EVENTS
159              
160             L inherits all events from L.
161              
162             =head1 ATTRIBUTES
163              
164             L inherits all attributes from L and implements the following new ones.
165              
166             =head2 cleanup
167              
168             my $bool = $file->cleanup;
169             $file = $file->cleanup($bool);
170              
171             Delete L automatically once the file is not used anymore.
172              
173             =head2 handle
174              
175             my $handle = $file->handle;
176             $file = $file->handle(IO::File->new);
177              
178             Filehandle, created on demand for L, which can be generated automatically and safely based on L.
179              
180             =head2 path
181              
182             my $path = $file->path;
183             $file = $file->path('/home/sri/foo.txt');
184              
185             File path used to create L.
186              
187             =head2 tmpdir
188              
189             my $tmpdir = $file->tmpdir;
190             $file = $file->tmpdir('/tmp');
191              
192             Temporary directory used to generate L, defaults to the value of the C environment variable or
193             auto-detection.
194              
195             =head1 METHODS
196              
197             L inherits all methods from L and implements the following new ones.
198              
199             =head2 add_chunk
200              
201             $file = $file->add_chunk('foo bar baz');
202              
203             Add chunk of data.
204              
205             =head2 contains
206              
207             my $position = $file->contains('bar');
208              
209             Check if asset contains a specific string.
210              
211             =head2 get_chunk
212              
213             my $bytes = $file->get_chunk($offset);
214             my $bytes = $file->get_chunk($offset, $max);
215              
216             Get chunk of data starting from a specific position, defaults to a maximum chunk size of C<131072> bytes (128KiB).
217              
218             =head2 is_file
219              
220             my $bool = $file->is_file;
221              
222             True, this is a L object.
223              
224             =head2 move_to
225              
226             $file = $file->move_to('/home/sri/bar.txt');
227              
228             Move asset data into a specific file and disable L.
229              
230             =head2 mtime
231              
232             my $mtime = $file->mtime;
233              
234             Modification time of asset.
235              
236             =head2 new
237              
238             my $file = Mojo::Asset::File->new;
239             my $file = Mojo::Asset::File->new(path => '/home/sri/test.txt');
240             my $file = Mojo::Asset::File->new({path => '/home/sri/test.txt'});
241              
242             Construct a new L object.
243              
244             =head2 size
245              
246             my $size = $file->size;
247              
248             Size of asset data in bytes.
249              
250             =head2 slurp
251              
252             my $bytes = $file->slurp;
253              
254             Read all asset data at once.
255              
256             =head2 to_file
257              
258             $file = $file->to_file;
259              
260             Does nothing but return the invocant, since we already have a L object.
261              
262             =head1 SEE ALSO
263              
264             L, L, L.
265              
266             =cut