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   315866 use Mojo::Base 'Mojo::Asset';
  66         99  
  66         385  
3              
4 66     66   319 use Carp qw(croak);
  66         105  
  66         3088  
5 66     66   313 use Fcntl qw(SEEK_SET);
  66         127  
  66         2599  
6 66     66   3792 use File::Spec::Functions ();
  66         6681  
  66         1554  
7 66     66   3930 use Mojo::File qw(tempfile);
  66         162  
  66         72084  
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   16478 my $self = shift;
31              
32 117 100 100     422 return unless $self->cleanup && defined(my $path = $self->path);
33 44 50       213 if (my $handle = $self->handle) { close $handle }
  44         769  
34              
35             # Only the process that created the file is allowed to remove it
36 44 100 33     1597 Mojo::File->new($path)->remove if -w $path && ($self->{pid} // $$) == $$;
      66        
37             }
38              
39             sub add_chunk {
40 64     64 1 159 my ($self, $chunk) = @_;
41 64 100 50     163 ($self->handle->syswrite($chunk) // -1) == length $chunk or croak "Can't write to asset: $!";
42 61         6427 return $self;
43             }
44              
45             sub contains {
46 69     69 1 146 my ($self, $str) = @_;
47              
48 69         185 my $handle = $self->handle;
49 69         172 $handle->sysseek($self->start_range, SEEK_SET);
50              
51             # Calculate window size
52 69   100     657 my $end = $self->end_range // $self->size;
53 69         108 my $len = length $str;
54 69 100       119 my $size = $len > 131072 ? $len : 131072;
55 69 100       159 $size = $end - $self->start_range if $size > $end - $self->start_range;
56              
57             # Sliding window search
58 69         76 my $offset = 0;
59 69         167 my $start = $handle->sysread(my $window, $len);
60 69         1009 while ($offset < $end) {
61              
62             # Read as much as possible
63 106         118 my $diff = $end - ($start + $offset);
64 106 100       233 my $read = $handle->sysread(my $buffer, $diff < $size ? $diff : $size);
65 106         3561 $window .= $buffer;
66              
67             # Search window
68 106         11199 my $pos = index $window, $str;
69 106 100       502 return $offset + $pos if $pos >= 0;
70 54 100 66     269 return -1 if $read == 0 || ($offset += $read) == $end;
71              
72             # Resize window
73 39         79 substr $window, 0, $read, '';
74             }
75              
76 2         10 return -1;
77             }
78              
79             sub get_chunk {
80 132     132 1 1827 my ($self, $offset, $max) = @_;
81 132   100     466 $max //= 131072;
82              
83 132         363 $offset += $self->start_range;
84 132         333 my $handle = $self->handle;
85 132         638 $handle->sysseek($offset, SEEK_SET);
86              
87 132         1350 my $buffer;
88 132 100       318 if (defined(my $end = $self->end_range)) {
89 32 100       89 return '' if (my $chunk = $end + 1 - $offset) <= 0;
90 23 100       78 $handle->sysread($buffer, $chunk > $max ? $max : $chunk);
91             }
92 100         403 else { $handle->sysread($buffer, $max) }
93              
94 123         3553 return $buffer;
95             }
96              
97 78     78 1 2924 sub is_file {1}
98              
99             sub move_to {
100 4     4 1 768 my ($self, $to) = @_;
101              
102             # Windows requires that the handle is closed
103 4         12 close $self->handle;
104 4         100 delete $self->{handle};
105              
106             # Move file and prevent clean up
107 4         10 Mojo::File->new($self->path)->move_to($to);
108 4         14 return $self->path($to)->cleanup(0);
109             }
110              
111 66     66 1 1923 sub mtime { (stat shift->handle)[9] }
112              
113             sub new {
114 118     118 1 360066 my $file = shift->SUPER::new(@_);
115 118         675 $file->{pid} = $$;
116 118         413 return $file;
117             }
118              
119 118     118 1 282 sub size { -s shift->handle }
120              
121             sub slurp {
122 34     34 1 815 my $handle = shift->handle;
123 34         232 $handle->sysseek(0, SEEK_SET);
124 34         290 my $ret = my $content = '';
125 34         142 while ($ret = $handle->sysread(my $buffer, 131072, 0)) { $content .= $buffer }
  38         1534  
126 34 50       496 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