Bommels05/Mozilla
Bommels05/Mozilla
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

work in progress

Browse Source 
git-svn-id: svn://10.0.0.236/trunk@94031 18797224-902f-48f8-a5cc-f745e15eee43
This commit is contained in:
ian%hixie.ch 2001-05-05 07:12:56 +00:00
parent 2f7e9262c9
commit 72c3f78013
34 changed files with 4191 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

467
mozilla/webtools/PLIF/Documentation.txt Normal file
View File

@ -0,0 +1,467 @@
_______________________
CHAPTER 1: INTRODUCTION
| Wherein the author whines about the people who asked for this
| document and denies all responsability for its upkeep.
People said they wanted documentation.
So.
Here it is.
Documentation.
Not that it's going to be very thorough or anything. Since I change
major parts of my codebase on an hourly basis, and I update the
documentation on an annual basis, this is not going to be of much use
to anyone who expects it to be accurate.
I warn you right now: if you complain about inaccuracies, I'll just
give up any pretense of writing documentation.
______________________
CHAPTER 2: THE CONCEPT
| Wherein services are explained to be the Saviour of the human race
| and an attempt is made to remove some of their mystery.
Services are a key concept to the PLIF architecture. They are the PLIF
version of XPCOM components, DOM interfaces, C++ pure virtual classes
or operating system APIs. They abstract out functionality using Perl's
polymorphism support so as to make consumers implementation-agnostic.
66-----------------------+
| But what does it all |
| _mean_, Austin? |
+-----------------------99
Imagine you want to order Pizza. The typical thing to do is call
Domino's Pizza, place your order, and await the food at your front
door. But what if you're on holiday, and Domino's aren't available in
that area? Your call fails, because you are unable to get Domino's to
ship pizza to you from your home town to your hotel on a different
continent, and thus you starve and die.
Clearly this is suboptimal.
Here is an alternative way of ordering pizza. Instead of picking up
the telephone, you pick up the business directory (aka, the yellow
pages). You look up "pizza takeaway" and search for the first entry
that claims to support deliveries. (I say "claims to support" because
marketing departments are often out of touch with reality.) Next, you
pick up the phone, and dial the appropriate number, without any
attempt to remember this number. You give the details of what you want
delivered. You wait for it to be delivered.
What's the difference, here? Well, there are several. First of all,
you have no idea what business you purchased your food from. Second,
your choice will be affected by the order in which the businesses are
listen in the directory, typically alphabetical, and not by previous
experience, food quality, or prices.
What on earth does this have to do with Perl?
Well, clearly you need to eat Pizza in order to code. Also, it just
struck me that this is in fact a good metaphor for the whole PLIF
thing that someone mentioned earlier. See Table 1.
Real Life | Perl Program
--------------------+-----------------------------------------
Telephone Call | Perl Method Call
Ordering Pizza | Processing Data
Business | A Perl Module
Domino's Pizza | A Specific Perl Module
Pizza | The Method Call Return Value
Front Door | Where The Method Call Returns Its Value
Holiday | Unexpected Environment
Business Directory | A List Of Perl Modules
Deliveries | A Particular Perl Method In A Module
--------------------+-----------------------------------------
Table 1: A mapping of the real life example to the perl program
equivalent, in case the metaphor wasn't blindingly obvious.
Let's be more specific. Say you have a record ID, and you want to get
the data that it refers to out of the database. For simplicity, we
will assume that our database merely associates each number with a
string. So. In the Old World, you would do something like:
SendSQL("select string from data where id = $id");
my $string;
if (@row = FetchSQLData()) {
$string = $row[0];
} else {
$string = '';
}
# do something with $string...
That has some flaws: for example, what happens when you want to change
from SQL queries to QBE queries? What about if the fields in the
database change name?
Instead, what you want to do is delegate the task of querying the
database to some other module, known as a "data source", and merely
concern yourself with getting said data from the data source. To do
this, you first need to get a hold of the data source. The problem is
that you have no idea what data source to use -- do you want the
default SQL database data source or the default database QBE data
source? What about if neither of these exist, but someone will provide
a third type that you don't know about yet?
So instead, you merely ask a central controlling entity -- a registry,
or directory, of all known data sources -- for the data source that
deals with the default database. You then call predefined methods in
the data source. The code would look something like:
my $string = $app->getService('dataSource.default')->getString($app, $id);
# do something with $string...
There are several things to notice here. First of all, to get hold of
the data source we said:
$app->getService('dataSource.default')
That tells us that $app is the controller -- that is to say, the
central registry of all data sources is the main application
object. More on this later. It also tells us that the method used to
get the data source is called "getService".
You may be asking yourself why it is called "getService" instead of
the more obvious "getDataSource".
Well, data sources are not the only thing that you might want to get a
hold of. All the input and output is done using this technique -- so
that the main code doesn't need to know it's talking to IRC or over
HTTP to do its work. More on this later.
The general term for all these different interfaces is "services".
Hence, the name of the method is "getService" -- it gets the
appropriate service. I tried making it more obvious, but it was hard,
so I gave up. There are several other methods that return services,
and they are explained in the chapter describing the workings of the
application object.
You should also notice that getService() gets passed a string -- that
string is used to determine whether or not each registered module
provides the service or not. ("Providing a service" is called
"implementing an interface" in COM terms, I believe.)
The string is generally opaque, although that depends on the
module. What I mean by "opaque" is that modules don't try to parse it
to work out whether or not to claim to support a particular service.
The next thing to notice is that getService() returns an object, and
that it is therefore directly used as such -- the method on the data
source is invoked straight off the return value of the getService()
call, and it is the results of the getString() call on the service
that is stored in $string.
So, in summary: If you want to do something that might be done in
several different ways and the code you are immediately dealing with
doesn't need to know the difference, then you would implement the
'something' as a Service and use the 'getService()' method on the
application object to get a reference to an instance of the service.
Questions raised by this:
1. How do you implement a service?
2. How do you use getService?
3. How do you get an application object?
4. How much should you tip the delivery guy?
We shall cover each of these questions, eventually. First, however,
I'm going to go on a totally different tangent because I am bored with
services now and what to talk about warnings and stuff.
______________________________
CHAPTER 3: PLIF ERROR HANDLING
| Wherein it is first claimed that PLIF has great tools for error
| handling but then that is shown to be totally untrue.
The root of (almost) every PLIF class is the "PLIF" class. What that
means is that at (almost) any point in PLIF-based code, you can use
methods that are part of the core PLIF class. Now, there aren't many
of them, so you'd better make the most of it!
The methods that are of interest to us right now are the following
five debugging aids:
dump(level, message)
Prints the message to standard error. The level argument is a
number, typically in the range of 0-9, stating the verbosity of the
message. Users of your application (as in, the people who install
it, not the people who use it on a daily basis) can change the
debugging level that is printed, so if you have a lot of
dump(9,'verbose debugging information') calls they can easily turn
them off. 0 is the most serious, 9 is the most trivial.
warn(level, message)
Same as dump(), but includes a stack trace.
error(level, message)
Same as warn(), but raises an exception as well. (You can catch
exceptions using eval{}.)
assert(condition, level, message)
Calls error() if condition is true.
notImplemented()
Calls error() with predefined arguments.
These tools are a great help. They should prevent you from ever
needing to use print() debugging, for instance. They allow you to
quickly wrap null pointer checks and the like in unobtrusive one
liners while supporting decent amounts of debugging information.
They also allow us to later reimplement the debugging code to add
better support for debuggers or pretty printing or mailing errors to
admins or whatever.
Unfortunately, using these utility methods to report errors can result
in suboptimal feedback to the user, and so should only be used to
report errors that you really were not expecting, such as missing
configuration files, errors sending mail, failures when connecting to
databases, and so on. For errors in user data, e.g. wrong password,
unknown requests, out of range input and the like, you want to report
the errors using the usual techniques of error codes and callbacks.
(Note. These debugging methods are _class methods_ and therefore you
do not need to ensure that $self is a reference before calling them.)
_________________________________
CHAPTER 4: IMPLEMENTING A SERVICE
| Wherein examples modules are provided on the grounds that they will
| enable the reader to learn how to create modules on their own, but
| with the knowledge that in practice the said examples will only be
| used for the purposes of copy and pasting.
Implementing a service is relatively easy. To demonstrate this, we
shall be implementing a "vendingMachine" service. First, we need to
define what we mean by a "vendingMachine" service, then we need to
define the API, and finally we shall implement it.
Concept Definition. You have to decide when you expect to use the
service -- in this case, it will be called by other parts of the
application when they need some food. The name of the service is
important. In this case, it's just a generic "vendingMachine", but
subtypes could include variants called "vendingMachine.drinks" or
"vendingMachine.sweets", for instance. One example of this in the PLIF
code is all the "dataSource.X" services, which all implement a basic
set of functionality that is used by other parts of the code when they
are passed a data source without knowning what it is.
API Definition. Now, having decided what we think the service is for,
we come to the second step, namely defining the API. This is just as
hard, and in my experience it takes a lot of attempts before you have
one you are happy with.
We're going to say that "vendingMachine" offers these methods:
insertCoins(amount)
Increases the amount of money assumed to be inside the vending
machine. Returns the result amount of cash.
selectSlot(slot)
Decreases the amount of money assumed to be inside the vending
machine and returns a string describing the product that occupied
the slot specified. Returns undef if there was not enough money.
refund()
Returns the amount of money in the machine, and sets it to zero.
Implementation. This is the fun part. Depending on the service, it can
also be the easiest.
I write my Perl modules in Emacs, so first I have a mode line:
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil; -*-
#
Next comes the license, in this case MPL/GPL:
# 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.
At last, some code! The first line is the Perl code saying what the
name of the package is:
package VendingMachine::Empty;
Hmm. It appears I've opted for implementing the Empty version of the
service. This ought the be fun. Next comes a bit of standard stuff:
use strict;
use vars qw(@ISA);
That's always there. "use strict" ensures that we avoid the worst of
ugly Perl, and "use vars" is required by the "use strict".
Next, we need to define what module we are inheriting from.
use PLIF::Service;
@ISA = qw(PLIF::Service);
All services must inherit from PLIF::Service or a descendant of that
module (e.g. VendingMachine::Empty!).
1;
This ensures that this module will return true. It's a Perlism.
Ok, finally the real meat. We have to claim that we provide the
vending machine service! This is done using a "provides" method:
sub provides {
my $class = shift;
my($service) = @_;
return ($service eq 'vendingMachine' or $class->SUPER::provides($service));
}
What this does is return true if the caller asked if we provide a
"vendingMachine" service, and otherwise it defers to the inherited
method. You'll notice this is a class method -- at this point, the
$class variable is probably a class and not necessarily an object.
Next we implement a constructor. (This is actually a method called by
the constructor. Just treat it like a constructor in other languages
and you'll be fine.) We need a constructor because we need to
initialise the amount of money to zero (as opposed to undefined).
sub init {
my $self = shift;
$self->SUPER::init(@_);
my($app) = @_;
$self->money(0);
}
Wowee, lots of PLIFisms there! Let's look at each one in turn. The
first line of the body sets the $self variable to be the reference to
the object. If you are familiar with JavaScript, think "this".
The second line calls the inherited constructor with the same
arguments as was passed to _this_ constructor.
Speaking of which, the arguments are sorted out on the third
line. Most services will be given just one argument on construction,
namely a reference to the application. It is vital that services not
hold on to this! See the Weak References chapter for more details.
Finally, the fourth line is pure fun. Due to some magical fu described
in a later chapter, you can use the syntax shown to set a "field" of
the object to 0. You can also get the value using a call without any
arguments, as in "$self->money". More on this later.
Ok, so now we have to implement the methods that we claim to provide
by saying that we are a vending machine.
# Increases the amount of money assumed to be inside the vending
# machine. Returns the resulting amount of cash.
sub insertCoins {
my $self = shift;
my($money) = @_;
return $self->money($self->money + $money);
}
That method should be self-explanatory... First it sets $self, then it
sorts out the arguments (in this case just one, $money) and then it
uses the syntax described above to add $money to $self->money, which
it returns.
# Decreases the amount of money assumed to be inside the vending
# machine and returns a string describing the product that
# occupied the slot specified. Returns undef if there was not
# enough money.
sub selectSlot {
my $self = shift;
my($slot) = @_;
return undef;
}
The vending machine is empty, right? So that always return undef.
Finally, refund() -- lucky we are going to implement this, otherwise
people could never get their money back!
# Returns the amount of money in the machine, and sets it to zero.
sub refund {
my $self = shift;
my $money = $self->money;
$self->money(0);
return $money;
}
Ok! We have an implementation of a service!
In the next chapter we shall look at how to use it.
.############################## Everything above this line has
#################### BOOK MARK # already been sent to mozilla-webtools
'############################## in some form or another.
____________________________
CHAPTER 5: USING GET SERVICE
| Wherein a family of methods is brought to the front and examined as
| if for a college entrance exam, resulting in the discovery that one
| of the methods is not very bright.
At this point I shall mention that some services get more than just
the $app as an argument on construction...
__________________________________
CHAPTER 6: THE MAGIC OF PROPERTIES
| Wherein it is admitted that the last description of the PLIF class
| was incomplete and was missing some rather important facts.
propertyGet, propertySet, and friends.
__________________________
CHAPTER 7: WEAK REFERENCES
| or, Why The $app Variable Is Passed Religiously From Service To
| Service Without A Thought To Caching It and Why It Would Be Bad To
| Do Otherwise.
You no copy you go boom boom.
______________________________________
CHAPTER 8: THE MAIN APPLICATION OBJECT
| Wherein the reader is introduced to the concept of magic and is then
| walked through the steps of taming the magic for his own purposes.
Or not.
___________________________
CHAPTER 9: INPUT AND OUTPUT
| Wherein the magic of $app->input and $app->output is explained.
Some day.
_____________________
CHAPTER n: CONCLUSION
| Wherein it is revealed that all is subject to change, only available
| while stocks last, and void where prohibited by law.
The End.

268
mozilla/webtools/PLIF/PLIF.pm Normal file
View File

@ -0,0 +1,268 @@
# -*- 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;
use strict; # require strict adherence to perl standards
use vars qw($AUTOLOAD); # it's a package global
use Carp qw(cluck confess); # stack trace versions of warn and die
my $DEBUG = 9; # level of warnings and dumps to print to STDERR (none go to user)
my $USER = 3; # level of errors to report to user (all go to STDERR)
my @FATAL = (); # a list of pointers to functions that want to report errors to the user
my $LOCKED = 0; # set to '1' while we are calling the error reporting code
1;
# PLIF = Program Logic Insulation Framework
# Levels are assumed to be something along the following:
# 0 = total failure: e.g. no input or output devices
# 1 = fatal errors: e.g. missing databases, broken connections, out of disk space
# 2 = security: e.g. warnings about repeated cracking attempts
# 3 = non-fatal errors: e.g. propagation of eval() errors as warnings
# 4 = important warnings (e.g. unexpected but possibly legitimate lack of data)
# 5 = important events (e.g. application started)
# 6 =
# 7 = typical checkpoints (e.g. someone tried to do some output)
# 8 =
# 9 = verbose debugging information
# 10 = ridiculously verbose debugging spam
# Note. All of the methods described in this class except for the
# propertyGet, propertySet and propertyExists methods are class
# methods. You can call "$class->notImplemented" without a problem.
# provide a standard virtual constructor
# if already created, merely return $self
sub create {
my $class = shift;
if (ref($class)) {
return $class; # already created, return self
} else {
return $class->bless(@_); # call our real constructor
}
}
# provide a constructor that always constructs a new copy of the
# class. This is used by services that implement factories for objects
# implemented in the same class (e.g., session objects do this).
sub bless {
my $class = shift;
if (ref($class)) {
$class = ref($class);
}
my $self = {};
CORE::bless($self, $class);
$self->init(@_);
return $self;
}
sub init {} # stub
# provide method-like access for any scalars in $self
sub AUTOLOAD {
my $self = shift;
my $name = $AUTOLOAD;
$name =~ s/^.*://o; # strip fully-qualified portion
if ($self->propertyImpliedAccessAllowed($name)) {
if (scalar(@_) == 1) {
$self->dump(10, "setting implied property $name in $self");
return $self->propertySet($name, @_);
} elsif (scalar(@_) == 0) {
if ($self->propertyExists($name)) {
$self->dump(10, "getting implied property $name in $self");
return $self->propertyGet($name);
} else {
$self->dump(10, "not getting non-existent implied property $name in $self");
return $self->propertyGetUndefined($name);
}
}
$self->dump(10, "neither setting nor getting implied property $name in $self");
} else {
$self->dump(10, "not treating $name in $self as an implied property, regardless of its existence");
}
$self->methodMissing($AUTOLOAD);
}
sub propertySet {
# this is not a class method
my $self = shift;
my($name, $value) = @_;
return $self->{$name} = $value;
}
sub propertyExists {
# this is not a class method
my $self = shift;
my($name) = @_;
$self->assert($name, 0, 'propertyExists() cannot be called without arguments');
$self->dump(10, "checking for existence of property $name in $self");
return exists($self->{$name});
}
sub propertyImpliedAccessAllowed {
# this is not (supposed to be) a class method
# my $self = shift;
# my($name) = @_;
# $self->assert($name, 0, 'propertyImpliedAccessAllowed() cannot be called without arguments');
return 1;
}
sub propertyGet {
# this is not a class method
my $self = shift;
my($name) = @_;
return $self->{$name};
}
sub propertyGetUndefined {
return undef;
}
sub methodMissing {
my $self = shift;
my($method) = @_;
$self->error(0, "Internal Error: Tried to access non-existent method $method in object $self");
}
# DEBUGGING AIDS
sub dump {
my $self = shift;
my($level, @data) = @_;
if ($self->isAtDebugLevel($level)) {
foreach (@data) {
print STDERR "$0: $_\n";
}
}
}
sub warn {
my $self = shift;
my($level, @data) = @_;
if ($self->isAtDebugLevel($level)) {
$self->dump($level, ('-'x12).' Start of Warning Stack Trace '.('-'x12));
cluck(@data); # warn with stack trace
$self->dump($level, ('-'x12). ('-'x30) .('-'x12));
}
}
sub error {
my $self = shift;
my($level, @data) = @_;
$self->dump(9, "error raised: $data[0]");
if ($self->isAtUserLevel($level) and not $LOCKED) {
$LOCKED = 1;
$self->dump(10, 'calling @FATAL error handlers...');
foreach my $entry (@FATAL) {
eval {
&{$entry->[1]}(@data);
};
if ($@) {
$self->warn(3, 'Error occured during \@FATAL callback of object \''.($entry->[0])."': $@");
}
}
$self->dump(10, 'done calling @FATAL error handlers');
$LOCKED = 0;
}
confess(@data); # die with stack trace
}
sub assert {
my $self = shift;
my($condition, $level, @data) = @_;
if (not $condition) {
$self->error($level, @data);
}
}
sub notImplemented {
my $self = shift;
$self->error(0, 'Internal Error: Method not implemented');
}
# returns true only if the argument is a debug level that is at least
# as important as the local value of $DEBUG.
sub isAtDebugLevel {
my $self = shift;
my($level) = @_;
return ($level <= $DEBUG);
}
# returns true only if the argument is a debug level that is at least
# as important as the local value of $USER.
sub isAtUserLevel {
my $self = shift;
my($level) = @_;
return ($level <= $USER);
}
# returns a reference to the $DEBUG variable for configuration
# purposes
sub getDebugLevel {
return \$DEBUG;
}
# returns a reference to the $USER variable for configuration purposes
sub getUserLevel {
return \$USER;
}
# returns a reference to the @FATAL variable for modules that have
# very exotic needs
sub getFatalHandlerList {
return \@FATAL;
}
# returns a reference to the $LOCKED variable for modules that which
# to block @FATAL reporting
sub getFatalHandlerLock {
return \$LOCKED;
}
# if you call this, make sure that you call the next function too,
# guarenteed, otherwise you will never be freed until the app dies.
# of course, if you _are_ the app then I guess it's ok...
sub enableErrorReporting {
my $self = shift;
push(@FATAL, [$self, sub { $self->fatalError(@_); }]);
}
sub disableErrorReporting {
my $self = shift;
my @OLDFATAL = @FATAL;
@FATAL = ();
foreach my $entry (@OLDFATAL) {
if ($entry->[0] != $self) {
push(@FATAL, $entry);
}
}
}
sub fatalError {} # stub
sub DESTROY {} # stub

98
mozilla/webtools/PLIF/PLIF/Application.pm Normal file
View File

@ -0,0 +1,98 @@
# -*- 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::Application;
use strict;
use vars qw(@ISA);
@ISA = qw(PLIF::Program);
require PLIF::Program; # see note below
1;
# Note: this module "require"s PLIF::Program (as opposed to "use"ing
# it) because that module will try to call 'main'->create, which won't
# work if the module is parsed during compilation instead of during
# execution. For the same reason, the @ISA line is above the
# require. All modules that have PLIF::Application as an ancestor need
# to do this.
#
# In theory, if you use PLIF::Application, the class tree should look
# like this:
#
# PLIF (the core module)
# |
# PLIF::Controller (defines the service management)
# |
# PLIF::Program (defines things like 'input' and 'output')
# |
# PLIF::Application (defines the generic command dispatcher)
# |
# A PLIF Shell (bootstraps PLIF::Application)
#
# However, you might want to skip the PLIF::Application layer if all
# you are doing is writing a `simple' utility (although frankly I
# would doubt your choice of PLIF as an infrastructure if all you are
# looking for is a `simple' utility -- HTTP content negotiation and
# database-agnostic logic is probably a bit of an overkill there...).
#
# If you are writing an application that uses PLIF for some part of
# the work, but not for input and output, then you would probably
# inherit straight from PLIF::Controller, and only use the getService
# call (and friends).
# find either a service or a one-shot object that claims to implement
# 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))) {
$self->SUPER::dispatch(@_);
}
}
sub registerServices {
my $self = shift;
$self->SUPER::registerServices(@_);
$self->registerDefaultServices();
$self->registerInstalledServices();
}
sub registerDefaultServices {
my $self = shift;
# install the configuration system
$self->register(qw(PLIF::DataSource::Configuration PLIF::Database::ConfigurationFile));
}
sub registerInstalledServices {
my $self = shift;
# install the modules from the configuration database
my $modules = $self->getService('dataSource.configuration')->getInstalledModules($self);
if (defined($modules)) {
$self->register(@$modules);
}
}

