cvsuser 01/12/10 21:03:46
Modified: P5EEx/Blue MANIFEST Makefile.PL
P5EEx/Blue/P5EEx/Blue Context.pm P5EE.pm Service.pm
Session.pm
P5EEx/Blue/P5EEx/Blue/Config File.pm
Log:
began adding event dispatching to the Context
Revision Changes Path
1.5 +3 -1 p5ee/P5EEx/Blue/MANIFEST
Index: MANIFEST
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/MANIFEST,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- MANIFEST 5 Dec 2001 22:45:03 -0000 1.4
+++ MANIFEST 11 Dec 2001 05:03:46 -0000 1.5
@@ -17,6 +17,7 @@
P5EEx/Blue/Serializer/XMLSimple.pm
P5EEx/Blue/Serializer/Ini.pm
P5EEx/Blue/Serializer/Properties.pm
+P5EEx/Blue/Serializer/Storable.pm
P5EEx/Blue/Session.pm
P5EEx/Blue/Security.pm
P5EEx/Blue/Repository.pm
@@ -28,7 +29,9 @@
P5EEx/Blue/datetime.pod
P5EEx/Blue/perlstyle.pod
P5EEx/Blue/podstyle.pod
+P5EEx/Blue/exceptions.pod
sbin/perldocs
+sbin/perlchanges
htdocs/api/perldocs.css
htdocs/style.css
htdocs/images/logo.gif
@@ -39,4 +42,3 @@
examples/config.xml
examples/Reference.1
examples/Reference.1.out
-t/Config.t
1.5 +2 -2 p5ee/P5EEx/Blue/Makefile.PL
Index: Makefile.PL
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/Makefile.PL,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- Makefile.PL 27 Nov 2001 20:58:37 -0000 1.4
+++ Makefile.PL 11 Dec 2001 05:03:46 -0000 1.5
@@ -1,6 +1,6 @@
######################################################################
-## File: $Id: Makefile.PL,v 1.4 2001/11/27 20:58:37 spadkins Exp $
+## File: $Id: Makefile.PL,v 1.5 2001/12/11 05:03:46 spadkins Exp $
######################################################################
use ExtUtils::MakeMaker;
@@ -15,7 +15,7 @@
'PMLIBDIRS' => [ 'P5EEx', ],
'linkext' => { LINKTYPE=>'' }, # no link needed
'dist' => {'COMPRESS'=>'gzip -9f', 'SUFFIX' => 'gz',
- 'ZIP'=>'/usr/bin/zip','ZIPFLAGS'=>'-rl'}
+ 'ZIP'=>'/usr/bin/zip','ZIPFLAGS'=>'-rl'},
);
######################################################################
1.6 +450 -5 p5ee/P5EEx/Blue/P5EEx/Blue/Context.pm
Index: Context.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Context.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- Context.pm 5 Dec 2001 22:45:03 -0000 1.5
+++ Context.pm 11 Dec 2001 05:03:46 -0000 1.6
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: Context.pm,v 1.5 2001/12/05 22:45:03 spadkins Exp $
+## $Id: Context.pm,v 1.6 2001/12/11 05:03:46 spadkins Exp $
#############################################################################
package P5EEx::Blue::Context;
@@ -19,6 +19,7 @@
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(
@@ -191,8 +192,8 @@
$config_class = "P5EEx::Blue::Config::File" if (! $config_class);
$self->{config} = P5EEx::Blue::P5EE->new($config_class, "new", $args);
-
$self->init($args);
+ $self->{args} = { %$args };
return $self;
}
@@ -204,7 +205,7 @@
=head1 Protected Methods:
The following methods are intended to be called by subclasses of the
-current class.
+current class (or environmental, "main" code).
=cut
@@ -220,7 +221,7 @@
constructor by overriding the init() method.
* Signature: $context->init($args)
- * Param: $args hash{string} [in]
+ * Param: $args {} [in]
* Return: void
* Throws: P5EEx::Blue::Exception
* Since: 0.01
@@ -236,14 +237,433 @@
}
#############################################################################
+# 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",
+ );
+}
+
+#############################################################################
# PUBLIC METHODS
#############################################################################
-=head1 Public Methods:
+=head1 Public Methods: Services
=cut
#############################################################################
+# service_config()
+#############################################################################
+
+=head2 service_config()
+
+The service_config() method returns a hash reference which is the
+configuration of the named service.
+
+ * Signature: $conf = $context->service_config($type);
+ * Signature: $conf = $context->service_config($type,$name);
+ * Signature: $conf = $context->service_config($type,$name,$named);
+ * Param: $type string [in]
+ * Param: $name string [in]
+ * Return: $conf {}
+ * Throws: P5EE::Blue::Exception
+ * Since: 0.01
+
+ Sample Usage:
+
+ $conf = $context->service_config("Widget","db.user.spadkins");
+ $gobutton_conf = $context->service_config("Widget","gobutton");
+
+See the service() method below for a discussion of service types.
+
+The name of a service, if not specified, is assumed to be "default".
+
+The named parameters ($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.
+
+The service config (i.e. $config->{repository}{default})
+is a simple hash which is the result of 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";
+ $config = $context->config();
+ $repositoryType = $config->{Repository}{sysdb}{repositoryType};
+ $container = $config->{Repository}{sysdb}{container};
+
+ 1. config of the service (in Config) (which override serviceType)
+ i.e. $config->{Repository}{sysdb}
+
+ 2. optional config of the service's serviceType (in Config)
+ i.e. $config->{RepositoryType}{$repositoryType}
+
+ 3. config of "container" service
+ i.e. $config->{Repository}{$container}
+
+ 4. args to the service_config() call, usually coming from the service
+ constructor some of these are defaults, others are overrides
+ i.e. %$named
+
+NOTES:
+
+ * we don't want to copy *all* attributes of container config, so
+ we need a list of "absorbable" attributes
+ * all service configuration happens before instantiation
+ this allows you to override the "serviceClass" in time for instantiation
+ * service config's are cached in the Context because the context
+ needs to know the configuration before it can instantiate the service.
+ * A reference to each service's config may be kept by the service
+
+=cut
+
+sub service_config {
+ my ($self, $type, $name, $args) = @_;
+
+ my ($lcf_type);
+ my ($config, $service_typeconfig, $service_baseconfig, $service_config);
+ my ($session, $service_session);
+ my ($serviceType, $attrib, $override, $new_config, $lightweight);
+
+ $self->dbgprint("Context->service_config($type,$name, " . join(", ",(defined
$args)?%$args:"") . ")")
+ if ($P5EEx::Blue::Context::DEBUG &&
$self->dbg(ref($self),"service_config",3));
+
+ # some data items are stored by $type (Repository) and some by $lcf_type
(repository)
+ $lcf_type = lcfirst($type);
+
+ $config = $self->config();
+ $service_config = $config->{$lcf_type}{$name};
+
+ #$session = $self->session();
+ #$service_session = $session->{$type}{$name};
+
+ if (defined $service_config) {
+ $new_config = 0;
+ }
+ else {
+ ################################################################
+ # set up the $service_config and $service_session hashrefs
+ ################################################################
+ $service_config = {};
+ $config->{$type}{$name} = $service_config;
+ $new_config = 1;
+
+ $service_session = {} if (!defined $service_session);
+
+ ################################################################
+ # start with runtime state for the widget from the state data
+ ################################################################
+ %$service_config = %$service_session;
+ $service_config->{name} = $name;
+
+ ################################################################
+ # overlay with attributes from the config file
+ ################################################################
+ $service_baseconfig = $config->{$type}{$name};
+ foreach $attrib (keys %$service_baseconfig) {
+ # include config attributes only if not provided in the service_session
+ if (!defined $service_config->{$attrib}) {
+ $service_config->{$attrib} = $service_baseconfig->{$attrib};
+ }
+ }
+
+ ################################################################
+ # overlay with attributes from the "serviceType"
+ ################################################################
+ $serviceType = $service_config->{"${lcf_type}Type"}; # i.e. "widgetType"
+ if ($serviceType) {
+ $service_baseconfig = $service_config->{"${type}Type"}{$serviceType};
+ foreach $attrib (keys %$service_baseconfig) {
+ # include serviceType configs only if not provided in the widget
configs
+ if (!defined $service_config->{$attrib}) {
+ $service_config->{$attrib} = $service_baseconfig->{$attrib};
+ }
+ }
+ }
+
+ ################################################################
+ # take care of all %$args attributes next
+ ################################################################
+ foreach $attrib (keys %$args) {
+ # don't include the entry which says whether we are overriding or not
+ next if ($attrib eq "override");
+
+ # include attrib if overriding OR attrib not provided in the widget
configs already
+ if (!defined $service_config->{$attrib} ||
+ ($override && $service_config->{$attrib} ne $args->{$attrib})) {
+ $service_config->{$attrib} = $args->{$attrib};
+ # don't store state in session for lightweight widgets
+ $service_session->{$attrib} = $args->{$attrib} if (! $lightweight);
+ }
+ $self->dbgprint("Context->service_config() [arg=$attrib] name=$name
lw=$lightweight ovr=$override",
+ " service_config=", $service_config->{$attrib},
+ " service_session=", $service_session->{$attrib},
+ " args=", $args->{$attrib})
+ if ($P5EEx::Blue::Context::DEBUG &&
$self->dbg(ref($self),"service_config",6));
+ }
+ }
+
+ ####################################################################
+ # infer a container (if none supplied, by the dots in the "name")
+ ####################################################################
+ if (! defined $service_config->{container}) {
+ if ($name =~ /^(.+)\./) {
+ $service_config->{container} = $1;
+ }
+ elsif ($name ne "default") {
+ $service_config->{container} = "default";
+ }
+ if (defined $service_config->{widgetClass}) {
+ $self->use($service_config->{widgetClass}); # load the perl code
+ $service_config->{absorbable_attribs} =
$service_config->{widgetClass}->absorbable_attribs();
+ }
+ }
+
+ # absorb attributes of the container config if ...
+ # TODO: sort out whether we need to absorb attributes more often
+ # (i.e. push model rather than a pull model)
+ if ($new_config && # ... it is the first time through
+ $service_config->{container} && # ... a container exists
+ $service_config->{absorbable_attribs}) { # ... there are known
attributes to absorb
+
+ my ($container, $container_config, $absorbable_attribs);
+ $container = $service_config->{container};
+ $container_config = $self->service_config($type,$container); # notice a
recursion here on containers
+ $absorbable_attribs = $service_config->{absorbable_attribs};
+ if (ref($absorbable_attribs) eq "") {
+ $absorbable_attribs = [ split(/ *, */,$absorbable_attribs) ];
+ }
+ if (ref($absorbable_attribs) eq "ARRAY") {
+ foreach $attrib (@$absorbable_attribs) {
+ if (!defined $service_config->{$attrib}) { # incorporate only if
from no other source
+ $service_config->{$attrib} = $container_config->{$attrib};
+ }
+ }
+ }
+ }
+
+ # ?why was this code here? we don't put anything in the service_session in this
routine.
+ # (it is certainly benign, but I will probably remove it.)
+ if (!defined $session->{$type}{$name} && !$lightweight && (%$service_session)) {
+ $session->{$type}{$name} = $service_session;
+ }
+
+ $self->dbgprint("Context->service_config($type,$name) = [" .
+ join(", ",(defined $service_config) ? %$service_config : "") . "]")
+ if ($P5EEx::Blue::Context::DEBUG &&
$self->dbg(ref($self),"service_config",3));
+
+ return $service_config;
+}
+
+#############################################################################
+# 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");
+
+Available service types are any that have had their type
+associated in the configuration with a class derived from the
+P5EEx::Blue::Service class. The name of a service, if not specified,
+is assumed to be "default".
+
+The following service types are standard in P5EE.
+All service types must start with a capital letter.
+
+ * Repository
+ * Security
+ * Widget
+ * Template
+ * Messaging
+ * Procedure
+ * LogChannel
+
+=cut
+
+sub service {
+ my ($self, $type, $name, %named) = @_;
+
+ $self->dbgprint("Context->service(" . join(", ",@_) . ")")
+ if ($P5EEx::Blue::Context::DEBUG && $self->dbg(ref($self),"service",3));
+
+ my ($args, $lcf_type, $service, $service_config, $class, $session);
+
+ if ($#_ == -1) {
+ P5EEx::Blue::Exception->throw(
+ error => "service(): no args specified\n",
+ );
+ }
+ elsif (%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}{$lcf_type}{$name}; # check the cache
+
+ if (!defined $service) {
+
+ $service_config = $self->service_config($type, $name, $args);
+ $class = $service_config->{"${lcf_type}Class"};
+
+ if (!defined $class || $class eq "") {
+ P5EEx::Blue::Exception->throw(
+ error => "service(): no class specified\n",
+ );
+ }
+
+ $self->use($class) if (! $self->{used}{$class});
+ $service = $class->new($name);
+
+ $session->{cache}{$lcf_type}{$name} = $service;
+ }
+
+ $self->dbgprint("Context->service() = $service")
+ if ($P5EEx::Blue::Context::DEBUG && $self->dbg(ref($self),"service",3));
+
+ return $service;
+}
+
+#############################################################################
+# service convenience methods
+#############################################################################
+
+=head2 session()
+
+=head2 repository()
+
+=head2 security()
+
+=head2 widget()
+
+=head2 template()
+
+=head2 messaging()
+
+=head2 procedure()
+
+=head2 logchannel()
+
+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 = $context->template();
+ $logchannel = $context->logchannel();
+
+=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 { my $self = shift; return $self->service("Template",@_); }
+sub messaging { my $self = shift; return $self->service("Messaging",@_); }
+sub procedure { my $self = shift; return $self->service("Procedure",@_); }
+sub logchannel { my $self = shift; return $self->service("LogChannel",@_); }
+
+#############################################################################
+# PUBLIC METHODS
+#############################################################################
+
+=head1 Public Methods: Miscellaneous
+
+=cut
+
+#############################################################################
+# use()
+#############################################################################
+
+=head2 use()
+
+The use() method writes a string (the concatenated list of @args) to
+the default use channel.
+
+ * Signature: $context->use($class);
+ * Param: $class string [in]
+ * Return: void
+ * Throws: <none>
+ * Since: 0.01
+
+ Sample Usage:
+
+ $context->use("P5EEx::Blue::Widget::Entity");
+
+=cut
+
+sub use {
+ my ($self, $class) = @_;
+ return if (defined $self->{used}{$class});
+ eval "use $class;";
+ $self->{used}{$class} = 1;
+}
+
+#############################################################################
# log()
#############################################################################
@@ -318,6 +738,31 @@
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;
+ return undef;
}
#############################################################################
1.6 +4 -4 p5ee/P5EEx/Blue/P5EEx/Blue/P5EE.pm
Index: P5EE.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/P5EE.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- P5EE.pm 5 Dec 2001 22:45:03 -0000 1.5
+++ P5EE.pm 11 Dec 2001 05:03:46 -0000 1.6
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: P5EE.pm,v 1.5 2001/12/05 22:45:03 spadkins Exp $
+## $Id: P5EE.pm,v 1.6 2001/12/11 05:03:46 spadkins Exp $
#############################################################################
package P5EEx::Blue::P5EE;
@@ -110,11 +110,11 @@
=item * Class Group: L<C<Config>|P5EEx::Blue::Config>
- retrieve and access configuration information
-=item * Class Group: L<C<Serializer>|P5EEx::Blue::Serializer>
- - transforms a perl struct to a scalar and back
-
=item * Class Group: L<C<Session>|P5EEx::Blue::Session>
- represents the state associated with a sequence of multiple events
+
+=item * Class Group: L<C<Serializer>|P5EEx::Blue::Serializer>
+ - transforms a perl struct to a scalar and back
=item * Class Group: L<C<Template>|P5EEx::Blue::Template>
- encapsulates template system details
1.4 +25 -1 p5ee/P5EEx/Blue/P5EEx/Blue/Service.pm
Index: Service.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Service.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- Service.pm 5 Dec 2001 22:45:03 -0000 1.3
+++ Service.pm 11 Dec 2001 05:03:46 -0000 1.4
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: Service.pm,v 1.3 2001/12/05 22:45:03 spadkins Exp $
+## $Id: Service.pm,v 1.4 2001/12/11 05:03:46 spadkins Exp $
#############################################################################
package P5EEx::Blue::Service;
@@ -95,6 +95,30 @@
$self->init($args);
return $self;
+}
+
+#############################################################################
+# Method: absorbable_attribs()
+#############################################################################
+
+=head2 absorbable_attribs()
+
+Returns a list of attributes which a service of this type would like to
+absorb from its container service.
+
+ * Signature: $attribs = P5EEx::Blue::Service->absorbable_attribs()
+ * Param: void
+ * Return: $attribs []
+ * Throws: P5EEx::Blue::Exception
+ * Since: 0.01
+
+ $attribs = $widget->absorbable_attribs();
+
+=cut
+
+sub absorbable_attribs {
+ my $self = shift;
+ return undef;
}
#############################################################################
1.3 +3 -3 p5ee/P5EEx/Blue/P5EEx/Blue/Session.pm
Index: Session.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Session.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- Session.pm 5 Dec 2001 22:45:03 -0000 1.2
+++ Session.pm 11 Dec 2001 05:03:46 -0000 1.3
@@ -1,13 +1,13 @@
#############################################################################
-## $Id: Session.pm,v 1.2 2001/12/05 22:45:03 spadkins Exp $
+## $Id: Session.pm,v 1.3 2001/12/11 05:03:46 spadkins Exp $
#############################################################################
package P5EEx::Blue::Session;
use P5EEx::Blue::P5EE;
-use P5EEx::Blue::Service;
-@ISA = ( "P5EEx::Blue::Service" );
+use P5EEx::Blue::Reference;
+@ISA = ( "P5EEx::Blue::Reference" );
use strict;
1.2 +25 -10 p5ee/P5EEx/Blue/P5EEx/Blue/Config/File.pm
Index: File.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Config/File.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- File.pm 5 Dec 2001 22:45:04 -0000 1.1
+++ File.pm 11 Dec 2001 05:03:46 -0000 1.2
@@ -1,10 +1,10 @@
#############################################################################
-## $Id: File.pm,v 1.1 2001/12/05 22:45:04 spadkins Exp $
+## $Id: File.pm,v 1.2 2001/12/11 05:03:46 spadkins Exp $
#############################################################################
package P5EEx::Blue::Config::File;
-$VERSION = do { my @r=(q$Revision: 1.1 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
+$VERSION = do { my @r=(q$Revision: 1.2 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
use P5EEx::Blue::P5EE;
use P5EEx::Blue::Config;
@@ -32,7 +32,7 @@
$dir = "." if (!$dir);
if (!$file) { # no file specified
- foreach $filetype qw(pl xml ini properties) {
+ foreach $filetype qw(pl xml ini properties perl conf) {
$testfile = ($dir eq ".") ? "config.$filetype" :
"$dir/config.$filetype";
if (-r $testfile) {
$file = $testfile;
@@ -71,7 +71,10 @@
}
if ($filetype eq "pl") {
- $serializer_class = "P5EEx::Blue::Serializer";
+ $serializer_class = ""; # don't bother with a serializer
+ }
+ elsif ($filetype eq "perl") {
+ $serializer_class = "P5EEx::Blue::Serializer::Dumper";
}
elsif ($filetype eq "stor") {
$serializer_class = "P5EEx::Blue::Serializer::Storable";
@@ -85,6 +88,9 @@
elsif ($filetype eq "properties") {
$serializer_class = "P5EEx::Blue::Serializer::Properties";
}
+ elsif ($filetype eq "conf") {
+ $serializer_class = "P5EEx::Blue::Serializer::Properties";
+ }
elsif ($filetype) {
my $serializer = uc(substr($filetype,0,1)) . substr($filetype,1);
$serializer_class = "P5EEx::Blue::Serializer::$serializer";
@@ -94,6 +100,7 @@
}
}
+ if ($serializer_class) {
eval "use $serializer_class;";
if ($@) {
P5EEx::Blue::Exception::Config->throw(
@@ -101,6 +108,14 @@
);
}
$conf = $serializer_class->deserialize($text);
+ }
+ else { # don't bother with a serializer
+ $conf = {};
+ if ($text =~ /^\$[a-zA-Z][a-zA-Z0-9_]* *= *(\{.*\};[ \n]*)$/s) {
+ $text = "\$conf = $1"; # untainted now
+ eval($text);
+ }
+ }
$conf;
}
