1 package Catalyst::Request::Upload;
4 with 'MooseX::Emulate::Class::Accessor::Fast';
6 use Catalyst::Exception;
10 use PerlIO::utf8_strict;
11 use namespace::clean -except => 'meta';
13 has filename => (is => 'rw');
14 has headers => (is => 'rw');
15 has size => (is => 'rw');
16 has tempname => (is => 'rw');
17 has type => (is => 'rw');
18 has basename => (is => 'ro', lazy_build => 1);
19 has raw_basename => (is => 'ro', lazy_build => 1);
20 has charset => (is=>'ro', predicate=>'has_charset');
29 my $fh = IO::File->new($self->tempname, IO::File::O_RDONLY);
30 unless ( defined $fh ) {
31 my $filename = $self->tempname;
32 Catalyst::Exception->throw(
33 message => qq/Can't open '$filename': '$!'/ );
40 my $basename = shift->raw_basename;
41 $basename =~ s|[^\w\.-]+|_|g;
45 sub _build_raw_basename {
47 my $basename = $self->filename;
48 $basename =~ s|\\|/|g;
49 $basename = ( File::Spec::Unix->splitpath($basename) )[2];
55 =for stopwords uploadtmp
59 Catalyst::Request::Upload - handles file upload requests
63 my $upload = $c->req->upload('field');
74 $upload->decoded_slurp;
79 To specify where Catalyst should put the temporary files, set the 'uploadtmp'
80 option in the Catalyst config. If unset, Catalyst will use the system temp dir.
82 __PACKAGE__->config( uploadtmp => '/path/to/tmpdir' );
88 This class provides accessors and methods to handle client upload requests.
96 =head2 $upload->copy_to
98 Copies the temporary file using L<File::Copy>. Returns true for success,
101 $upload->copy_to('/path/to/target');
103 Please note the filename used for the copy target is the 'tempname' that
104 is the actual filename on the filesystem, NOT the 'filename' that was
105 part of the upload headers. This might seem counter intuitive but at this
106 point this behavior is so established that its not something we can change.
108 You can always create your own copy routine that munges the target path
115 return File::Copy::copy( $self->tempname, @_ );
118 =head2 $upload->is_utf8_encoded
120 Returns true of the upload defines a character set at that value is 'UTF-8'.
121 This does not try to inspect your upload and make any guesses if the Content
122 Type charset is undefined.
126 sub is_utf8_encoded {
128 if(my $charset = $self->charset) {
129 return $charset eq 'UTF-8' ? 1 : 0;
136 Opens a temporary file (see tempname below) and returns an L<IO::File> handle.
138 This is a filehandle that is opened with no additional IO Layers.
140 =head2 $upload->decoded_fh(?$encoding)
142 Returns a filehandle that has binmode set to UTF-8 if a UTF-8 character set
143 is found. This also accepts an override encoding value that you can use to
144 force a particular L<PerlIO> layer. If neither are found the filehandle is
147 This is useful if you are pulling the file into code and inspecting bits and
148 maybe then sending those bits back as the response. (Please note this is not
149 a suitable filehandle to set in the body; use C<fh> if you are doing that).
151 Please note that using this method sets the underlying filehandle IO layer
152 so once you use this method if you go back and use the C<fh> method you
153 still get the IO layer applied.
158 my ($self, $layer) = @_;
161 $layer = ':utf8_strict' if !$layer && $self->is_utf8_encoded;
162 $layer = ':raw' unless $layer;
164 binmode($fh, $layer);
168 =head2 $upload->filename
170 Returns the client-supplied filename.
172 =head2 $upload->headers
174 Returns an L<HTTP::Headers> object for the request.
176 =head2 $upload->link_to
178 Creates a hard link to the temporary file. Returns true for success,
181 $upload->link_to('/path/to/target');
186 my ( $self, $target ) = @_;
187 return CORE::link( $self->tempname, $target );
192 Returns the size of the uploaded file in bytes.
194 =head2 $upload->slurp(?$encoding)
196 Optionally accepts an argument to define an IO Layer (which is applied to
197 the filehandle via binmode; if no layer is defined the default is set to
200 Returns a scalar containing the contents of the temporary file.
202 Note that this will cause the filehandle pointed to by C<< $upload->fh >> to
203 be reset to the start of the file using seek and the file handle to be put
204 into whatever encoding mode is applied.
209 my ( $self, $layer ) = @_;
216 my $handle = $self->fh;
218 binmode( $handle, $layer );
220 $handle->seek(0, IO::File::SEEK_SET);
222 if ($layer eq ':raw') {
223 while ( $handle->sysread( my $buffer, 8192 ) ) {
228 $content = do { local $/; $handle->getline };
231 $handle->seek(0, IO::File::SEEK_SET);
235 =head2 $upload->decoded_slurp(?$encoding)
237 Works just like C<slurp> except we use C<decoded_fh> instead of C<fh> to
238 open a filehandle to slurp. This means if your upload charset is UTF8
239 we binmode the filehandle to that encoding.
244 my ( $self, $layer ) = @_;
245 my $handle = $self->decoded_fh($layer);
247 $handle->seek(0, IO::File::SEEK_SET);
249 my $content = do { local $/; $handle->getline };
251 $handle->seek(0, IO::File::SEEK_SET);
255 =head2 $upload->basename
257 Returns basename for C<filename>. This filters the name through a regexp
258 C<basename =~ s|[^\w\.-]+|_|g> to make it safe for filesystems that don't
259 like advanced characters. This will of course filter UTF8 characters.
260 If you need the exact basename unfiltered use C<raw_basename>.
262 =head2 $upload->raw_basename
264 Just like C<basename> but without filtering the filename for characters that
265 don't always write to a filesystem.
267 =head2 $upload->tempname
269 Returns the path to the temporary file.
273 Returns the client-supplied Content-Type.
275 =head2 $upload->charset
277 The character set information part of the content type, if any. Useful if you
278 need to figure out any encodings on the file upload.
286 Catalyst Contributors, see Catalyst.pm
290 This library is free software. You can redistribute it and/or modify
291 it under the same terms as Perl itself.
295 __PACKAGE__->meta->make_immutable;