cvsuser 03/12/03 08:16:03
Modified: App-Context/lib/App Context.pm
Log:
worked on sessions and options
Revision Changes Path
1.12 +114 -70 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.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- Context.pm 20 Jun 2003 17:18:44 -0000 1.11
+++ Context.pm 3 Dec 2003 16:16:03 -0000 1.12
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: Context.pm,v 1.11 2003/06/20 17:18:44 spadkins Exp $
+## $Id: Context.pm,v 1.12 2003/12/03 16:16:03 spadkins Exp $
#############################################################################
package App::Context;
@@ -118,9 +118,9 @@
=head2 Master Data Structure Map
$context
- $context->{debugscope}{$class} Debugging all methods in class
- $context->{debugscope}{$class.$method} Debugging a single method
- $context->{initconf} Args that Context was created with
+ $context->{dbgscope}{$class} Debugging all methods in class
+ $context->{dbgscope}{$class.$method} Debugging a single method
+ $context->{options} Args that Context was created with
$context->{used}{$class} Similar to %INC, keeps track of what classes used
$context->{Conf}{$user} Info from conf file
[$context->{conf}]
@@ -152,6 +152,7 @@
as a singleton and the autodetection of what type of Context subclass
should in fact be instantiated.
+ * Signature: $context = App->new($named);
* Signature: $context = App->new(%named);
* Param: context_class class [in]
* Param: conf_class class [in]
@@ -163,8 +164,11 @@
Sample Usage:
$context = App::Context->new();
+ $context = App::Context->new( {
+ conf_class => 'App::Conf::File',
+ conf_file => 'app.xml',
+ } );
$context = App::Context->new(
- context_class => 'App::Context::CGI',
conf_class => 'App::Conf::File',
conf_file => 'app.xml',
);
@@ -178,20 +182,21 @@
my $self = {};
bless $self, $class;
- my ($initconf, %initconf, $i);
+ my ($options, %options, $i);
if ($#_ > -1) {
if (ref($_[0]) eq "HASH") {
- $initconf = shift;
- pop if ($#_ % 2 == 0); # throw away odd arg (probably should throw
exception)
+ $options = shift;
+ die "Odd number of named args in App::Context->new()"
+ if ($#_ % 2 == 0);
for ($i = 0; $i < $#_; $i++) {
- $initconf->{$_[$i]} = $_[$i+1];
+ $options->{$_[$i]} = $_[$i+1];
}
}
else {
- $initconf = ($#_ > -1) ? { @_ } : {};
+ $options = ($#_ > -1) ? { @_ } : {};
}
}
- %initconf = %$initconf;
+ %options = %$options;
#################################################################
# DEBUGGING
@@ -203,66 +208,52 @@
# -debug=3,App::Context,App::Session (multiple classes)
# -debug=6,App::Repository::DBI.select_rows (indiv. methods)
my ($debug, $pkg);
- $debug = $initconf{debug};
+ $debug = $options{debug};
if (defined $debug && $debug ne "") {
if ($debug =~ s/^([0-9]+),?//) {
$App::DEBUG = $1;
}
if ($debug) {
foreach $pkg (split(/,/,$debug)) {
- $self->{debugscope}{$pkg} = 1;
+ $self->{dbgscope}{$pkg} = 1;
}
}
}
my ($conf_class, $session_class);
- $self->{initconf} = \%initconf;
- $initconf{context} = $self;
+ $self->{options} = \%options;
+ $options{context} = $self;
- $conf_class = $initconf{conf_class};
+ $conf_class = $options{conf_class};
$conf_class = "App::Conf::File" if (! $conf_class);
- $session_class = $initconf{session_class} || $self->_default_session();
-
if ($App::DEBUG >= 2) {
my (@str, $key);
- push(@str,"Context->new(): conf=$conf_class session=$session_class\n");
- foreach $key (sort keys %initconf) {
- push(@str, " $key => $initconf{$key}\n");
+ push(@str,"Context->new(): conf=$conf_class\n");
+ foreach $key (sort keys %options) {
+ push(@str, " $key => $options{$key}\n");
}
$self->dbgprint(join("",@str));
}
eval {
- $self->{conf} = App->new($conf_class, "new", \%initconf);
+ $self->{conf} = App->new($conf_class, "new", \%options);
};
$self->add_message($@) if ($@);
- if ($initconf{debugconf} >= 2) {
+ if ($options{debugconf} >= 2) {
$self->dbgprint($self->{conf}->dump());
}
- $self->_init(\%initconf);
-
- eval {
- $self->dbgprint("Context->new(): conf_class=$conf_class
session_class=$session_class (", join(",",%initconf), ")")
- if ($App::DEBUG && $self->dbg(1));
-
- $self->{session} = App->new($session_class, "new", { context => $self });
- };
- $self->add_message($@) if ($@);
+ $self->_init(\%options); # allows the subclass to do initialization
- foreach my $key (keys %initconf) {
- if ($key =~ /^set_(.+)$/) {
- $self->so_default($1, "", $initconf{$key});
- }
- }
+ $self->set_current_session($self->session("default"));
&App::sub_exit($self) if ($App::trace_subs);
return $self;
}
-sub _default_session {
+sub _default_session_class {
return("App::Session");
}
@@ -442,9 +433,9 @@
$conf = $self->{conf};
$service_conf = $conf->{$type}{$name};
if (!$service_conf) {
- my $initconf = $self->{initconf};
- my $prefix = $initconf->{prefix};
- my $conf_type = $initconf->{conf_type} || "pl";
+ my $options = $self->{options};
+ my $prefix = $options->{prefix};
+ my $conf_type = $options->{conf_type} || "pl";
my $conf_file = "$prefix/etc/app/$type.$name.$conf_type";
if (-r $conf_file) {
$service_conf = App::Conf::File->create({ conf_file => $conf_file });
@@ -767,17 +758,17 @@
This is an alternative to
getting the reference of the entire hash of Initialization Conf
-variables with $self->initconf().
+variables with $self->options().
=cut
sub iget {
my ($self, $var, $default) = @_;
my ($value, $var2, $value2);
- $value = $self->{initconf}{$var};
+ $value = $self->{options}{$var};
while ($value =~ /\{([^\{\}]+)\}/) {
$var2 = $1;
- $value2 = $self->{initconf}{$var2};
+ $value2 = $self->{options}{$var2};
$value =~ s/\{$var2\}/$value2/g;
}
$self->dbgprint("Context->iget($var) = [$value]")
@@ -1250,29 +1241,29 @@
}
#############################################################################
-# initconf()
+# options()
#############################################################################
-=head2 initconf()
+=head2 options()
- * Signature: $initconf = $context->initconf();
+ * Signature: $options = $context->options();
* Param: void
- * Return: $initconf {}
+ * Return: $options {}
* Throws: <none>
* Since: 0.01
Sample Usage:
- $initconf = $context->initconf();
+ $options = $context->options();
-The initconf() method returns a hashreference to all of the variable/value
+The options() method returns a hashreference to all of the variable/value
pairs used in the initialization of the Context.
=cut
-sub initconf {
+sub options {
my $self = shift;
- return($self->{initconf} || {});
+ return($self->{options} || {});
}
#############################################################################
@@ -1317,14 +1308,61 @@
Sample Usage:
$session = $context->session();
+ $session = $context->session("some_session_id");
=cut
sub session {
- my $self = shift;
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $session_id) = @_;
+ my ($session_class, $session, $options);
+ if ($session_id) {
+ $session = $self->{sessions}{$session_id};
+ if (! defined $session) {
+ $session_id = $self->new_session_id();
+ $options = $self->{options};
+ $session_class = $options->{session_class} ||
$self->_default_session_class();
+
+ eval {
+ $self->dbgprint("Context->new(): session_class=$session_class (",
join(",",%$options), ")")
+ if ($App::DEBUG && $self->dbg(1));
+
+ $self->{sessions}{$session_id} = App->new($session_class, "new", {
context => $self, name => $session_id });
+ };
+ $self->add_message($@) if ($@);
+ }
+ else {
+ $session = $self->{sessions}{$session_id};
+ }
+ }
+ else {
+ $session = $self->{session};
+ }
+ &App::sub_exit($session) if ($App::trace_subs);
+ return($session);
+}
+
+sub new_session_id {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self) = @_;
+ &App::sub_exit($self->{session}) if ($App::trace_subs);
$self->{session};
}
+sub set_current_session {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self, $session) = @_;
+ $self->{session} = $session;
+ &App::sub_exit() if ($App::trace_subs);
+}
+
+sub set_default_session {
+ &App::sub_entry if ($App::trace_subs);
+ my ($self) = @_;
+ $self->{session} = $self->{sessions}{default};
+ &App::sub_exit() if ($App::trace_subs);
+}
+
#############################################################################
# PUBLIC METHODS
#############################################################################
@@ -1370,26 +1408,26 @@
=cut
-my %debugscope;
+my %dbgscope;
sub dbg {
my ($self, $level) = @_;
return 0 if (! $App::DEBUG);
$level = 1 if (!defined $level);
return 0 if (defined $level && $App::DEBUG < $level);
- my ($debugscope, $stacklevel);
+ my ($dbgscope, $stacklevel);
my ($package, $file, $line, $subroutine, $hasargs, $wantarray);
- $debugscope = (ref($self) eq "") ? \%debugscope : $self->{debugscope};
+ $dbgscope = (ref($self) eq "") ? \%dbgscope : $self->{dbgscope};
$stacklevel = 1;
($package, $file, $line, $subroutine, $hasargs, $wantarray) =
caller($stacklevel);
while (defined $subroutine && $subroutine eq "(eval)") {
$stacklevel++;
($package, $file, $line, $subroutine, $hasargs, $wantarray) =
caller($stacklevel);
}
- return 1 if (! defined $debugscope);
- return 1 if (! %$debugscope);
- return 1 if (defined $debugscope->{$package});
- return 1 if (defined $debugscope->{$subroutine});
+ return 1 if (! defined $dbgscope);
+ return 1 if (! %$dbgscope);
+ return 1 if (defined $dbgscope->{$package});
+ return 1 if (defined $dbgscope->{$subroutine});
return 0;
}
@@ -1418,7 +1456,7 @@
sub dbgprint {
my $self = shift;
- if (defined $App::conf{debugfile}) {
+ if (defined $App::options{debugfile}) {
print App::DEBUGFILE $$, ": ", @_, "\n";
}
else {
@@ -1538,13 +1576,6 @@
=head2 dispatch_events()
-The dispatch_events() method is called by the bootstrap environmental code
-in order to get the Context object rolling. It causes the program to block
-(wait on I/O), loop, or poll, in order to find events from the environment
-and dispatch them to the appropriate places within the App-Context framework.
-
-It is considered "protected" because no classes should be calling it.
-
* Signature: $context->dispatch_events()
* Param: void
* Return: void
@@ -1555,6 +1586,13 @@
$context->dispatch_events();
+The dispatch_events() method is called by the bootstrap environmental code
+in order to get the Context object rolling. It causes the program to block
+(wait on I/O), loop, or poll, in order to find events from the environment
+and dispatch them to the appropriate places within the App-Context framework.
+
+It is considered "protected" because no classes should be calling it.
+
=cut
sub dispatch_events {
@@ -1563,7 +1601,7 @@
my ($results);
eval {
- $results = $self->execute_event();
+ $results = $self->_execute_event();
$self->send_results($results);
};
if ($@) {
@@ -1580,11 +1618,17 @@
EOF
}
- if ($self->{initconf}{debugcontext}) {
+ if ($self->{options}{debugcontext}) {
print STDERR $self->dump();
}
$self->shutdown();
+}
+
+sub _execute_event {
+ # do nothing.
+ # this method (or all of dispatch_events() would normally be overridden
+ # in the subclass
}
#############################################################################
