Newer Older
260 lines | 5.707kb
copy gitweblite soruce code
root authored on 2012-11-23
1
package Mojo::Asset::File;
2
use Mojo::Base 'Mojo::Asset';
3

            
4
use Carp 'croak';
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
5
use Errno 'EEXIST';
6
use Fcntl qw(O_CREAT O_EXCL O_RDWR);
copy gitweblite soruce code
root authored on 2012-11-23
7
use File::Copy 'move';
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
8
use File::Spec::Functions 'catfile';
copy gitweblite soruce code
root authored on 2012-11-23
9
use IO::File;
10
use Mojo::Util 'md5_sum';
11

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
12
has [qw(cleanup path)];
copy gitweblite soruce code
root authored on 2012-11-23
13
has handle => sub {
14
  my $self = shift;
15

            
16
  # Open existing file
17
  my $handle = IO::File->new;
18
  my $path   = $self->path;
19
  if (defined $path && -f $path) {
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
20
    $handle->open($path, '<') or croak qq{Can't open file "$path": $!};
copy gitweblite soruce code
root authored on 2012-11-23
21
    return $handle;
22
  }
23

            
24
  # Open new or temporary file
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
25
  my $base = catfile $self->tmpdir, 'mojo.tmp';
copy gitweblite soruce code
root authored on 2012-11-23
26
  my $name = defined $path ? $path : $base;
27
  until ($handle->open($name, O_CREAT | O_EXCL | O_RDWR)) {
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
28
    croak qq{Can't open file "$name": $!} if defined $path || $! != $!{EEXIST};
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
29
    $name = "$base." . md5_sum(time . $$ . rand 9 x 7);
copy gitweblite soruce code
root authored on 2012-11-23
30
  }
31
  $self->path($name);
32

            
33
  # Enable automatic cleanup
34
  $self->cleanup(1) unless defined $self->cleanup;
35

            
36
  return $handle;
37
};
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
38
has tmpdir => sub { $ENV{MOJO_TMPDIR} || File::Spec::Functions::tmpdir };
copy gitweblite soruce code
root authored on 2012-11-23
39

            
40
sub DESTROY {
41
  my $self = shift;
42
  return unless $self->cleanup && defined(my $path = $self->path);
43
  close $self->handle;
44
  unlink $path if -w $path;
45
}
46

            
47
sub add_chunk {
48
  my ($self, $chunk) = @_;
49

            
50
  my $handle = $self->handle;
51
  $handle->sysseek(0, SEEK_END);
52
  $chunk = defined $chunk ? $chunk : '';
53
  croak "Can't write to asset: $!"
54
    unless defined $handle->syswrite($chunk, length $chunk);
55

            
56
  return $self;
57
}
58

            
59
sub contains {
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
60
  my ($self, $str) = @_;
copy gitweblite soruce code
root authored on 2012-11-23
61

            
62
  my $handle = $self->handle;
63
  $handle->sysseek($self->start_range, SEEK_SET);
64

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
65
  # Calculate window size
66
  my $end  = defined $self->end_range ? $self->end_range : $self->size;
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
67
  my $len  = length $str;
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
68
  my $size = $len > 131072 ? $len : 131072;
69
  $size = $end - $self->start_range if $size > $end - $self->start_range;
70

            
71
  # Sliding window search
72
  my $offset = 0;
73
  my $start = $handle->sysread(my $window, $len);
74
  while ($offset < $end) {
75

            
76
    # Read as much as possible
77
    my $diff = $end - ($start + $offset);
78
    my $read = $handle->sysread(my $buffer, $diff < $size ? $diff : $size);
copy gitweblite soruce code
root authored on 2012-11-23
79
    $window .= $buffer;
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
80

            
81
    # Search window
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
82
    my $pos = index $window, $str;
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
83
    return $offset + $pos if $pos >= 0;
84
    $offset += $read;
85
    return -1 if $read == 0 || $offset == $end;
86

            
87
    # Resize window
copy gitweblite soruce code
root authored on 2012-11-23
88
    substr $window, 0, $read, '';
89
  }
90

            
91
  return -1;
92
}
93

            
94
sub get_chunk {
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
95
  my ($self, $offset, $max) = @_;
96
  $max = defined $max ? $max : 131072;
copy gitweblite soruce code
root authored on 2012-11-23
97

            
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
98
  $offset += $self->start_range;
copy gitweblite soruce code
root authored on 2012-11-23
99
  my $handle = $self->handle;
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
100
  $handle->sysseek($offset, SEEK_SET);
copy gitweblite soruce code
root authored on 2012-11-23
101

            
102
  my $buffer;
103
  if (defined(my $end = $self->end_range)) {
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
104
    my $chunk = $end + 1 - $offset;
copy gitweblite soruce code
root authored on 2012-11-23
105
    return '' if $chunk <= 0;
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
106
    $handle->sysread($buffer, $chunk > $max ? $max : $chunk);
copy gitweblite soruce code
root authored on 2012-11-23
107
  }
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
108
  else { $handle->sysread($buffer, $max) }
copy gitweblite soruce code
root authored on 2012-11-23
109

            
110
  return $buffer;
111
}
112

            
113
sub is_file {1}
114

            
115
sub move_to {
116
  my ($self, $to) = @_;
117

            
118
  # Windows requires that the handle is closed
119
  close $self->handle;
120
  delete $self->{handle};
121

            
122
  # Move file and prevent clean up
123
  my $from = $self->path;
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
124
  move($from, $to) or croak qq{Can't move file "$from" to "$to": $!};
125
  return $self->path($to)->cleanup(0);
copy gitweblite soruce code
root authored on 2012-11-23
126
}
127

            
128
sub size {
129
  return 0 unless defined(my $file = shift->path);
130
  return -s $file;
131
}
132

            
133
sub slurp {
134
  my $handle = shift->handle;
135
  $handle->sysseek(0, SEEK_SET);
136
  my $content = '';
137
  while ($handle->sysread(my $buffer, 131072)) { $content .= $buffer }
138
  return $content;
139
}
140

            
141
1;
142

            
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
143
=encoding utf8
144

            
copy gitweblite soruce code
root authored on 2012-11-23
145
=head1 NAME
146

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
147
Mojo::Asset::File - File storage for HTTP content
copy gitweblite soruce code
root authored on 2012-11-23
148

            
149
=head1 SYNOPSIS
150

            
151
  use Mojo::Asset::File;
152

            
153
  # Temporary file
154
  my $file = Mojo::Asset::File->new;
155
  $file->add_chunk('foo bar baz');
156
  say 'File contains "bar"' if $file->contains('bar') >= 0;
157
  say $file->slurp;
158

            
159
  # Existing file
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
160
  my $file = Mojo::Asset::File->new(path => '/home/sri/foo.txt');
copy gitweblite soruce code
root authored on 2012-11-23
161
  $file->move_to('/yada.txt');
162
  say $file->slurp;
163

            
164
=head1 DESCRIPTION
165

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
166
L<Mojo::Asset::File> is a file storage backend for HTTP content.
copy gitweblite soruce code
root authored on 2012-11-23
167

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
168
=head1 EVENTS
169

            
170
L<Mojo::Asset::File> inherits all events from L<Mojo::Asset>.
171

            
copy gitweblite soruce code
root authored on 2012-11-23
172
=head1 ATTRIBUTES
173

            
174
L<Mojo::Asset::File> inherits all attributes from L<Mojo::Asset> and
175
implements the following new ones.
176

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
177
=head2 cleanup
copy gitweblite soruce code
root authored on 2012-11-23
178

            
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
179
  my $bool = $file->cleanup;
180
  $file    = $file->cleanup($bool);
copy gitweblite soruce code
root authored on 2012-11-23
181

            
182
Delete file automatically once it's not used anymore.
183

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
184
=head2 handle
copy gitweblite soruce code
root authored on 2012-11-23
185

            
186
  my $handle = $file->handle;
187
  $file      = $file->handle(IO::File->new);
188

            
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
189
Filehandle, created on demand.
copy gitweblite soruce code
root authored on 2012-11-23
190

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
191
=head2 path
copy gitweblite soruce code
root authored on 2012-11-23
192

            
193
  my $path = $file->path;
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
194
  $file    = $file->path('/home/sri/foo.txt');
copy gitweblite soruce code
root authored on 2012-11-23
195

            
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
196
File path used to create L</"handle">, can also be automatically generated if
copy gitweblite soruce code
root authored on 2012-11-23
197
necessary.
198

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
199
=head2 tmpdir
copy gitweblite soruce code
root authored on 2012-11-23
200

            
201
  my $tmpdir = $file->tmpdir;
202
  $file      = $file->tmpdir('/tmp');
203

            
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
204
Temporary directory used to generate L</"path">, defaults to the value of the
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
205
MOJO_TMPDIR environment variable or auto detection.
copy gitweblite soruce code
root authored on 2012-11-23
206

            
207
=head1 METHODS
208

            
209
L<Mojo::Asset::File> inherits all methods from L<Mojo::Asset> and implements
210
the following new ones.
211

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
212
=head2 add_chunk
copy gitweblite soruce code
root authored on 2012-11-23
213

            
214
  $file = $file->add_chunk('foo bar baz');
215

            
216
Add chunk of data.
217

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
218
=head2 contains
copy gitweblite soruce code
root authored on 2012-11-23
219

            
220
  my $position = $file->contains('bar');
221

            
222
Check if asset contains a specific string.
223

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
224
=head2 get_chunk
copy gitweblite soruce code
root authored on 2012-11-23
225

            
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
226
  my $bytes = $file->get_chunk($offset);
227
  my $bytes = $file->get_chunk($offset, $max);
copy gitweblite soruce code
root authored on 2012-11-23
228

            
update Mojolicious 4.07
Yuki Kimoto authored on 2013-06-03
229
Get chunk of data starting from a specific position, defaults to a maximum
230
chunk size of C<131072> bytes.
copy gitweblite soruce code
root authored on 2012-11-23
231

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
232
=head2 is_file
copy gitweblite soruce code
root authored on 2012-11-23
233

            
234
  my $true = $file->is_file;
235

            
236
True.
237

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
238
=head2 move_to
copy gitweblite soruce code
root authored on 2012-11-23
239

            
upgraded Mojolicious to v3.7...
Yuki Kimoto authored on 2013-01-28
240
  $file = $file->move_to('/home/sri/bar.txt');
copy gitweblite soruce code
root authored on 2012-11-23
241

            
update Mojolicious to 4.57
Yuki Kimoto authored on 2013-12-02
242
Move asset data into a specific file and disable L</"cleanup">.
copy gitweblite soruce code
root authored on 2012-11-23
243

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
244
=head2 size
copy gitweblite soruce code
root authored on 2012-11-23
245

            
246
  my $size = $file->size;
247

            
248
Size of asset data in bytes.
249

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
250
=head2 slurp
copy gitweblite soruce code
root authored on 2012-11-23
251

            
update Mojolicious and added...
Yuki Kimoto authored on 2013-03-20
252
  my $bytes = $file->slurp;
copy gitweblite soruce code
root authored on 2012-11-23
253

            
254
Read all asset data at once.
255

            
256
=head1 SEE ALSO
257

            
258
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
259

            
260
=cut