cvs commit: p5ee/App-Context/lib/App Context.pm
[email protected] (Stephen Adkins)
| Newsgroups | perl.cvs.p5ee |
|---|---|
| Message-ID | <[email protected]> |
cvsuser 04/02/27 06:24:06
Modified: App-Context/lib/App Context.pm
Log:
migrating to new dispatch_events() using get_events()
Revision Changes Path
1.15 +104 -47 p5ee/App-Context/lib/App/Context.pm
Index: Context.pm
===================================================================
RCS file: /cvs/public/p5ee/App-Context/lib/App/Context.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- Context.pm 2 Feb 2004 22:18:06 -0000 1.14
+++ Context.pm 27 Feb 2004 14:24:06 -0000 1.15
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: Context.pm,v 1.14 2004/02/02 22:18:06 spadkins Exp $
+## $Id: Context.pm,v 1.15 2004/02/27 14:24:06 spadkins Exp $
#############################################################################
package App::Context;
@@ -176,7 +176,7 @@
=cut
sub new {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my $this = shift;
my $class = ref($this) || $this;
my $self = {};
@@ -245,11 +245,14 @@
$self->dbgprint($self->{conf}->dump());
}
+ $self->{events} = []; # the event queue starts empty
+ $self->{returntype} = "default"; # assume default return type
+
$self->_init(\%options); # allows the subclass to do initialization
$self->set_current_session($self->session("default"));
- &App::sub_exit($self) if ($App::trace_subs);
+ &App::sub_exit($self) if ($App::trace);
return $self;
}
@@ -279,20 +282,20 @@
It allows subclasses of the Context to customize the behavior of the
constructor by overriding the _init() method.
- * Signature: $context->_init($args)
- * Param: $args {} [in]
+ * Signature: $context->_init($options)
+ * Param: $options {} [in]
* Return: void
* Throws: App::Exception
* Since: 0.01
Sample Usage:
- $context->_init($args);
+ $context->_init($options);
=cut
sub _init {
- my ($self, $args) = @_;
+ my ($self, $options) = @_;
}
#############################################################################
@@ -396,7 +399,7 @@
=cut
sub service {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $type, $name, %named) = @_;
$self->dbgprint("Context->service(" . join(", ",@_) . ")")
if ($App::DEBUG && $self->dbg(3));
@@ -523,7 +526,6 @@
# service can usually never handle events.
# 1. its attributes are only ever required when they are all supplied
# 2. its attributes will be OK by combining the %$args with the %$conf
- # and %$store.
# This all saves space in the Session store, as the attribute values can
# be relied upon to be supplied by the conf file and the code (and
# minimal reliance on the Session store).
@@ -594,7 +596,7 @@
$self->dbgprint("Context->service() = $service")
if ($App::DEBUG && $self->dbg(3));
- &App::sub_exit($service) if ($App::trace_subs);
+ &App::sub_exit($service) if ($App::trace);
return $service;
}
@@ -725,6 +727,7 @@
$self->dbgprint("Context->session_object_exists($session_object_name) = $exists")
if ($App::DEBUG && $self->dbg(2));
+ &App::sub_exit($exists) if ($App::trace);
return $exists;
}
@@ -861,7 +864,7 @@
#print STDERR "ERROR: Context->get($var): eval ($perl): $@\n" if ($@);
$self->dbgprint("Context->so_get($name,$var) (indexed) = [$value]")
- if ($P5EEx::Blue::DEBUG && $self->dbg(3));
+ if ($App::DEBUG && $self->dbg(3));
}
return $value;
@@ -1081,6 +1084,7 @@
=cut
sub substitute {
+ &App::sub_entry if ($App::trace);
my ($self, $text, $values) = @_;
$self->dbgprint("Context->substitute()")
if ($App::DEBUG && $self->dbg(1));
@@ -1142,6 +1146,7 @@
$value = "" if (!defined $value);
$text =~ s/\{$var\}/$value/g;
}
+ &App::sub_exit($text) if ($App::trace);
$text;
}
@@ -1175,17 +1180,16 @@
=cut
sub add_message {
+ &App::sub_entry if ($App::trace);
my ($self, $msg) = @_;
- $self->dbgprint("Context->add_message()\n====\n$msg====\n")
- if ($App::DEBUG && $self->dbg(1));
-
if (defined $self->{messages}) {
$self->{messages} .= "<br>\n" . $msg;
}
else {
$self->{messages} = $msg;
}
+ &App::sub_exit() if ($App::trace);
}
#############################################################################
@@ -1210,8 +1214,10 @@
=cut
sub log {
+ &App::sub_entry if ($App::trace);
my $self = shift;
- print STDERR "Log: ", @_, "\n";
+ print STDERR @_, "\n";
+ &App::sub_exit() if ($App::trace);
}
#############################################################################
@@ -1287,9 +1293,9 @@
=cut
sub conf {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my $self = shift;
- &App::sub_exit($self->{conf}) if ($App::trace_subs);
+ &App::sub_exit($self->{conf}) if ($App::trace);
$self->{conf};
}
@@ -1318,7 +1324,7 @@
=cut
sub session {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $session_id, $args) = @_;
my ($session_class, $session, $options);
if ($session_id) {
@@ -1348,30 +1354,30 @@
};
$self->add_message($@) if ($@);
}
- &App::sub_exit($session) if ($App::trace_subs);
+ &App::sub_exit($session) if ($App::trace);
return($session);
}
sub new_session_id {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self) = @_;
my $session_id = "user";
- &App::sub_exit($session_id) if ($App::trace_subs);
+ &App::sub_exit($session_id) if ($App::trace);
return($session_id);
}
sub set_current_session {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self, $session) = @_;
$self->{session} = $session;
- &App::sub_exit() if ($App::trace_subs);
+ &App::sub_exit() if ($App::trace);
}
sub restore_default_session {
- &App::sub_entry if ($App::trace_subs);
+ &App::sub_entry if ($App::trace);
my ($self) = @_;
$self->{session} = $self->{sessions}{default};
- &App::sub_exit() if ($App::trace_subs);
+ &App::sub_exit() if ($App::trace);
}
#############################################################################
@@ -1609,37 +1615,73 @@
sub dispatch_events {
my ($self) = @_;
- my ($results);
+ $self->dispatch_events_begin();
+
+ my $events = $self->{events};
+ my ($event, $service, $name, $method, $args);
+ my $results = "";
eval {
- $results = $self->_execute_event();
+ while ($#$events > -1) {
+ $event = shift(@$events);
+ ($service, $name, $method, $args) = @$event;
+ $results = $self->call($service, $name, $method, $args);
+ }
$self->send_results($results);
};
if ($@) {
- print <<EOF;
------------------------------------------------------------------------------
-AN ERROR OCCURRED in App::Context->dispatch_events()
------------------------------------------------------------------------------
-$@
-
------------------------------------------------------------------------------
-Additional messages from earlier stages may be relevant if they exist below.
------------------------------------------------------------------------------
-$self->{messages}
-EOF
+ $self->send_error($@);
}
- if ($self->{options}{debugcontext}) {
+ if ($self->{options}{debug_context}) {
print STDERR $self->dump();
}
- $self->shutdown();
+ $self->dispatch_events_finish();
+}
+
+sub dispatch_events_begin {
+ my ($self) = @_;
}
-sub _execute_event {
- # do nothing.
- # this method (or all of dispatch_events() would normally be overridden
- # in the subclass
+sub dispatch_events_finish {
+ my ($self) = @_;
+ $self->shutdown(); # assume we won't be doing anything else (this can be overridden)
+}
+
+sub call {
+ my ($self, $service_type, $name, $method, $args) = @_;
+ my ($contents, $result);
+
+ $self->dbgprint("Context->call(): ${service_type}\[$name].$method($args)")
+ if ($App::DEBUG && $self->dbg(1));
+
+ my $service = $self->service($service_type, $name);
+ if (!$service) {
+ $result = "Service not defined: $service_type($name)\n";
+ }
+ elsif (!$service->can($method)) {
+ if ($method eq "contents") {
+ $result = $service;
+ }
+ else {
+ $result = "Method not defined on Service: $service($name).$method($args)\n";
+ }
+ }
+ else {
+ my @args = (ref($args) eq "ARRAY") ? (@$args) : $args;
+ my @results = $service->$method(@args);
+ if ($#results == -1) {
+ $result = $service->internals();
+ }
+ elsif ($#results == 0) {
+ $result = $results[0];
+ }
+ else {
+ $result = \@results;
+ }
+ }
+ return($result);
}
#############################################################################
@@ -1663,11 +1705,11 @@
sub send_results {
my ($self, $results) = @_;
- my ($serializer, $curr_returntype);
+ my ($serializer, $returntype);
if (ref($results)) {
- $curr_returntype = $self->so_get("default", "curr_returntype", "default");
- $serializer = $self->serializer($curr_returntype);
+ $returntype = $self->{returntype};
+ $serializer = $self->serializer($returntype);
$results = $serializer->serialize($results);
}
@@ -1680,6 +1722,21 @@
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
}
#############################################################################