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=6df2dffca7e675ef815763e6434d58e6120b761f;hp=5891332b49adc0df5cad009ff49763536155241f;hb=6adc45cf93c50a080f1f32bad475fd2ab5844887;hpb=c539a1c32cc974e531bea851e9f393800ed7a1c0 diff --git a/lib/Catalyst/Request/Upload.pm b/lib/Catalyst/Request/Upload.pm index 5891332..6df2dff 100644 --- a/lib/Catalyst/Request/Upload.pm +++ b/lib/Catalyst/Request/Upload.pm @@ -1,50 +1,101 @@ 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; +=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 - -=item $upload->new - -Constructor. Normally only for engine use. - -=cut +=head2 $upload->new -sub new { shift->SUPER::new( ref( $_[0] ) ? $_[0] : {@_} ) } +Simple constructor. -=item $upload->copy_to +=head2 $upload->copy_to -Copies tempname using C. Returns true for success, false otherwise. +Copies the temporary file using L. Returns true for success, +false for failure. $upload->copy_to('/path/to/target'); @@ -55,29 +106,68 @@ sub copy_to { 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; +} + +=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 bit and +maybe then sending those bits back as the response. (Please not this is not +a suitable filehandle to set in the body; use C if you are doing that). - my $fh = IO::File->new( $self->tempname, IO::File::O_RDONLY ) - or die( "Can't open ", $self->tempname, ": ", $! ); +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 -Contains client supplied filename. +Returns the client-supplied filename. -=item $upload->link_to +=head2 $upload->headers -Creates a hard link to the tempname. Returns true for success, -false otherwise. +Returns an L object for the request. + +=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'); @@ -88,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. + +=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 { + my ( $self, $layer ) = @_; + + unless ($layer) { + $layer = ':raw'; + } + + 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) -Contains size of the file in bytes. +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. -=item $upload->tempname +=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. -Contains path to the temporary spool file. +=head2 $upload->raw_basename -=item $upload->type +Just like C but without filtering the filename for characters that +don't always write to a filesystem. -Contains client supplied Content-Type. +=head2 $upload->tempname -=back +Returns the path to the temporary file. -=head1 AUTHOR +=head2 $upload->type -Sebastian Riedel, C -Christian Hansen, C +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;