lib/Catalyst/Request/Upload.pm

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