lib/Catalyst/Request/Upload.pm

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