X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FRequest%2FUpload.pm;h=486653c61b582d7c265429a5218da04a0d85f64d;hp=02848b27da93b51be3c0d5ad958227d2432d39ce;hb=2d48c2fc524aa2c1c077ba4be61970ed698af12d;hpb=e5ecd5bc38bac3e2fcfaf643ea2a4c6ab46d7e57 diff --git a/lib/Catalyst/Request/Upload.pm b/lib/Catalyst/Request/Upload.pm index 02848b2..486653c 100644 --- a/lib/Catalyst/Request/Upload.pm +++ b/lib/Catalyst/Request/Upload.pm @@ -1,18 +1,22 @@ package Catalyst::Request::Upload; use Moose; +with 'MooseX::Emulate::Class::Accessor::Fast'; use Catalyst::Exception; use File::Copy (); -use IO::File (); +use IO::File (); use File::Spec::Unix; +use namespace::clean -except => 'meta'; -has filename => (is => 'rw'); -has headers => (is => 'rw'); -has size => (is => 'rw'); -has tempname => (is => 'rw'); -has type => (is => 'rw'); -has basename => (is => 'rw'); +has filename => (is => 'rw'); +has headers => (is => 'rw'); +has size => (is => 'rw'); +has tempname => (is => 'rw'); +has type => (is => 'rw'); +has basename => (is => 'ro', lazy_build => 1); +has raw_basename => (is => 'ro', lazy_build => 1); +has charset => (is=>'ro', predicate=>'has_charset'); has fh => ( is => 'rw', @@ -27,40 +31,55 @@ has fh => ( Catalyst::Exception->throw( message => qq/Can't open '$filename': '$!'/ ); } - return $fh; }, ); +sub _build_basename { + my $basename = shift->raw_basename; + $basename =~ s|[^\w\.-]+|_|g; + return $basename; +} + +sub _build_raw_basename { + my $self = shift; + my $basename = $self->filename; + $basename =~ s|\\|/|g; + $basename = ( File::Spec::Unix->splitpath($basename) )[2]; + return $basename; +} + no Moose; +=for stopwords uploadtmp + =head1 NAME Catalyst::Request::Upload - handles file upload requests =head1 SYNOPSIS + my $upload = $c->req->upload('field'); + $upload->basename; $upload->copy_to; $upload->fh; + $upload->decoded_fh $upload->filename; $upload->headers; $upload->link_to; $upload->size; $upload->slurp; + $upload->decoded_slurp; $upload->tempname; $upload->type; + $upload->charset; To specify where Catalyst should put the temporary files, set the 'uploadtmp' option in the Catalyst config. If unset, Catalyst will use the system temp dir. __PACKAGE__->config( uploadtmp => '/path/to/tmpdir' ); -It is provided a way to have configurable temporary directory. -If there is no config uploadtmp, system temprary directory will used. - - __PACKAGE__->config( uploadtmp => '/path/to/tmpdir' ); - See also L. =head1 DESCRIPTION @@ -80,6 +99,14 @@ false for failure. $upload->copy_to('/path/to/target'); +Please note the filename used for the copy target is the 'tempname' that +is the actual filename on the filesystem, NOT the 'filename' that was +part of the upload headers. This might seem counter intuitive but at this +point this behavior is so established that its not something we can change. + +You can always create your own copy routine that munges the target path +as you wish. + =cut sub copy_to { @@ -87,10 +114,56 @@ sub copy_to { return File::Copy::copy( $self->tempname, @_ ); } +=head2 $upload->is_utf8_encoded + +Returns true of the upload defines a character set at that value is 'UTF-8'. +This does not try to inspect your upload and make any guesses if the Content +Type charset is undefined. + +=cut + +sub is_utf8_encoded { + my $self = shift; + if(my $charset = $self->charset) { + return $charset eq 'UTF-8' ? 1 : 0; + } + return 0; +} + =head2 $upload->fh Opens a temporary file (see tempname below) and returns an L handle. +This is a filehandle that is opened with no additional IO Layers. + +=head2 $upload->decoded_fh(?$encoding) + +Returns a filehandle that has binmode set to UTF-8 if a UTF-8 character set +is found. This also accepts an override encoding value that you can use to +force a particular L layer. If neither are found the filehandle is +set to :raw. + +This is useful if you are pulling the file into code and inspecting bits and +maybe then sending those bits back as the response. (Please note this is not +a suitable filehandle to set in the body; use C if you are doing that). + +Please note that using this method sets the underlying filehandle IO layer +so once you use this method if you go back and use the C method you +still get the IO layer applied. + +=cut + +sub decoded_fh { + my ($self, $layer) = @_; + my $fh = $self->fh; + + $layer = ":encoding(UTF-8)" if !$layer && $self->is_utf8_encoded; + $layer = ':raw' unless $layer; + + binmode($fh, $layer); + return $fh; +} + =head2 $upload->filename Returns the client-supplied filename. @@ -117,10 +190,18 @@ sub link_to { Returns the size of the uploaded file in bytes. -=head2 $upload->slurp +=head2 $upload->slurp(?$encoding) + +Optionally accepts an argument to define an IO Layer (which is applied to +the filehandle via binmode; if no layer is defined the default is set to +":raw". Returns a scalar containing the contents of the temporary file. +Note that this will cause the filehandle pointed to by C<< $upload->fh >> to +be reset to the start of the file using seek and the file handle to be put +into whatever encoding mode is applied. + =cut sub slurp { @@ -130,34 +211,57 @@ sub slurp { $layer = ':raw'; } - my $content = undef; + my $content = ''; my $handle = $self->fh; binmode( $handle, $layer ); - while ( $handle->sysread( my $buffer, 8192 ) ) { - $content .= $buffer; + $handle->seek(0, IO::File::SEEK_SET); + + if ($layer eq ':raw') { + while ( $handle->sysread( my $buffer, 8192 ) ) { + $content .= $buffer; + } + } + else { + $content = do { local $/; $handle->getline }; } + $handle->seek(0, IO::File::SEEK_SET); return $content; } -sub basename { - my $self = shift; - unless ( $self->{basename} ) { - my $basename = $self->filename; - $basename =~ s|\\|/|g; - $basename = ( File::Spec::Unix->splitpath($basename) )[2]; - $basename =~ s|[^\w\.-]+|_|g; - $self->{basename} = $basename; - } +=head2 $upload->decoded_slurp(?$encoding) - return $self->{basename}; +Works just like C except we use C instead of C to +open a filehandle to slurp. This means if your upload charset is UTF8 +we binmode the filehandle to that encoding. + +=cut + +sub decoded_slurp { + my ( $self, $layer ) = @_; + my $handle = $self->decoded_fh($layer); + + $handle->seek(0, IO::File::SEEK_SET); + + my $content = do { local $/; $handle->getline }; + + $handle->seek(0, IO::File::SEEK_SET); + return $content; } =head2 $upload->basename -Returns basename for C. +Returns basename for C. This filters the name through a regexp +C to make it safe for filesystems that don't +like advanced characters. This will of course filter UTF8 characters. +If you need the exact basename unfiltered use C. + +=head2 $upload->raw_basename + +Just like C but without filtering the filename for characters that +don't always write to a filesystem. =head2 $upload->tempname @@ -167,19 +271,22 @@ Returns the path to the temporary file. Returns the client-supplied Content-Type. +=head2 $upload->charset + +The character set information part of the content type, if any. Useful if you +need to figure out any encodings on the file upload. + =head2 meta Provided by Moose =head1 AUTHORS -Sebastian Riedel, C - -Christian Hansen, C +Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT -This program is free software, you can redistribute it and/or modify +This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut