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