lib/Catalyst/Request/Upload.pm

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