lib/Catalyst/Request/Upload.pm

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