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=9a5f1c4e6b3969e61f9c4a0c60c33e9d050c87df;hb=2d48c2fc524aa2c1c077ba4be61970ed698af12d;hpb=b5ecfcf07b8ffe7e9984f0279c8781ce51c6ac6a diff --git a/lib/Catalyst/Request/Upload.pm b/lib/Catalyst/Request/Upload.pm index 9a5f1c4..486653c 100644 --- a/lib/Catalyst/Request/Upload.pm +++ b/lib/Catalyst/Request/Upload.pm @@ -1,15 +1,57 @@ package Catalyst::Request::Upload; -use strict; -use base 'Class::Accessor::Fast'; +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 => 'ro', lazy_build => 1); +has raw_basename => (is => 'ro', lazy_build => 1); +has charset => (is=>'ro', predicate=>'has_charset'); + +has fh => ( + is => 'rw', + required => 1, + lazy => 1, + default => sub { + my $self = shift; + + my $fh = IO::File->new($self->tempname, IO::File::O_RDONLY); + unless ( defined $fh ) { + my $filename = $self->tempname; + 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; +} -__PACKAGE__->mk_accessors(qw/filename headers size tempname type/); +sub _build_raw_basename { + my $self = shift; + my $basename = $self->filename; + $basename =~ s|\\|/|g; + $basename = ( File::Spec::Unix->splitpath($basename) )[2]; + return $basename; +} -sub new { shift->SUPER::new( ref( $_[0] ) ? $_[0] : {@_} ) } +no Moose; + +=for stopwords uploadtmp =head1 NAME @@ -17,15 +59,26 @@ 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' ); See also L. @@ -46,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 { @@ -53,25 +114,53 @@ sub copy_to { return File::Copy::copy( $self->tempname, @_ ); } -=head2 $upload->fh +=head2 $upload->is_utf8_encoded -Opens a temporary file (see tempname below) and returns an L handle. +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 fh { +sub is_utf8_encoded { my $self = shift; + if(my $charset = $self->charset) { + return $charset eq 'UTF-8' ? 1 : 0; + } + return 0; +} - my $fh = IO::File->new( $self->tempname, IO::File::O_RDONLY ); +=head2 $upload->fh - unless ( defined $fh ) { +Opens a temporary file (see tempname below) and returns an L handle. - my $filename = $self->tempname; +This is a filehandle that is opened with no additional IO Layers. - Catalyst::Exception->throw( - message => qq/Can't open '$filename': '$!'/ ); - } +=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; } @@ -85,7 +174,7 @@ Returns an L object for the request. =head2 $upload->link_to -Creates a hard link to the temporary file. Returns true for success, +Creates a hard link to the temporary file. Returns true for success, false for failure. $upload->link_to('/path/to/target'); @@ -101,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 { @@ -114,18 +211,58 @@ 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; } +=head2 $upload->decoded_slurp(?$encoding) + +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. 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 Returns the path to the temporary file. @@ -134,17 +271,26 @@ Returns the path to the temporary file. Returns the client-supplied Content-Type. -=head1 AUTHORS +=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 -Sebastian Riedel, C +Provided by Moose -Christian Hansen, C +=head1 AUTHORS + +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 +__PACKAGE__->meta->make_immutable; + 1;