cvsuser 02/06/18 14:05:52
Added: P5EEx/Blue/t Context.t P5EE.t config.ini config.pl
config.properties config.xml
Log:
new file
Revision Changes Path
1.1 p5ee/P5EEx/Blue/t/Context.t
Index: Context.t
===================================================================
#!/usr/local/bin/perl -wT
use Test::More qw(no_plan);
use lib ".";
use lib "..";
BEGIN {
use_ok("P5EEx::Blue::P5EE");
use_ok("P5EEx::Blue::Config::File");
}
my ($conf, $config, $file, $dir);
#$P5EEx::Blue::DEBUG = 1;
$dir = ".";
$dir = "t" if (! -f "config.pl");
$conf = do "$dir/config.pl";
$config = P5EEx::Blue::P5EE->config();
ok(defined $config, "constructor ok");
isa_ok($config, "P5EEx::Blue::Config", "right class");
is_deeply($conf, { %$config }, "config to depth");
exit 0;
__END__
## $Id: Context.t,v 1.1 2002/06/18 21:05:52 spadkins Exp $
#############################################################################
package P5EEx::Blue::Context;
use strict;
use P5EEx::Blue::P5EE;
use P5EEx::Blue::UserAgent;
=head1 NAME
P5EEx::Blue::Context - context in which we are currently running
=head1 SYNOPSIS
# ... official way to get a Context object ...
use P5EEx::Blue::P5EE;
$context = P5EEx::Blue::P5EE->context();
$config = $context->config(); # get the configuration
$config->dispatch_events(); # dispatch events
# any of the following named parameters may be specified
$context = P5EEx::Blue::P5EE->context(
contextClass => "P5EEx::Blue::Context::CGI",
configClass => "P5EEx::Blue::Config::File", # or any Config args
);
# ... alternative way (used internally) ...
use P5EEx::Blue::Context;
$context = P5EEx::Blue::Context->new();
=cut
#############################################################################
# CONSTANTS
#############################################################################
=head1 DESCRIPTION
A Context class models the environment (aka "context")
in which the current process is running.
The role of the Context class is to abstract the details of the
various runtime environments (or Platforms) (including their event loops)
so that the basic programming model for the developer is uniform.
Since the Context objects are the objects that initiate events in the
P5EE universe, they must be sure to wrap those event handlers with
try/catch blocks (i.e. "eval{};if($@){}" blocks).
The main functions of the Context class are to
* load the Config data,
* dispatch events from the Context event loop, and
* manage Session data.
The Context object is always a singleton per process (except in rare cases
like debugging during development).
Conceptually, the Context may be associated with many
Config's (one per authenticated user) and
Sessions (one per unique session_id)
in a single process (ModPerl).
However, in practice, it is often
associated with only one Config or Session throughout the lifetime of
the process (CGI, Cmd).
=cut
#############################################################################
# CLASS GROUP
#############################################################################
=head1 Class Group: Context
The following classes might be a part of the Context Class Group.
=over
=item * Class: P5EEx::Blue::Context
=item * Class: P5EEx::Blue::Context::CGI
=item * Class: P5EEx::Blue::Context::FCGI
=item * Class: P5EEx::Blue::Context::ModPerl
=item * Class: P5EEx::Blue::Context::ModPerlRegistry
=item * Class: P5EEx::Blue::Context::PPerl
=item * Class: P5EEx::Blue::Context::Cmd
=item * Class: P5EEx::Blue::Context::Daemon
=item * Class: P5EEx::Blue::Context::POE
=item * Class: P5EEx::Blue::Context::SOAP (when acting as a SOAP server)
=item * Class: P5EEx::Blue::Context::Gtk
=item * Class: P5EEx::Blue::Context::WxPerl
=back
=cut
#############################################################################
# ATTRIBUTES/CONSTANTS/CLASS VARIABLES/GLOBAL VARIABLES
#############################################################################
=head1 Attributes, Constants, Global Variables, Class Variables
=head2 Master Data Structure Map
$context
$context->{debugscope}{$class} Debugging all methods in class
$context->{debugscope}{$class.$method} Debugging a single method
$context->{initconfig} Args that Context was created with
$context->{used}{$class} Similar to %INC, keeps track of what classes used
$context->{cgi} (Context::CGI only) the CGI object
$context->{Config}{$user} Info from config file
[$context->{config}]
$config->{$type}{$name} Read-only service config
$context->{Session}{$session_id}
[$context->{session}]
$session->{store}{$type}{$name} Runtime state which is stored
$session->{cache}{$type}{$name} Instances of services
=cut
#############################################################################
# CONSTRUCTOR METHODS
#############################################################################
=head1 Constructor Methods:
=cut
#############################################################################
# new()
#############################################################################
=head2 new()
The P5EEx::Blue::Context->new() method is rarely called directly.
That is because a $context should always be instantiated by calling
P5EEx::Blue::P5EE->context(). This allows for caching of the $context
as a singleton and the autodetection of what type of Context subclass
should in fact be instantiated.
* Signature: $context = P5EEx::Blue::P5EE->new(%named);
* Param: contextClass class [in]
* Param: configClass class [in]
* Param: configFile string [in]
* Return: $context P5EEx::Blue::Context
* Throws: Exception::Class::Context
* Since: 0.01
Sample Usage:
$context = P5EEx::Blue::Context->new();
$context = P5EEx::Blue::Context->new(
contextClass => 'P5EEx::Blue::Context::CGI',
configClass => 'P5EEx::Blue::Config::File',
configFile => 'config.xml',
);
=cut
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = {};
bless $self, $class;
my ($args, %args, $i);
if ($#_ > -1) {
if (ref($_[0]) eq "HASH") {
$args = shift;
pop if ($#_ % 2 == 0); # throw away odd arg (probably should throw
exception)
for ($i = 0; $i < $#_; $i++) {
$args->{$_[$i]} = $_[$i+1];
}
}
else {
$args = ($#_ > -1) ? { @_ } : {};
}
}
my ($config_class, $session_class);
%args = %$args;
$self->{initconfig} = \%args;
$args{context} = $self;
$config_class = $args{configClass};
$config_class = $ENV{P5EE_CONFIG_CLASS} if (! $config_class);
$config_class = "P5EEx::Blue::Config::File" if (! $config_class);
$session_class = $args{sessionClass};
$session_class = "P5EEx::Blue::Session::HTMLHidden" if (! $session_class);
eval {
$self->{config} = P5EEx::Blue::P5EE->new($config_class, "new", \%args);
};
$self->add_message($@) if ($@);
$self->init(\%args);
eval {
$self->dbgprint("Context->new(): configClass=$config_class
sessionClass=$session_class")
if ($P5EEx::Blue::DEBUG && $self->dbg(1));
$self->{session} = P5EEx::Blue::P5EE->new($session_class, "new", \%args);
};
$self->add_message($@) if ($@);
eval {
$self->{user_agent} = P5EEx::Blue::UserAgent->new($self);
};
$self->add_message($@) if ($@);
return $self;
}
#############################################################################
# PROTECTED METHODS
#############################################################################
=head1 Protected Methods:
The following methods are intended to be called by subclasses of the
current class (or environmental, "main" code).
=cut
#############################################################################
# init()
#############################################################################
=head2 init()
The init() method is called from within the standard Context constructor.
The init() method in this class does nothing.
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]
* Return: void
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
$context->init($args);
=cut
sub init {
my ($self, $args) = @_;
}
#############################################################################
# PUBLIC METHODS
#############################################################################
=head1 Public Methods: Services
=cut
#############################################################################
# service()
#############################################################################
=head2 service()
The service() method returns a named object of a certain service type.
* Signature: $service = $context->service($type);
* Signature: $service = $context->service($type,$name);
* Signature: $service = $context->service($type,$name,%named);
* Param: $type string [in]
* Param: $name string [in]
* Return: $service P5EEx::Blue::Service
* Throws: P5EE::Blue::Exception
* Since: 0.01
Sample Usage:
$user = $context->service("Widget","db.user.spadkins");
$gobutton = $context->service("Widget","gobutton");
There are many services available within a P5EE application.
Each service is identified by two pieces of information:
it's type and its name.
The following service types are standard in P5EE.
Others can be developed by deriving a class from the
P5EEx::Blue::Service class.
All service types must start with a capital letter.
* Repository
* Security
* Widget
* TemplateEngine
* Messaging
* Procedure
* LogChannel
Within each service type, each individual service is
identified by its name.
The name of a service, if not
specified, is assumed to be "default".
Whenever a service is requested from the Context via this
service() method, the service cache in the Session is checked
first. If it exists, it is generally returned immediately
without modification by the named parameters.
(Parameters *are* taken into account if the "override"
parameter is supplied.)
If it does not exist, it must be created and stored in the
cache.
The name of a service, if not specified, is assumed to be "default".
The named parameters (%named or $named),
if supplied, are considered defaults.
They are ignored if the values already exist in the service config.
However, the additional named parameter, "override", may be supplied.
In that case, all of the values in the named parameters will accepted
into the service config.
Every service (i.e. $config->{Repository}{default}) starts as
a simple hash which is populated with attributes from several
complementary sources. If we imagine that a service is requested
with type $type and name $name, we can envision the following
additional derived variables.
$type = "Repository";
$name = "sysdb";
$lcf_type = "repository"; # lower-case first letter
$config = $context->config();
$repositoryType = $config->{Repository}{sysdb}{repositoryType};
The following sources are consulted to populate the service
attributes.
1. config of the service (in Config)
i.e. $config->{Repository}{sysdb}
2. optional config of the service's service_type (in Config)
i.e. $config->{RepositoryType}{$repositoryType}
3. named parameters to the service() call
All service configuration happens before instantiation
this allows you to override the "serviceClass" in the configuration
in time for instantiation
=cut
sub service {
my ($self, $type, $name, %named) = @_;
$self->dbgprint("Context->service(" . join(", ",@_) . ")")
if ($P5EEx::Blue::DEBUG && $self->dbg(3));
my ($args, $lcf_type, $new_service, $override, $lightweight, $attrib);
my ($service, $config, $class, $session);
my ($service_store, $service_config, $service_type, $service_type_config);
my ($default);
if (!defined $type) {
P5EEx::Blue::Exception->throw(
error => "cannot create a service of unknown type\n",
);
}
if (%named) {
$args = \%named;
}
else {
$args = {};
}
if (! defined $name || $name eq "") { # we need a name!
$name = "default";
}
$lcf_type = lcfirst($type);
$session = $self->{session};
$service = $session->{cache}{$type}{$name}; # check the cache
$new_service = 0;
if (!defined $service || ref($service) eq "HASH") {
$service = {} if (!defined $service); # start with new hash ref
$service->{name} = $name;
$service->{context} = $self;
$config = $self->{config};
$service_config = $config->{$type}{$name};
$service_store = $session->{store}{$type}{$name};
$self->dbgprint("Context->service(): new service. config=$config
sconf=$service_config sstore=$service_store")
if ($P5EEx::Blue::DEBUG && $self->dbg(6));
$new_service = 1;
################################################################
# start with runtime store for the service from the session
################################################################
if ($service_store) {
foreach $attrib (keys %$service_store) {
if (!defined $service->{$attrib}) {
$service->{$attrib} = $service_store->{$attrib};
}
}
}
################################################################
# overlay with attributes from the config file
################################################################
if ($service_config) {
foreach $attrib (keys %$service_config) {
# include config attributes only if not set already
if (!defined $service->{$attrib}) {
$service->{$attrib} = $service_config->{$attrib};
}
}
}
################################################################
# overlay with attributes from the "service_type"
################################################################
$service_type = $service->{"${lcf_type}Type"}; # i.e. "widgetType"
if ($service_type) {
$service_type_config = $config->{"${type}Type"}{$service_type};
if ($service_type_config) {
foreach $attrib (keys %$service_type_config) {
# include service_type configs only if not set already
if (!defined $service->{$attrib}) {
$service->{$attrib} = $service_type_config->{$attrib};
}
}
}
}
}
################################################################
# take care of all %$args attributes next
################################################################
# A "lightweight" service is one which never has to 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 %$config
# and %$store.
# This all saves space in the Session store, as the attribute values can
# be relied upon to be supplied by the config file and the code (and
# minimal reliance on the Session store).
# This is really handy when you have something like a huge spreadsheet
# of text entry cells (usually an indexed variable).
if (defined $args->{lightweight}) { # may be specified explicitly
$lightweight = $args->{lightweight};
}
else {
$lightweight = ($name =~ /[\{\}\[\]]/); # or implicitly for indexed
variables
}
$override = $args->{override};
if ($new_service || $override) {
foreach $attrib (keys %$args) {
# don't include the entry which says whether we are overriding or not
next if ($attrib eq "override");
if ($attrib eq "default") {
if ($name =~ /^(.+)\.([^.]+)$/) {
$self->wget($1, $2, $args->{default}, 1);
}
else {
$self->wget("session", $name, $args->{default}, 1);
}
next;
}
# include attrib if overriding OR attrib not provided in the widget
configs already
if (!defined $service->{$attrib} ||
($override && $service->{$attrib} ne $args->{$attrib})) {
$service->{$attrib} = $args->{$attrib};
$session->{store}{$type}{$name}{$attrib} = $args->{$attrib} if
(!$lightweight);
}
$self->dbgprint("Context->service() [arg=$attrib] name=$name
lw=$lightweight ovr=$override",
" service=", $service->{$attrib},
" service_store=", $service_store->{$attrib},
" args=", $args->{$attrib})
if ($P5EEx::Blue::DEBUG && $self->dbg(6));
}
}
if ($new_service) {
$class = $service->{"${lcf_type}Class"}; # find class of service
if (!defined $class || $class eq "") { # error if no class given
if ($name eq "session") {
$class = "P5EEx::Blue::$type"; # assume the "generic" class
}
else {
P5EEx::Blue::Exception->throw(
error => "no class was configured for the \"$type\" named
\"$name\"\n",
);
}
}
if (! $self->{used}{$class}) { # load the code
P5EEx::Blue::P5EE->use($class);
$self->{used}{$class} = 1;
}
bless $service, $class; # bless the service into the class
$session->{cache}{$type}{$name} = $service; # save in the cache
$service->init(); # perform additional initializations
}
$self->dbgprint("Context->service() = $service")
if ($P5EEx::Blue::DEBUG && $self->dbg(3));
return $service;
}
#############################################################################
# service convenience methods
#############################################################################
=head2 session()
=head2 repository()
=head2 security()
=head2 widget()
=head2 template_engine()
=head2 messaging()
=head2 procedure()
=head2 log_channel()
=head2 shared_datastore()
=head2 shared_resource_set()
These are all convenience methods, which simply turn around
and call the service() method with the service type as the
first argument.
* Signature: $session = $context->session();
* Signature: $session = $context->session($name);
* Signature: $session = $context->session($name,%named);
* Param: $name string [in]
* Return: $service P5EEx::Blue::Service
* Throws: P5EE::Blue::Exception
* Since: 0.01
Sample Usage:
$session = $context->session();
$repository = $context->repository();
$security = $context->security();
$template_engine = $context->template_engine();
$log_channel = $context->log_channel();
$shared_datastore = $context->shared_datastore();
$shared_resource_set = $context->shared_resource_set();
=cut
sub repository { my $self = shift; return $self->service("Repository",@_); }
sub security { my $self = shift; return $self->service("Security",@_); }
sub widget { my $self = shift; return $self->service("Widget",@_); }
sub template_engine { my $self = shift; return
$self->service("TemplateEngine",@_); }
sub messaging { my $self = shift; return $self->service("Messaging",@_); }
sub procedure { my $self = shift; return $self->service("Procedure",@_); }
sub log_channel { my $self = shift; return $self->service("LogChannel",@_); }
sub shared_datastore { my $self = shift; return
$self->service("SharedDatastore",@_); }
sub shared_resource_set { my $self = shift; return
$self->service("SharedResourceSet",@_); }
#############################################################################
# widget_exists()
#############################################################################
=head2 widget_exists()
* Signature: $exists = $context->widget_exists($widget_name);
* Param: $widget_name string
* Return: $exists boolean
* Throws: <none>
* Since: 0.01
Sample Usage:
if ($context->widget_exists($widget_name)) {
# do something
}
The widget_exists() returns whether or not a widget is already known to the
Context. This is true if
* it exists in the Session's widget cache, or
(i.e. it has already been referenced and instantiated in the cache),
* it exists in the Session's store, or
(i.e. it was referenced in an earlier request in this session)
* it exists in the Config
If this method returns FALSE (undef), then any call to the widget() method
must specify the widgetClass (at a minimum) and may not simply call it
with the $widget_name.
This is useful particularly for lightweight widgets which generate events
(such as image buttons). The $context->dispatch_events() method can check
that the widget has not yet been defined and automatically passes the
event to the widget's container (implied by the name) for handling.
=cut
sub widget_exists {
my ($self, $widget_name) = @_;
my ($exists, $widget_type, $widget_class);
$widget_class =
$self->{session}{cache}{Widget}{$widget_name}{widgetClass} ||
$self->{session}{store}{Widget}{$widget_name}{widgetClass} ||
$self->{config}{Widget}{$widget_name}{widgetClass};
if (!$widget_class) {
$widget_type =
$self->{session}{cache}{Widget}{$widget_name}{widgetType} ||
$self->{session}{store}{Widget}{$widget_name}{widgetType} ||
$self->{config}{Widget}{$widget_name}{widgetType};
if ($widget_type) {
$widget_class = $self->{config}{WidgetType}{$widget_type}{widgetClass};
}
}
$exists = $widget_class ? 1 : 0;
$self->dbgprint("Context->widget_exists($widget_name) = $exists")
if ($P5EEx::Blue::DEBUG && $self->dbg(2));
return $exists;
}
#############################################################################
# PUBLIC METHODS
#############################################################################
=head1 Public Methods: Accessors
=cut
#############################################################################
# iget()
#############################################################################
=head2 iget()
* Signature: $value = $context->iget($var, $default);
* Param: $var string
* Param: $attribute string
* Return: $value string
* Throws: <none>
* Since: 0.01
Sample Usage:
$script_url_dir = $context->iget("scriptUrlDir", "/cgi-bin");
The iget() returns the value of an Initialization Config variable
(or the "default" value if not set).
This is an alternative to
getting the reference of the entire hash of Initialization Config
variables with $self->initconfig().
=cut
sub iget {
my ($self, $var, $default) = @_;
my $value = $self->{initconfig}{$var};
return (defined $value) ? $value : $default;
}
#############################################################################
# wget()
#############################################################################
=head2 wget()
The wget() returns the attribute of a widget.
* Signature: $value = $context->wget($widgetname, $attribute);
* Param: $widgetname string
* Param: $attribute string
* Return: $value string,ref
* Throws: <none>
* Since: 0.01
Sample Usage:
$wname = $context->wget("session", "wname");
$width = $context->wget("main.app.toolbar.calc", "width");
=cut
sub wget {
my ($self, $name, $var, $default, $setdefault) = @_;
my ($perl, $value);
if ($var !~ /[\[\]\{\}]/) { # no special chars, "foo.bar"
$value = $self->{session}{cache}{Widget}{$name}{$var};
if (!defined $value && defined $default) {
$value = $default;
if ($setdefault) {
$self->{session}{store}{Widget}{$name}{$var} = $value;
$self->widget($name) if (!defined
$self->{session}{cache}{Widget}{$name});
$self->{session}{cache}{Widget}{$name}{$var} = $value;
}
}
$self->dbgprint("Context->wget($name,$var) (value) = [$value]")
if ($P5EEx::Blue::DEBUG && $self->dbg(3));
return $value;
} # match {
elsif ($var =~ /^\{([^\}]+)\}$/) { # a simple "{foo.bar}"
$var = $1;
$value = $self->{session}{cache}{Widget}{$name}{$var};
if (!defined $value && defined $default) {
$value = $default;
if ($setdefault) {
$self->{session}{store}{Widget}{$name}{$var} = $value;
$self->widget($name) if (!defined
$self->{session}{cache}{Widget}{$name});
$self->{session}{cache}{Widget}{$name}{$var} = $value;
}
}
$self->dbgprint("Context->wget($name,$var) (attrib) = [$value]")
if ($P5EEx::Blue::DEBUG && $self->dbg(3));
return $value;
} # match {
elsif ($var =~ /^([a-zA-Z0-9_\.-]+)([\{\}\[\]].*)$/) {
$name = $1;
$var = $2;
$self->widget($name) if (!defined $self->{session}{cache}{Widget}{$name});
$var =~ s/\{([^\}]+)\}/\{"$1"\}/g;
$perl = "\$value = \$self->{session}{cache}{Widget}{\$name}$var;";
eval $perl;
print STDERR "ERROR: Context->get($var): eval ($perl): $@\n" if ($@);
$self->dbgprint("Context->wget($name,$var) (indexed) = [$value]")
if ($P5EEx::Blue::DEBUG && $self->dbg(3));
}
return $value;
}
#############################################################################
# wset()
#############################################################################
=head2 wset()
The wset() sets an attribute of a widget in the Session.
* Signature: $context->wset($widgetname, $attribute, $value);
* Param: $widgetname string
* Param: $attribute string
* Param: $value string,ref
* Return: void
* Throws: <none>
* Since: 0.01
Sample Usage:
$context->wset("session", "wname", "main_screen");
$context->wset("main.app.toolbar.calc", "width", 50);
$context->wset("xyz", "{arr}[1][2]", 14);
$context->wset("xyz", "{arr.totals}", 14);
=cut
sub wset {
my ($self, $name, $var, $value) = @_;
my ($perl);
if ($value eq "{:delete:}") {
return $self->wdelete($name,$var);
}
$self->dbgprint("Context->wset($name,$var,$value)")
if ($P5EEx::Blue::DEBUG && $self->dbg(3));
if ($var !~ /[\[\]\{\}]/) { # no special chars, "foo.bar"
$self->{session}{store}{Widget}{$name}{$var} = $value;
$self->{session}{cache}{Widget}{$name}{$var} = $value
if (defined $self->{session}{cache}{Widget}{$name});
return;
} # match {
elsif ($var =~ /^\{([^\}]+)\}$/) { # a simple "{foo.bar}"
$var = $1;
$self->{session}{store}{Widget}{$name}{$var} = $value;
$self->{session}{cache}{Widget}{$name}{$var} = $value
if (defined $self->{session}{cache}{Widget}{$name});
return;
}
elsif ($var =~ /^\{/) { # { i.e. "{columnSelected}{first_name}"
$var =~ s/\{([^\}]+)\}/\{"$1"\}/g; # put quotes around hash keys
#$self->widget($name) if (!defined $self->{session}{cache}{Widget}{$name});
$perl = "\$self->{session}{store}{Widget}{\$name}$var = \$value;";
$perl .= "\$self->{session}{cache}{Widget}{\$name}$var = \$value;"
if (defined $self->{session}{cache}{Widget}{$name});
eval $perl;
die "ERROR: Context->wset($name,$var,$value): eval ($perl): $@" if ($@);
}
# } else we do nothing with it!
return $value;
}
#############################################################################
# wdelete()
#############################################################################
=head2 wdelete()
The wdelete() deletes an attribute of a widget in the Session.
* Signature: $context->wdelete($widgetname, $attribute);
* Param: $widgetname string
* Param: $attribute string
* Return: void
* Throws: <none>
* Since: 0.01
Sample Usage:
$context->wdelete("session", "wname");
$context->wdelete("main.app.toolbar.calc", "width");
$context->wdelete("xyz", "{arr}[1][2]");
$context->wdelete("xyz", "{arr.totals}");
=cut
sub wdelete {
my ($self, $name, $var) = @_;
my ($perl);
$self->dbgprint("Context->wdelete($name,$var)")
if ($P5EEx::Blue::DEBUG && $self->dbg(3));
if ($var !~ /[\[\]\{\}]/) { # no special chars, "foo.bar"
delete $self->{session}{store}{Widget}{$name}{$var};
delete $self->{session}{cache}{Widget}{$name}{$var}
if (defined $self->{session}{cache}{Widget}{$name});
return;
} # match {
elsif ($var =~ /^\{([^\}]+)\}$/) { # a simple "{foo.bar}"
$var = $1;
delete $self->{session}{store}{Widget}{$name}{$var};
delete $self->{session}{cache}{Widget}{$name}{$var}
if (defined $self->{session}{cache}{Widget}{$name});
return;
}
elsif ($var =~ /^\{/) { # { i.e. "{columnSelected}{first_name}"
$var =~ s/\{([^\}]+)\}/\{"$1"\}/g; # put quotes around hash keys
#$self->widget($name) if (!defined $self->{session}{cache}{Widget}{$name});
$perl = "delete \$self->{session}{store}{Widget}{\$name}$var;";
$perl .= "delete \$self->{session}{cache}{Widget}{\$name}$var;"
if (defined $self->{session}{cache}{Widget}{$name});
eval $perl;
die "ERROR: Context->wdelete($name,$var): eval ($perl): $@" if ($@);
}
# } else we do nothing with it!
}
#############################################################################
# PUBLIC METHODS
#############################################################################
=head1 Public Methods: Miscellaneous
=cut
#############################################################################
# add_message()
#############################################################################
=head2 add_message()
The add_message() method stores a string (the concatenated list of @args) in
the Context until it can be viewed by and acted upon by the user.
* Signature: $context->add_message($msg);
* Param: $msg string [in]
* Return: void
* Throws: <none>
* Since: 0.01
Sample Usage:
$context->add_message("Data was not saved. Try again.");
=cut
sub add_message {
my ($self, $msg) = @_;
if (defined $self->{messages}) {
$self->{messages} .= "<br>\n" . $msg;
}
else {
$self->{messages} = $msg;
}
}
#############################################################################
# log()
#############################################################################
=head2 log()
The log() method writes a string (the concatenated list of @args) to
the default log channel.
* Signature: $context->log(@args);
* Param: @args string [in]
* Return: void
* Throws: <none>
* Since: 0.01
Sample Usage:
$context->log("oops, a bug happened");
=cut
sub log {
my $self = shift;
print STDERR "Log: ", @_, "\n";
}
#############################################################################
# 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;
"guest";
}
#############################################################################
# initconfig()
#############################################################################
=head2 initconfig()
* Signature: $initconfig = $context->initconfig();
* Param: void
* Return: $initconfig {}
* Throws: <none>
* Since: 0.01
Sample Usage:
$initconfig = $context->initconfig();
The initconfig() method returns a hashreference to all of the variable/value
pairs used in the initialization of the Context.
=cut
sub initconfig {
my $self = shift;
$self->{initconfig};
}
#############################################################################
# config()
#############################################################################
=head2 config()
* Signature: $config = $context->config();
* Param: void
* Return: $config P5EEx::Blue::Config
* Throws: <none>
* Since: 0.01
Sample Usage:
$config = $context->config();
The config() method returns the user's config data structure.
=cut
sub config {
my $self = shift;
$self->{config};
}
#############################################################################
# session()
#############################################################################
=head2 session()
The session() method returns the session
* Signature: $session = $context->session();
* Param: void
* Return: $session P5EEx::Blue::Session
* Throws: <none>
* Since: 0.01
Sample Usage:
$session = $context->session();
=cut
sub session {
my $self = shift;
$self->{session};
}
#############################################################################
# user_agent()
#############################################################################
=head2 user_agent()
The user_agent() method returns a UserAgent objects which is primarily
useful to see what capabilities the user agent (browser) supports.
* Signature: $user_agent = $context->user_agent();
* Param: void
* Return: $user_agent P5EEx::Blue::UserAgent
* Throws: <none>
* Since: 0.01
Sample Usage:
$user_agent = $context->user_agent();
=cut
sub user_agent {
my $self = shift;
$self->{user_agent};
}
#############################################################################
# domain()
#############################################################################
=head2 domain()
The domain() method is called to get the list of valid values in a data
domain and the labels that should be used to represent these values to
a user.
* Signature: ($values, $labels) = $self->domain($domain_name)
* Param: $domain_name string
* Return: $values []
* Return: $labels {}
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
($values, $labels) = $self->domain("gender");
foreach (@$values) {
print "$_ => $labels->{$_}\n";
}
=cut
sub domain {
my ($self, $domain) = @_;
my ($domain_config, $domain_session, $repository, $rep);
my ($values, $labels, $needs_loading, $time_to_live, $time);
my ($class, $method, $args, $rows, $row);
$self->dbgprint("Context->domain($domain)")
if ($P5EEx::Blue::DEBUG && $self->dbg(1));
$domain_config = $self->{config}{Domain}{$domain};
$domain_session = $self->{session}{Domain}{$domain};
$domain_config = {} if (!defined $domain_config);
$domain_session = {} if (!defined $domain_session);
$values = $domain_session->{values};
$values = $domain_config->{values} if (!$values);
$labels = $domain_session->{labels};
$labels = $domain_config->{labels} if (!$labels);
$needs_loading = 0;
$repository = $domain_session->{repository};
$repository = $domain_config->{repository} if (!$repository);
if (defined $repository && $repository ne "") {
if (!defined $values || !defined $labels) {
$needs_loading = 1;
}
else {
$time_to_live = $domain_config->{time_to_live};
if (defined $time_to_live && $time_to_live ne "" && $time_to_live >= 0) {
if ($time_to_live == 0) {
$needs_loading = 1;
}
else {
if (time() >= $domain_session->{time} + $time_to_live) {
$needs_loading = 1;
}
}
}
}
}
$self->dbgprint("Context->domain($domain): needs_loading=$needs_loading")
if ($P5EEx::Blue::DEBUG && $self->dbg(1));
if ($needs_loading) {
$rep = $self->repository($repository);
if (defined $rep) {
#$method = $domain_session->{getmethod};
#$method = "get" if (!defined $method);
#$args = $domain_session->{getmethod_args};
#$args = [ $domain ] if (!defined $args);
#$self->dbgprint("Context->domain($domain): $rep->$method(@$args)")
# if ($P5EEx::Blue::DEBUG && $self->dbg(1));
#$rows = ${rep}->${method}(@$args);
#$values = [];
#$labels = {};
#foreach $row (@$rows) {
# push(@$values, $row->[0]);
# $labels->{$row->[0]} = $row->[1];
#}
#$domain_session->{values} = $values;
#$domain_session->{labels} = $labels;
#$time = time();
#$domain_session->{time} = $time;
}
$values = $domain_session->{values};
$labels = $domain_session->{labels};
}
$values = [] if (! defined $values);
$labels = {} if (! defined $labels);
return ($values, $labels);
}
#############################################################################
# PUBLIC METHODS
#############################################################################
=head1 Public Methods: Debugging
=cut
#############################################################################
# dbg()
#############################################################################
=head2 dbg()
The dbg() method is used to check whether a given line of debug output
should be generated.
It returns true or false (1 or 0).
If all three parameters are specified, this function
returns true only when the global debug level ($P5EEX::Blue::Context::DEBUG)
is at least equal to $level and when the debug scope
is set to debug this class and method.
* Signature: $flag = $context->dbg($class,$method,$level);
* Param: $class class [in]
* Param: $method string [in]
* Param: $level integer [in]
* Return: void
* Throws: P5EEx::Blue::Exception::Context
* Since: 0.01
Sample Usage:
$context->dbgprint("this is debug output")
if ($P5EEx::Blue::DEBUG && $context->dbg(3));
$context->dbgprint("this is debug output")
if ($context->dbg(3));
The first usage is functionally identical to the second, but the check
of the global debug level explicitly reduces the runtime overhead to
eliminate any method calls when debugging is not turned on.
=cut
my %debugscope;
sub dbg {
my ($self, $level) = @_;
return 0 if (! $P5EEx::Blue::DEBUG);
$level = 1 if (!defined $level);
return 0 if (defined $level && $P5EEx::Blue::DEBUG < $level);
my ($debugscope, $stacklevel);
my ($package, $file, $line, $subroutine, $hasargs, $wantarray);
$debugscope = (ref($self) eq "") ? \%debugscope : $self->{debugscope};
$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 0;
}
#############################################################################
# dbgprint()
#############################################################################
=head2 dbgprint()
The dbgprint() method is used to produce debug output.
The output goes to an output stream which is appropriate for
the runtime context in which it is called.
* Signature: $flag = $context->dbgprint(@args);
* Param: @args string [in]
* Return: void
* Throws: P5EEx::Blue::Exception::Context
* Since: 0.01
Sample Usage:
$context->dbgprint("this is debug output")
if ($P5EEx::Blue::DEBUG && $context->dbg(3));
=cut
sub dbgprint {
my $self = shift;
my ($file);
$file = $self->{initconfig}{debugfile};
if (! $file) {
print STDOUT "Debug: ", @_, "\n";
}
else {
local(*FILE);
if (open(main::FILE, ">> $file")) {
print main::FILE $$, ": ", @_, "\n";
close(main::FILE);
}
}
}
#############################################################################
# dbglevel()
#############################################################################
=head2 dbglevel()
The dbglevel() method is used to set the debug level.
Setting the dbglevel to 0 turns off debugging output and is suitable
for production use. Setting the dbglevel to 1 or higher turns on
increasingly verbose debug output.
* Signature: $context->dbglevel($dbglevel);
* Signature: $dbglevel = $context->dbglevel();
* Param: $dbglevel integer
* Return: $dbglevel integer
* Throws: P5EEx::Blue::Exception::Context
* Since: 0.01
Sample Usage:
$context->dbglevel(1); # turn it on
$context->dbglevel(0); # turn it off
$dbglevel = $context->dbglevel(); # get the debug level
=cut
sub dbglevel {
my ($self, $dbglevel) = @_;
$P5EEx::Blue::DEBUG = $dbglevel if (defined $dbglevel);
return $P5EEx::Blue::DEBUG;
}
#############################################################################
# dbgscope()
#############################################################################
=head2 dbgscope()
The dbgscope() method is used to get the hash which determines which
debug statements are to be printed out when the debug level is set to a
positive number. It returns a hash reference. If class names or
"class.method" names are defined in the hash, it will cause the
debug statements from those classes or methods to be printed.
* Signature: $dbgscope = $context->dbgscope();
* Param: void
* Return: $dbgscope {}
* Throws: P5EEx::Blue::Exception::Context
* Since: 0.01
Sample Usage:
$dbgscope = $context->dbgscope();
$dbgscope->{"P5EEx::Blue::Context::CGI"} = 1;
$dbgscope->{"P5EEx::Blue::Context::CGI.process_request"} = 1;
=cut
sub dbgscope {
my $self = shift;
my $dbgscope = $self->{dbgscope};
if (!defined $dbgscope) {
$dbgscope = {};
$self->{dbgscope} = $dbgscope;
}
$dbgscope;
}
#############################################################################
# dump()
#############################################################################
=head2 dump()
* Signature: $perl = $context->dump();
* Param: void
* Return: $perl text
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
print $self->dump(), "\n";
=cut
use Data::Dumper;
sub dump {
my ($self) = @_;
my $d = Data::Dumper->new([ $self ], [ "context" ]);
$d->Indent(1);
return $d->Dump();
}
#############################################################################
# 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()
#############################################################################
=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 P5EE framework.
It is considered "protected" because no classes should be calling it.
* Signature: $context->dispatch_events()
* Param: void
* Return: void
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
$context->dispatch_events();
=cut
sub dispatch_events {
my ($self) = @_;
P5EEx::Blue::Exception->throw (
error => "dispatch_events(): unimplemented\n",
);
}
#############################################################################
# shutdown()
#############################################################################
=head2 shutdown()
The shutdown() method is called when the Context is preparing to exit.
This allows for connections to databases, etc. to be closed gracefully.
* Signature: $self->shutdown()
* Param: void
* Return: void
* Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
$self->shutdown();
=cut
sub shutdown {
my $self = shift;
my ($config, $repdef, $repname, $instance);
my ($class, $method, $args, $argidx, $repcache);
$self->dbgprint("Context->shutdown()")
if ($P5EEx::Blue::DEBUG && $self->dbg(1));
$repcache = $self->{session}{cache}{Repository};
if (defined $repcache && ref($repcache) eq "HASH") {
foreach $repname (keys %$repcache) {
$instance = $repcache->{$repname};
$self->dbgprint("Context->shutdown(): $instance->disconnect()")
if ($P5EEx::Blue::DEBUG && $self->dbg(1));
$instance->disconnect();
delete $repcache->{$repname};
}
}
}
1;
1.1 p5ee/P5EEx/Blue/t/P5EE.t
Index: P5EE.t
===================================================================
#!/usr/local/bin/perl -wT
use Test::More qw(no_plan);
use lib ".";
use lib "..";
BEGIN {
use_ok("P5EEx::Blue::P5EE");
}
use strict;
my ($conf, $config, $file, $dir, $w);
#$P5EEx::Blue::DEBUG = 1;
$dir = ".";
$dir = "t" if (! -f "config.pl");
########################################################
# config()
########################################################
$conf = do "$dir/config.pl";
$config = P5EEx::Blue::P5EE->config("configFile" => "$dir/config.pl");
ok(defined $config, "constructor ok");
isa_ok($config, "P5EEx::Blue::Config", "right class");
is_deeply($conf, { %$config }, "config to depth");
########################################################
# use()
########################################################
eval {
P5EEx::Blue::P5EE->use("P5EEx::Blue::Nonexistent");
};
ok($@, "use(001) class does not exist");
eval {
$w = P5EEx::Blue::Widget->new("w");
};
ok($@, "use(002) known class not used before");
P5EEx::Blue::P5EE->use("P5EEx::Blue::Widget");
ok(1, "use(002) class never used before");
P5EEx::Blue::P5EE->use("P5EEx::Blue::Widget");
ok(1, "use(003) class used before");
$w = P5EEx::Blue::Widget->new("w");
ok(1, "use(004) can use class after");
ok(defined $w, "constructor ok");
isa_ok($w, "P5EEx::Blue::Widget", "right class");
exit 0;
__END__
# eliminate warnings about uninitialized values
$SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /Use of uninitialized value/};
my ($context, $config, $object);
$context = P5EEx::Blue::P5EE->context(); # singleton per process
$config = P5EEx::Blue::P5EE->config(); # returns a hashref to config
$context = P5EEx::Blue::P5EE->new();
$object = P5EEx::Blue::P5EE->new($class);
$object = P5EEx::Blue::P5EE->new($class, $method);
$object = P5EEx::Blue::P5EE->new($class, $method, @args);
=head1 Class: P5EEx::Blue::P5EE
P5EE is the main class through which all of the features
of the Perl 5 Enterprise Environment may be accessed.
* Throws: Exception::Class::Base
* Throws: P5EEx::Blue::Exception
* Throws: P5EEx::Blue::Exception::Config
* Throws: P5EEx::Blue::Exception::Context
* Since: 0.01
=head2 use()
The use() method loads additional perl code and enables aspect-oriented
programming (AOP) features if they are appropriate.
* Signature: P5EEx::Blue->use($class);
* Param: $class string [in]
* Return: void
* Throws: <none>
* Since: 0.01
Sample Usage:
P5EEx::Blue->use("P5EEx::Blue::Widget::Entity");
=cut
my (%used);
my (%class_aop_enabled, %class_aop_instrumented);
my ($aop_entry, $aop_exit, @advice);
sub use {
my ($self, $class) = @_;
return if (defined $used{$class});
eval "use $class;";
if ($@) {
P5EEx::Blue::Exception->throw(
error => "class $class failed to load: $@\n",
);
}
$used{$class} = 1;
@advice = ();
#P5EEx::Blue->instrument_aop();
}
#############################################################################
# printargs()
#############################################################################
=head2 printargs()
* Signature: P5EEx::Blue::P5EE->printargs($depth, $skipatend, @args);
* Param: $depth integer [in]
* Param: $skipatend integer [in]
* Param: @args any [in]
* Return: void
* Throws: none
* Since: 0.01
=cut
sub printargs {
my $depth = shift;
my $skipatend = shift;
my ($narg);
for ($narg = 0; $narg <= $#_ - $skipatend; $narg++) {
print "," if ($narg);
if (ref($_[$narg]) eq "") {
print $_[$narg];
}
elsif (ref($_[$narg]) eq "ARRAY") {
print "[";
if ($depth <= 1) {
print join(",", @{$_[$narg]});
}
else {
&printdepth($depth-1, 0, @{$_[$narg]});
}
print "]";
}
elsif (ref($_[$narg]) eq "HASH") {
print "{";
if ($depth <= 1) {
print join(",", %{$_[$narg]});
}
else {
&printdepth($depth-1, 0, %{$_[$narg]});
}
print "}";
}
else {
print $_[$narg];
}
}
}
#############################################################################
# CONSTRUCTOR METHODS
#############################################################################
=head1 Constructor Methods:
=cut
#############################################################################
# new()
#############################################################################
=head2 new()
The P5EEx::Blue::P5EE->new() method is not a constructor for
a P5EEx::Blue::P5EE class. However, it is a constructor, returning
an object of the class given as the first parameter.
If no parameters are given,
it is simply a synonym for "P5EEx::Blue::P5EE->context()".
* Signature: $context = P5EEx::Blue::P5EE->new()
* Signature: $object = P5EEx::Blue::P5EE->new($class)
* Signature: $object = P5EEx::Blue::P5EE->new($class,$method)
* Signature: $object = P5EEx::Blue::P5EE->new($class,$method,@args)
* Param: $class class [in]
* Param: $method string [in]
* Return: $context P5EEx::Blue::Context
* Return: $object ref
* Throws: Exception::Class::Base
* Since: 0.01
Sample Usage:
$context = P5EEx::Blue::P5EE->new();
$dbh = P5EEx::Blue::P5EE->new("DBI", "new", "dbi:mysql:db", "dbuser",
"dbpasswd2");
$cgi = P5EEx::Blue::P5EE->new("CGI", "new");
=cut
sub new {
my $self = shift;
return $self->context(@_) if ($#_ == -1);
my $class = shift;
if ($class =~ /^([A-Za-z0-9:_]+)$/) {
$class = $1; # untaint the $class
if (! $used{$class}) {
$self->use($class);
}
my $method = ($#_ > -1) ? shift : "new";
return $class->$method(@_);
}
print STDERR "Illegal Class Name: [$class]\n";
return undef;
}
#############################################################################
# context()
#############################################################################
=head2 context()
* Signature: $context = P5EEx::Blue::P5EE->context()
* Param: contextClass class [in]
* Param: configFile string [in]
* Return: $context P5EEx::Blue::Context
* Throws: P5EEx::Blue::Exception::Context
* Since: 0.01
Sample Usage:
$context = P5EEx::Blue::P5EE->context();
$context = P5EEx::Blue::P5EE->context(
contextClass => "P5EEx::Blue::Context::CGI",
configFile => "config.xml",
);
This static (class) method returns the $context object
of the context in which you are running.
It tries to use some intelligence in determining which
context is the right one to instantiate, although you
can override it explicitly.
It implements a "Factory" design pattern. Instead of using the
constructor of a class itself to get an instance of that
class, the context() method of P5EE is used. The former
technique would require us to know at development time
which class was to be instantiated. Using the factory
style constructor, the developer need not ever know what physical class
is implementing the "Context" interface. Rather, it is
configured at deployment-time, and the proper physical class
is instantiated at run-time.
=cut
my (%context); # usually a singleton per process (under "default" name)
# multiple named contexts are allowed for debugging purposes
sub context {
my $self = shift;
my ($name, $args, $i);
if ($#_ == -1) {
$args = {};
$name = "default";
}
else {
if (ref($_[0]) eq "HASH") {
$args = shift;
$name = shift if ($#_ % 2 == 0);
for ($i = 0; $i < $#_; $i++) {
$args->{$_[$i]} = $_[$i+1];
}
}
else {
$name = shift if ($#_ % 2 == 0);
$args = ($#_ > -1) ? { @_ } : {};
}
$name = $args->{name} if (!$name);
$name = "default" if (!$name);
}
return ($context{$name}) if (defined $context{$name});
if (! $args->{contextClass}) {
if (defined $ENV{P5EE_CONTEXT_CLASS}) { # env variable set?
$args->{contextClass} = $ENV{P5EE_CONTEXT_CLASS};
}
else { # try autodetection ...
my $gateway = $ENV{GATEWAY_INTERFACE};
if (defined $gateway && $gateway =~ /CGI-Perl/) { # mod_perl?
$args->{contextClass} = "P5EEx::Blue::Context::Modperl";
}
elsif ($ENV{HTTP_USER_AGENT}) { # running as CGI script?
$args->{contextClass} = "P5EEx::Blue::Context::CGI";
}
# let's be real... these next two are not critical right now
#elsif ($ENV{DISPLAY}) { # running with an X DISPLAY var set?
# $args->{contextClass} = "P5EEx::Blue::Context::Gtk";
#}
#elsif ($ENV{TERM}) { # running with a TERM var for Curses?
# $args->{contextClass} = "P5EEx::Blue::Context::Curses";
#}
else { # fall back to CGI, because it works OK in command mode
$args->{contextClass} = "P5EEx::Blue::Context::CGI";
}
}
}
$context{$name} = $self->new($args->{contextClass}, "new", $args);
return $context{$name};
}
#############################################################################
# config()
#############################################################################
=head2 config()
* Signature: $config = P5EEx::Blue::P5EE->config(%named);
* Param: configClass class [in]
* Param: configFile string [in]
* Return: $config P5EEx::Blue::Config
* Throws: P5EEx::Blue::Exception::Config
* Since: 0.01
=cut
sub config {
my $self = shift;
my ($name, $args, $i);
if ($#_ == -1) {
$args = {};
$name = "default";
}
else {
if (ref($_[0]) eq "HASH") {
$args = shift;
$name = shift if ($#_ % 2 == 0);
for ($i = 0; $i < $#_; $i += 2) {
$args->{$_[$i]} = $_[$i+1];
}
}
else {
$name = shift if ($#_ % 2 == 0);
$args = ($#_ > -1) ? { @_ } : {};
}
$name = $args->{name} if (!$name);
$name = "default" if (!$name);
}
$self->context($args)->config();
}
=head1 ACKNOWLEDGEMENTS
* Author: Stephen Adkins <[EMAIL PROTECTED]>
* License: This is free software. It is licensed under the same terms as Perl
itself.
=head1 SEE ALSO
=cut
1;
1.1 p5ee/P5EEx/Blue/t/config.ini
Index: config.ini
===================================================================
[Standard.Log-Dispatch]
logdir = /var/p5ee
[Authen]
passwd = /etc/passwd
seed = 303292
[Session.default]
sessionClass = P5EE::Blue::Session::CGI
1.1 p5ee/P5EEx/Blue/t/config.pl
Index: config.pl
===================================================================
$conf = {
Session => {
default => {
sessionClass => "P5EE::Blue::Session::CGI",
},
},
Standard => {
'Log-Dispatch' => {
logdir => '/var/p5ee',
}
},
Authen => {
passwd => '/etc/passwd',
seed => 303292,
},
Repository => {
default => {
repositoryClass => "P5EEx::Blue::Repository::DBI",
dbidriver => "mysql",
dbname => "test",
dbuser => "dbuser",
dbpass => "dbuser7",
},
test => {
repositoryClass => "P5EEx::Blue::Repository::DBI",
dbidriver => "mysql",
dbname => "test",
dbuser => "dbuser",
dbpass => "dbuser7",
},
},
SharedResourceSet => {
default => {
sharedResourceSetClass => "P5EEx::Blue::SharedResourceSet::IPCLocker",
},
},
};
1.1 p5ee/P5EEx/Blue/t/config.properties
Index: config.properties
===================================================================
# this is a comment
Standard.Log-Dispatch.logdir = /var/p5ee
# regarding Authen ..
Authen.passwd = /etc/passwd
Authen.seed = 303292
# stuff about Session.default
Session.default.sessionClass = P5EE::Blue::Session::CGI
1.1 p5ee/P5EEx/Blue/t/config.xml
Index: config.xml
===================================================================
<conf>
<Standard>
<Log-Dispatch logdir="/var/p5ee"/>
</Standard>
<Authen passwd="/etc/passwd" seed="303292"/>
<Session>
<default>
<sessionClass>P5EE::Blue::Session::CGI</sessionClass>
</default>
</Session>
</conf>
