package CGI::Test::Input; use strict; #################################################################### # $Id: Input.pm,v 1.2 2003/09/29 11:00:37 mshiltonj Exp $ # $Name: cgi-test_0-104_t1 $ ##################################################################### # # 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. # # # Abstract representation of the POST input data, which is a list of incoming # parameters that can be encoded differently. # use Carp::Datum; use Log::Agent; ############################################################ # # ->new # # Creation routine # ############################################################ sub new { logconfess "deferred"; } ############################################################ # # ->_init # # Initialization of common attributes # ############################################################ sub _init { DFEATURE my $f_; my $this = shift; $this->{stale} = 0; $this->{fields} = []; # list of [name, value] $this->{files} = []; # list of [name, value, content or undef] $this->{length} = 0; $this->{data} = ''; return DVOID; } # # Attribute access # ############################################################ sub _stale { my $this = shift; $this->{stale}; } ############################################################ sub _fields { my $this = shift; $this->{fields}; } ############################################################ sub _files { my $this = shift; $this->{files}; } ############################################################ sub length { my $this = shift; $this->_refresh() if $this->_stale(); $this->{length}; } ############################################################ sub data { my $this = shift; $this->_refresh() if $this->_stale(); $this->{data}; } ############################################################ # # ->add_widget # # Add new input widget. # # This routine is called to build input data for POST requests issued in # response to a submit button being pressed. # ############################################################ sub add_widget { DFEATURE my $f_; my $this = shift; my ($w) = @_; DREQUIRE ref $w && $w->isa("CGI::Test::Form::Widget"); # # Appart from the fact that file widgets get inserted in a dedicated list, # the processing here is the same. The 3rd value of the entry for files # will be undefined, meaning the file will be read at a later time, when # the input data is built. # my @tuples = $w->submit_tuples; my $array = $w->is_file ? $this->_files : $this->_fields; while (my ($name, $value) = splice @tuples, 0, 2) { $value = '' unless defined $value; push @$array, [ $name, $value ]; } $this->{stale} = 1; return DVOID; } ############################################################ # # ->add_field # # Add a new name/value pair to the input data. # # This routine is meant for manual input data building. # ############################################################ sub add_field { DFEATURE my $f_; my $this = shift; my ($name, $value) = @_; $value = '' unless defined $value; push @{$this->_fields}, [ $name, $value ]; $this->{stale} = 1; return DVOID; } ############################################################ # # ->add_file # # Add a new upload-file information to the input data. # The actual reading of the file is deferred up to the moment where we # need to build the input data. # # This routine is meant for manual input data building. # ############################################################ sub add_file { DFEATURE my $f_; my $this = shift; my ($name, $value) = @_; $value = '' unless defined $value; push @{$this->_files}, [ $name, $value ]; $this->{stale} = 1; return DVOID; } ############################################################ # # ->add_file_now # # Add a new upload-file information to the input data. # The file is read immediately, and can be disposed of once we return. # # This routine is meant for manual input data building. # ############################################################ sub add_file_now { DFEATURE my $f_; my $this = shift; my ($name, $value) = @_; VERIFY -r $value, "readable file '$value'"; local *FILE; open(FILE, $value); binmode FILE; local $_; my $content = ''; while () { $content .= $_; } close FILE; push @{$this->_files}, [ $name, $value, $content ]; $this->{stale} = 1; return DVOID; } # # Interface to be implemented by heirs # ############################################################ sub mime_type { logconfess "deferred"; } ############################################################ sub _build_data { logconfess "deferred"; } # # Internal routines # ############################################################ # # ->_refresh # # Recomputes `data' and `length' attributes when stale # ############################################################ sub _refresh { DFEATURE my $f_; my $this = shift; DREQUIRE $this->_stale; # internal pre-condition my $data = $this->_build_data; # deferred $this->{data} = $data; $this->{length} = CORE::length $data; $this->{stale} = 0; DENSURE !$this->_stale; return DVOID; } 1; =head1 NAME CGI::Test::Input - Abstract representation of POST input =head1 SYNOPSIS # Deferred class, only heirs can be created # $input holds a CGI::Test::Input object $input->add_widget($w); # done internally for you $input->add_field("name", "value"); # manual input construction $input->add_file("name", "path"); # deferred reading $input->add_file_now("name", "/tmp/path"); # read file immediately syswrite INPUT, $input->data, $input->length; # if you really have to # $test is a CGI::Test object $test->POST("http://server:70/cgi-bin/script", $input); =head1 DESCRIPTION The C class is deferred. It is an abstract representation of HTTP POST request input, as expected by the C routine of C. Unless you wish to issue a C request manually to provide carefully crafted input, you do not need to learn the interface of this hierarchy, nor even bother knowing about it. Otherwise, you need to decide which MIME encoding you want, and create an object of the appropriate type. Note that file uploading requires the use of the C encoding: MIME Encoding Type to Create --------------------------------- --------------------------- application/x-www-form-urlencoded CGI::Test::Input::URL multipart/form-data CGI::Test::Input::Multipart Once the object is created, you will be able to add name/value tuples corresponding to the CGI parameters to submit. For instance: my $input = CGI::Test::Input::Multipart->new(); $input->add_field("login", "ram"); $input->add_field("password", "foobar"); $input->add_file("organization", "/etc/news/organization"); Then, to inspect what is normally sent to the HTTP server: print "Content-Type: ", $input->mime_type, "\015\012"; print "Content-Length: ", $input->length, "\015\012"; print "\015\012"; print $input->data; But usually you'll hand out the $input object to the C routine of C. =head1 INTERFACE =head2 Creation Routine It is called C as usual. All subclasses have the same creation routine signature, which takes no parameter. =head2 Adding Parameters CGI parameter are name/value tuples. In case of file uploads, they can have a content as well, the value being the file path on the client machine. =over 4 =item C I, I Adds the CGI parameter I, whose value is I. =item add_file I, I Adds the file upload parameter I, located at I. The file is not read immediately, so it must remain available until the I routine is called, at least. It is not an error if the file cannot be read at that time. When not using the C encoding, only the name/path tuple will be transmitted to the script. =item add_file_now I, I Same as C, but the file is immediately read and can therefore be disposed of afterwards. However, the file B exist. =item add_widget I Add any widget, i.e. a C object. This routine is called internally by C to construct the input data when submiting a form via POST. =back =head2 Generation =over 4 =item C Returns the data, under the proper encoding. =item C Returns the proper MIME encoding type, suitable for inclusion within a Content-Type header. =item C Returns the data length. =head1 BUGS Please let me know about them. =head1 WEBSITE You can find information about CGI::Test and other related modules at: http://cgi-test.sourceforge.net =head1 PUBLIC CVS SERVER CGI::Test now has a publicly accessible CVS server provided by SourceForge (www.sourceforge.net). You can access it by going to: http://sourceforge.net/cvs/?group_id=89570 =head1 AUTHORS The original author is Raphael Manfredi FRaphael_Manfredi@pobox.comE>. Send bug reports, hints, tips, suggestions to Steven Hilton at =head1 SEE ALSO CGI::Test(3), CGI::Test::Input::URL(3), CGI::Test::Input::Multipart(3). =cut