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 63     63   258438 use Mojo::Base 'Mojo::Asset';
  63         159  
  63         483  
3              
4 63     63   531 use Carp qw(croak);
  63         177  
  63         3459  
5 63     63   484 use Fcntl qw(SEEK_SET);
  63         174  
  63         3356  
6 63     63   5682 use File::Spec::Functions ();
  63         9845  
  63         1774  
7 63     63   5149 use Mojo::File qw(tempfile);
  63         189  
  63         85741  
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 119     119   17354 my $self = shift;
31              
32 119 100 100     509 return unless $self->cleanup && defined(my $path = $self->path);
33 44 50       138 if (my $handle = $self->handle) { close $handle }
  44         692  
34              
35             # Only the process that created the file is allowed to remove it
36 44 100 33     1546 Mojo::File->new($path)->remove if -w $path && ($self->{pid} // $$) == $$;
      66        
37             }
38              
39             sub add_chunk {
40 64     64 1 397 my ($self, $chunk) = @_;
41 64 100 50     205 ($self->handle->syswrite($chunk) // -1) == length $chunk or croak "Can't write to asset: $!";
42 61         7863 return $self;
43             }
44              
45             sub contains {
46 69     69 1 186 my ($self, $str) = @_;
47              
48 69         216 my $handle = $self->handle;
49 69         215 $handle->sysseek($self->start_range, SEEK_SET);
50              
51             # Calculate window size
52 69   100     1004 my $end = $self->end_range // $self->size;
53 69         178 my $len = length $str;
54 69 100       199 my $size = $len > 131072 ? $len : 131072;
55 69 100       207 $size = $end - $self->start_range if $size > $end - $self->start_range;
56              
57             # Sliding window search
58 69         119 my $offset = 0;
59 69         223 my $start = $handle->sysread(my $window, $len);
60 69         1337 while ($offset < $end) {
61              
62             # Read as much as possible
63 106         196 my $diff = $end - ($start + $offset);
64 106 100       420 my $read = $handle->sysread(my $buffer, $diff < $size ? $diff : $size);
65 106         5397 $window .= $buffer;
66              
67             # Search window
68 106         11484 my $pos = index $window, $str;
69 106 100       681 return $offset + $pos if $pos >= 0;
70 54 100 66     410 return -1 if $read == 0 || ($offset += $read) == $end;
71              
72             # Resize window
73 39         133 substr $window, 0, $read, '';
74             }
75              
76 2         16 return -1;
77             }
78              
79             sub get_chunk {
80 134     134 1 1777 my ($self, $offset, $max) = @_;
81 134   100     627 $max //= 131072;
82              
83 134         422 $offset += $self->start_range;
84 134         423 my $handle = $self->handle;
85 134         778 $handle->sysseek($offset, SEEK_SET);
86              
87 134         1989 my $buffer;
88 134 100       518 if (defined(my $end = $self->end_range)) {
89 32 100       140 return '' if (my $chunk = $end + 1 - $offset) <= 0;
90 23 100       93 $handle->sysread($buffer, $chunk > $max ? $max : $chunk);
91             }
92 102         438 else { $handle->sysread($buffer, $max) }
93              
94 125         3776 return $buffer;
95             }
96              
97 79     79 1 2903 sub is_file {1}
98              
99             sub move_to {
100 4     4 1 824 my ($self, $to) = @_;
101              
102             # Windows requires that the handle is closed
103 4         14 close $self->handle;
104 4         132 delete $self->{handle};
105              
106             # Move file and prevent clean up
107 4         20 Mojo::File->new($self->path)->move_to($to);
108 4         22 return $self->path($to)->cleanup(0);
109             }
110              
111 67     67 1 2135 sub mtime { (stat shift->handle)[9] }
112              
113             sub new {
114 120     120 1 58010 my $file = shift->SUPER::new(@_);
115 120         627 $file->{pid} = $$;
116 120         994 return $file;
117             }
118              
119 119     119 1 413 sub size { -s shift->handle }
120              
121             sub slurp {
122 34     34 1 987 my $handle = shift->handle;
123 34         290 $handle->sysseek(0, SEEK_SET);
124 34         504 my $ret = my $content = '';
125 34         197 while ($ret = $handle->sysread(my $buffer, 131072, 0)) { $content .= $buffer }
  38         2665  
126 34 50       1117 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