lib/Catalyst/Request/Upload.pm

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