194
mozilla/webtools/PLIF/PLIF/Controller.pm Normal file
View File

@ -0,0 +1,194 @@
# -*- 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::Controller;
use strict;
use vars qw(@ISA);
use PLIF;
use PLIF::MagicPipingArray;
use PLIF::MagicSelectingArray;
@ISA = qw(PLIF);
1;
# setup everything (typically called from the constructor)
sub init {
my $self = shift;
$self->SUPER::init(@_);
# initialise our app name to be the name of the executable
$self->name($0); # may be overridden by descendants
# prepare the services array for the registration system
$self->services([]);
# perform the registration
$self->registerServices();
}
# should be called from the implementation of registerServices, should
# be passed a list similar to the @ISA list. The order matters, since
# services will be instantiated on a first-matched first-used basis
sub register {
my $self = shift;
foreach my $service (@_) {
push(@{$self->services}, $service);
my $file = $service;
# XXX THIS IS PLATFORM SPECIFIC CODE XXX
if ($^O eq 'linux') {
$file =~ s/::/\//go;
$file .= '.pm';
} else {
$self->error(0, "Platform '$^O' not supported yet.");
}
# XXX END OF PLATFORM SPECIFIC CODE XXX
eval {
require $file;
};
if ($@) {
$self->error(1, "Compile error in $file: $@");
}
}
}
# helper method for input verifiers to add instantiated service
# objects specific to the current state (e.g. the current user in an
# event loop). These should be wiped out when the state changes
# (e.g. at the start of an event loop).
sub addObject {
my $self = shift;
foreach my $object (@_) {
push(@{$self->objects}, $object);
}
}
sub getService {
my $self = shift;
my($name) = @_;
foreach my $service (@{$self->services}) {
if ($service->provides($name)) {
# Create the service. If it is already created, this will
# just return the object reference, so no harm done.
# IT IS ABSOLUTELY IMPERATIVE THAT NO SERVICE EVER HOLD ON
# TO THE $self ARGUMENT PASSED TO THE CONSTRUCTOR!
# Doing so would create a circular dependency, resulting
# in a memory leak.
$service = $service->create($self);
return $service;
}
}
return undef;
}
sub getObject {
# same as getService but on the objects list and without the
# constructor call
my $self = shift;
my($name) = @_;
foreach my $service (@{$self->objects}) {
if ($service->provides($name)) {
return $service;
}
}
return undef;
}
sub getServiceList {
my $self = shift;
my($name) = @_;
my @services;
foreach my $service (@{$self->services}) {
if ($service->provides($name)) {
# Create the service. If it is already created, this will
# just return the object reference, so no harm done.
# IT IS ABSOLUTELY IMPERATIVE THAT NO SERVICE EVER HOLD ON
# 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));
}
}
return @services;
}
sub getObjectList {
# same as getServiceList but on the objects list and without the
# constructor call
my $self = shift;
my($name) = @_;
my @services;
foreach my $service (@{$self->objects}) {
if ($service->provides($name)) {
push(@services, $service);
}
}
return @services;
}
sub getSelectingServiceList {
my $self = shift;
return PLIF::MagicSelectingArray->create($self->getServiceList(@_));
}
sub getSelectingObjectList {
my $self = shift;
return PLIF::MagicSelectingArray->create($self->getObjectList(@_));
}
sub getPipingServiceList {
my $self = shift;
return PLIF::MagicPipingArray->create($self->getServiceList(@_));
}
sub getPipingObjectList {
my $self = shift;
return PLIF::MagicPipingArray->create($self->getObjectList(@_));
}
sub getServiceInstance {
my $self = shift;
my($name, @data) = @_;
foreach my $service (@{$self->services}) {
if ($service->provides($name)) {
# Create and return the service instance, without storing
# a copy.
# This is the only time it is safe for a service to store
# a reference to us. This is because here no reference to
# the service is being held by us, so the moment the
# service goes out of scope, it will be freed.
# IMPORTANT! DON'T HOLD ON TO A SERVICE INSTANCE OBJECT!
local $" = '\', \'';
return $service->create($self, @data);
}
}
return undef;
}
# there's no getObjectInstance since objects already are instances...
# Implementation Specific Methods
# These should be overriden by real programs
sub registerServices {} # stub

