cvsuser 03/12/03 08:22:11
Modified: App-Context/lib/App/Request CGI.pm
Log:
more work
Revision Changes Path
1.9 +80 -72 p5ee/App-Context/lib/App/Request/CGI.pm
Index: CGI.pm
===================================================================
RCS file: /cvs/public/p5ee/App-Context/lib/App/Request/CGI.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- CGI.pm 19 May 2003 17:41:12 -0000 1.8
+++ CGI.pm 3 Dec 2003 16:22:11 -0000 1.9
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: CGI.pm,v 1.8 2003/05/19 17:41:12 spadkins Exp $
+## $Id: CGI.pm,v 1.9 2003/12/03 16:22:11 spadkins Exp $
#############################################################################
package App::Request::CGI;
@@ -74,20 +74,23 @@
=cut
sub _init {
- my ($self, $initconf) = @_;
- my ($cgi, $var, $value, $lang, $prog, $file);
- $initconf = {} if (!defined $initconf);
-
- # untaint the $prog
+ my ($self, $options) = @_;
+ my ($cgi, $var, $value, $lang, $app, $file);
+ $options = {} if (!defined $options);
+
+ $app = $options->{app};
+ if (!defined $app) {
+ # untaint the $app
$0 =~ /(.*)/;
- $prog = $1;
+ $app = $1;
+ }
#################################################################
# read environment variables
#################################################################
- if (defined $initconf->{debugmode} && $initconf->{debugmode} eq "replay") {
- $file = "$prog.env";
+ if (defined $options->{debugmode} && $options->{debugmode} eq "replay") {
+ $file = "$app.env";
if (open(App::FILE, "< $file")) {
foreach $var (keys %ENV) {
delete $ENV{$var}; # unset all environment variables
@@ -103,8 +106,8 @@
}
}
- if (defined $initconf->{debugmode} && $initconf->{debugmode} eq "record") {
- $file = "$prog.env";
+ if (defined $options->{debugmode} && $options->{debugmode} eq "record") {
+ $file = "$app.env";
if (open(App::FILE, "> $file")) {
foreach $var (keys %ENV) {
print App::FILE "$var=$ENV{$var}\n"; # save environment variables
@@ -116,8 +119,8 @@
# include the environment variables in the configuration
while (($var,$value) = each %ENV) {
$var = lc($var); # make lower case
- if ($value ne "" && (!defined $initconf->{$var} || $initconf->{$var} eq ""))
{
- $initconf->{$var} = $value;
+ if ($value ne "" && (!defined $options->{$var} || $options->{$var} eq "")) {
+ $options->{$var} = $value;
}
}
@@ -125,32 +128,31 @@
# READ HTTP PARAMETERS (CGI VARIABLES)
#################################################################
- if (defined $initconf->{debugmode} && $initconf->{debugmode} eq "replay") {
+ if (defined $options->{debugmode} && $options->{debugmode} eq "replay") {
# when the "debugmode" is in "replay", the saved CGI environment from
# a previous query (when "debugmode" was "record") is used
- $file = "$prog.vars";
- if (open(App::FILE, "< $file")) {
+ $file = "$app.vars";
+ open(App::FILE, "< $file") || die "Unable to open $file: $!";
$cgi = new CGI(*App::FILE); # Get vars from debug file
close(App::FILE);
}
- }
else { # ... the normal path
- if (defined $initconf && defined $initconf->{cgi}) {
+ if (defined $options && defined $options->{cgi}) {
# this allows for migration from old scripts where they already
# read in the CGI object and they pass it in to App-Context as an arg
- $cgi = $initconf->{cgi};
+ $cgi = $options->{cgi};
}
else {
- # this is the normal path for App-Context execution, where the
Context::CGI
+ # this is the normal path for App-Context execution, where the
Request::CGI
# is responsible for reading its environment
$cgi = CGI->new();
- $initconf->{cgi} = $cgi if (defined $initconf);
+ $options->{cgi} = $cgi if (defined $options);
}
}
# when the "debugmode" is "record", save the CGI vars
- if (defined $initconf->{debugmode} && $initconf->{debugmode} eq "record") {
- $file = "$prog.vars";
+ if (defined $options->{debugmode} && $options->{debugmode} eq "record") {
+ $file = "$app.vars";
if (open(App::FILE, "> $file")) {
$cgi->save(*App::FILE); # Save vars to debug file
close(App::FILE);
@@ -161,7 +163,7 @@
# LANGUAGE
#################################################################
- # Hmmm... do I use $ENV{HTTP_ACCEPT_LANGUAGE} or
$initconf->{http_accept_language} ?
+ # Hmmm... do I use $ENV{HTTP_ACCEPT_LANGUAGE} or
$options->{http_accept_language} ?
if (defined $ENV{HTTP_ACCEPT_LANGUAGE}) {
$lang = $ENV{HTTP_ACCEPT_LANGUAGE};
$lang =~ s/ *,.*//;
@@ -186,8 +188,8 @@
=head2 process()
-The process() method executes the events within a
-single CGI request.
+The process() method processes a request. i.e. It executes the events within
+a single CGI request.
It is called primarily from the event loop handler, dispatch_events().
However, it may be called from external software if that code manages
@@ -227,32 +229,37 @@
$session = $context->{session}; # get the Session
my ($app_path_info, $curr_service, $curr_name, $curr_method, $curr_args,
$curr_returntype);
- my $initconf = $self->{context}->initconf();
+ my $options = $self->{context}->options();
+
+ $curr_name = $context->so_get("default", "curr_name");
+ $curr_service = $context->so_get("default", "curr_service");
+ $curr_returntype = $context->so_get("default", "curr_returntype");
+ # print "name=[$curr_name] service=[$curr_service]
returntype=[$curr_returntype]\n";
- my $curr_name_new = 0;
+ if (!$curr_name) {
if ($cgi->request_method() eq "POST") {
- $curr_service = $cgi->param("curr_service") || $initconf->{service} ||
"SessionObject";
- $curr_name = $cgi->param("curr_name") || $initconf->{name} ||
"default";
- $curr_method = $cgi->param("curr_method") || $initconf->{method} ||
"content";
- $curr_args = $cgi->param("curr_args") || $initconf->{args} || "";
- $curr_returntype = $cgi->param("curr_returntype") ||
$initconf->{returntype} || "default";
+ $curr_service = $cgi->param("curr_service") || $options->{service}
|| "SessionObject";
+ $curr_name = $cgi->param("curr_name") || $options->{name} ||
"default";
+ $curr_method = $cgi->param("curr_method") || $options->{method}
|| "content";
+ $curr_args = $cgi->param("curr_args") || $options->{args} ||
"";
+ $curr_returntype = $cgi->param("curr_returntype") ||
$options->{returntype} || "default";
}
else {
# app_path_info = /Procedure/local.f2c(32):xml
- $app_path_info = $context->iget("app_path_info") || $ENV{PATH_INFO};
+ $app_path_info = $options->{app_path_info} || $ENV{PATH_INFO};
if ($app_path_info =~ s!^/([A-Z][^/]*)!!) {
$curr_service = $1;
}
else {
- $curr_service = $initconf->{service} || "SessionObject";
+ $curr_service = $options->{service} || "SessionObject";
}
if ($app_path_info =~ s!:([a-zA-Z0-9_]+)$!!) {
$curr_returntype = $1;
}
else {
- $curr_returntype = $cgi->param("curr_returntype") ||
$initconf->{returntype} || "default";
+ $curr_returntype = $cgi->param("curr_returntype") ||
$options->{returntype} || "default";
}
if ($app_path_info =~ s!\.([a-zA-Z0-9_]+)\(([^\(\)]*)\)$!!) {
@@ -260,15 +267,15 @@
$curr_args = $2;
}
else {
- $curr_method = $cgi->param("curr_method") || $initconf->{method}
|| "content";
- $curr_args = $cgi->param("curr_args") || $initconf->{args} || "";
+ $curr_method = $cgi->param("curr_method") ||
$options->{method} || "content";
+ $curr_args = $cgi->param("curr_args") || $options->{args} ||
"";
}
if ($app_path_info =~ m!^/(.+)!) {
$curr_name = $1;
}
else {
- $curr_name = $cgi->param("curr_name") || $initconf->{name} ||
"default";
+ $curr_name = $cgi->param("curr_name") || $options->{name} ||
$options->{app};
}
}
@@ -277,6 +284,7 @@
# $context->so_set("default", "curr_method", $curr_method);
# $context->so_set("default", "curr_args", $curr_args);
$context->so_set("default", "curr_returntype", $curr_returntype);
+ }
##########################################################
# For each CGI variable, do the appropriate thing
