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=39bc4c0eb917d7e72cf886f2cd5db06b78555410;hp=867c0980a94047ec42d024b4b534516defe7834f;hb=772bd9deac85d462d77bfe2cbbe73f3de1688ebf;hpb=3ffaf022fdbd8d058e76df96b6b0f117bd4c0c85 diff --git a/lib/Catalyst/Request/Upload.pm b/lib/Catalyst/Request/Upload.pm index 867c098..39bc4c0 100644 --- a/lib/Catalyst/Request/Upload.pm +++ b/lib/Catalyst/Request/Upload.pm @@ -1,76 +1,173 @@ 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; +} + +sub _build_raw_basename { + my $self = shift; + my $basename = $self->filename; + $basename =~ s|\\|/|g; + $basename = ( File::Spec::Unix->splitpath($basename) )[2]; + return $basename; +} -__PACKAGE__->mk_accessors(qw/filename size tempname type/); +no Moose; -sub new { shift->SUPER::new( ref( $_[0] ) ? $_[0] : {@_} ) } +=for stopwords uploadtmp =head1 NAME -Catalyst::Request::Upload - Catalyst Request Upload Class +Catalyst::Request::Upload - handles file upload requests =head1 SYNOPSIS - $upload->copy_to - $upload->fh + 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. =head1 DESCRIPTION -This is the Catalyst Request Upload class, which provides a set of accessors -to the upload data. +This class provides accessors and methods to handle client upload requests. =head1 METHODS -=over 4 +=head2 $upload->new -=item $upload->copy_to +Simple constructor. -Copies tempname using C. Returns true for success, false otherwise. +=head2 $upload->copy_to + +Copies the temporary file using L. Returns true for success, +false for failure. $upload->copy_to('/path/to/target'); =cut sub copy_to { - my ( $self, $target, $buffer ) = @_; - return File::Copy::copy( $self->tempname, $target, $buffer ); + my $self = shift; + return File::Copy::copy( $self->tempname, @_ ); } -=item $upload->fh +=head2 $upload->is_utf8_encoded -Opens tempname and returns a C 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 ) - or die( "Can't open ", $self->tempname, ": ", $! ); +=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; } -=item $upload->filename +=head2 $upload->filename + +Returns the client-supplied filename. -Contains client supplied filename. +=head2 $upload->headers -=item $upload->link_to +Returns an L object for the request. -Creates a hard link to the tempname. Returns true for success, -false otherwise. +=head2 $upload->link_to + +Creates a hard link to the temporary file. Returns true for success, +false for failure. $upload->link_to('/path/to/target'); @@ -81,30 +178,107 @@ sub link_to { return CORE::link( $self->tempname, $target ); } -=item $upload->size +=head2 $upload->size + +Returns the size of the uploaded file in bytes. -Contains size of the file in bytes. +=head2 $upload->slurp(?$encoding) -=item $upload->tempname +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". -Contains path to the temporary spool file. +Returns a scalar containing the contents of the temporary file. -=item $upload->type +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. -Contains client supplied Content-Type. +=cut -=back +sub slurp { + my ( $self, $layer ) = @_; -=head1 AUTHOR + unless ($layer) { + $layer = ':raw'; + } -Sebastian Riedel, C -Christian Hansen, C + my $content = undef; + my $handle = $self->fh; + + binmode( $handle, $layer ); + + $handle->seek(0, IO::File::SEEK_SET); + while ( $handle->sysread( my $buffer, 8192 ) ) { + $content .= $buffer; + } + + $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); + + my $content = undef; + $handle->seek(0, IO::File::SEEK_SET); + while ( $handle->sysread( my $buffer, 8192 ) ) { + $content .= $buffer; + } + + $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. + +=head2 $upload->type + +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 + +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;