* fixed the methodMissing() method so that it actually is possible to use it to do method dispatching;

* factored out some of the method dispatching code by adding a dispatchMethod() method to the controller;
* turned the Dispatcher class into simply a function on the base Service class and removed Dispatcher.pm;
* made it possible for services to be both services and objects and provide different services depending on which context they were called in (and used this to make the AdminCommands module actually do what it was intended to in the first place, namely, only work for CommandLine access);
* fixed it so if a service is first created by getServiceList the constructed version will actually be cached;
* made output more generic by allowing services to implement arbitrary parts of the output API, used that to make AdminCommands usable without requiring additional code to support it;
* added some documentation;
* added some dump(10) statements to help debugging;
* fixed the string datasource SQL;
* fixed the DBI database so it can handle errors;
* added tableExists API to the DBI database helper.
Thanks to myk, justdave and zach for some ideas.


git-svn-id: svn://10.0.0.236/trunk@94080 18797224-902f-48f8-a5cc-f745e15eee43
This commit is contained in:
ian%hixie.ch 2001-05-06 06:26:24 +00:00
parent 37acdac8a8
commit d33e786523
15 changed files with 208 additions and 96 deletions

View File

@ -60,8 +60,10 @@ my $LOCKED = 0; # set to '1' while we are calling the error reporting code
sub create {
my $class = shift;
if (ref($class)) {
$class->dump(10, "Tried to call constructor of already existing object $class, so returning same object");
return $class; # already created, return self
} else {
$class->dump(10, "Called constructor of class $class, creating object...");
return $class->bless(@_); # call our real constructor
}
}
@ -104,7 +106,7 @@ sub AUTOLOAD {
} else {
$self->dump(10, "not treating $name in $self as an implied property, regardless of its existence");
}
$self->methodMissing($AUTOLOAD);
$self->methodMissing($name, @_);
}
sub propertySet {

View File

@ -68,9 +68,7 @@ require PLIF::Program; # see note below
# command dispatching, and ask them to handle this.
sub dispatch {
my $self = shift;
my($command) = @_;
if (not ($self->getSelectingObjectList('commands.dispatcher')->dispatch($self, $command) or
$self->getSelectingObjectList('commands.dispatcher')->dispatch($self, $command))) {
if (not $self->dispatchMethod('dispatcher.commands', 'cmd', @_)) {
$self->SUPER::dispatch(@_);
}
}

View File

@ -107,7 +107,7 @@ sub getObject {
my $self = shift;
my($name) = @_;
foreach my $service (@{$self->objects}) {
if ($service->provides($name)) {
if ($service->objectProvides($name)) {
return $service;
}
}
@ -126,7 +126,8 @@ sub getServiceList {
# TO THE $self ARGUMENT PASSED TO THE CONSTRUCTOR!
# Doing so would create a circular dependency, resulting
# in a memory leak.
push(@services, $service->create($self));
$service = $service->create($self);
push(@services, $service);
}
}
return @services;
@ -139,7 +140,7 @@ sub getObjectList {
my($name) = @_;
my @services;
foreach my $service (@{$self->objects}) {
if ($service->provides($name)) {
if ($service->objectProvides($name)) {
push(@services, $service);
}
}
@ -166,6 +167,14 @@ sub getPipingObjectList {
return PLIF::MagicPipingArray->create($self->getObjectList(@_));
}
sub dispatchMethod {
my $self = shift;
my($service, $prefix, $method, @arguments) = @_;
# the \u makes the first letter of the $command uppercase
return ($self->getSelectingServiceList($service)->dispatch($self, "$prefix\u$method", @arguments) or
$self->getSelectingObjectList($service)->dispatch($self, "$prefix\u$method", @arguments));
}
sub getServiceInstance {
my $self = shift;
my($name, @data) = @_;

View File

@ -164,7 +164,7 @@ sub getString {
sub getDefaultString {
my $self = shift;
my($app, $protocol, $string) = @_;
return $app->getSelectingServiceList('dataSource.strings.default')->get($app, $protocol, $string);
return $app->getSelectingServiceList('dataSource.strings.default')->getDefaultString($app, $protocol, $string);
}
sub getVariants {

View File

@ -40,49 +40,53 @@ sub databaseType {
sub getString {
my $self = shift;
my($app, $variant, $string) = @_;
return $self->database($app)->execute("SELECT data FROM strings WHERE variant = ? string = ?", $variant, $string)->rows;
return $self->database($app)->execute("SELECT data FROM strings WHERE variant = ? AND name = ?", $variant, $string)->rows;
}
sub getVariants {
my $self = shift;
my($app, $protocol) = @_;
return $self->database($app)->execute("SELECT id, quality, type, encoding, charset, language FROM variants WHERE protocol = ?", $protocol)->rows;
return $self->database($app)->execute("SELECT id, quality, type, encoding, charset, language FROM stringVariants WHERE protocol = ?", $protocol)->rows;
}
sub setupInstall {
my $self = shift;
my($app) = @_;
my $helper = $self->helper($app);
$self->dump(9, 'about to configure string data source...');
if (not $helper->tableExists($app, $self->database($app), 'stringVariants')) {
$self->debug('going to create \'stringVariants\' table');
$self->database($app)->execute('
CREATE TABLE stringVariants (
id integer unsigned auto_increment not null primary key,
name varchar(255) not null,
protocol varchar(255) not null,
id integer unsigned auto_increment NOT NULL PRIMARY KEY,
name varchar(255) NOT NULL,
protocol varchar(255) NOT NULL,
encoding varchar(255),
type varchar(255) not null,
type varchar(255) NOT NULL,
charset varchar(255),
language varchar(255) not null,
quality float not null default 1.0,
language varchar(255) NOT NULL,
quality float NOT NULL default 1.0,
description text,
translator varchar(255),
unique index (name)
);
');
UNIQUE KEY (name)
)
')->row;
} else {
# check its schema is up to date
}
if (not $helper->tableExists($app, $self->database($app), 'strings')) {
$self->debug('going to create \'strings\' table');
$self->database($app)->execute('
CREATE TABLE strings (
variant integer unsigned not null,
name varchar(32) not null,
variant integer unsigned NOT NULL,
name varchar(32) NOT NULL,
data text,
primary key (variant, name)
);
');
PRIMARY KEY (variant, name)
)
')->row;
} else {
# check its schema is up to date
}
$self->dump(9, 'done configuring string data source');
return;
}

View File

@ -58,9 +58,9 @@ sub init {
my $port = $self->port;
$self->handle(DBI->connect("DBI:$type:$name:$host:$port",
$self->username, $self->password,
{RaiseError => 0, PrintError => 0, AutoCommit => 1}));
{RaiseError => 0, PrintError => 0, AutoCommit => 1, Taint => 1}));
$self->errstr($DBI::errstr);
$self->dump(9, 'tried to connect to database without raising an exception!');
$self->dump(9, 'created a database object without raising an exception');
};
if ($@) {
$self->handle(undef);
@ -86,11 +86,14 @@ sub propertyGetUndefined {
sub execute {
my $self = shift;
my($statement, @values) = @_; # XXX does this not need $app to be passed?
my($statement, @values) = @_;
$self->assert($self->handle, 1, 'No database handle: '.(defined($self->errstr) ? $self->errstr : 'unknown error'));
my $handle = $self->handle->prepare($statement);
$handle->execute(@values);
return PLIF::Database::ResultsFrame::DBI->create($handle); # XXX no app?
if ($handle and $handle->execute(@values)) {
return PLIF::Database::ResultsFrame::DBI->create($handle);
} else {
$self->error(1, $handle->errstr);
}
}
sub getConfig {
@ -117,7 +120,7 @@ sub setupConfigure {
}
}
$app->getService('dataSource.configuration')->setDBIDatabaseSettings($app, $self);
$self->dump(9, 'done configuring DBI...');
$self->dump(9, 'done configuring DBI');
return;
}

View File

@ -54,4 +54,4 @@ sub rows {
# other possible APIs:
# $ary_ref = $sth->fetchrow_arrayref;
# $hash_ref = $sth->fetchrow_hashref;
# reexecute with new bound values

View File

@ -37,9 +37,22 @@ sub databaseType {
return qw(mysql);
}
sub tableExists {
my $self = shift;
my($app, $database, $table) = @_;
return defined($database->execute('SHOW TABLES LIKE ?', $table)->row);
}
=over time i would expect the following to be implemented:
*********************
**** WARNING!!!! ****
*********************
The following section is only licensed as MPL and not MPL/GPL.
It is copied from the Bugzilla 2.x codebase for our information only.
###########################################################################
# Detect changed local settings
###########################################################################

View File

@ -53,12 +53,21 @@ sub init {
# propertySet() here instead of just $self->app($app).
}
sub reportFatalError {} # stub - should this be required? probably...
# disable implied property access so that calls to unimplemented
# output methods will always be caught.
# output methods will always be caught and can be handled by generic
# output handlers.
sub propertyImpliedAccessAllowed {
my $self = shift;
$self->dump(10, "access to property @_ of object $self attempted");
return $self->propertyExists(@_);
}
# if we don't implement the output handler directly, let's see if some
# output dispatcher service for this protocol does
sub methodMissing {
my $self = shift;
my($method, @arguments) = @_;
if (not $self->app->dispatchMethod('dispatcher.output.'.$self->protocol, 'output', $method, $self, @arguments)) {
$self->SUPER::methodMissing(@_);
}
}

View File

@ -33,6 +33,62 @@ use PLIF::Output;
@ISA = qw(PLIF::Output);
1;
# NOTES
#
# The codepath resulting from a call through PLIF::Output::Generic are
# somewhat involved, although they make for a very flexible and
# powerful potential result.
#
# In the logic code, you simply have to call the output method without
# worrying about anything:
#
# $app->output->HelloWorld($fullname, $date);
#
# ...or whatever. However this ends up following the following
# codepath:
#
# First, the PLIF internal program logic (Program.pm) looks for a
# specific output handler for the protocol (we'll assume we're using
# HTTP here). This will typically fail.
#
# Then it looks for a generic output handler (probably this module).
#
# It calls the generic output module's 'HelloWorld' method, which in
# this case doesn't exist and ends up going through core PLIF and then
# back to methodMissing implemented in the ancestor Output module.
#
# The methodMissing method calls every output dispatcher service (for
# the generic protocol, anyway) until one of them handles the
# HelloWorld method.
#
# This ends up calling HelloWorld on one of the output dispatchers,
# which should result in calling the 'output' method of this object
# (defined below) with a string name and a hash.
#
# The output method now calls for a string expander service, passes it
# the string and the hash, and waits for a string in return. Notice
# that we still have not yet done anything output-protocol-specific.
#
# The string expander calls the string data source which calls the
# default database which calls the configuration data source which
# calls the configuration file database which looks up the name of the
# database, which is used to look up the list of variants and the
# specific string which should be used from those variants. If that
# fails, then the string data source will instead ask each of the
# default string data sources in turn for a suitable string, which it
# will return to the string expander which will expand the string and
# return it to the output method.
#
# The output method then looks for a protocol outputter and passes it
# the final string.
#
# The stack then unwinds all the way back to the application logic.
#
# Phew! Bet you never thought writing "Hello World" would be that
# hard. But at least this means we can do it in HTML and SVG without
# changing the underlying code.
sub protocol {
return 'generic';
}

View File

@ -144,12 +144,15 @@ sub selectOutputProtocol {
# Implementation Specific Methods
# At least some of these should be overriden by real applications
# if you override this one, only call $self->SUPER::dispatch(@_) if
# If you override this one, only call $self->SUPER::dispatch(@_) if
# you couldn't dispatch the command.
# Note: Don't confuse this method with the identically named method in
# the Service class hierarchy that does something similar!
sub dispatch {
my $self = shift;
my($command) = @_;
my $method = $self->can('cmd'.$command);
# the \u makes the first letter of the $command uppercase
my $method = $self->can("cmd\u$command");
if ($method) {
&$method($self);
} else {

View File

@ -33,4 +33,23 @@ use PLIF;
@ISA = qw(PLIF);
1;
# what services the module provides as a service
sub provides { return 0; } # stub
# what services the module provides as an object
sub objectProvides {
my $class = shift;
return $class->provides(@_);
}
sub dispatch {
my $self = shift;
my($app, $name, @arguments) = @_;
my $method = $self->can($name);
if ($method) {
&$method($self, $app, @arguments);
return 1;
} else {
return undef;
}
}

View File

@ -29,20 +29,34 @@
package PLIF::Service::AdminCommands;
use strict;
use vars qw(@ISA);
use PLIF::Service::Dispatcher;
@ISA = qw(PLIF::Service::Dispatcher);
use PLIF::Service;
@ISA = qw(PLIF::Service);
1;
# Any application that uses PLIF::Service::AdminCommands must also
# have an output implementation that supports "setupFailed($result)"
# and "setupSucceeded()".
# implement "setupFailed($result)" and "setupSucceeded()" in any
# output services that might get called in a Setup context, as well as
# default string data sources for any protocols that might be used in
# a Setup context that use the Generic output module other than
# 'stdout' which is supported by this module itself.
sub provides {
my $class = shift;
my($service) = @_;
return ($service eq 'input.verify' or $class->SUPER::provides($service));
return ($service eq 'input.verify' or
$service eq 'dispatcher.output.generic' or
$service eq 'dataSource.strings.default' or
$class->SUPER::provides($service));
}
sub objectProvides {
my $class = shift;
my($service) = @_;
return ($service eq 'dispatcher.commands' or
$class->SUPER::objectProvides($service));
}
# input.verify
sub verifyInput {
my $self = shift;
my($app) = @_;
@ -52,6 +66,7 @@ sub verifyInput {
return;
}
# dispatcher.commands
sub cmdSetup {
my $self = shift;
my($app) = @_;
@ -67,8 +82,33 @@ sub cmdSetup {
}
}
# dispatcher.output.generic
sub outputSetupSucceeded {
my $self = shift;
my($app, $output) = @_;
$output->output(undef, 'setup', {
'failed' => 0,
});
}
# XXX other commands to add
# cmdAddModule
# cmdRemoveModule
# dispatcher.output.generic as well
sub outputSetupFailed {
my $self = shift;
my($app, $output, $result) = @_;
$output->output(undef, 'setup', {
'failed' => 1,
'result' => $result,
});
}
# dataSource.strings.default
sub getDefaultString {
my $self = shift;
my($app, $protocol, $string) = @_;
if ($protocol eq 'stdout' and $string eq 'setup') {
return '<text><if lvalue="(data.failed)" condition="=" rvalue="1">Failed with:<br/><text variable="(data.result)"/></if><else>Succeeded!</else><br/></text>';
} else {
return; # nope, sorry
}
}

View File

@ -1,52 +0,0 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
#
# This file is MPL/GPL dual-licensed under the following terms:
#
# The contents of this file are subject to the Mozilla Public License
# Version 1.1 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
# the License for the specific language governing rights and
# limitations under the License.
#
# The Original Code is PLIF 1.0.
# The Initial Developer of the Original Code is Ian Hickson.
#
# Alternatively, the contents of this file may be used under the terms
# of the GNU General Public License Version 2 or later (the "GPL"), in
# which case the provisions of the GPL are applicable instead of those
# above. If you wish to allow use of your version of this file only
# under the terms of the GPL and not to allow others to use your
# version of this file under the MPL, indicate your decision by
# deleting the provisions above and replace them with the notice and
# other provisions required by the GPL. If you do not delete the
# provisions above, a recipient may use your version of this file
# under either the MPL or the GPL.
package PLIF::Service::Dispatcher;
use strict;
use vars qw(@ISA);
use PLIF::Service;
@ISA = qw(PLIF::Service);
1;
sub provides {
my $class = shift;
my($service) = @_;
return ($service eq 'commands.dispatcher' or $class->SUPER::provides($service));
}
sub dispatch {
my $self = shift;
my($app, $command) = @_;
my $method = $self->can('cmd'.$command);
if ($method) {
&$method($self, $app);
return 1;
} else {
return undef;
}
}

View File

@ -125,3 +125,11 @@ only if they are well commented.
is 'init'), then the methods you are overriding, then the new
methods, then the destructor ('DESTROY'). This isn't cast in stone
though. Whatever works best.
Further notes:
You'll notice PLIF doesn't use prototypes. This is because Perl
doesn't support prototypes for method calls.
- end -