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');
102 Please note the filename used for the copy target is the 'tempname' that
103 is the actual filename on the filesystem, NOT the 'filename' that was
104 part of the upload headers. This might seem counter intuitive but at this
105 point this behavior is so established that its not something we can change.
107 You can always create your own copy routine that munges the target path
114 return File::Copy::copy( $self->tempname, @_ );
117 =head2 $upload->is_utf8_encoded
119 Returns true of the upload defines a character set at that value is 'UTF-8'.
120 This does not try to inspect your upload and make any guesses if the Content
121 Type charset is undefined.
125 sub is_utf8_encoded {
127 if(my $charset = $self->charset) {
128 return $charset eq 'UTF-8' ? 1 : 0;
135 Opens a temporary file (see tempname below) and returns an L<IO::File> handle.
137 This is a filehandle that is opened with no additional IO Layers.
139 =head2 $upload->decoded_fh(?$encoding)
141 Returns a filehandle that has binmode set to UTF-8 if a UTF-8 character set
142 is found. This also accepts an override encoding value that you can use to
143 force a particular L<PerlIO> layer. If neither are found the filehandle is
146 This is useful if you are pulling the file into code and inspecting bits and
147 maybe then sending those bits back as the response. (Please note this is not
148 a suitable filehandle to set in the body; use C<fh> if you are doing that).
150 Please note that using this method sets the underlying filehandle IO layer
151 so once you use this method if you go back and use the C<fh> method you
152 still get the IO layer applied.
157 my ($self, $layer) = @_;
160 $layer = ":encoding(UTF-8)" if !$layer && $self->is_utf8_encoded;
161 $layer = ':raw' unless $layer;
163 binmode($fh, $layer);
167 =head2 $upload->filename
169 Returns the client-supplied filename.
171 =head2 $upload->headers
173 Returns an L<HTTP::Headers> object for the request.
175 =head2 $upload->link_to
177 Creates a hard link to the temporary file. Returns true for success,
180 $upload->link_to('/path/to/target');
185 my ( $self, $target ) = @_;
186 return CORE::link( $self->tempname, $target );
191 Returns the size of the uploaded file in bytes.
193 =head2 $upload->slurp(?$encoding)
195 Optionally accepts an argument to define an IO Layer (which is applied to
196 the filehandle via binmode; if no layer is defined the default is set to
199 Returns a scalar containing the contents of the temporary file.
201 Note that this will cause the filehandle pointed to by C<< $upload->fh >> to
202 be reset to the start of the file using seek and the file handle to be put
203 into whatever encoding mode is applied.
208 my ( $self, $layer ) = @_;
215 my $handle = $self->fh;
217 binmode( $handle, $layer );
219 $handle->seek(0, IO::File::SEEK_SET);
220 while ( $handle->sysread( my $buffer, 8192 ) ) {
224 $handle->seek(0, IO::File::SEEK_SET);
228 =head2 $upload->decoded_slurp(?$encoding)
230 Works just like C<slurp> except we use C<decoded_fh> instead of C<fh> to
231 open a filehandle to slurp. This means if your upload charset is UTF8
232 we binmode the filehandle to that encoding.
237 my ( $self, $layer ) = @_;
238 my $handle = $self->decoded_fh($layer);
241 $handle->seek(0, IO::File::SEEK_SET);
242 while ( $handle->sysread( my $buffer, 8192 ) ) {
246 $handle->seek(0, IO::File::SEEK_SET);
250 =head2 $upload->basename
252 Returns basename for C<filename>. This filters the name through a regexp
253 C<basename =~ s|[^\w\.-]+|_|g> to make it safe for filesystems that don't
254 like advanced characters. This will of course filter UTF8 characters.
255 If you need the exact basename unfiltered use C<raw_basename>.
257 =head2 $upload->raw_basename
259 Just like C<basename> but without filtering the filename for characters that
260 don't always write to a filesystem.
262 =head2 $upload->tempname
264 Returns the path to the temporary file.
268 Returns the client-supplied Content-Type.
270 =head2 $upload->charset
272 The character set information part of the content type, if any. Useful if you
273 need to figure out any encodings on the file upload.
281 Catalyst Contributors, see Catalyst.pm
285 This library is free software. You can redistribute it and/or modify
286 it under the same terms as Perl itself.
290 __PACKAGE__->meta->make_immutable;