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