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