cvsuser 02/01/25 11:24:28
Modified: P5EEx/Blue/P5EEx/Blue Context.pm Service.pm Widget.pm
P5EEx/Blue/P5EEx/Blue/Repository DBI.pm
Log:
cleaned up service initialization
Revision Changes Path
1.9 +183 -220 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.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- Context.pm 22 Jan 2002 22:44:33 -0000 1.8
+++ Context.pm 25 Jan 2002 19:24:28 -0000 1.9
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: Context.pm,v 1.8 2002/01/22 22:44:33 spadkins Exp $
+## $Id: Context.pm,v 1.9 2002/01/25 19:24:28 spadkins Exp $
#############################################################################
package P5EEx::Blue::Context;
@@ -60,7 +60,9 @@
like debugging during development).
Conceptually, the Context may be associated with many
-Config's and Sessions in a single process (ModPerl).
+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).
@@ -115,6 +117,22 @@
* Global Variable: $P5EEx::Blue::Context::DEBUG integer
+=head2 Master Data Structure Map
+
+ $context
+ $context->{debugscope}{$class} Debugging all methods in class
+ $context->{debugscope}{$class.$method} Debugging a single method
+ $context->{args} 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->{state}{$type}{$name} Runtime state
+ $session->{cache}{$type}{$name} Instances of services
+
=cut
$P5EEx::Blue::Context::DEBUG = 0 if (!defined $P5EEx::Blue::Context::DEBUG);
@@ -191,7 +209,9 @@
$config_class = $ENV{P5EE_CONFIG_CLASS} if (! $config_class);
$config_class = "P5EEx::Blue::Config::File" if (! $config_class);
+ # TODO: $self->{Config}{$user}, $self->{Session}{$session_id}
$self->{config} = P5EEx::Blue::P5EE->new($config_class, "new", $args);
+ $self->{session} = {}; # TODO: instantiate a real Session object
$self->init($args);
$self->{args} = { %$args };
@@ -277,136 +297,175 @@
=cut
#############################################################################
-# service_config()
+# service()
#############################################################################
-=head2 service_config()
+=head2 service()
-The service_config() method returns a hash reference which is the
-configuration of the named service.
+The service() method returns a named object of a certain service type.
- * Signature: $conf = $context->service_config($type);
- * Signature: $conf = $context->service_config($type,$name);
- * Signature: $conf = $context->service_config($type,$name,$named);
+ * Signature: $service = $context->service($type);
+ * Signature: $service = $context->service($type,$name);
+ * Signature: $service = $context->service($type,$name,$named);
+ * Signature: $service = $context->service($type,$name,%named);
* Param: $type string [in]
* Param: $name string [in]
- * Return: $conf {}
+ * Return: $service P5EEx::Blue::Service
* Throws: P5EE::Blue::Exception
* Since: 0.01
Sample Usage:
- $conf = $context->service_config("Widget","db.user.spadkins");
- $gobutton_conf = $context->service_config("Widget","gobutton");
+ $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.
-See the service() method below for a discussion of service types.
+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
+ * Template
+ * 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), if supplied, are considered defaults.
+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.
-The service config (i.e. $config->{repository}{default})
-is a simple hash which is the result of several
+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";
+ $lcf_type = "repository"; # lower-case first letter
$config = $context->config();
$repositoryType = $config->{Repository}{sysdb}{repositoryType};
$container = $config->{Repository}{sysdb}{container};
- 1. config of the service (in Config) (which override serviceType)
+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 serviceType (in Config)
+ 2. optional config of the service's service_type (in Config)
i.e. $config->{RepositoryType}{$repositoryType}
- 3. config of "container" service
- i.e. $config->{Repository}{$container}
+ 3. named parameters to the service() call
- 4. args to the service_config() call, usually coming from the service
- constructor some of these are defaults, others are overrides
- i.e. %$named
+All service configuration happens before instantiation
+this allows you to override the "serviceClass" in the configuration
+in time for instantiation
-NOTES:
+=cut
- * 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
+sub service {
+ my ($self, $type, $name, %named) = @_;
-=cut
+ $self->dbgprint("Context->service(" . join(", ",@_) . ")")
+ if ($P5EEx::Blue::Context::DEBUG && $self->dbg(ref($self),"service",3));
-sub service_config {
- my ($self, $type, $name, $args) = @_;
+ my ($args, $lcf_type, $new_service, $override, $lightweight, $attrib);
+ my ($service, $config, $class, $session);
+ my ($service_state, $service_config, $service_type, $service_type_config);
- my ($lcf_type);
- my ($config, $service_typeconfig, $service_baseconfig, $service_config);
- my ($session, $service_session);
- my ($serviceType, $attrib, $override, $new_config, $lightweight);
+ if ($#_ < 1) {
+ P5EEx::Blue::Exception->throw(
+ error => "service(): no args specified\n",
+ );
+ }
+ elsif (%named) {
+ $args = \%named;
+ }
+ else {
+ $args = {};
+ }
- $self->dbgprint("Context->service_config($type,$name, " . join(", ",(defined
$args)?%$args:"") . ")")
- if ($P5EEx::Blue::Context::DEBUG &&
$self->dbg(ref($self),"service_config",3));
+ if (! defined $name || $name eq "") { # we need a name!
+ $name = "default";
+ }
- # some data items are stored by $type (Repository) and some by $lcf_type
(repository)
$lcf_type = lcfirst($type);
- $config = $self->config();
- $service_config = $config->{$type}{$name};
+ $session = $self->{session};
+ $service = $session->{cache}{$type}{$name}; # check the cache
- $session = $self->session();
- $service_session = $session->{$type}{$name};
+ $new_service = 0;
- 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;
+ if (!defined $service) {
+ $service = {}; # start with a new simple hash reference
+ $service->{name} = $name;
+ $service->{context} = $self;
+
+ $config = $self->{config};
+ $service_config = $config->{$type}{$name};
+ $service_state = $session->{state}{$type}{$name};
- $service_session = {} if (!defined $service_session);
+ $new_service = 1;
################################################################
- # start with runtime state for the widget from the state data
+ # start with runtime state for the widget from the session
################################################################
- %$service_config = %$service_session;
- $service_config->{name} = $name;
+ if ($service_state) {
+ %$service = %$service_state;
+ }
################################################################
# 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};
+ 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 "serviceType"
+ # overlay with attributes from the "service_type"
################################################################
- $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};
+ $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};
+ }
+ }
}
}
}
@@ -414,161 +473,65 @@
################################################################
# take care of all %$args attributes next
################################################################
+
+ $lightweight = ($name =~ /[\{\}\[\]]/);
+ $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");
# 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},
+ if (!defined $service->{$attrib} ||
+ ($override && $service->{$attrib} ne $args->{$attrib})) {
+ $service->{$attrib} = $args->{$attrib};
+ # don't store state in session for "lightweight" services
+ # $service_state->{$attrib} = $args->{$attrib} if (! $lightweight);
+ }
+ $self->dbgprint("Context->service() [arg=$attrib] name=$name
lw=$lightweight ovr=$override",
+ " service=", $service->{$attrib},
+ " service_state=", $service_state->{$attrib},
" args=", $args->{$attrib})
- if ($P5EEx::Blue::Context::DEBUG &&
$self->dbg(ref($self),"service_config",6));
+ if ($P5EEx::Blue::Context::DEBUG &&
$self->dbg(ref($self),"service",6));
}
}
+ if ($new_service) {
####################################################################
# infer a container (if none supplied, by the dots in the "name")
####################################################################
- if (! defined $service_config->{container}) {
+ if (! defined $service->{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 &&
(%$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;
-}
+ $class = $service->{"${lcf_type}Class"}; # find class of service
-#############################################################################
-# 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) {
+ if (!defined $class || $class eq "") { # error if no class given
P5EEx::Blue::Exception->throw(
- error => "service(): no args specified\n",
+ error => "service(): no class 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",
+ if (! $self->{used}{$class}) { # load the code
+ eval "use $class;";
+ if ($@) {
+ P5EEx::Blue::Exception::Context->throw(
+ error => "service(): class $class failed to load: $@\n",
);
}
+ $self->{used}{$class} = 1;
+ }
- $self->use($class) if (! $self->{used}{$class});
- $service = $class->new($name);
+ bless $service, $class; # bless the service into the class
+ $service->init(); # perform additional initializations
- $session->{cache}{$lcf_type}{$name} = $service;
+ $session->{cache}{$type}{$name} = $service; # save in the cache
}
$self->dbgprint("Context->service() = $service")
@@ -767,7 +730,7 @@
sub session {
my $self = shift;
- return undef;
+ $self->{session};
}
#############################################################################
1.7 +13 -72 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.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- Service.pm 16 Jan 2002 18:32:47 -0000 1.6
+++ Service.pm 25 Jan 2002 19:24:28 -0000 1.7
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: Service.pm,v 1.6 2002/01/16 18:32:47 spadkins Exp $
+## $Id: Service.pm,v 1.7 2002/01/25 19:24:28 spadkins Exp $
#############################################################################
package P5EEx::Blue::Service;
@@ -58,27 +58,17 @@
Sample Usage: (never used because this is a base class, but the
constructors of all services follow these rules)
- * If the first constructor arg is a hashref, it is used as a base
- set of arguments or base config
- * If the number arguments remaining is odd, the next arg is the
- service name
+ * If the number of arguments is odd, the first arg is the service name
+ (otherwise, "default" is assumed)
* If there are remaining arguments, they are variable/value pairs
* If there are no arguments at all, the "default" name is assumed
* If a "name" was supplied using any of these methods,
the master config is consulted to find the config for this
- particular service instance (service_type/name). Otherwise,
- the service is an "anonymous" service and the resulting arg hashref
- is assumed to be the sum total of its configuration information.
- (No config file is needed or consulted.)
+ particular service instance (service_type/name).
$service = P5EEx::Blue::Service->new(); # assumes "default" name
$service = P5EEx::Blue::Service->new("srv1"); # instantiate named service
- $service = P5EEx::Blue::Service->new( # anonymous
- arg1 => 'value1',
- arg2 => 'value2',
- );
- $service = P5EEx::Blue::Service->new(\%baseargs, "srv1");
- $service = P5EEx::Blue::Service->new(\%baseargs, # anonymous
+ $service = P5EEx::Blue::Service->new( # "default" with named args
arg1 => 'value1',
arg2 => 'value2',
);
@@ -88,42 +78,17 @@
sub new {
my $this = shift;
my $class = ref($this) || $this;
- my $self = {};
- bless $self, $class;
+ my ($self, $context, $type, $lcf_type);
- my ($name, $args, $i);
- $name = "";
- if ($#_ == -1) {
- $args = {};
- $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) ? { @_ } : {};
+ $context = P5EEx::Blue::P5EE->context();
+ $type = $self->service_type();
+ $lcf_type = lcfirst($type);
+ if ($#_ % 2 == 0) { # odd number of args
+ $self = $context->service($type, @_, "${lcf_type}Class", $class);
}
- $args->{name} = $name if ($name);
+ else { # even number of args (
+ $self = $context->service($type, "default", @_, "${lcf_type}Class", $class);
}
- if ($args->{name}) {
- my ($config, $service_type);
- $config = P5EEx::Blue::P5EE->config();
- $service_type = $self->service_type();
- $self->{global_config} = $config;
- $self->{config} = $config->{$service_type}{$name};
- }
- else {
- $self->{config} = $args; # this is all there is
- }
-
- $self->init($args);
-
return $self;
}
@@ -145,30 +110,6 @@
=cut
sub service_type () { 'Service'; }
-
-#############################################################################
-# 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;
-}
#############################################################################
# PROTECTED METHODS
1.5 +69 -18 p5ee/P5EEx/Blue/P5EEx/Blue/Widget.pm
Index: Widget.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Widget.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- Widget.pm 6 Jan 2002 20:57:07 -0000 1.4
+++ Widget.pm 25 Jan 2002 19:24:28 -0000 1.5
@@ -1,6 +1,6 @@
#############################################################################
-## $Id: Widget.pm,v 1.4 2002/01/06 20:57:07 spadkins Exp $
+## $Id: Widget.pm,v 1.5 2002/01/25 19:24:28 spadkins Exp $
#############################################################################
package P5EEx::Blue::Widget;
@@ -106,34 +106,61 @@
=cut
#############################################################################
-# PUBLIC METHODS
+# init()
#############################################################################
-=head1 Public Methods:
+=head2 init()
-=cut
+The init() method is called from within the standard Service
+constructor.
+Common to all Widget initializations, is the absorption of container
+attributes. "Absorbable attributes" from the widget are copied from
+the container widget to the initialized widget.
-#############################################################################
-# TBD()
-#############################################################################
-
-=head2 TBD()
-
- * Signature: $tbd_return = $repository->tbd($tbd_param);
- * Param: $tbd_param integer
- * Return: $tbd_return integer
- * Throws: P5EEx::Blue::Exception::Repository
+ * Signature: init($named)
+ * Param: $named {} [in]
+ * Return: void
+ * Throws: P5EEx::Blue::Exception
* Since: 0.01
Sample Usage:
- $tbd_return = $repository->tbd($tbd_param);
+ $service->init(\%args);
=cut
-sub tbd {
- my ($self) = @_;
+sub init {
+ my ($self, $args) = @_;
+ my ($absorbable_attribs, $container_name, $container);
+
+ $absorbable_attribs = $self->absorbable_attribs();
+ $container_name = $self->{container};
+
+ # 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 ($container_name && # ... a container exists
+ $absorbable_attribs) { # ... there are known attributes to absorb
+
+ # notice a recursion here on containers
+ $container = $self->{context}->widget($container_name);
+
+ foreach $attrib (@$absorbable_attribs) {
+ if (!defined $self->{$attrib}) { # incorporate if not set yet
+ $self->{$attrib} = $container->{$attrib};
+ }
+ }
}
+}
+
+#############################################################################
+# PUBLIC METHODS
+#############################################################################
+
+=head1 Public Methods:
+
+=cut
#############################################################################
# PROTECTED METHODS
@@ -161,6 +188,30 @@
=cut
sub service_type () { 'Widget'; }
+
+#############################################################################
+# 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 [];
+}
=head1 ACKNOWLEDGEMENTS
1.5 +17 -24 p5ee/P5EEx/Blue/P5EEx/Blue/Repository/DBI.pm
Index: DBI.pm
===================================================================
RCS file: /cvs/public/p5ee/P5EEx/Blue/P5EEx/Blue/Repository/DBI.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- DBI.pm 24 Jan 2002 04:15:08 -0000 1.4
+++ DBI.pm 25 Jan 2002 19:24:28 -0000 1.5
@@ -1,13 +1,13 @@
######################################################################
-## File: $Id: DBI.pm,v 1.4 2002/01/24 04:15:08 spadkins Exp $
+## File: $Id: DBI.pm,v 1.5 2002/01/25 19:24:28 spadkins Exp $
######################################################################
use P5EEx::Blue::P5EE;
use P5EEx::Blue::Repository;
package P5EEx::Blue::Repository::DBI;
-$VERSION = do { my @r=(q$Revision: 1.4 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
+$VERSION = do { my @r=(q$Revision: 1.5 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
use P5EEx::Blue::Repository;
@ISA = ( "P5EEx::Blue::Repository" );
@@ -138,21 +138,16 @@
sub init2 {
my $self = shift;
- my ($name, $config);
+ my ($name);
$name = $self->{name};
- $config = $self->{config};
- if (defined $config->{dbh}) {
- $self->{dbh} = $config->{dbh};
+ if (defined $self->{dbh}) {
$self->{preconnected} = 1;
}
else {
my ($var, $capsvar);
foreach $var qw(dbidriver dbname dbuser dbpass dbioptions dbschema) {
- if (defined $config->{$var}) {
- $self->{$var} = $config->{$var};
- }
- else {
+ if (! defined $self->{$var}) {
$capsvar = uc($var);
if ($ENV{$capsvar}) {
$self->{$var} = $ENV{$capsvar};
@@ -192,10 +187,10 @@
if ($dbidriver eq "mysql") {
# force an update of a row to report that is was found (even if the
values didn't change)
$self->{dsn} .= ";mysql_client_found_rows=true";
- $self->{attr} = { "PrintError" => 0, "AutoCommit" => 1,
"RaiseError" => 1 };
+ $self->{attr} = { "PrintError" => 0, "AutoCommit" => 1,
"RaiseError" => 0 };
}
else {
- $self->{attr} = { "PrintError" => 0, "AutoCommit" => 0,
"RaiseError" => 1 };
+ $self->{attr} = { "PrintError" => 0, "AutoCommit" => 0,
"RaiseError" => 0 };
}
}
@@ -317,7 +312,7 @@
if (!defined $self->{dbh}) {
$self->{error} = "Not connected to database";
- return 0
+ return 0;
}
$dbh = $self->{dbh};
delete $self->{error};
@@ -929,9 +924,9 @@
$self->load_table_metadata($table) if (!defined $self->{table}{$table}{loaded});
my ($sql, $values, $col, $value, $colnum, $quoted);
-print "mk_insert_row_sql($table,\n [",
- join(",",@$cols), "],\n [",
- join(",",@$row), "])\n";
+ #print "mk_insert_row_sql($table,\n [",
+ # join(",",@$cols), "],\n [",
+ # join(",",@$row), "])\n";
if ($#$cols == -1) {
$self->{error} = "Database->mk_insert_row_sql(): no columns specified";
@@ -957,8 +952,6 @@
$value =~ s/'/\\'/g;
$value = "'$value'";
}
-print "col=$col value=$value quoted=$quoted tabcols->{quoted}=",
$tabcols->{$col}{quoted},
- ":", (defined $tabcols->{$col}{quoted}), "\n";
}
}
$sql .= ($colnum == 0) ? " ($col" : ",\n $col";
@@ -967,7 +960,6 @@
$sql .= ")\n";
$values .= ")\n";
$sql .= $values;
-print "mk_insert_row_sql():\n$sql\n";
$sql;
}
@@ -1214,10 +1206,11 @@
sub store_row {
my ($self, $table, $cols, $row, $keycolidx, $update_first) = @_;
my ($update_sql, $insert_sql, $success);
-print "store_row($table,\n [",
- join(",",@$cols), "],\n [",
- join(",",@$row), "],\n [",
- join(",",@$keycolidx), "], $update_first);\n";
+
+ #print "store_row($table,\n [",
+ # join(",",@$cols), "],\n [",
+ # join(",",@$row), "],\n [",
+ # join(",",@$keycolidx), "], $update_first);\n";
$success = 0;
if ($update_first) {
