cvsuser 02/02/01 12:33:16
Modified: P5EEx/Blue/P5EEx/Blue/Context CGI.pm
Log:
moved the display methods out to Context::HTML
Revision Changes Path
1.3 +239 -130 p5ee/P5EEx/Blue/P5EEx/Blue/Context/CGI.pm
Index: CGI.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Context/CGI.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- CGI.pm 3 Jan 2002 18:32:58 -0000 1.2
+++ CGI.pm 1 Feb 2002 20:33:16 -0000 1.3
@@ -1,13 +1,13 @@
#############################################################################
-## $Id: CGI.pm,v 1.2 2002/01/03 18:32:58 spadkins Exp $
+## $Id: CGI.pm,v 1.3 2002/02/01 20:33:16 spadkins Exp $
#############################################################################
package P5EEx::Blue::Context::CGI;
use P5EEx::Blue::P5EE;
-use P5EEx::Blue::Context;
-@ISA = ( "P5EEx::Blue::Context" );
+use P5EEx::Blue::Context::HTML;
+@ISA = ( "P5EEx::Blue::Context::HTML" );
use strict;
@@ -87,26 +87,246 @@
sub init {
my ($self, $args) = @_;
- my ($lang);
+ my ($cgi, $var, $value, $lang, $prog, $file);
- if (defined $ENV{"HTTP_ACCEPT_LANGUAGE"}) {
- $lang = $ENV{"HTTP_ACCEPT_LANGUAGE"};
- $lang =~ s/ *,.*//;
- $lang =~ s/-/_/g;
- # do something with the $lang ...
+ # untaint the $prog
+ $0 =~ /(.*)/;
+ $prog = $1;
+
+ #################################################################
+ # read environment variables
+ #################################################################
+
+ if (defined $main::conf{debugmode} && $main::conf{debugmode} eq "replay") {
+ $file = "$prog.env";
+ if (open(main::FILE, "< $file")) {
+ foreach $var (keys %ENV) {
+ delete $ENV{$var}; # unset all environment variables
+ }
+ while (<main::FILE>) {
+ chop;
+ /^([^=]+)=(.*)/; # parse variable, value (and untaint)
+ $var = $1; # get variable name
+ $value = $2; # get variable value
+ $ENV{$var} = $value; # restore environment variable
+ }
+ close(main::FILE);
+ }
}
- if (defined $args && ref($args) eq "HASH") {
- if (! defined $args->{cgi}) {
- $args->{cgi} = CGI->new();
+ if (defined $main::conf{debugmode} && $main::conf{debugmode} eq "record") {
+ $file = "$prog.env";
+ if (open(main::FILE, "> $file")) {
+ foreach $var (keys %ENV) {
+ print main::FILE "$var=$ENV{$var}\n"; # save environment variables
}
- $self->{cgi} = $args->{cgi}; # save the CGI object reference
+ close(main::FILE);
+ }
+ }
+
+ # include the environment variables in the configuration
+ while (($var,$value) = each %ENV) {
+ $var = lc($var); # make lower case
+ if ($value ne "" && (!defined $main::conf{$var} || $main::conf{$var} eq ""))
{
+ $main::conf{$var} = $value;
+ }
+ }
+
+ #################################################################
+ # READ CGI VARIABLES
+ #################################################################
+
+ if (defined $main::conf{debugmode} && $main::conf{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(main::FILE, "< $file")) {
+ $cgi = new CGI(*main::FILE); # Get vars from debug file
+ close(main::FILE);
+ }
+ }
+ else { # ... the normal path
+ if (defined $args && defined $args->{cgi}) {
+ # this allows for migration from old scripts where they already
+ # read in the CGI object and they pass it in to P5EE as an arg
+ $cgi = $args->{cgi};
}
else {
- $self->{cgi} = CGI->new();
+ # this is the normal path for P5EE execution, where the Context::CGI
+ # is responsible for reading its environment
+ $cgi = CGI->new();
}
}
+ # when the "debugmode" is "record", save the CGI vars
+ if (defined $main::conf{debugmode} && $main::conf{debugmode} eq "record") {
+ $file = "$prog.vars";
+ if (open(main::FILE, "> $file")) {
+ $cgi->save(*main::FILE); # Save vars to debug file
+ close(main::FILE);
+ }
+ }
+
+ #################################################################
+ # DEBUGGING
+ #################################################################
+
+ # Supports the following command-line usage:
+ # -debug=1 (global debug)
+ # -debug=1,P5EEx::Blue::Context (debug class only)
+ # -debug=3,P5EEx::Blue::Context,P5EEx::Blue::Session (multiple classes)
+ # -debug=6,P5EEx::Blue::Repository::DBI.select_rows (individual methods)
+ my ($debug, $pkg);
+ $debug = $main::conf{debug};
+ if (defined $debug && $debug ne "") {
+ if ($debug =~ s/^([0-9]+),?//) {
+ $P5EEx::Blue::Context::DEBUG = $1;
+ $P5EEx::Blue::Context::DEBUG += 0; # use again to avoid a warning
+ }
+ if ($debug) {
+ foreach $pkg (split(/,/,$debug)) {
+ $self->{debugscope}{$pkg} = 1;
+ }
+ }
+ }
+
+ #################################################################
+ # LANGUAGE
+ #################################################################
+
+ # Hmmm... do I use $ENV{HTTP_ACCEPT_LANGUAGE} or
$main::conf{http_accept_language} ?
+ if (defined $ENV{HTTP_ACCEPT_LANGUAGE}) {
+ $lang = $ENV{HTTP_ACCEPT_LANGUAGE};
+ $lang =~ s/ *,.*//;
+ $lang =~ s/-/_/g;
+ # TODO: do something with the $lang ...
+ }
+
+ $self->{cgi} = $cgi;
+}
+
+#############################################################################
+# PUBLIC METHODS
+#############################################################################
+
+=head1 Public Methods:
+
+=cut
+
+#############################################################################
+# log()
+#############################################################################
+
+=head2 log()
+
+This method is inherited from
+L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"log()">.
+
+=cut
+
+#############################################################################
+# user()
+#############################################################################
+
+=head2 user()
+
+The user() method returns the username of the authenticated user.
+The special name, "guest", refers to the unauthenticated (anonymous) user.
+
+ * Signature: $username = $context->user();
+ * Param: void
+ * Return: string
+ * Throws: <none>
+ * Since: 0.01
+
+ Sample Usage:
+
+ $username = $context->user();
+
+=cut
+
+sub user {
+ my $self = shift;
+ my ($user);
+ $user = $self->{cgi}->remote_user();
+ $user = "guest" if (!$user);
+ $user;
+}
+
+#############################################################################
+# config()
+#############################################################################
+
+=head2 config()
+
+This method is inherited from
+L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"config()">.
+
+=cut
+
+#############################################################################
+# PUBLIC METHODS
+#############################################################################
+
+=head1 Public Methods: Debugging
+
+=cut
+
+#############################################################################
+# dbg()
+#############################################################################
+
+=head2 dbg()
+
+This method is inherited from
+L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"dbg()">.
+
+=cut
+
+#############################################################################
+# dbgprint()
+#############################################################################
+
+=head2 dbgprint()
+
+This method is inherited from
+L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"dbgprint()">.
+
+=cut
+
+#############################################################################
+# dbglevel()
+#############################################################################
+
+=head2 dbglevel()
+
+This method is inherited from
+L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"dbglevel()">.
+
+=cut
+
+#############################################################################
+# dbgscope()
+#############################################################################
+
+=head2 dbgscope()
+
+This method is inherited from
+L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"dbgscope()">.
+
+=cut
+
+#############################################################################
+# PROTECTED METHODS
+#############################################################################
+
+=head1 Protected Methods
+
+These methods are considered protected because no class is ever supposed
+to call them. They may however be called by the context-specific drivers.
+
+=cut
+
#############################################################################
# dispatch_events()
#############################################################################
@@ -126,8 +346,6 @@
all of the events of a single request, assuming that it will be called
again when the next CGI request is received.
-It is considered "protected" because no classes should be calling it.
-
* Signature: $context->dispatch_events()
* Param: void
* Return: void
@@ -149,7 +367,7 @@
$session = $self->session(); # get the Session
$wname = $cgi->param("wname"); # the "wname" variable is treated
specially
$wname = "" if (!defined $wname);
- $session->set("Widget.default.wname", $wname) if ($wname ne "");
+ $session->set("state.Widget.default.wname", $wname) if ($wname ne "");
##########################################################
# For each CGI variable, do the appropriate thing
@@ -252,7 +470,7 @@
$event = $2;
#$self->add_message("Event (input): name=[$name] event=[$event]
args=[@args]\n");
$self->dbgprint(ref($self), "->process_request(button):
$name->$event(@args)")
- if ($Widget::DEBUG && $self->dbg(ref($self),
"process_request", 1));
+ if ($P5EEx::Blue::Context::DEBUG && $self->dbg(ref($self),
"process_request", 1));
$self->widget($name)->handle_event($name, $event, @args);
}
}
@@ -276,125 +494,16 @@
#$self->add_message("Event (hidden): name=[$name]
event=[$event] args=[@args]\n");
$self->dbgprint(ref($self), "->process_request(hidden):
$name->$event(@args)")
- if ($Widget::DEBUG && $self->dbg(ref($self),
"process_request", 1));
+ if ($P5EEx::Blue::Context::DEBUG &&
$self->dbg(ref($self), "process_request", 1));
$self->widget($name)->handle_event($name, $event, @args);
}
}
}
}
}
-}
-
-#############################################################################
-# PUBLIC METHODS
-#############################################################################
-
-=head1 Public Methods:
-
-=cut
-
-#############################################################################
-# log()
-#############################################################################
-
-=head2 log()
-
-This method is inherited from
-L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"log()">.
-
-=cut
-
-#############################################################################
-# user()
-#############################################################################
-
-=head2 user()
-
-The user() method returns the username of the authenticated user.
-The special name, "guest", refers to the unauthenticated (anonymous) user.
- * Signature: $username = $context->user();
- * Param: void
- * Return: string
- * Throws: <none>
- * Since: 0.01
-
- Sample Usage:
-
- $username = $context->user();
-
-=cut
-
-sub user {
- my $self = shift;
- my ($user);
- $user = $self->{cgi}->remote_user();
- $user = "guest" if (!$user);
- $user;
+ $self->display_current_widget();
}
-
-#############################################################################
-# config()
-#############################################################################
-
-=head2 config()
-
-This method is inherited from
-L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"config()">.
-
-=cut
-
-#############################################################################
-# PUBLIC METHODS
-#############################################################################
-
-=head1 Public Methods: Debugging
-
-=cut
-
-#############################################################################
-# dbg()
-#############################################################################
-
-=head2 dbg()
-
-This method is inherited from
-L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"dbg()">.
-
-=cut
-
-#############################################################################
-# dbgprint()
-#############################################################################
-
-=head2 dbgprint()
-
-This method is inherited from
-L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"dbgprint()">.
-
-=cut
-
-#############################################################################
-# dbglevel()
-#############################################################################
-
-=head2 dbglevel()
-
-This method is inherited from
-L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"dbglevel()">.
-
-=cut
-
-#############################################################################
-# dbgscope()
-#############################################################################
-
-=head2 dbgscope()
-
-This method is inherited from
-L<C<P5EEx::Blue::Context>|P5EEx::Blue::Context/"dbgscope()">.
-
-=cut
1;
