/usr/share/perl5/CGI/Test/Input/Multipart.pm is in libcgi-test-perl 1.111-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 | package CGI::Test::Input::Multipart;
use strict;
use warnings;
####################################################################
# $Id: Multipart.pm 411 2011-09-26 11:19:30Z nohuhu@nohuhu.org $
# $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.
#
#
# POST input data to be encoded with "multipart/form-data".
#
use Carp;
use base qw(CGI::Test::Input);
#
# ->new
#
# Creation routine
#
sub new
{
my $this = bless {}, shift;
$this->_init;
$this->{boundary} =
"-------------cgi-test--------------"
. int(rand(1 << 31)) . '-'
. int(rand(1 << 31));
return $this;
}
# DEPRECATED METHOD
sub make
{ #
my $class = shift;
return $class->new(@_);
}
#
# Attribute access
#
sub boundary
{
my $this = shift;
return $this->{boundary};
}
#
# Defined interface
#
sub mime_type
{
my $this = shift;
"multipart/form-data; boundary=" . $this->boundary();
}
#
# ->_build_data
#
# Rebuild data buffer from input fields.
#
sub _build_data
{
my $this = shift;
my $CRLF = "\015\012";
my $data = '';
my $fmt = 'Content-Disposition: form-data; name="%s"';
my $boundary = "--" . $this->boundary(); # With extra "--" per MIME specs
# XXX field name encoding of special chars?
# XXX does not escape "" in filenames
foreach my $tuple (@{$this->_fields()})
{
my ($name, $value) = @$tuple;
$data .= $boundary . $CRLF;
$data .= sprintf($fmt, $name) . $CRLF . $CRLF;
$data .= $value . $CRLF;
}
foreach my $tuple (@{$this->_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 (<FILE>)
{
$data .= $_;
}
close FILE;
}
}
}
$data .= $boundary . $CRLF;
return $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->new();
=head1 DESCRIPTION
This class represents the input for HTTP POST requests, encoded
as C<multipart/form-data>.
Please see L<CGI::Test::Input> for interface details.
=head1 AUTHORS
The original author is Raphael Manfredi.
Steven Hilton was long time maintainer of this module.
Current maintainer is Alexander Tokarev F<E<lt>tokarev@cpan.orgE<gt>>.
=head1 SEE ALSO
CGI::Test::Input(3).
=cut
|