88
mozilla/webtools/PLIF/PLIF/DataSource.pm Normal file
View File

@ -0,0 +1,88 @@
# -*- 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::DataSource;
use strict;
use vars qw(@ISA);
use PLIF::Service;
@ISA = qw(PLIF::Service);
1;
sub database {
my $self = shift;
my($app) = @_;
# do we have a cached, checked copy?
if (defined($self->{'_database'})) {
# yes, return it
return $self->{'_database'};
}
# no, find the relevant database and return it
my @databases = $app->getServiceList('database.'.$self->databaseName);
foreach my $database (@databases) {
foreach my $type ($self->databaseType) {
if ($type eq $database->type) {
$self->{'_database'} = $database;
return $database;
}
}
}
$self->error(1, 'Configuration Error: There is no suitable \''.$self->databaseName.'\' database installed.');
}
sub helper {
my $self = shift;
my($app) = @_;
# do we have a cached, checked copy?
if (defined($self->{'_helper'})) {
# yes, return it
return $self->{'_helper'};
}
# no, find the relevant database helper and return it
my @helpers = $app->getServiceList('database.helper');
foreach my $helper (@helpers) {
foreach my $helperType ($helper->databaseType) {
foreach my $sourceType ($self->databaseType) {
if ($helperType eq $sourceType) {
$self->{'_helper'} = $helper;
return $helper;
}
}
}
}
$self->error(1, 'Configuration Error: There is no database helper suitable for the \''.$self->databaseName.'\' database installed.');
}
sub databaseName {
my $self = shift;
$self->notImplemented();
}
sub databaseType {
my $self = shift;
$self->notImplemented();
}

109
mozilla/webtools/PLIF/PLIF/DataSource/Configuration.pm Normal file
View File

@ -0,0 +1,109 @@
# -*- 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::DataSource::Configuration;
use strict;
use vars qw(@ISA);
use PLIF::DataSource;
@ISA = qw(PLIF::DataSource);
1;
sub provides {
my $class = shift;
my($service) = @_;
return ($service eq 'dataSource.configuration' or $service eq 'setup.configure' or $class->SUPER::provides($service));
}
sub databaseName {
return 'configuration';
}
sub databaseType {
return 'property';
}
# Configuration API Implementation Follows
sub configurationFilename {
return '.PLIF';
}
sub setupConfigure {
my $self = shift;
my($app) = @_;
$self->dump(9, 'about to configure Configuration data source...');
eval {
# if it failed earlier but without crashing the app, then it
# will fail again (we only stop trying once it works)
$self->database($app)->ensureRead();
};
if ($@) {
# well, that didn't go down too well. Let's create a brand
# spanking new configuration file, since they clearly don't
# have one.
$self->database($app)->assumeRead(); # new file at the ready
# options should now be set by the users of the datasource.
}
$self->dump(9, 'done configuring Configuration data source');
return; # no problems
}
sub getInstalledModules {
my $self = shift;
my($app) = @_;
return $self->database($app)->propertyGet('PLIF.modulesList');
}
sub setInstalledModules {
my $self = shift;
my($app, $value) = @_;
$self->database($app)->propertySet('PLIF.modulesList', $value);
}
sub getDBIDatabaseSettings {
my $self = shift;
my($app, $database) = @_;
my $configuration = $self->database($app);
my $prefix = 'database.'.$database->class;
foreach my $property ($database->settings) {
my $value = $configuration->propertyGet("$prefix.$property");
$self->assert($value, 1, "The configuration is missing a valid value for '$prefix.$property'");
$database->propertySet($property, $value);
}
}
sub setDBIDatabaseSettings {
my $self = shift;
my($app, $database) = @_;
my $configuration = $self->database($app);
my $prefix = 'database.'.$database->class;
foreach my $property ($database->settings) {
$configuration->propertySet("$prefix.$property", $database->propertyGet($property));
}
}

178
mozilla/webtools/PLIF/PLIF/DataSource/Strings.pm Normal file
View File

@ -0,0 +1,178 @@
# -*- 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::DataSource::Strings;
use strict;
use vars qw(@ISA);
use PLIF::DataSource;
use HTTP::Negotiate; # DEPENDENCY
use HTTP::Headers; # DEPENDENCY
@ISA = qw(PLIF::DataSource);
1;
sub provides {
my $class = shift;
my($service) = @_;
return ($service eq 'dataSource.strings' or $service eq 'setup.install' or $class->SUPER::provides($service));
}
sub init {
my $self = shift;
$self->SUPER::init(@_);
$self->variantsCache({});
}
sub databaseName {
return 'default';
}
sub get {
my $self = shift;
my($app, $session, $protocol, $string) = @_;
# error handling makes code ugly :-)
my $variant;
if (defined($session)) {
$variant = $session->selectVariant($app, $protocol);
}
if (not defined($variant)) {
# default session or $session didn't care, get stuff from
# $app->input instead
$variant = $self->selectVariant($app, $protocol);
}
my $result;
eval {
$self->getString($app, $variant, $string);
};
if ($@) {
# ok, so, er, it seems that didn't go to well
# XXX do we want to do an error here or something?
$self->warn(4, "While I was looking for the string '$string' in protocol '$protocol' using variant '$variant', I failed with: $@");
}
if (not defined($result)) {
$result = $self->getDefaultString($app, $protocol, $string);
$self->assert($result, 1, "Couldn't find a string to display for '$string' in protocol '$protocol'");
}
return $result;
}
sub selectVariant {
my $self = shift;
my($app, $protocol) = @_;
# Find list of options from DB.
my $variants = $self->variants($app, $protocol);
# Initialize the fake header
my $request = new HTTP::Headers;
foreach my $header (['Accept', $self->acceptType($app, $protocol)],
['Accept-Encoding', $self->acceptEncoding($app, $protocol)],
['Accept-Charset', $self->acceptCharset($app, $protocol)],
['Accept-Language', $self->acceptLanguage($app, $protocol)]) {
# only add headers that exist -- HTTP::Negotiate isn't very bullet-proof :-)
if ($header->[1]) {
$request->header(@$header);
}
}
# Do Content Negotiation :-D
my $choice;
if (scalar(@$variants) > 0) {
# $HTTP::Negotiate::DEBUG = 1; # enable debugging
$choice = choose($variants, $request);
}
if (not defined($choice)) {
$choice = 0; # XXX we could maybe not hard code the default variant some how... ;-)
}
return $choice;
}
# Variants returns an arrayref or arrayrefs, typically to be passed to
# HTTP::Negotiate, containing:
# variant id, quality, content type, encoding, character set,
# language, size
# Note that we don't support 'size', since doing so would require the
# unbelivably slow operation of calculating the length of the every
# possible string for everyone. No thanks. ;-)
sub variants {
my $self = shift;
my($app, $protocol) = @_;
if (not defined($self->variantsCache->{$protocol})) {
eval {
$self->variantsCache->{$protocol} = $self->getVariants($app, $protocol);
};
if ($@) {
# ok, so, er, it seems that didn't go to well
# XXX do we want to do an error here or something?
$self->warn(4, "Just so you know, I'm going to silently ignore the fact that I completely failed to get any variants... For what it's worth, the error was: $@");
return []; # no variants here, no sir!
}
}
return $self->variantsCache->{$protocol};
}
sub acceptType {
my $self = shift;
my($app, $protocol) = @_;
return $app->input->acceptType;
}
sub acceptEncoding {
my $self = shift;
my($app, $protocol) = @_;
return $app->input->acceptEncoding;
}
sub acceptCharset {
my $self = shift;
my($app, $protocol) = @_;
return $app->input->acceptCharset;
}
sub acceptLanguage {
my $self = shift;
my($app, $protocol) = @_;
return $app->input->acceptLanguage;
}
sub getString {
my $self = shift;
$self->notImplemented();
}
sub getDefaultString {
my $self = shift;
my($app, $protocol, $string) = @_;
return $app->getSelectingServiceList('dataSource.strings.default')->get($app, $protocol, $string);
}
sub getVariants {
my $self = shift;
$self->notImplemented();
}
sub setupInstall {
my $self = shift;
$self->notImplemented();
}

