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   256322 use Mojo::Base 'Mojo::Asset';
  62         142  
  62         404  
3              
4 62     62   438 use Carp qw(croak);
  62         194  
  62         3116  
5 62     62   459 use Fcntl qw(SEEK_SET);
  62         219  
  62         3113  
6 62     62   5254 use File::Spec::Functions ();
  62         9570  
  62         1658  
7 62     62   4914 use Mojo::File qw(tempfile);
  62         174  
  62         79034  
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   17970 my $self = shift;
31              
32 116 100 100     487 return unless $self->cleanup && defined(my $path = $self->path);
33 44 50       170 if (my $handle = $self->handle) { close $handle }
  44         675  
34              
35             # Only the process that created the file is allowed to remove it
36 44 100 33     1596 Mojo::File->new($path)->remove if -w $path && ($self->{pid} // $$) == $$;
      66        
37             }
38              
39             sub add_chunk {
40 64     64 1 361 my ($self, $chunk) = @_;
41 64 100 50     194 ($self->handle->syswrite($chunk) // -1) == length $chunk or croak "Can't write to asset: $!";
42 61         7544 return $self;
43             }
44              
45             sub contains {
46 69     69 1 203 my ($self, $str) = @_;
47              
48 69         232 my $handle = $self->handle;
49 69         210 $handle->sysseek($self->start_range, SEEK_SET);
50              
51             # Calculate window size
52 69   100     948 my $end = $self->end_range // $self->size;
53 69         145 my $len = length $str;
54 69 100       176 my $size = $len > 131072 ? $len : 131072;
55 69 100       169 $size = $end - $self->start_range if $size > $end - $self->start_range;
56              
57             # Sliding window search
58 69         126 my $offset = 0;
59 69         199 my $start = $handle->sysread(my $window, $len);
60 69         1371 while ($offset < $end) {
61              
62             # Read as much as possible
63 106         215 my $diff = $end - ($start + $offset);
64 106 100       397 my $read = $handle->sysread(my $buffer, $diff < $size ? $diff : $size);
65 106         5416 $window .= $buffer;
66              
67             # Search window
68 106         11416 my $pos = index $window, $str;
69 106 100       754 return $offset + $pos if $pos >= 0;
70 54 100 66     355 return -1 if $read == 0 || ($offset += $read) == $end;
71              
72             # Resize window
73 39         149 substr $window, 0, $read, '';
74             }
75              
76 2         12 return -1;
77             }
78              
79             sub get_chunk {
80 128     128 1 1709 my ($self, $offset, $max) = @_;
81 128   100     571 $max //= 131072;
82              
83 128         467 $offset += $self->start_range;
84 128         378 my $handle = $self->handle;
85 128         671 $handle->sysseek($offset, SEEK_SET);
86              
87 128         1677 my $buffer;
88 128 100       450 if (defined(my $end = $self->end_range)) {
89 32 100       157 return '' if (my $chunk = $end + 1 - $offset) <= 0;
90 23 100       89 $handle->sysread($buffer, $chunk > $max ? $max : $chunk);
91             }
92 96         373 else { $handle->sysread($buffer, $max) }
93              
94 119         3073 return $buffer;
95             }
96              
97 76     76 1 2996 sub is_file {1}
98              
99             sub move_to {
100 4     4 1 782 my ($self, $to) = @_;
101              
102             # Windows requires that the handle is closed
103 4         38 close $self->handle;
104 4         130 delete $self->{handle};
105              
106             # Move file and prevent clean up
107 4         20 Mojo::File->new($self->path)->move_to($to);
108 4         18 return $self->path($to)->cleanup(0);
109             }
110              
111 64     64 1 1970 sub mtime { (stat shift->handle)[9] }
112              
113             sub new {
114 117     117 1 59802 my $file = shift->SUPER::new(@_);
115 117         554 $file->{pid} = $$;
116 117         563 return $file;
117             }
118              
119 116     116 1 389 sub size { -s shift->handle }
120              
121             sub slurp {
122 34     34 1 909 my $handle = shift->handle;
123 34         244 $handle->sysseek(0, SEEK_SET);
124 34         459 my $ret = my $content = '';
125 34         177 while ($ret = $handle->sysread(my $buffer, 131072, 0)) { $content .= $buffer }
  38         2521  
126 34 50       972 return defined $ret ? $content : croak "Can't read from asset: $!";
127             }
128              
129 2     2 1 8 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