Fix fallout in the Input modules from the removal of implied properties

This commit is contained in:
ian%hixie.ch 2003-03-27 19:50:40 +00:00
Родитель 44e5e9bcfc
Коммит 6a3dab8272
3 изменённых файлов: 20 добавлений и 29 удалений

Просмотреть файл

@ -304,3 +304,7 @@ sub hash {
# output Set-Cookie headers.) Eventually, output systems will have # output Set-Cookie headers.) Eventually, output systems will have
# out-of-band metadata too, such as Last-Modified dates and this # out-of-band metadata too, such as Last-Modified dates and this
# session data. # session data.
sub username {}
sub password {}
sub address {}

Просмотреть файл

@ -166,32 +166,9 @@ sub createArgument {
sub implyMethod { sub implyMethod {
my $self = shift; my $self = shift;
my($name, @data) = @_; my($name, @data) = @_;
if (@data > 1) {
return $self->SUPER::implyMethod(@_);
}
if (@data) { if (@data) {
return $self->propertySet($name, @data); return $self->SUPER::implyMethod(@_);
} else { } else {
return $self->propertyGet($name); return $self->peekArgument($name);
}
}
sub propertyGet {
my $self = shift;
if ($self->SUPER::propertyExists(@_)) {
return $self->SUPER::propertyGet(@_);
} else {
return $self->peekArgument(@_); # XXX assumes that return propagates wantarray context...
# if not:
# my @result = $self->getArgument(@_);
# if (wantarray) {
# return @result;
# } else {
# if (@result) {
# return $result[0];
# } else {
# return undef;
# }
# }
} }
} }

Просмотреть файл

@ -59,15 +59,15 @@ sub splitArguments {
PATH_INFO PATH_TRANSLATED SCRIPT_NAME QUERY_STRING REMOTE_HOST PATH_INFO PATH_TRANSLATED SCRIPT_NAME QUERY_STRING REMOTE_HOST
REMOTE_ADDR AUTH_TYPE REMOTE_USER REMOTE_IDENT CONTENT_TYPE REMOTE_ADDR AUTH_TYPE REMOTE_USER REMOTE_IDENT CONTENT_TYPE
CONTENT_LENGTH)) { CONTENT_LENGTH)) {
$self->propertySet($property, $ENV{$property}); $self->{$property} = $ENV{$property};
} }
foreach my $property (keys(%ENV)) { foreach my $property (keys(%ENV)) {
if ($property =~ /^HTTP_/o) { if ($property =~ /^HTTP_/o) {
$self->propertySet($property, $ENV{$property}); $self->{$property} = $ENV{$property};
} }
} }
# hook in the metadata variables # hook in the metadata variables
$self->metaData({}); # empty the list of meta data first $self->{metaData} = {}; # empty the list of meta data first
$self->registerPropertyAsMetaData('UA', 'HTTP_USER_AGENT'); $self->registerPropertyAsMetaData('UA', 'HTTP_USER_AGENT');
$self->registerPropertyAsMetaData('referrer', 'HTTP_REFERER'); $self->registerPropertyAsMetaData('referrer', 'HTTP_REFERER');
$self->registerPropertyAsMetaData('host', 'REMOTE_HOST', 'REMOTE_ADDR'); $self->registerPropertyAsMetaData('host', 'REMOTE_HOST', 'REMOTE_ADDR');
@ -77,7 +77,7 @@ sub splitArguments {
$self->registerPropertyAsMetaData('acceptLanguage', 'HTTP_ACCEPT_LANGUAGE'); $self->registerPropertyAsMetaData('acceptLanguage', 'HTTP_ACCEPT_LANGUAGE');
# decode username and password data # decode username and password data
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
my($username, $password) = split(/:/, decode_base64($1), 2); my($username, $password) = split(/:/, decode_base64($1), 2);
$self->{username} = $username; $self->{username} = $username;
@ -165,6 +165,16 @@ sub registerPropertyAsMetaData {
} }
} }
sub username {
my $self = shift;
return $self->{username};
}
sub password {
my $self = shift;
return $self->{password};
}
# cookies # cookies
sub getSessionData { sub getSessionData {
my $self = shift; my $self = shift;