lib/Catalyst/Request/Upload.pm

   1 package Catalyst::Request::Upload;
   2
   3 use Class::C3;
   4 use Moose;
   5
   6 use Catalyst::Exception;
   7 use File::Copy ();
   8 use IO::File   ();
   9 use File::Spec::Unix;
  10
  11 has filename => (is => 'rw');
  12 has headers => (is => 'rw');
  13 has size => (is => 'rw');
  14 has tempname => (is => 'rw');
  15 has type => (is => 'rw');
  16 has basename => (is => 'rw');
  17
  18 has fh => (
  19   is => 'rw',
  20   required => 1,
  21   lazy => 1,
  22   default => sub {
  23     my $self = shift;
  24
  25     my $fh = IO::File->new($self->tempname, IO::File::O_RDONLY);
  26     unless ( defined $fh ) {
  27       my $filename = $self->tempname;
  28       Catalyst::Exception->throw(
  29           message => qq/Can't open '$filename': '$!'/ );
  30     }
  31
  32     return $fh;
  33   },
  34 );
  35
  36 no Moose;
  37
  38 =head1 NAME
  39
  40 Catalyst::Request::Upload - handles file upload requests
  41
  42 =head1 SYNOPSIS
  43
  44     $upload->basename;
  45     $upload->copy_to;
  46     $upload->fh;
  47     $upload->filename;
  48     $upload->headers;
  49     $upload->link_to;
  50     $upload->size;
  51     $upload->slurp;
  52     $upload->tempname;
  53     $upload->type;
  54
  55 To specify where Catalyst should put the temporary files, set the 'uploadtmp'
  56 option in the Catalyst config. If unset, Catalyst will use the system temp dir.
  57
  58     __PACKAGE__->config( uploadtmp => '/path/to/tmpdir' );
  59
  60 It is provided a way to have configurable temporary directory.
  61 If there is no config uploadtmp, system temprary directory will used.
  62
  63     __PACKAGE__->config( uploadtmp => '/path/to/tmpdir' );
  64
  65 See also L<Catalyst>.
  66
  67 =head1 DESCRIPTION
  68
  69 This class provides accessors and methods to handle client upload requests.
  70
  71 =head1 METHODS
  72
  73 =head2 $upload->new
  74
  75 Simple constructor.
  76
  77 =head2 $upload->copy_to
  78
  79 Copies the temporary file using L<File::Copy>. Returns true for success,
  80 false for failure.
  81
  82      $upload->copy_to('/path/to/target');
  83
  84 =cut
  85
  86 sub copy_to {
  87     my $self = shift;
  88     return File::Copy::copy( $self->tempname, @_ );
  89 }
  90
  91 =head2 $upload->fh
  92
  93 Opens a temporary file (see tempname below) and returns an L<IO::File> handle.
  94
  95 =head2 $upload->filename
  96
  97 Returns the client-supplied filename.
  98
  99 =head2 $upload->headers
 100
 101 Returns an L<HTTP::Headers> object for the request.
 102
 103 =head2 $upload->link_to
 104
 105 Creates a hard link to the temporary file. Returns true for success,
 106 false for failure.
 107
 108     $upload->link_to('/path/to/target');
 109
 110 =cut
 111
 112 sub link_to {
 113     my ( $self, $target ) = @_;
 114     return CORE::link( $self->tempname, $target );
 115 }
 116
 117 =head2 $upload->size
 118
 119 Returns the size of the uploaded file in bytes.
 120
 121 =head2 $upload->slurp
 122
 123 Returns a scalar containing the contents of the temporary file.
 124
 125 =cut
 126
 127 sub slurp {
 128     my ( $self, $layer ) = @_;
 129
 130     unless ($layer) {
 131         $layer = ':raw';
 132     }
 133
 134     my $content = undef;
 135     my $handle  = $self->fh;
 136
 137     binmode( $handle, $layer );
 138
 139     while ( $handle->sysread( my $buffer, 8192 ) ) {
 140         $content .= $buffer;
 141     }
 142
 143     return $content;
 144 }
 145
 146 sub basename {
 147     my $self = shift;
 148     unless ( $self->{basename} ) {
 149         my $basename = $self->filename;
 150         $basename =~ s|\\|/|g;
 151         $basename = ( File::Spec::Unix->splitpath($basename) )[2];
 152         $basename =~ s|[^\w\.-]+|_|g;
 153         $self->{basename} = $basename;
 154     }
 155
 156     return $self->{basename};
 157 }
 158
 159 =head2 $upload->basename
 160
 161 Returns basename for C<filename>.
 162
 163 =head2 $upload->tempname
 164
 165 Returns the path to the temporary file.
 166
 167 =head2 $upload->type
 168
 169 Returns the client-supplied Content-Type.
 170
 171 =head2 meta
 172
 173 Provided by Moose
 174
 175 =head1 AUTHORS
 176
 177 Sebastian Riedel, C<sri@cpan.org>
 178
 179 Christian Hansen, C<ch@ngmedia.com>
 180
 181 =head1 COPYRIGHT
 182
 183 This program is free software, you can redistribute it and/or modify
 184 it under the same terms as Perl itself.
 185
 186 =cut
 187
 188 __PACKAGE__->meta->make_immutable;
 189
 190 1;