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