1 package Catalyst::Request::Upload;
4 with 'MooseX::Emulate::Class::Accessor::Fast';
6 use Catalyst::Exception;
10 use namespace::clean -except => 'meta';
12 has filename => (is => 'rw');
13 has headers => (is => 'rw');
14 has size => (is => 'rw');
15 has tempname => (is => 'rw');
16 has type => (is => 'rw');
17 has basename => (is => 'ro', lazy_build => 1);
18 has raw_basename => (is => 'ro', lazy_build => 1);
19 has charset => (is=>'ro', predicate=>'has_charset');
28 my $fh = IO::File->new($self->tempname, IO::File::O_RDONLY);
29 unless ( defined $fh ) {
30 my $filename = $self->tempname;
31 Catalyst::Exception->throw(
32 message => qq/Can't open '$filename': '$!'/ );
39 my $basename = shift->raw_basename;
40 $basename =~ s|[^\w\.-]+|_|g;
44 sub _build_raw_basename {
46 my $basename = $self->filename;
47 $basename =~ s|\\|/|g;
48 $basename = ( File::Spec::Unix->splitpath($basename) )[2];
54 =for stopwords uploadtmp
58 Catalyst::Request::Upload - handles file upload requests
62 my $upload = $c->req->upload('field');
73 $upload->decoded_slurp;
78 To specify where Catalyst should put the temporary files, set the 'uploadtmp'
79 option in the Catalyst config. If unset, Catalyst will use the system temp dir.
81 __PACKAGE__->config( uploadtmp => '/path/to/tmpdir' );
87 This class provides accessors and methods to handle client upload requests.
95 =head2 $upload->copy_to
97 Copies the temporary file using L<File::Copy>. Returns true for success,
100 $upload->copy_to('/path/to/target');
106 return File::Copy::copy( $self->tempname, @_ );
109 =head2 $upload->is_utf8_encoded
111 Returns true of the upload defines a character set at that value is 'UTF-8'.
112 This does not try to inspect your upload and make any guesses if the Content
113 Type charset is undefined.
117 sub is_utf8_encoded {
119 if(my $charset = $self->charset) {
120 return $charset eq 'UTF-8' ? 1 : 0;
127 Opens a temporary file (see tempname below) and returns an L<IO::File> handle.
129 This is a filehandle that is opened with no additional IO Layers.
131 =head2 $upload->decoded_fh(?$encoding)
133 Returns a filehandle that has binmode set to UTF-8 if a UTF-8 character set
134 is found. This also accepts an override encoding value that you can use to
135 force a particular L<PerlIO> layer. If neither are found the filehandle is
138 This is useful if you are pulling the file into code and inspecting bit and
139 maybe then sending those bits back as the response. (Please not this is not
140 a suitable filehandle to set in the body; use C<fh> if you are doing that).
142 Please note that using this method sets the underlying filehandle IO layer
143 so once you use this method if you go back and use the C<fh> method you
144 still get the IO layer applied.
149 my ($self, $layer) = @_;
152 $layer = ":encoding(UTF-8)" if !$layer && $self->is_utf8_encoded;
153 $layer = ':raw' unless $layer;
155 binmode($fh, $layer);
159 =head2 $upload->filename
161 Returns the client-supplied filename.
163 =head2 $upload->headers
165 Returns an L<HTTP::Headers> object for the request.
167 =head2 $upload->link_to
169 Creates a hard link to the temporary file. Returns true for success,
172 $upload->link_to('/path/to/target');
177 my ( $self, $target ) = @_;
178 return CORE::link( $self->tempname, $target );
183 Returns the size of the uploaded file in bytes.
185 =head2 $upload->slurp(?$encoding)
187 Optionally accepts an argument to define an IO Layer (which is applied to
188 the filehandle via binmode; if no layer is defined the default is set to
191 Returns a scalar containing the contents of the temporary file.
193 Note that this will cause the filehandle pointed to by C<< $upload->fh >> to
194 be reset to the start of the file using seek and the file handle to be put
195 into whatever encoding mode is applied.
200 my ( $self, $layer ) = @_;
207 my $handle = $self->fh;
209 binmode( $handle, $layer );
211 $handle->seek(0, IO::File::SEEK_SET);
212 while ( $handle->sysread( my $buffer, 8192 ) ) {
216 $handle->seek(0, IO::File::SEEK_SET);
220 =head2 $upload->decoded_slurp(?$encoding)
222 Works just like C<slurp> except we use C<decoded_fh> instead of C<fh> to
223 open a filehandle to slurp. This means if your upload charset is UTF8
224 we binmode the filehandle to that encoding.
229 my ( $self, $layer ) = @_;
230 my $handle = $self->decoded_fh($layer);
233 $handle->seek(0, IO::File::SEEK_SET);
234 while ( $handle->sysread( my $buffer, 8192 ) ) {
238 $handle->seek(0, IO::File::SEEK_SET);
242 =head2 $upload->basename
244 Returns basename for C<filename>. This filters the name through a regexp
245 C<basename =~ s|[^\w\.-]+|_|g> to make it safe for filesystems that don't
246 like advanced characters. This will of course filter UTF8 characters.
247 If you need the exact basename unfiltered use C<raw_basename>.
249 =head2 $upload->raw_basename
251 Just like C<basename> but without filtering the filename for characters that
252 don't always write to a filesystem.
254 =head2 $upload->tempname
256 Returns the path to the temporary file.
260 Returns the client-supplied Content-Type.
262 =head2 $upload->charset
264 The character set information part of the content type, if any. Useful if you
265 need to figure out any encodings on the file upload.
273 Catalyst Contributors, see Catalyst.pm
277 This library is free software. You can redistribute it and/or modify
278 it under the same terms as Perl itself.
282 __PACKAGE__->meta->make_immutable;