# # $Id: Multipart.pm,v 0.1 2001/03/31 10:54:02 ram Exp $ # # Copyright (c) 2001, Raphael Manfredi # # You may redistribute only under the terms of the Artistic License, # as specified in the README file that comes with the distribution. # # HISTORY # $Log: Multipart.pm,v $ # Revision 0.1 2001/03/31 10:54:02 ram # Baseline for first Alpha release. # # $EndLog$ # use strict; package CGI::Test::Input::Multipart; # # POST input data to be encoded with "multipart/form-data". # require CGI::Test::Input; use vars qw(@ISA); @ISA = qw(CGI::Test::Input); use Carp::Datum; use Log::Agent; # # ->make # # Creation routine # sub make { DFEATURE my $f_; my $self = bless {}, shift; $self->_init; $self->{boundary} = "-------------cgi-test--------------" . int(rand(1 << 31)) . '-' . int(rand(1 << 31)); return DVAL $self; } # # Attribute access # sub boundary { $_[0]->{boundary} } # # Defined interface # sub mime_type { "multipart/form-data; boundary=" . $_[0]->{boundary} } # # ->_build_data # # Rebuild data buffer from input fields. # sub _build_data { DFEATURE my $f_; my $self = shift; my $CRLF = "\015\012"; my $data = ''; my $fmt = 'Content-Disposition: form-data; name="%s"'; my $boundary = "--" . $self->boundary; # With extra "--" per MIME specs # XXX field name encoding of special chars? # XXX does not escape "" in filenames foreach my $tuple (@{$self->_fields}) { my ($name, $value) = @$tuple; $data .= $boundary . $CRLF; $data .= sprintf($fmt, $name) . $CRLF . $CRLF; $data .= $value . $CRLF; } foreach my $tuple (@{$self->_files}) { my ($name, $value, $content) = @$tuple; $data .= $boundary . $CRLF; $data .= sprintf($fmt, $name); $data .= sprintf('; filename="%s"', $value). $CRLF; $data .= "Content-Type: application/octet-stream" . $CRLF . $CRLF; if (defined $content) { $data .= $content; } else { local *FILE; if (open(FILE, $value)) { # Might not exist, but that's OK binmode FILE; local $_; while () { $data .= $_; } close FILE; } } } $data .= $boundary . $CRLF; return DVAL $data; } 1; =head1 NAME CGI::Test::Input::Multipart - POST input encoded as multipart/form-data =head1 SYNOPSIS # Inherits from CGI::Test::Input require CGI::Test::Input::Multipart; my $input = CGI::Test::Input::Multipart->make(); =head1 DESCRIPTION This class represents the input for HTTP POST requests, encoded as C. Please see L for interface details. =head1 AUTHOR Raphael Manfredi FRaphael_Manfredi@pobox.comE> =head1 SEE ALSO CGI::Test::Input(3). =cut