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
  10 __PACKAGE__->mk_accessors(qw/filename headers size tempname type/);
  11
  12 sub new { shift->SUPER::new( ref( $_[0] ) ? $_[0] : {@_} ) }
  13
  14 =head1 NAME
  15
  16 Catalyst::Request::Upload - handles file upload requests
  17
  18 =head1 SYNOPSIS
  19
  20     $upload->copy_to;
  21     $upload->fh;
  22     $upload->filename;
  23     $upload->headers;
  24     $upload->link_to;
  25     $upload->size;
  26     $upload->slurp;
  27     $upload->tempname;
  28     $upload->type;
  29
  30 See also L<Catalyst>.
  31
  32 =head1 DESCRIPTION
  33
  34 This class provides accessors and methods to handle client upload requests.
  35
  36 =head1 METHODS
  37
  38 =over 4
  39
  40 =item $upload->new
  41
  42 Simple constructor.
  43
  44 =item $upload->copy_to
  45
  46 Copies the temporary file using L<File::Copy>. Returns true for success,
  47 false for failure.
  48
  49      $upload->copy_to('/path/to/target');
  50
  51 =cut
  52
  53 sub copy_to {
  54     my $self = shift;
  55     return File::Copy::copy( $self->tempname, @_ );
  56 }
  57
  58 =item $upload->fh
  59
  60 Opens a temporary file (see tempname below) and returns an L<IO::File> handle.
  61
  62 =cut
  63
  64 sub fh {
  65     my $self = shift;
  66
  67     my $fh = IO::File->new( $self->tempname, IO::File::O_RDONLY );
  68
  69     unless ( defined $fh ) {
  70
  71         my $filename = $self->tempname;
  72
  73         Catalyst::Exception->throw(
  74             message => qq/Can't open '$filename': '$!'/ );
  75     }
  76
  77     return $fh;
  78 }
  79
  80 =item $upload->filename
  81
  82 Returns the client-supplied filename.
  83
  84 =item $upload->headers
  85
  86 Returns an L<HTTP::Headers> object for the request.
  87
  88 =item $upload->link_to
  89
  90 Creates a hard link to the temporary file. Returns true for success,
  91 false for failure.
  92
  93     $upload->link_to('/path/to/target');
  94
  95 =cut
  96
  97 sub link_to {
  98     my ( $self, $target ) = @_;
  99     return CORE::link( $self->tempname, $target );
 100 }
 101
 102 =item $upload->size
 103
 104 Returns the size of the uploaded file in bytes.
 105
 106 =item $upload->slurp
 107
 108 Returns a scalar containing the contents of the temporary file.
 109
 110 =cut
 111
 112 sub slurp {
 113     my ( $self, $layer ) = @_;
 114
 115     unless ($layer) {
 116         $layer = ':raw';
 117     }
 118
 119     my $content = undef;
 120     my $handle  = $self->fh;
 121
 122     binmode( $handle, $layer );
 123
 124     while ( $handle->sysread( my $buffer, 8192 ) ) {
 125         $content .= $buffer;
 126     }
 127
 128     return $content;
 129 }
 130
 131 =item $upload->tempname
 132
 133 Returns the path to the temporary file.
 134
 135 =item $upload->type
 136
 137 Returns the client-supplied Content-Type.
 138
 139 =back
 140
 141 =head1 AUTHORS
 142
 143 Sebastian Riedel, C<sri@cpan.org>
 144
 145 Christian Hansen, C<ch@ngmedia.com>
 146
 147 =head1 COPYRIGHT
 148
 149 This program is free software, you can redistribute it and/or modify
 150 it under the same terms as Perl itself.
 151
 152 =cut
 153
 154 1;