cvs commit: p5ee/App-Context/lib/App/Context Cmd.pm HTTP.pm
[email protected] (Stephen Adkins)
| Newsgroups | perl.cvs.p5ee |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/02/27 06:23:55
Modified: App-Context/lib/App/Context Cmd.pm HTTP.pm
Log:
migrating to new dispatch_events() using get_events()
Revision Changes Path
1.7 +19 -59 p5ee/App-Context/lib/App/Context/Cmd.pm
Index: Cmd.pm
===================================================================
RCS file: /cvs/public/p5ee/App-Context/lib/App/Context/Cmd.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- Cmd.pm 18 Feb 2004 19:28:02 -0000 1.6
+++ Cmd.pm 27 Feb 2004 14:23:55 -0000 1.7
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: Cmd.pm,v 1.6 2004/02/18 19:28:02 spadkins Exp $
+## $Id: Cmd.pm,v 1.7 2004/02/27 14:23:55 spadkins Exp $
#############################################################################
package App::Context::Cmd;
@@ -52,48 +52,47 @@
=head1 Methods:
-The following methods ...
-
=cut
-sub _execute_event {
+sub dispatch_events_begin {
my ($self) = @_;
my $options = $self->options();
+ my $events = $self->{events};
if ($#ARGV == -1 || $options->{"?"} || $options->{help}) {
$self->_print_usage();
exit(0);
}
- my ($curr_service, $curr_name, $curr_method, $curr_args, $curr_returntype);
+ my ($service, $name, $method, $args, $returntype, $contents);
- my $curr_name_new = 0;
+ my $name_new = 0;
- $curr_service = $options->{service} || "SessionObject";
+ $service = $options->{service} || "SessionObject";
if ($#ARGV > -1 && $ARGV[0] =~ /^[A-Z]/) {
- $curr_service = shift @ARGV;
+ $service = shift @ARGV;
}
- $curr_returntype = $options->{returntype} || "default";
+ $returntype = $options->{returntype} || "default";
if ($#ARGV > -1 && $ARGV[$#ARGV] =~ /^:(.+)/) {
- $curr_returntype = $1;
+ $returntype = $1;
pop(@ARGV);
}
+ $self->{returntype} = $returntype;
- $curr_name = $options->{name} || "default";
+ $name = $options->{name} || "default";
if ($#ARGV > -1) {
- $curr_name = shift @ARGV;
+ $name = shift @ARGV;
}
- $curr_method = $options->{method} || "content";
- $curr_method =~ /(.*)/;
- $curr_method = $1;
+ $method = $options->{method} || "content";
+ $method =~ /(.*)/;
+ $method = $1;
- my ($contents);
if ($#ARGV > -1) {
- $curr_method = shift @ARGV;
- $curr_args = [];
+ $method = shift @ARGV;
+ $args = [];
my ($arg);
while ($#ARGV > -1) {
$arg = shift(@ARGV);
@@ -127,48 +126,9 @@
$arg = { split(/ *[,=>]+ */,$contents) };
}
}
- push(@$curr_args, $arg);
- }
- }
- else {
- $curr_args = $options->{args} || "";
- }
-
- # $self->so_set("default", "curr_service", $curr_service);
- # $self->so_set("default", "curr_name", $curr_name);
- # $self->so_set("default", "curr_method", $curr_method);
- # $self->so_set("default", "curr_args", $curr_args);
- $self->so_set("default", "curr_returntype", $curr_returntype);
-
- $self->dbgprint("Request->process(): ${curr_service}\[$curr_name].$curr_method($curr_args)")
- if ($App::DEBUG && $self->dbg(1));
-
- if ($curr_service) {
- my $service = $self->service($curr_service, $curr_name);
- if (!$service) {
- return("Service not defined: $curr_service($curr_name)\n");
- }
- elsif (!$service->can($curr_method)) {
- if ($curr_method eq "contents") {
- return($service);
- }
- else {
- return("Method not defined on Service: $curr_service($curr_name).$curr_method($curr_args)\n");
- }
- }
- else {
- my @args = (ref($curr_args) eq "ARRAY") ? (@$curr_args) : $curr_args;
- my @results = $service->$curr_method(@args);
- if ($#results == -1) {
- return($service->internals());
- }
- elsif ($#results == 0) {
- return($results[0]);
- }
- else {
- return(\@results);
- }
+ push(@$args, $arg);
}
+ push(@$events, [ $service, $name, $method, $args ]);
}
}
1.7 +99 -49 p5ee/App-Context/lib/App/Context/HTTP.pm
Index: HTTP.pm
===================================================================
RCS file: /cvs/public/p5ee/App-Context/lib/App/Context/HTTP.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- HTTP.pm 3 Dec 2003 16:21:11 -0000 1.6
+++ HTTP.pm 27 Feb 2004 14:23:55 -0000 1.7
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: HTTP.pm,v 1.6 2003/12/03 16:21:11 spadkins Exp $
+## $Id: HTTP.pm,v 1.7 2004/02/27 14:23:55 spadkins Exp $
#############################################################################
package App::Context::HTTP;
@@ -103,56 +103,25 @@
=cut
-#############################################################################
-# dispatch_events()
-#############################################################################
-
-=head2 dispatch_events()
-
-The dispatch_events() method is called by the CGI script
-in order to get the Context object rolling. It causes the program to
-process the CGI request, interpret and dispatch encoded events in the
-request and exit.
-
-In concept, the dispatch_events() method would not return until all
-events for a Session were dispatched. However, the reality of the CGI
-context is that events associated with a Session occur in many different
-processes over different CGI requests. Therefore, the CGI Context
-implements the dispatch_events() method to return after processing
-all of the events of a single request, assuming that it will be called
-again when the next CGI request is received.
-
- * Signature: $context->dispatch_events()
- * Param: void
- * Return: void
- * Throws: App::Exception
- * Since: 0.01
-
- Sample Usage:
-
- $context->dispatch_events();
-
-=cut
-
-sub dispatch_events {
+sub dispatch_events_begin {
my ($self) = @_;
+ my $events = $self->{events};
+ my $request = $self->request();
+ my $request_events = $request->get_events();
+ if ($request_events && $#$request_events > -1) {
+ push(@$events, @$request_events);
+ }
+}
- my ($request);
-
- eval {
- $request = $self->request(); # get the request
- $request->process(); # process it
- $self->send_response(); # send a response
- };
- if ($@) {
+sub send_error {
+ my ($self, $errmsg) = @_;
print <<EOF;
Content-type: text/plain
-----------------------------------------------------------------------------
AN ERROR OCCURRED in App::Context::HTTP->dispatch_events()
-----------------------------------------------------------------------------
-(request=$request)
-$@
+$errmsg
-----------------------------------------------------------------------------
Additional messages from earlier stages may be relevant if they exist below.
@@ -161,9 +130,6 @@
EOF
}
- $self->shutdown();
-}
-
#############################################################################
# request()
#############################################################################
@@ -211,7 +177,10 @@
eval {
$self->{request} = App->new($request_class, "new", $self, $self->{options});
};
- $self->add_message("Context::HTTP::request(): $@") if ($@);
+ if ($@) {
+ $self->add_message("Context::HTTP::request(): $@");
+ print STDERR "request=$self->{request} err=[$@]\n";
+ }
return $self->{request};
}
@@ -273,7 +242,88 @@
=cut
-sub send_response {
+# this code needs to be restored at the Context->dispatch_events() level
+#
+# my $session_id = $cgi->param("session_id");
+# $session_id = $context->new_session_id() if (!$session_id);
+# my $session = $context->session($session_id, { cgi => $cgi });
+# $context->set_current_session($session);
+# ...
+# $context->restore_default_session();
+# ...
+# $name = $context->so_get("default", "name");
+# $service = $context->so_get("default", "service");
+# $returntype = $context->so_get("default", "returntype");
+# # print "name=[$curr_name] service=[$curr_service] returntype=[$curr_returntype]\n";
+# ...
+# $context->so_set("default", "curr_service", $curr_service);
+# $context->so_set("default", "curr_name", $curr_name);
+# # $context->so_set("default", "curr_method", $curr_method);
+# # $context->so_set("default", "curr_args", $curr_args);
+# $context->so_set("default", "curr_returntype", $curr_returntype);
+# ...
+# if ($service) {
+# my $service = $context->service($service, $name);
+# my $response = $context->response();
+# if (!$service) {
+# $response->content("Service not defined: $service($name)\n");
+# }
+# elsif (!$service->can($method)) {
+# $response->content("Method not defined on Service: $service($name).$method($args)\n");
+# }
+# else {
+# my @results = $service->$method($args);
+# if ($#results == -1) {
+# $response->content($service->internals());
+# }
+# elsif ($#results == 0) {
+# $response->content($results[0]);
+# $response->content_type($service->content_type());
+# }
+# else {
+# $response->content(\@results);
+# }
+# }
+# }
+
+#sub send_results {
+# my ($self, $results) = @_;
+#
+# my ($serializer, $returntype);
+#
+# if (ref($results)) {
+# $returntype = $self->{returntype};
+# $serializer = $self->serializer($returntype);
+# $results = $serializer->serialize($results);
+# }
+#
+# if ($self->{messages}) {
+# my $msg = $self->{messages};
+# $self->{messages} = "";
+# $msg =~ s/<br>/\n/g;
+# print $msg;
+# }
+# else {
+# print $results;
+# }
+#}
+#
+#sub send_error {
+# my ($self, $errmsg) = @_;
+# print <<EOF;
+#-----------------------------------------------------------------------------
+#AN ERROR OCCURRED in App::Context->dispatch_events()
+#-----------------------------------------------------------------------------
+#$errmsg
+#
+#-----------------------------------------------------------------------------
+#Additional messages from earlier stages may be relevant if they exist below.
+#-----------------------------------------------------------------------------
+#$self->{messages}
+#EOF
+#}
+
+sub send_results {
my $self = shift;
my ($serializer, $response, $ctype, $content, $content_type, $headers);