mirror of
https://github.com/mozilla/gecko-dev.git
synced 2024-10-17 15:25:52 +00:00
Primitive POST support (work in progress)
This commit is contained in:
parent
f4a812c534
commit
24c018b496
@ -37,10 +37,13 @@ use PLIF::Input::Arguments;
|
|||||||
# The CommandLine module can't tell the difference between a keyword
|
# The CommandLine module can't tell the difference between a keyword
|
||||||
# query and real command line.
|
# query and real command line.
|
||||||
|
|
||||||
|
# XXX should split this up into one CGI module per request method
|
||||||
|
|
||||||
sub init {
|
sub init {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my($app) = @_;
|
my($app) = @_;
|
||||||
require MIME::Base64; import MIME::Base64; # DEPENDENCY
|
require MIME::Base64; import MIME::Base64; # DEPENDENCY
|
||||||
|
require MIME::Parser; import MIME::Parser; # DEPENDENCY
|
||||||
$self->SUPER::init(@_);
|
$self->SUPER::init(@_);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -66,31 +69,80 @@ sub splitArguments {
|
|||||||
$self->propertySet($parameter, $ENV{$parameter});
|
$self->propertySet($parameter, $ENV{$parameter});
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (defined($ENV{'QUERY_STRING'})) {
|
my $method = $ENV{'REQUEST_METHOD'} || '';
|
||||||
foreach my $argument (split(/&/o, $ENV{'QUERY_STRING'})) {
|
if ($method eq 'POST') {
|
||||||
if ($argument =~ /^(.*?)(?:=(.*))?$/os) {
|
local $/ = undef;
|
||||||
my $name = $1;
|
$ENV{'QUERY_STRING'} = <STDIN>;
|
||||||
my $value = $2;
|
$method = 'GET';
|
||||||
# decode the strings
|
}
|
||||||
foreach my $string ($name, $value) {
|
if ($method eq 'GET') {
|
||||||
if (defined($string)) {
|
if (defined($ENV{'QUERY_STRING'})) {
|
||||||
$string =~ tr/+/ /; # convert + to spaces
|
foreach my $argument (split(/&/o, $ENV{'QUERY_STRING'})) {
|
||||||
$string =~ s/% # a percent symbol
|
if ($argument =~ /^(.*?)(?:=(.*))?$/os) {
|
||||||
( # followed by
|
my $name = $1;
|
||||||
[0-9A-Fa-f]{2} # 2 hexidecimal characters
|
my $value = $2;
|
||||||
) # which we shall put in $1
|
# decode the strings
|
||||||
/chr(hex($1)) # and convert back into a character
|
foreach my $string ($name, $value) {
|
||||||
/egox; # (evaluate, globally, optimised, with comments)
|
if (defined($string)) {
|
||||||
} else {
|
$string =~ tr/+/ /; # convert + to spaces
|
||||||
$string = '';
|
$string =~ s/% # a percent symbol
|
||||||
|
( # followed by
|
||||||
|
[0-9A-Fa-f]{2} # 2 hexidecimal characters
|
||||||
|
) # which we shall put in $1
|
||||||
|
/chr(hex($1)) # and convert back into a character
|
||||||
|
/egox; # (evaluate, globally, optimised, with comments)
|
||||||
|
} else {
|
||||||
|
$string = '';
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
$self->addArgument($name, $value);
|
||||||
|
} else {
|
||||||
|
$self->warn(2, "argument (|$argument|) did not match regexp (can't happen!)");
|
||||||
}
|
}
|
||||||
$self->addArgument($name, $value);
|
|
||||||
} else {
|
|
||||||
$self->warn(2, "argument (|$argument|) did not match regexp (can't happen!)");
|
|
||||||
}
|
}
|
||||||
|
} else {
|
||||||
|
# XXX no arguments
|
||||||
}
|
}
|
||||||
} # should also deal with HTTP POST, PUT, etc, here XXX
|
} elsif ($method eq 'POST') {
|
||||||
|
=wip
|
||||||
|
# XXX
|
||||||
|
|
||||||
|
check CONTENT_TYPE. is it 'application/x-www-form-urlencoded', 'multipart/form-data'?
|
||||||
|
|
||||||
|
### Create parser, and set some parsing options:
|
||||||
|
my $parser = new MIME::Parser;
|
||||||
|
$parser->output_under("$ENV{HOME}/mimemail");
|
||||||
|
|
||||||
|
### Parse input:
|
||||||
|
my $entity = $parser->parse(\*STDIN);
|
||||||
|
|
||||||
|
foreach my $argument (XXX) {
|
||||||
|
if ($argument =~ /^(.*?)(?:=(.*))?$/os) {
|
||||||
|
my $name = $1;
|
||||||
|
my $value = $2;
|
||||||
|
# decode the strings
|
||||||
|
foreach my $string ($name, $value) {
|
||||||
|
if (defined($string)) {
|
||||||
|
$string =~ tr/+/ /; # convert + to spaces
|
||||||
|
$string =~ s/% # a percent symbol
|
||||||
|
( # followed by
|
||||||
|
[0-9A-Fa-f]{2} # 2 hexidecimal characters
|
||||||
|
) # which we shall put in $1
|
||||||
|
/chr(hex($1)) # and convert back into a character
|
||||||
|
/egox; # (evaluate, globally, optimised, with comments)
|
||||||
|
} else {
|
||||||
|
$string = '';
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$self->addArgument($name, $value);
|
||||||
|
} else {
|
||||||
|
$self->warn(2, "argument (|$argument|) did not match regexp (can't happen!)");
|
||||||
|
}
|
||||||
|
|
||||||
|
=cut
|
||||||
|
} else {
|
||||||
|
# should also deal with HTTP HEAD, PUT, etc, here XXX
|
||||||
|
}
|
||||||
if (defined($ENV{'HTTP_AUTHORIZATION'})) {
|
if (defined($ENV{'HTTP_AUTHORIZATION'})) {
|
||||||
if ($self->HTTP_AUTHORIZATION =~ /^Basic +(.*)$/os) {
|
if ($self->HTTP_AUTHORIZATION =~ /^Basic +(.*)$/os) {
|
||||||
# HTTP Basic Authentication
|
# HTTP Basic Authentication
|
||||||
|
Loading…
Reference in New Issue
Block a user