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 =head1 NAME
  49
  50 Catalyst::Request::Upload - handles file upload requests
  51
  52 =head1 SYNOPSIS
  53
  54     my $upload = $c->req->upload('field');
  55
  56     $upload->basename;
  57     $upload->copy_to;
  58     $upload->fh;
  59     $upload->filename;
  60     $upload->headers;
  61     $upload->link_to;
  62     $upload->size;
  63     $upload->slurp;
  64     $upload->tempname;
  65     $upload->type;
  66
  67 To specify where Catalyst should put the temporary files, set the 'uploadtmp'
  68 option in the Catalyst config. If unset, Catalyst will use the system temp dir.
  69
  70     __PACKAGE__->config( uploadtmp => '/path/to/tmpdir' );
  71
  72 See also L<Catalyst>.
  73
  74 =head1 DESCRIPTION
  75
  76 This class provides accessors and methods to handle client upload requests.
  77
  78 =head1 METHODS
  79
  80 =head2 $upload->new
  81
  82 Simple constructor.
  83
  84 =head2 $upload->copy_to
  85
  86 Copies the temporary file using L<File::Copy>. Returns true for success,
  87 false for failure.
  88
  89      $upload->copy_to('/path/to/target');
  90
  91 =cut
  92
  93 sub copy_to {
  94     my $self = shift;
  95     return File::Copy::copy( $self->tempname, @_ );
  96 }
  97
  98 =head2 $upload->fh
  99
 100 Opens a temporary file (see tempname below) and returns an L<IO::File> handle.
 101
 102 =head2 $upload->filename
 103
 104 Returns the client-supplied filename.
 105
 106 =head2 $upload->headers
 107
 108 Returns an L<HTTP::Headers> object for the request.
 109
 110 =head2 $upload->link_to
 111
 112 Creates a hard link to the temporary file. Returns true for success,
 113 false for failure.
 114
 115     $upload->link_to('/path/to/target');
 116
 117 =cut
 118
 119 sub link_to {
 120     my ( $self, $target ) = @_;
 121     return CORE::link( $self->tempname, $target );
 122 }
 123
 124 =head2 $upload->size
 125
 126 Returns the size of the uploaded file in bytes.
 127
 128 =head2 $upload->slurp
 129
 130 Returns a scalar containing the contents of the temporary file.
 131
 132 Note that this method will cause the filehandle pointed to by
 133 C<< $upload->fh >> to be seeked to the start of the file,
 134 and the file handle to be put into binary mode.
 135
 136 =cut
 137
 138 sub slurp {
 139     my ( $self, $layer ) = @_;
 140
 141     unless ($layer) {
 142         $layer = ':raw';
 143     }
 144
 145     my $content = undef;
 146     my $handle  = $self->fh;
 147
 148     binmode( $handle, $layer );
 149
 150     $handle->seek(0, IO::File::SEEK_SET);
 151     while ( $handle->sysread( my $buffer, 8192 ) ) {
 152         $content .= $buffer;
 153     }
 154
 155     $handle->seek(0, IO::File::SEEK_SET);
 156     return $content;
 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 Catalyst Contributors, see Catalyst.pm
 178
 179 =head1 COPYRIGHT
 180
 181 This library is free software. You can redistribute it and/or modify
 182 it under the same terms as Perl itself.
 183
 184 =cut
 185
 186 __PACKAGE__->meta->make_immutable;
 187
 188 1;