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=e5922c27363729c3e4e08a4bd5c9da9fb4023be9;hb=772bd9deac85d462d77bfe2cbbe73f3de1688ebf;hpb=3e22baa5ca02859b9180a0ec17d49fd204f5ba37 diff --git a/lib/Catalyst/Request/Upload.pm b/lib/Catalyst/Request/Upload.pm index e5922c2..39bc4c0 100644 --- a/lib/Catalyst/Request/Upload.pm +++ b/lib/Catalyst/Request/Upload.pm @@ -1,16 +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; -__PACKAGE__->mk_accessors(qw/filename headers size tempname type basename/); + 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 new { shift->SUPER::new( ref( $_[0] ) ? $_[0] : {@_} ) } +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 @@ -18,27 +59,27 @@ 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 @@ -65,25 +106,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; +} + +=head2 $upload->fh - my $fh = IO::File->new( $self->tempname, IO::File::O_RDONLY ); +Opens a temporary file (see tempname below) and returns an L handle. - unless ( defined $fh ) { +This is a filehandle that is opened with no additional IO Layers. - my $filename = $self->tempname; +=head2 $upload->decoded_fh(?$encoding) - Catalyst::Exception->throw( - message => qq/Can't open '$filename': '$!'/ ); - } +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; } @@ -97,7 +166,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'); @@ -113,10 +182,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 { @@ -131,29 +208,48 @@ sub slurp { 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; } -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) + +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; } - return $self->{basename}; + $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 @@ -163,17 +259,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;