88
mozilla/webtools/PLIF/PLIF/DataSource/Strings/MySQL.pm Normal file
View File

@ -0,0 +1,88 @@
# -*- 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::DataSource::Strings::MySQL;
use strict;
use vars qw(@ISA);
use PLIF::DataSource::Strings;
@ISA = qw(PLIF::DataSource::Strings);
1;
sub databaseType {
return qw(mysql);
}
sub getString {
my $self = shift;
my($app, $variant, $string) = @_;
return $self->database($app)->execute("SELECT data FROM strings WHERE variant = ? string = ?", $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;
}
sub setupInstall {
my $self = shift;
my($app) = @_;
my $helper = $self->helper($app);
if (not $helper->tableExists($app, $self->database($app), 'stringVariants')) {
$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,
encoding varchar(255),
type varchar(255) not null,
charset varchar(255),
language varchar(255) not null,
quality float not null default 1.0,
description text,
translator varchar(255),
unique index (name)
);
');
} else {
# check its schema is up to date
}
if (not $helper->tableExists($app, $self->database($app), 'strings')) {
$self->database($app)->execute('
CREATE TABLE strings (
variant integer unsigned not null,
name varchar(32) not null,
data text,
primary key (variant, name)
);
');
} else {
# check its schema is up to date
}
return;
}

49
mozilla/webtools/PLIF/PLIF/Database.pm Normal file
View File

@ -0,0 +1,49 @@
# -*- 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::Database;
use strict;
use vars qw(@ISA);
use PLIF::Service;
@ISA = qw(PLIF::Service);
1;
sub provides {
my $class = shift;
my($service) = @_;
return ($service eq 'database.'.$class->class or $class->SUPER::provides($service));
}
sub class {
return 'undefined';
}
sub type {
my $self = shift;
return $self->SUPER::type(@_);
}

145
mozilla/webtools/PLIF/PLIF/Database/ConfigurationFile.pm Normal file
View File

@ -0,0 +1,145 @@
# -*- 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::Database::ConfigurationFile;
use strict;
use vars qw(@ISA);
use PLIF::Database;
use Data::Dumper; # DEPENDENCY
@ISA = qw(PLIF::Database);
1;
# WARNING XXX
# Reading without create a file first will FAIL!
#
# You must run the equivalent of an installer program to ensure the
# configuration file exists
sub init {
my $self = shift;
$self->SUPER::init(@_);
my($app) = @_;
$self->{'_FILENAME'} = $app->getService('dataSource.configuration')->configurationFilename;
}
sub class {
return 'configuration';
}
sub type {
return 'property';
}
sub filename {
my $self = shift;
return $self->{'_FILENAME'};
}
# typically uou won't call this directly, but will ese ensureRead below.
sub read {
my $self = shift;
$self->{'_DIRTY'} = undef; # to prevent recursion: eval -> propertySet -> ensureRead (dirty check) -> read -> eval
my $filename = $self->filename;
local *FILE; # ugh
$self->assert(open(FILE, "<$filename"), 1, "Could not open configuration file '$filename' for reading: $!");
local $/ = undef; # slurp entire file (no record delimiter)
my $settings = <FILE>;
$self->assert(close(FILE), 3, "Could not close configuration file '$filename': $!");
if ($settings) {
$settings =~ /^(.*)$/so;
eval($1); # untaint the configuration file
$self->assert(defined($@), 1, "Error processing configuration file '$filename': $@");
}
$self->{'_DIRTY'} = 0;
}
# reads the database unless that was already done
sub ensureRead {
my $self = shift;
if (not exists($self->{'_DIRTY'})) {
# not yet read configuration
$self->read();
}
}
# don't call this unless you know very well what you are doing
# it basically results in the file being overwritten (if you
# call it before using propertyGet, anyway)
sub assumeRead {
my $self = shift;
$self->{'_DIRTY'} = 0;
}
# typically you won't call this directly, but will just rely on the
# DESTROY handler below.
sub write {
my $self = shift;
my $filename = $self->filename;
local *FILE; # ugh
$self->assert(open(FILE, ">$filename"), 1, "Could not open configuration file '$filename' for writing: $!");
$self->assert(FILE->print("# This is the configuration file.\n# You may edit this file, so long as it remains valid Perl.\n"), 1,
"Could not store leading comments in '$filename': $!");
local $Data::Dumper::Terse = 1;
foreach my $variable (sort(keys(%$self))) {
if ($variable !~ /^_/o) { # we skip the internal variables (prefixed with '_')
my $contents = Data::Dumper->Dump([$self->{$variable}]);
chop($contents); # remove the newline
$self->assert(FILE->print("\$self->propertySet('$variable', $contents);\n"), 1,
"Could not dump variable '$variable' to configuration file '$filename': $!");
}
}
$self->assert(close(FILE), 1, "Could not close configuration file '$filename': $!");
$self->{'_DIRTY'} = 0;
}
sub propertySet {
my $self = shift;
$self->ensureRead();
my $result = $self->SUPER::propertySet(@_);
$self->{'_DIRTY'} = 1;
return $result;
}
sub propertyExists {
my $self = shift;
$self->ensureRead();
return $self->SUPER::propertyExists(@_);
}
sub propertyGet {
my $self = shift;
$self->ensureRead();
return $self->SUPER::propertyGet(@_);
}
sub DESTROY {
my $self = shift;
if ($self->{'_DIRTY'}) {
$self->write();
}
}

131
mozilla/webtools/PLIF/PLIF/Database/DBI.pm Normal file
View File

@ -0,0 +1,131 @@
# -*- 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::Database::DBI;
use strict;
use vars qw(@ISA);
use PLIF::Database;
use PLIF::Database::ResultsFrame::DBI;
use DBI; # DEPENDENCY
@ISA = qw(PLIF::Database);
1;
sub provides {
my $class = shift;
my($service) = @_;
return ($service eq 'setup.configure' or $class->SUPER::provides($service));
}
# the name used to identify this database in the configuration
sub class {
return 'default';
}
sub init {
my $self = shift;
$self->SUPER::init(@_);
my($app) = @_;
eval {
$self->getConfig($app);
my $type = $self->type;
my $name = $self->name;
my $host = $self->host;
my $port = $self->port;
$self->handle(DBI->connect("DBI:$type:$name:$host:$port",
$self->username, $self->password,
{RaiseError => 0, PrintError => 0, AutoCommit => 1}));
$self->errstr($DBI::errstr);
$self->dump(9, 'tried to connect to database without raising an exception!');
};
if ($@) {
$self->handle(undef);
$self->errstr($@);
$self->dump(9, "failed to connect to the database because of $@");
}
}
sub settings {
return qw(type name host port username password);
}
sub propertyGetUndefined {
my $self = shift;
my($name) = @_;
foreach my $property ($self->settings) {
if ($name eq $property) {
return '';
}
}
return $self->SUPER::propertyGetUndefined(@_);
}
sub execute {
my $self = shift;
my($statement, @values) = @_; # XXX does this not need $app to be passed?
$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?
}
sub getConfig {
my $self = shift;
my($app) = @_;
$app->getService('dataSource.configuration')->getDBIDatabaseSettings($app, $self);
}
sub setupConfigure {
my $self = shift;
my($app) = @_;
$self->dump(9, 'about to configure DBI...');
my $prefix = 'database.'.$self->class;
foreach my $property ($self->settings) {
# XXX need to be able to offer current configuration as default values!
if (not $self->propertyExists($property)) {
my $value = $app->input->getArgument("$prefix.$property");
$self->dump(9, "Setting value '$property' to '$value'");
if (defined($value)) {
$self->propertySet($property, $value);
} else {
return "$prefix.$property";
}
}
}
$app->getService('dataSource.configuration')->setDBIDatabaseSettings($app, $self);
$self->dump(9, 'done configuring DBI...');
return;
}
sub DESTROY {
my $self = shift;
if ($self->handle) {
$self->handle->disconnect();
$self->handle(undef);
}
$self->SUPER::DESTROY(@_);
}

57
mozilla/webtools/PLIF/PLIF/Database/ResultsFrame/DBI.pm Normal file
View File

@ -0,0 +1,57 @@
# -*- 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::Database::ResultsFrame::DBI;
use strict;
use vars qw(@ISA);
use PLIF;
use DBI;
@ISA = qw(PLIF);
1;
sub init {
my $self = shift;
$self->SUPER::init(@_);
my($handle) = @_;
$self->handle($handle);
}
sub row {
my $self = shift;
return $self->handle->fetchrow_array();
}
sub rows {
my $self = shift;
return $self->handle->fetchall_arrayref();
}
# other possible APIs:
# $ary_ref = $sth->fetchrow_arrayref;
# $hash_ref = $sth->fetchrow_hashref;

45
mozilla/webtools/PLIF/PLIF/DatabaseHelper.pm Normal file
View File

@ -0,0 +1,45 @@
# -*- 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::DatabaseHelper;
use strict;
use vars qw(@ISA);
use PLIF::Service;
@ISA = qw(PLIF::Service);
1;
sub provides {
my $class = shift;
my($service) = @_;
return ($service eq 'database.helper' or $class->SUPER::provides($service));
}
sub databaseType {
my $self = shift;
$self->notImplemented();
}

213
mozilla/webtools/PLIF/PLIF/DatabaseHelper/DBI.pm Normal file
View File

@ -0,0 +1,213 @@
# -*- 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::DatabaseHelper::DBI;
use strict;
use vars qw(@ISA);
use PLIF::DatabaseHelper;
@ISA = qw(PLIF::DatabaseHelper);
1;
sub databaseType {
return qw(mysql);
}
=over time i would expect the following to be implemented:
###########################################################################
# Detect changed local settings
###########################################################################
sub GetFieldDef ($$)
{
my ($table, $field) = @_;
my $sth = $dbh->prepare("SHOW COLUMNS FROM $table");
$sth->execute;
while (my $ref = $sth->fetchrow_arrayref) {
next if $$ref[0] ne $field;
return $ref;
}
}
sub GetIndexDef ($$)
{
my ($table, $field) = @_;
my $sth = $dbh->prepare("SHOW INDEX FROM $table");
$sth->execute;
while (my $ref = $sth->fetchrow_arrayref) {
next if $$ref[2] ne $field;
return $ref;
}
}
sub CountIndexes ($)
{
my ($table) = @_;
my $sth = $dbh->prepare("SHOW INDEX FROM $table");
$sth->execute;
if ( $sth->rows == -1 ) {
die ("Unexpected response while counting indexes in $table:" .
" \$sth->rows == -1");
}
return ($sth->rows);
}
sub DropIndexes ($)
{
my ($table) = @_;
my %SEEN;
# get the list of indexes
#
my $sth = $dbh->prepare("SHOW INDEX FROM $table");
$sth->execute;
# drop each index
#
while ( my $ref = $sth->fetchrow_arrayref) {
# note that some indexes are described by multiple rows in the
# index table, so we may have already dropped the index described
# in the current row.
#
next if exists $SEEN{$$ref[2]};
my $dropSth = $dbh->prepare("ALTER TABLE $table DROP INDEX $$ref[2]");
$dropSth->execute;
$dropSth->finish;
$SEEN{$$ref[2]} = 1;
}
}
#
# Check if the enums in the bugs table return the same values that are defined
# in the various locally changeable variables. If this is true, then alter the
# table definition.
#
sub CheckEnumField ($$@)
{
my ($table, $field, @against) = @_;
my $ref = GetFieldDef($table, $field);
#print "0: $$ref[0] 1: $$ref[1] 2: $$ref[2] 3: $$ref[3] 4: $$ref[4]\n";
$_ = "enum('" . join("','", @against) . "')";
if ($$ref[1] ne $_) {
print "Updating field $field in table $table ...\n";
$_ .= " NOT NULL" if $$ref[3];
$dbh->do("ALTER TABLE $table
CHANGE $field
$field $_");
$::regenerateshadow = 1;
}
}
###########################################################################
# Update the tables to the current definition
###########################################################################
#
# As time passes, fields in tables get deleted, added, changed and so on.
# So we need some helper subroutines to make this possible:
#
sub ChangeFieldType ($$$)
{
my ($table, $field, $newtype) = @_;
my $ref = GetFieldDef($table, $field);
#print "0: $$ref[0] 1: $$ref[1] 2: $$ref[2] 3: $$ref[3] 4: $$ref[4]\n";
my $oldtype = $ref->[1];
if ($ref->[4]) {
$oldtype .= qq{ default "$ref->[4]"};
}
if ($oldtype ne $newtype) {
print "Updating field type $field in table $table ...\n";
print "old: $oldtype\n";
print "new: $newtype\n";
$newtype .= " NOT NULL" if $$ref[3];
$dbh->do("ALTER TABLE $table
CHANGE $field
$field $newtype");
}
}
sub RenameField ($$$)
{
my ($table, $field, $newname) = @_;
my $ref = GetFieldDef($table, $field);
return unless $ref; # already fixed?
#print "0: $$ref[0] 1: $$ref[1] 2: $$ref[2] 3: $$ref[3] 4: $$ref[4]\n";
if ($$ref[1] ne $newname) {
print "Updating field $field in table $table ...\n";
my $type = $$ref[1];
$type .= " NOT NULL" if $$ref[3];
$dbh->do("ALTER TABLE $table
CHANGE $field
$newname $type");
}
}
sub AddField ($$$)
{
my ($table, $field, $definition) = @_;
my $ref = GetFieldDef($table, $field);
return if $ref; # already added?
print "Adding new field $field to table $table ...\n";
$dbh->do("ALTER TABLE $table
ADD COLUMN $field $definition");
}
sub DropField ($$)
{
my ($table, $field) = @_;
my $ref = GetFieldDef($table, $field);
return unless $ref; # already dropped?
print "Deleting unused field $field from table $table ...\n";
$dbh->do("ALTER TABLE $table
DROP COLUMN $field");
}
=cut

113
mozilla/webtools/PLIF/PLIF/Input.pm Normal file
View File

@ -0,0 +1,113 @@
# -*- 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::Input;
use strict;
use vars qw(@ISA);
use PLIF::Service;
@ISA = qw(PLIF::Service);
1;
sub provides {
my $class = shift;
my($service) = @_;
return (($service eq 'input' and $class->applies) or $class->SUPER::provides($service));
}
sub applies {
my $self = shift;
$self->notImplemented(); # this must be overriden by descendants
}
sub defaultOutputProtocol {
my $self = shift;
$self->notImplemented(); # this must be overriden by descendants
}
sub init {
my $self = shift;
my($app) = @_;
$self->SUPER::init(@_);
$self->app($app); # only safe because input services are created as service instances not pure services!!!
$self->fetchArguments();
}
sub next {
return 0;
}
sub fetchArguments {} # stub
# returns the argument, potentially after asking the user or whatever.
sub getArgument {
my $self = shift;
$self->notImplemented();
}
# returns the argument if it has been provided, otherwise undef.
sub peekArgument {
return undef;
}
# XXX I don't like having these here:
sub UA {
my $self = shift;
$self->notImplemented();
}
sub referrer {
my $self = shift;
$self->notImplemented();
}
sub host {
my $self = shift;
$self->notImplemented();
}
sub acceptType {
my $self = shift;
$self->notImplemented();
}
sub acceptCharset {
my $self = shift;
$self->notImplemented();
}
sub acceptEncoding {
my $self = shift;
$self->notImplemented();
}
sub acceptLanguage {
my $self = shift;
$self->notImplemented();
}

155
mozilla/webtools/PLIF/PLIF/Input/Arguments.pm Normal file
View File

@ -0,0 +1,155 @@
# -*- 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::Input::Arguments;
use strict;
use vars qw(@ISA);
use PLIF::Input;
@ISA = qw(PLIF::Input);
1;
sub fetchArguments {
my $self = shift;
$self->splitArguments();
$self->setCommandArgument();
}
# Returns the values given for that argument. In a scalar context,
# returns the first value (or undef if the argument was never
# given). In an array context, returns all the values given.
sub getArgument {
my $self = shift;
my($argument) = @_;
if (not defined($self->{"argument $argument"})) {
$self->createArgument($argument);
}
if (wantarray) {
return @{$self->{"argument $argument"}};
} else {
if (@{$self->{"argument $argument"}}) {
return $self->{"argument $argument"}->[0];
} else {
return undef;
}
}
}
# Returns the values given for that argument if it already exists,
# otherwise undef. In a scalar context, returns the first value (or
# undef if the argument was never given). In an array context, returns
# all the values given.
sub peekArgument {
my $self = shift;
my($argument) = @_;
if (defined($self->{"argument $argument"})) {
if (wantarray) {
return @{$self->{"argument $argument"}};
} elsif (@{$self->{"argument $argument"}}) {
return $self->{"argument $argument"}->[0];
}
}
return undef;
}
# Specifics of this implementation:
sub splitArguments {} # stub
sub addArgument {
my $self = shift;
my($argument, $value) = @_;
if (not defined($self->{"argument $argument"})) {
$self->{"argument $argument"} = [];
}
push(@{$self->{"argument $argument"}}, $value);
}
sub setArgument {
my $self = shift;
my($argument, @value) = @_;
$self->{"argument $argument"} = [@value];
}
# modifies the last value for this argument to the new value
sub pokeArgument {
my $self = shift;
my($argument, $newValue) = @_;
$self->assert(defined($self->{"argument $argument"}), 1, 'Cannot poke an argument that doesn\'t exist yet');
$self->assert(@{$self->{"argument $argument"}} > 0, 1, 'Cannot poke an argument that has no value yet');
$self->{"argument $argument"}->[$#{$self->{"argument $argument"}}] = $newValue;
}
sub resetArguments {
my $self = shift;
foreach my $argument (keys(%{$self})) {
if ($argument =~ /^argument /o) {
delete($self->{$argument});
}
}
}
sub setCommandArgument {
my $self = shift;
my $argument = $self->getArgument('');
if ($argument) {
$self->command($argument);
} else {
$self->command('');
}
}
sub createArgument {
my $self = shift;
my($argument) = @_;
$self->{"argument $argument"} = [];
}
sub propertyExists {
return 1;
}
sub propertyGet {
my $self = shift;
if ($self->SUPER::propertyExists(@_)) {
return $self->SUPER::propertyGet(@_);
} else {
return $self->getArgument(@_); # XXX assumes that return propagates wantarray context...
# if not:
# my @result = $self->getArgument(@_);
# if (wantarray) {
# return @result;
# } else {
# if (@result) {
# return $result[0];
# } else {
# return undef;
# }
# }
}
}

127
mozilla/webtools/PLIF/PLIF/Input/CGI.pm Normal file
View File

@ -0,0 +1,127 @@
# -*- 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::Input::CGI;
use strict;
use vars qw(@ISA);
use PLIF::Input::Arguments;
use MIME::Base64; # DEPENDENCY
@ISA = qw(PLIF::Input::Arguments);
1;
# Don't forget to put this module ABOVE the "CommandLine" module!
# The CommandLine module can't tell the difference between a keyword
# query and real command line.
sub applies {
return defined($ENV{'GATEWAY_INTERFACE'});
}
sub defaultOutputProtocol {
return 'http';
}
sub splitArguments {
my $self = shift;
foreach my $parameter (qw(SERVER_SOFTWARE SERVER_NAME
GATEWAY_INTERFACE SERVER_PROTOCOL SERVER_PORT REQUEST_METHOD
PATH_INFO PATH_TRANSLATED SCRIPT_NAME QUERY_STRING REMOTE_HOST
REMOTE_ADDR AUTH_TYPE REMOTE_USER REMOTE_IDENT CONTENT_TYPE
CONTENT_LENGTH)) {
$self->propertySet($parameter, $ENV{$parameter});
}
foreach my $parameter (keys(%ENV)) {
if ($parameter =~ /^HTTP_/o) {
$self->propertySet($parameter, $ENV{$parameter});
}
}
if (defined($ENV{'QUERY_STRING'})) {
foreach my $argument (split(/&/o, $ENV{'QUERY_STRING'})) {
if ($argument =~ /^(.*?)(?:=(.*))?$/os) {
$self->addArgument($1, $2);
} else {
$self->warn(2, "argument (|$argument|) did not match regexp (can't happen!)");
}
}
} # should also deal with HTTP POST, PUT, etc, here XXX
if (defined($ENV{'HTTP_AUTHORIZATION'})) {
if ($self->HTTP_AUTHORIZATION =~ /^Basic +(.*)$/os) {
# HTTP Basic Authentication
my($username, $password) = split(/:/, decode_base64($1), 2);
$self->username($username);
$self->password($password);
} else {
# Some other authentication scheme
}
}
}
sub setCommandArgument {
my $self = shift;
my $argument = $self->getArgument('command');
if ($argument) {
$self->command($argument);
} else {
$self->command('');
}
}
sub UA {
my $self = shift;
return $self->getArgument('overrideUserAgent') or $self->HTTP_USER_AGENT;
}
sub referrer {
my $self = shift;
return $self->getArgument('overrideReferrer') or $self->HTTP_REFERER; # (sic)
}
sub host {
my $self = shift;
return $self->REMOTE_HOST or $self->REMOTE_ADDR;
}
sub acceptType {
my $self = shift;
return $self->getArgument('overrideAcceptType') or $self->HTTP_ACCEPT;
}
sub acceptCharset {
my $self = shift;
return $self->getArgument('overrideAcceptCharset') or $self->HTTP_ACCEPT_CHARSET;
}
sub acceptEncoding {
my $self = shift;
return $self->getArgument('overrideAcceptEncoding') or $self->HTTP_ACCEPT_ENCODING;
}
sub acceptLanguage {
my $self = shift;
return $self->getArgument('overrideAcceptLanguage') or $self->HTTP_ACCEPT_LANGUAGE;
}

130
mozilla/webtools/PLIF/PLIF/Input/CommandLine.pm Normal file
View File

@ -0,0 +1,130 @@
# -*- 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::Input::CommandLine;
use strict;
use vars qw(@ISA);
use PLIF::Input::Arguments;
use Term::ReadLine; # DEPENDENCY
@ISA = qw(PLIF::Input::Arguments);
1;
sub applies {
return @ARGV > 0;
}
sub defaultOutputProtocol {
return 'stdout';
}
sub splitArguments {
my $self = shift;
# first, make sure the command argument is created even if it is
# not explicitly given -- this avoids us from asking the user what
# command they want in interactive mode.
$self->SUPER::createArgument('');
# next, parse the arguments provided.
my $lastArgument;
foreach my $argument (@ARGV) {
if ($argument =~ /^-([^-]+)$/os) {
my @shortArguments = split(//o, $1);
foreach my $shortArgument (@shortArguments) {
$self->addArgument($shortArgument, 1);
}
$lastArgument = $shortArguments[$#shortArguments];
} elsif ($argument =~ /^--([^-][^=]*)=(.+)$/os) {
$self->addArgument($1, $2);
$lastArgument = undef;
} elsif ($argument =~ /^--no-([^-].+)/os) {
$self->addArgument($1, 0);
$lastArgument = undef;
} elsif ($argument =~ /^--([^-].+)/os) {
$self->addArgument($1, 1);
$lastArgument = $1;
} else {
if (defined($lastArgument)) {
$self->addArgument($lastArgument, $argument);
$lastArgument = undef;
} else {
$self->addArgument('', $argument);
}
}
}
}
sub createArgument {
my $self = shift;
my($argument) = @_;
if ($argument eq 'batch') {
$self->setArgument($argument, 0);
} else {
if ($self->getArgument('batch')) {
$self->SUPER::createArgument($argument);
} else {
$self->dump(5, "going to request $argument from user!");
$self->app->output->request($argument);
# get input from user :-)
my $term = Term::ReadLine->new($self->app->name);
my $value = $term->readline(''); # argument is prompt
# if we cached the input device:
# $term->addhistory($value);
$self->setArgument($argument, $value);
}
}
}
# XXX Grrrr:
sub UA {
return '';
}
sub referrer {
return '';
}
sub host {
return 'localhost';
}
sub acceptType {
return 'text/plain';
}
sub acceptCharset {
return '';
}
sub acceptEncoding {
return '';
}
sub acceptLanguage {
return '';
}

76
mozilla/webtools/PLIF/PLIF/Input/Default.pm Normal file
View File

@ -0,0 +1,76 @@
# -*- 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::Input::Default;
use strict;
use vars qw(@ISA);
use PLIF::Input::Arguments;
@ISA = qw(PLIF::Input::Arguments);
1;
sub applies {
return 1;
}
sub defaultOutputProtocol {
return 'stdout';
}
# Everything else that PLIF::Input::Arguments does by default is great
# for this. Namely, no command, and returning 'undef' for everything.
# XXX Grrrr:
sub UA {
return '';
}
sub referrer {
return '';
}
sub host {
return 'localhost';
}
sub acceptType {
return 'text/plain';
}
sub acceptCharset {
return '';
}
sub acceptEncoding {
return '';
}
sub acceptLanguage {
return '';
}

72
mozilla/webtools/PLIF/PLIF/MagicPipingArray.pm Normal file
View File

@ -0,0 +1,72 @@
# -*- 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::MagicPipingArray;
use strict;
use vars qw($AUTOLOAD); # it's a package global
use Carp qw(cluck confess); # stack trace versions of warn and die
1;
# This can be used separate from PLIF, and so does not inherit from
# the PLIF core. Calling any method except 'create' will result in the
# method call being forwarded to the wrapped objects. Calling 'create'
# will create a new MagicPipingArray object, see the AUTOLOAD function
# below for an example.
sub create {
my $class = shift;
if (ref($class)) {
$class = ref($class);
}
my $self = [@_];
bless ($self, $class);
return $self;
}
sub AUTOLOAD {
my $self = shift;
my $name = $AUTOLOAD;
$name =~ s/^.*://o; # strip fully-qualified portion
my @allResults;
foreach my $object (@$self) {
my $method = $object->can($name);
if ($method) {
my @result = &$method($object, @_);
if (@result <= 1) {
if (@result and defined($result[0])) {
push(@allResults, @result);
}
} else {
push(@allResults, [@result]);
}
} else {
confess("Failed to find method or property '$name' in object '$object' of MagicPipingArray '$self', aborting"); # die with stack trace
}
}
return $self->create(@allResults);
}

71
mozilla/webtools/PLIF/PLIF/MagicSelectingArray.pm Normal file
View File

@ -0,0 +1,71 @@
# -*- 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::MagicSelectingArray;
use strict;
use vars qw($AUTOLOAD); # it's a package global
use Carp qw(cluck confess); # stack trace versions of warn and die
1;
# This can be used separate from PLIF, and so does not inherit from
# the PLIF core. Calling any method except 'create' will result in the
# method call being forwarded to each of the wrapped objects until one
# returns a value (including 'undef'), which will then be returned.
sub create {
my $class = shift;
if (ref($class)) {
$class = ref($class);
}
my $self = [@_];
bless ($self, $class);
return $self;
}
sub AUTOLOAD {
my $self = shift;
my $name = $AUTOLOAD;
$name =~ s/^.*://o; # strip fully-qualified portion
my @allResults;
foreach my $object (@$self) {
my $method = $object->can($name);
if ($method) {
my @result = &$method($object, @_);
if (@result) {
if (wantarray) {
return @result;
} else {
return $result[0];
}
}
} else {
confess("Failed to find method or property '$name' in object '$object' of MagicSelectingArray '$self', aborting"); # die with stack trace
}
}
return;
}

64
mozilla/webtools/PLIF/PLIF/Output.pm Normal file
View File

@ -0,0 +1,64 @@
# -*- 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::Output;
use strict;
use vars qw(@ISA);
use PLIF::Service;
@ISA = qw(PLIF::Service);
1;
sub provides {
my $class = shift;
my($service) = @_;
return ($service eq 'output.'.$class->protocol or $class->SUPER::provides($service));
}
sub protocol {
my $self = shift;
$self->notImplemented(); # this must be overriden by descendants
}
sub init {
my $self = shift;
$self->SUPER::init(@_);
my($app) = @_;
$self->propertySet('app', $app);
# output classes disable implied property creation, so we use
# 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.
sub propertyImpliedAccessAllowed {
my $self = shift;
$self->dump(10, "access to property @_ of object $self attempted");
return $self->propertyExists(@_);
}

61
mozilla/webtools/PLIF/PLIF/Output/Generic.pm Normal file
View File

@ -0,0 +1,61 @@
# -*- 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::Output::Generic;
use strict;
use vars qw(@ISA);
use PLIF::Output;
@ISA = qw(PLIF::Output);
1;
sub protocol {
return 'generic';
}
sub init {
my $self = shift;
$self->SUPER::init(@_);
my($app, $session, $protocol) = @_;
$self->propertySet('actualSession', $session);
$self->propertySet('actualProtocol', $protocol);
}
sub output {
my $self = shift;
my($session, $string, $data) = @_;
if (not defined($session)) {
$session = $self->actualSession;
}
my $expander = $self->app->getService("string.expander.$string");
if (not defined($expander)) {
$expander = $self->app->getService('string.expander');
$self->assert($expander, 1, 'Could not find a string expander.');
}
$self->app->getService('output.generic.'.$self->actualProtocol)->output($self->app, $session,
$expander->expand($self->app, $session, $self->actualProtocol, $string, $data));
}

48
mozilla/webtools/PLIF/PLIF/Output/Generic/StdOut.pm Normal file
View File

@ -0,0 +1,48 @@
# -*- 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::Output::Generic::StdOut;
use strict;
use vars qw(@ISA);
use PLIF::Service;
@ISA = qw(PLIF::Service);
1;
sub provides {
my $class = shift;
my($service) = @_;
return ($service eq 'output.generic.http' or
$service eq 'output.generic.stdout' or
$class->SUPER::provides($service));
}
sub output {
my $self = shift;
my($app, $session, $string) = @_;
print $string;
}

69
mozilla/webtools/PLIF/PLIF/Output/HTTP.pm Normal file
View File

@ -0,0 +1,69 @@
# -*- 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::Output::HTTP;
use strict;
use vars qw(@ISA);
use PLIF::Output;
@ISA = qw(PLIF::Output);
1;
sub protocol {
return 'http';
}
sub finaliseHeader {
my $self = shift;
print "Content-Type: " . $self->format . "\n";
foreach my $header ($self->headers) {
print "$header\n";
}
print "\n";
}
sub authenticate {
my $self = shift;
my $realm = $self->realm;
print "HTTP/1.1 401 Unauthorized\nWWW-Authenticate: Basic realm=\"$realm\"\n";
$self->finaliseHeader();
}
sub header {
my $self = shift;
print "HTTP/1.1 200 OK\n";
$self->finaliseHeader();
}
sub realm {
my $self = shift;
$self->notImplemented();
}
sub headers {
return ();
}

173
mozilla/webtools/PLIF/PLIF/Program.pm Normal file
View File

@ -0,0 +1,173 @@
# -*- 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::Program;
use strict;
use vars qw(@ISA);
use PLIF::Controller;
@ISA = qw(PLIF::Controller);
# the center of the PLIF-based application:
my $app = 'main'->create();
$app->run();
1;
# setup everything (automatically called by the constructor, above)
sub init {
my $self = shift;
$self->dump(5, '*** Started PLIF Application ***');
$self->SUPER::init(@_);
$self->initInput();
}
# called after the constructor (see above)
# this is the core of the application
sub run {
my $self = shift;
do {
eval {
$self->objects([]);
if ($self->verifyInput()) {
if ($self->input->command) {
$self->dispatch($self->input->command);
} else {
$self->noCommand();
}
} # verifyInput should deal with the errors
};
if ($@) {
$self->dump(3, "previous command didn't go over well: $@");
$self->output->reportFatalError($@);
}
# In case we used a progressive output device, let it shut
# down. It's important to do this, because it holds a
# reference to us and we wouldn't want a memory leak...
$self->defaultOutput(undef);
} while ($self->input->next());
$self->input(undef); # shutdown the input service instance
}
# takes the first applicable input method.
sub initInput {
my $self = shift;
my $input = $self->getServiceInstance('input');
if ($input) {
$self->input($input);
} else {
$self->noInput();
}
}
# Returns an applicable output method. If you need a particular
# protocol, pass it as a parameter. To get the default output class
# given the current objects, do not pass any parameters. The output
# object is a one-off and is not (and should not) be cached; once you
# have called the relevant output method on it let it go out of scope
# and that should be it.
# You may also pass a session argument (typically the object
# representing a user, for example). If you don't pass any, a the
# first session object that was created by the input verifiers is used
# instead (e.g. during authentication).
sub output {
my $self = shift;
my($protocol, $session) = @_;
my $default = 0;
if (not $protocol) {
if (defined($self->defaultOutput)) {
return $self->defaultOutput;
}
if ($session) {
$self->warn(3, 'Tried to use default output method for a specific session object');
$session = undef;
}
$default = 1;
$protocol = $self->selectOutputProtocol();
}
my $output = $self->getServiceInstance("output.$protocol", $session);
if (not $output) {
$output = $self->getServiceInstance("output.generic", $session, $protocol);
if (not $output) {
$self->error(0, 'Could not find an applicable output class');
}
}
if ($default) {
$self->defaultOutput($output);
}
return $output;
}
sub verifyInput {
my $self = shift;
# we invoke all the input verifiers until one fails
my($result) = $self->getSelectingServiceList('input.verify')->verifyInput($self);
if (defined($result)) {
# if one failed, then the result will be the object that should report the error
$result->reportInputVerificationError($self);
return 0;
} else {
return 1;
}
}
sub selectOutputProtocol {
my $self = shift;
return $self->input->defaultOutputProtocol;
}
# 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
# you couldn't dispatch the command.
sub dispatch {
my $self = shift;
my($command) = @_;
my $method = $self->can('cmd'.$command);
if ($method) {
&$method($self);
} else {
$self->unknownCommand();
}
}
sub noInput {
my $self = shift;
$self->error(0, 'Could not find an applicable input method');
}
sub unknownCommand {
my $self = shift;
$self->error(0, 'The command given was not recognised.');
}
sub noCommand {
my $self = shift;
$self->unknownCommand(@_);
}

135
mozilla/webtools/PLIF/PLIF/README Normal file
View File

@ -0,0 +1,135 @@
PLIF: Program Logic Insulation Framework
========================================
Overview
--------
PLIF is based around the idea of services. Some more text really
should go here, don't you think?
Note that in this document, the term "provide a service" is used to
mean what some people term "implement an interface". The terms are
interchangeable. Due to Perl's amorphous nature, I found the term
"interface" to be a bit inappropriate, in my opinion it has
connotations of strictness that are not really applicable to Perl...
Services
--------
The following services (also termed 'interfaces') have meaning in the
basic PLIF design:
input - implements all of the Input API
input.verify - provides a verifyInput() method
output.<protocol> - implements all of the Output API
dataSource.<dataSet> - provides a data source for dataSet
dataSource.setupAware - knows how to set up the database
input semantics
---------------
These are not simple. See the example implementations.
input.verify semantics
----------------------
If you provide input.verify, then you should expect to get called each
time a set of input needs validating. Input validation means stuff
like checking that an e-mail's format is correct, or authentication
the user if they have tried to log in, or whatever.
When your "verifyInput()" method is called, you should return nothing
(not even undef) if everything is ok, and a reference to an object
that has a reportInputVerificationError() method if something went
wrong. If you return yourself (i.e., if you implement both methods
being discussed here), remember that there is no guarentee that you
will be destructed before the next time you are called, so don't
design your verifyInput() method in a way that assumes you won't have
pre-existing state. Also, since there is no guarentee that your
reportInputVerificationError() method will be called, don't hold on to
any references like, say, input. If you do you might end up leaking
memory, which we don't want!
Verifiers will be called in the order they were registered. If any
fail (i.e., return an object) then the verification loop is aborted.
For this reason, you should register verifiers in the order that they
are most likely to fail so that the loop ends in the shortest time.
If successful, the verifiers should initialise any objects (like user
objects from successful authentication) using $app->addObject(). The
first object claiming to provide the 'session' service is the object
that will be passed (by default) to output services.
output.* semantics
------------------
Output uses the following kind of command flow through services:
logic
|
+---------+---------+
| |
output.<protocol> output.generic
|
+------------+------------+
| |
string.expander.<string> string.expander
| |
+------------+------------+
|
output.generic.<protocol>
string.expander semantics
-------------------------
These services provide and |expand| function that takes four
arguments: the application object, the name of the protocol, the name
of the string to expand, and the data hash. The function should return
an opaque string.
dataSource.setupAware
---------------------
Most data sources are expected to provide the "dataSource.setupAware"
service, which basically means that they have a setup method that does
whatever is required to the databases. We should also introduce some
uninstall awareness, some default data populatingness, and stuff...
Class Tree
----------
CORE
|
+------+------------+-------------------+
| | | |
PLIF ... MagicPipingArray MagicSelectingArray
|
+---------+-----------------------+--------------------+
Controller | |
| Service DBI
Program | (ResultsFrame)
| |
Application +--------+-------+-----+-----+-------+-------+--------+
| | | | | | | |
... DataSource COSES DataBase Input Object Output StdOut
| | | | | (Outputter)
+--------+------+----+ +--+--+ Arguments ... +--+--+
| | | | | | | |
... Configuration Strings CfgFile DBI +-----+-----+ ... Generic
| | | |
MySQL CommandLine CGI Default
Contributions
-------------
Please make sure you read the STYLEGUIDE if you want to consider
writing code.

36
mozilla/webtools/PLIF/PLIF/Service.pm Normal file
View File

@ -0,0 +1,36 @@
# -*- 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;
use strict;
use vars qw(@ISA);
use PLIF;
@ISA = qw(PLIF);
1;
sub provides { return 0; } # stub

74
mozilla/webtools/PLIF/PLIF/Service/AdminCommands.pm Normal file
View File

@ -0,0 +1,74 @@
# -*- 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::AdminCommands;
use strict;
use vars qw(@ISA);
use PLIF::Service::Dispatcher;
@ISA = qw(PLIF::Service::Dispatcher);
1;
# Any application that uses PLIF::Service::AdminCommands must also
# have an output implementation that supports "setupFailed($result)"
# and "setupSucceeded()".
sub provides {
my $class = shift;
my($service) = @_;
return ($service eq 'input.verify' or $class->SUPER::provides($service));
}
sub verifyInput {
my $self = shift;
my($app) = @_;
if ($app->input->isa('PLIF::Input::CommandLine')) {
$app->addObject($self);
}
return;
}
sub cmdSetup {
my $self = shift;
my($app) = @_;
my $result;
$result = $app->getSelectingServiceList('setup.configure')->setupConfigure($app);
if (not $result) {
$result = $app->getSelectingServiceList('setup.install')->setupInstall($app);
}
if ($result) {
$app->output->setupFailed($result);
} else {
$app->output->setupSucceeded();
}
}
# XXX other commands to add
# cmdAddModule
# cmdRemoveModule

382
mozilla/webtools/PLIF/PLIF/Service/Coses.pm Normal file
View File

@ -0,0 +1,382 @@
# -*- 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::Coses;
use strict;
use vars qw(@ISA);
use PLIF::Service;
use XML::Parser; # DEPENDENCY
@ISA = qw(PLIF::Service);
1;
sub provides {
my $class = shift;
my($service) = @_;
return ($service eq 'string.expander' or $service eq 'service.coses' or $class->SUPER::provides($service));
}
sub expand {
my $self = shift;
my($app, $session, $protocol, $string, $data) = @_;
my @index = (); my $index = 0;
my @stack = (); my $stack = $self->parseString($self->getString($app, $session, $protocol, $string));
my @scope = (); my $scope = {'data' => $data};
my $result = '';
node: while (1) {
if ($index > $#$stack) {
# end of this level, pop the stack
if (@stack) {
$stack = pop(@stack);
$index = pop(@index);
$scope = pop(@scope);
} else {
# end of stack, have a nice day!
return $result;
}
} else {
# more data to deal with at this level
my $node = $stack->[$index];
my $contents = $stack->[$index+1];
my $superscope = $scope; # scope of parent element
$index += 2; # move the pointer on to the next node
if ($node) {
# element node
my $attributes = $contents->[0];
if ($attributes->{'xml:space'}) {
$scope = {%$scope}; # take a local copy of the root level for descendants
$scope->{'coses: white space'} = $attributes->{'xml:space'} eq 'default'; # vs 'preserve', which is assumed
}
if ($node eq 'if') {
if (not $self->evaluateCondition($self->evaluateExpression($attributes->{'lvalue'}, $scope),
$self->evaluateExpression($attributes->{'rvalue'}, $scope),
$self->evaluateExpression($attributes->{'condition'}, $scope),
)) {
$superscope->{'coses: last condition'} = 0;
next node;
}
$superscope->{'coses: last condition'} = 1;
if ($scope == $superscope) {
$scope = {%$scope};
}
$scope->{'coses: last condition'} = 0;
} elsif ($node eq 'set') {
my $variable = $self->evaluateExpression($attributes->{'variable'}, $scope);
$self->assert($variable !~ /[\(\.\)]/o, 1,
"variable '$variable' contains one of '(', ')' or '.' and is therefore not valid to use as a variable name.");
my $value = $self->evaluateExpression($attributes->{'value'}, $scope);
my $order = $self->evaluateExpression($attributes->{'order'}, $scope);
my $source = $self->evaluateExpression($attributes->{'source'}, $scope);
if ($order or $source) {
my @items = $self->sort($order, $self->keys($value, $source));
push(@index, $index);
push(@stack, $stack);
push(@scope, $superscope);
# now we push all but one of the items onto
# the stack -- so first take that item...
my $firstItem = pop(@items); # (@items is sorted backwards)
# and then take a copy of the scope if we didn't already
if ($scope == $superscope) {
$scope = {%$scope};
}
foreach my $item (@items) {
push(@index, 1);
push(@stack, $contents);
$scope->{$variable} = $item;
push(@scope, $scope);
# make sure we create a new scope for the
# next item -- otherwise each part of the
# loop would just have a reference to the
# same shared hash, and so they would all
# have the same value!
$scope = {%$scope};
}
# and finally create the first scope (not pushed on the stack, it is the next, live one)
$index = 1; # skip past attributes
$stack = $contents;
$scope->{$variable} = $firstItem;
next node;
} else {
if ($scope == $superscope) {
# take a copy since we haven't yet
$scope = {%$scope};
}
$scope->{$variable} = $value;
}
} elsif ($node eq 'text') {
if ($attributes->{'value'}) {
$result .= $self->evaluateExpression($attributes->{'value'}, $scope);
next node; # skip contents if attribute 'value' is present
}
} elsif ($node eq 'br') {
# useful if xml:space is set to 'default'
$result .= "\n";
} elsif ($node eq 'embed') {
push(@index, $index);
push(@stack, $stack);
$index = 0;
$stack = $self->parseString($self->getString($app, $session, $protocol, $self->evaluateExpression($attributes->{'string'}, $scope)));
push(@scope, $superscope);
next node; # skip default handling
} elsif ($node eq 'else') {
if ($superscope->{'coses: last condition'}) {
next node; # skip this block if the variable IS there
}
} elsif ($node eq 'with') {
my $variable = $self->evaluateExpression($attributes->{'variable'}, $scope);
if (not defined($scope->{$variable})) {
next node; # skip this block if the variable isn't there
}
} elsif ($node eq 'without') {
my $variable = $self->evaluateExpression($attributes->{'variable'}, $scope);
if (defined($scope->{$variable})) {
next node; # skip this block if the variable IS there
}
} else {
$self->error(1, "Tried to expand a string with an unrecognised COSES element: '$node'");
}
# fall through to default handling: push current
# stack, scope and index, and set new index to move
# past attributes
push(@index, $index); $index = 1;
push(@stack, $stack); $stack = $contents;
push(@scope, $superscope);
} elsif ($scope->{'coses: white space'}) {
# raw text node which may or may not be included
if ($contents =~ /\S/o) {
# if xml:space="default" then only include text nodes with non-whitespace.
$result .= $contents;
}
} else {
# raw text node
$result .= $contents;
}
}
}
}
sub parseString {
my $self = shift;
my($string) = @_;
# parse string (it's an XML file)
my $parser = new XML::Parser(Style => 'Tree');
return $parser->parse($string);
}
sub getString {
my $self = shift;
my($app, $session, $protocol, $string) = @_;
return $app->getService('dataSource.strings')->get($app, $session, $protocol, $string);
}
sub evaluateVariable {
my $self = shift;
my($variable, $scope) = @_;
my @parts = split(/\./o, $variable); # split variable at dots ('.')
# drill down through scope
foreach my $part (@parts) {
if (ref($scope) eq 'HASH') {
$scope = $scope->{$part};
} elsif (ref($scope) eq 'ARRAY') {
$scope = $scope->[$part];
} else {
$self->error(1, "Could not resolve '$variable' at '$part'");
}
}
if (defined($scope)) {
# fully dereference all scalar references
while (ref($scope) eq 'SCALAR') {
$scope = $$scope;
}
return $scope;
} else {
return '';
}
}
sub evaluateNestedVariableSafely {
my $self = shift;
my($variable, $scope) = @_;
$scope = $self->evaluateVariable($variable, $scope);
if ($scope =~ /[\(\)]/o) {
$self->error(1, "Evaluated nested variable '$variable' to '$scope' which contains one of '(', or ')' and is therefore not safe to use as a variable part");
}
return $scope;
}
sub evaluateExpression {
my $self = shift;
my($expression, $scope) = @_;
if (defined($expression)) {
if ($expression =~ /^\'(.*)$/os) {
return $1; # bypass next bit if it's an explicit string
} elsif ($expression =~ /^[^()]*$/o) {
return $expression; # bypass next bit if there are no brackets at all
} else {
# expand *nested* variables safely
while ($expression =~ s/^ # the start of the line
( # followed by a group of
.*\( # anything up to an open bracket
[^()]* # then anything but brackets
) # followed by
\( # an open bracket
([^()]*) # our variable
\) # a close bracket
( # followed by a group of
(?: # as many instances as required
[^()]* # of first other-variable stuff
\([^()]*\) # and then of more embedded variabled
)* # followed by
[^()]*\).* # anything but brackets, a close bracket then anything
) # which should be at the
$ # end of the line
/$1.$self->evaluateNestedVariableSafely($2, $scope).$3/sexo) {
# this should cope with this smoketest (d=ab, g=fcde): (f.(c).((a).(b)).(e))
}
# expand outer variable without safety checks, if there are any
# first, check if the result would be a single variable
if ($expression =~ /^\(([^()]*)\)$/o) {
# we special case this -- doing it without using a
# regexp s/// construct ensures we keep references as
# live references in strict mode (i.e., we don't call
# their "ToString" method or whatever...)
$expression = $self->evaluateVariable($1, $scope);
} else {
# expand all remaining outer variables
my $result = '';
while ($expression =~ s/^(.*?)\(([^()]*)\)//o) {
# ok, let's deal with the next embedded variable
$result .= $1.$self->evaluateVariable($2, $scope);
# the bit we've dealt with so far will end up
# removed from the $expression string (so the
# current state is "$result$expression). This is
# so that things that appear to be variables in
# the strings we are expanding don't themselves
# get expanded.
}
# put it back together again
$expression = $result.$expression;
}
# and return the result
return $expression;
}
} else {
return '';
}
}
sub evaluateCondition {
my $self = shift;
my($lvalue, $rvalue, $condition) = @_;
if (defined($condition) and defined($lvalue) and defined($rvalue)) {
if ($condition eq '=') {
return $lvalue == $rvalue;
} elsif ($condition eq '!=') {
return $lvalue != $rvalue;
} elsif ($condition eq '<') {
return $lvalue < $rvalue;
} elsif ($condition eq '>') {
return $lvalue > $rvalue;
} elsif ($condition eq '<=') {
return $lvalue <= $rvalue;
} elsif ($condition eq '>=') {
return $lvalue >= $rvalue;
} elsif ($condition eq 'eq') {
return $lvalue eq $rvalue;
} elsif ($condition eq 'ne') {
return $lvalue ne $rvalue;
} elsif ($condition eq '=~') {
return eval { $lvalue =~ /$rvalue/; }; # XXX does this actually work? ;-)
} elsif ($condition eq '!~') {
return eval { $lvalue !~ /$rvalue/; };
} elsif ($condition eq 'is') {
if (ref($lvalue)) {
return $rvalue eq lc(ref($lvalue));
} else {
return $rvalue eq 'scalar';
}
} elsif ($condition eq 'is not') {
if (ref($lvalue)) {
return $rvalue ne lc(ref($lvalue));
} else {
return $rvalue ne 'scalar';
}
}
} # else, well, they got it wrong, so it won't match now will it :-)
return 0;
}
sub keys {
my $self = shift;
my($value, $source) = @_;
if (ref($value) eq 'HASH') {
if (defined($source) and $source eq 'values') {
return values(%$value);
} else { # (not defined($source) or $source eq 'keys')
return keys(%$value);
}
} elsif (ref($value) eq 'ARRAY') {
if (defined($source) and $source eq 'values') {
return @$value;
} else { # (not defined($source) or $source eq 'keys')
if ($#$value >= 0) {
return (0..$#$value);
} else {
return ();
}
}
} else {
return ($value);
}
}
sub sort {
my $self = shift;
my($order, @list) = @_;
# sort the list (in reverse order!)
if (defined($order)) {
if ($order eq 'lexical') {
return sort { $b cmp $a } @list;
} elsif ($order eq 'reverse lexical') {
return sort { $a cmp $b } @list;
} elsif ($order eq 'case insensitive lexical') {
return sort { lc($b) cmp lc($a) } @list;
} elsif ($order eq 'reverse case insensitive lexical') {
return sort { lc($a) cmp lc($b) } @list;
} elsif ($order eq 'numerical') {
return sort { $b <=> $a } @list;
} elsif ($order eq 'reverse numerical') {
return sort { $a <=> $b } @list;
} elsif ($order eq 'length') {
return sort { length($b) <=> length($b) } @list;
} elsif ($order eq 'reverse length') {
return sort { length($a) <=> length($a) } @list;
}
}
# else:
return reverse @list;
}

49
mozilla/webtools/PLIF/PLIF/Service/Coses.txt Normal file
View File

@ -0,0 +1,49 @@
Sample COSES files
==================
<!--
!
! This example will dump every single string passed into it. For
! example, if you pass it a hash with one item 'data' containing two
! items 'a' and 'b' with 'a' containing 'hello' and 'b' containing
! an array of two values 'wonderful' and 'world', you would get as
! output the following:
!
! data.a = hello
! data.b.1 = wonderful
! data.b.2 = world
!
! This example uses almost all the features of COSES, and so is
! quite a useful example to study. (It doesn't use <else/> or all
! the values of <set>'s attributes.) It's also a great help when
! debugging! You can use it at any point in a COSES document merely
! by nesting it, so you can, for example, study what is happening
! with a <set> statement. If you declare this example as having the
! name 'debug.dumpVars' then to embed it you would do:
!
! <embed string="debug.dumpVars"/>
!
! This example is covered by the same license terms as COSES itself.
! Author: Ian Hickson
!
!-->
<text xml:space="default"> <!-- trim whitespace -->
<with variable="prefix">
<if lvalue="((prefix))" condition="is" rvalue="scalar">
<text value=" (prefix)"/> = <text value="((prefix))"/><br/>
</if>
<if lvalue="((prefix))" condition="is not" rvalue="scalar">
<set variable="index" value="((prefix))" source="keys" order="case insensitive lexical">
<set variable="prefix" value="(prefix).(index)">
<embed string="debug.dumpVars"/>
</set>
</set>
</if>
</with>
<without variable="prefix">
<set variable="prefix" value="()" source="keys" order="lexical">
<embed string="debug.dumpVars"/>
</set>
</without>
</text>

52
mozilla/webtools/PLIF/PLIF/Service/Dispatcher.pm Normal file
View File

@ -0,0 +1,52 @@
# -*- 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;
}
}

47
mozilla/webtools/PLIF/PLIF/Service/Session.pm Normal file
View File

@ -0,0 +1,47 @@
# -*- 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::Session;
use strict;
use vars qw(@ISA);
use PLIF::Service;
@ISA = qw(PLIF::Service);
1;
sub provides {
my $class = shift;
my($service) = @_;
return ($service eq 'session' or $class->SUPER::provides($service));
}
# expected by dataSource.strings
sub selectVariant {
my $self = shift;
my($app, $protocol) = @_;
return undef; # 'use some other method to work it out...'
}

127
mozilla/webtools/PLIF/STYLEGUIDE Normal file
View File

@ -0,0 +1,127 @@
Coding Style for PLIF
---------------------
This style guide is designed to make sure that the code is consistent
throughout. It isn't necessarily the best way of writing Perl, but it
is consistent. Consistency is more important than using your preferred
method. Please follow the style guide.
Note: Exceptions will be accepted if they improve performance, but
only if they are well commented.
1. Brackets are preferred to other punctuation
return ($a eq 'a' or $b); # preferred
return $a eq 'a' || $b;
2. Use brackets around all function arguments
push(@list, $item); # preferred
push @list, $item;
foreach $item (sort(keys(%{$self->list}))) { } # preferred
foreach $item (sort keys %{$self->list}) { }
3. When calling a method for its side-effect, always use brackets
$self->go(); # preferred
$self->go;
4. When calling a method as if it was a property, omit brackets
return $self->name; # preferred;
return $self->name();
5. Don't use print(), use dump()
$self->dump(9, "foo called with bar $bar"); # preferred
print("foo called with bar $bar\n");
6. To set a property, use the method call notation
$self->name('foo'); # preferred
$self->{'name'} = 'foo';
7. method and property names should start lowercase and have a capital
letter for each word
sub myLovelyMethod { ... } # preferred
sub MyLovelyMethod { ... } # bad (first letter not lowercase)
sub mylovelymethod { ... } # bad (intervening words not capitalized)
sub my_lovely_method { ... } # bad (underscores)
8. methods should start with setting $self and taking their arguments
sub myLovelyMethod {
my $self = shift;
my($argument) = @_;
# code...
}
9. Curly brackets should cuddle
if ($condition) {
# do something
} else {
# do something else
}
10. Comments should be indented just like code
if ($condition) {
# preferred
} else {
# bad
}
11. Avoid using the implicit $_ variable
foreach my $item (@list) { $item++; } # preferred
foreach (@list) { $_++; }
12. Thou shalt avoid using useful functions (which break Win32):
alarm, chroot, crypt, endgrent, endhostent, endnetent,
endprotoent, endpwent, endservent, fork, getgrent, getgrgid,
getgrnam, getnetbyaddr, getnetbyname, getnetent, getpgrp,
getppid, getpriority, getprotoent, getpwent, getpwnam, getpwuid,
getservent, link, msgctl, msgget, msgrcv, msgsnd, semctl, semget,
semop, setgrent, sethostent, setnetent, setpgrp, setpriority,
setprotoent, setpwent, setservent, shmctl, shmget, shmread,
shmwrite, socketpair, symlink, syscall
http://ftp.univie.ac.at/packages/perl/ports/nt/FAQ/perlwin32faq5.html
13. When creating a new dependency, make sure you mark it with the
magic string 'DEPENDENCY', as in:
package PLIF::Coses;
use strict;
use vars qw(@ISA);
use PLIF::Service;
use XML::Parser; # DEPENDENCY
@ISA = qw(PLIF::Service);
1;
This allows for an easy listing of each dependency using 'find'
and 'grep'.
14. The order for declaring methods should be something along the
lines of first class methods, then the constructor (in PLIF this
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.