package HTTP::Request::Common;
use strict;
use vars qw(@EXPORT @EXPORT_OK $VERSION $DYNAMIC_FILE_UPLOAD);
$DYNAMIC_FILE_UPLOAD ||= 0; # make it defined (don't know why)
require Exporter;
*import = \&Exporter::import;
@EXPORT =qw(GET HEAD PUT POST);
@EXPORT_OK = qw($DYNAMIC_FILE_UPLOAD DELETE);
require HTTP::Request;
use Carp();
$VERSION = "5.817";
my $CRLF = "\015\012"; # "\r\n" is not portable
sub GET { _simple_req('GET', @_); }
sub HEAD { _simple_req('HEAD', @_); }
sub PUT { _simple_req('PUT' , @_); }
sub DELETE { _simple_req('DELETE', @_); }
sub POST
{
my $url = shift;
my $req = HTTP::Request->new(POST => $url);
my $content;
$content = shift if @_ and ref $_[0];
my($k, $v);
while (($k,$v) = splice(@_, 0, 2)) {
if (lc($k) eq 'content') {
$content = $v;
}
else {
$req->push_header($k, $v);
}
}
my $ct = $req->header('Content-Type');
unless ($ct) {
$ct = 'application/x-www-form-urlencoded';
}
elsif ($ct eq 'form-data') {
$ct = 'multipart/form-data';
}
if (ref $content) {
if ($ct =~ m,^multipart/form-data\s*(;|$),i) {
require HTTP::Headers::Util;
my @v = HTTP::Headers::Util::split_header_words($ct);
Carp::carp("Multiple Content-Type headers") if @v > 1;
@v = @{$v[0]};
my $boundary;
my $boundary_index;
for (my @tmp = @v; @tmp;) {
my($k, $v) = splice(@tmp, 0, 2);
if ($k eq "boundary") {
$boundary = $v;
$boundary_index = @v - @tmp - 1;
last;
}
}
($content, $boundary) = form_data($content, $boundary, $req);
if ($boundary_index) {
$v[$boundary_index] = $boundary;
}
else {
push(@v, boundary => $boundary);
}
$ct = HTTP::Headers::Util::join_header_words(@v);
}
else {
# We use a temporary URI object to format
# the application/x-www-form-urlencoded content.
require URI;
my $url = URI->new('http:');
$url->query_form(ref($content) eq "HASH" ? %$content : @$content);
$content = $url->query;
}
}
$req->header('Content-Type' => $ct); # might be redundant
if (defined($content)) {
$req->header('Content-Length' =>
length($content)) unless ref($content);
$req->content($content);
}
else {
$req->header('Content-Length' => 0);
}
$req;
}
sub _simple_req
=1= |