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 66     66   507666 use Mojo::Base 'Mojo::Asset';
  66         140  
  66         508  
3              
4 66     66   554 use Carp qw(croak);
  66         170  
  66         4252  
5 66     66   445 use Fcntl qw(SEEK_SET);
  66         156  
  66         3991  
6 66     66   5366 use File::Spec::Functions ();
  66         13270  
  66         2387  
7 66     66   9807 use Mojo::File qw(tempfile);
  66         192  
  66         111981  
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 117     117   25960 my $self = shift;
31              
32 117 100 100     776 return unless $self->cleanup && defined(my $path = $self->path);
33 44 50       215 if (my $handle = $self->handle) { close $handle }
  44         1070  
34              
35             # Only the process that created the file is allowed to remove it
36 44 100 33     5679 Mojo::File->new($path)->remove if -w $path && ($self->{pid} // $$) == $$;
      66        
37             }
38              
39             sub add_chunk {
40 64     64 1 319 my ($self, $chunk) = @_;
41 64 100 50     270 ($self->handle->syswrite($chunk) // -1) == length $chunk or croak "Can't write to asset: $!";
42 61         9667 return $self;
43             }
44              
45             sub contains {
46 69     69 1 239 my ($self, $str) = @_;
47              
48 69         366 my $handle = $self->handle;
49 69         265 $handle->sysseek($self->start_range, SEEK_SET);
50              
51             # Calculate window size
52 69   100     1097 my $end = $self->end_range // $self->size;
53 69         186 my $len = length $str;
54 69 100       182 my $size = $len > 131072 ? $len : 131072;
55 69 100       199 $size = $end - $self->start_range if $size > $end - $self->start_range;
56              
57             # Sliding window search
58 69         199 my $offset = 0;
59 69         291 my $start = $handle->sysread(my $window, $len);
60 69         1753 while ($offset < $end) {
61              
62             # Read as much as possible
63 106         273 my $diff = $end - ($start + $offset);
64 106 100       406 my $read = $handle->sysread(my $buffer, $diff < $size ? $diff : $size);
65 106         5420 $window .= $buffer;
66              
67             # Search window
68 106         17782 my $pos = index $window, $str;
69 106 100       824 return $offset + $pos if $pos >= 0;
70 54 100 66     449 return -1 if $read == 0 || ($offset += $read) == $end;
71              
72             # Resize window
73 39         126 substr $window, 0, $read, '';
74             }
75              
76 2         16 return -1;
77             }
78              
79             sub get_chunk {
80 132     132 1 2927 my ($self, $offset, $max) = @_;
81 132   100     871 $max //= 131072;
82              
83 132         551 $offset += $self->start_range;
84 132         442 my $handle = $self->handle;
85 132         1011 $handle->sysseek($offset, SEEK_SET);
86              
87 132         1860 my $buffer;
88 132 100       713 if (defined(my $end = $self->end_range)) {
89 32 100       158 return '' if (my $chunk = $end + 1 - $offset) <= 0;
90 23 100       138 $handle->sysread($buffer, $chunk > $max ? $max : $chunk);
91             }
92 100         477 else { $handle->sysread($buffer, $max) }
93              
94 123         4553 return $buffer;
95             }
96              
97 78     78 1 3556 sub is_file {1}
98              
99             sub move_to {
100 4     4 1 1112 my ($self, $to) = @_;
101              
102             # Windows requires that the handle is closed
103 4         22 close $self->handle;
104 4         158 delete $self->{handle};
105              
106             # Move file and prevent clean up
107 4         18 Mojo::File->new($self->path)->move_to($to);
108 4         28 return $self->path($to)->cleanup(0);
109             }
110              
111 66     66 1 3537 sub mtime { (stat shift->handle)[9] }
112              
113             sub new {
114 118     118 1 559132 my $file = shift->SUPER::new(@_);
115 118         1149 $file->{pid} = $$;
116 118         734 return $file;
117             }
118              
119 118     118 1 487 sub size { -s shift->handle }
120              
121             sub slurp {
122 34     34 1 1418 my $handle = shift->handle;
123 34         361 $handle->sysseek(0, SEEK_SET);
124 34         431 my $ret = my $content = '';
125 34         221 while ($ret = $handle->sysread(my $buffer, 131072, 0)) { $content .= $buffer }
  38         5846  
126 34 50       965 return defined $ret ? $content : croak "Can't read from asset: $!";
127             }
128              
129 2     2 1 10 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