diff --git a/mozilla/webtools/PLIF/Documentation.txt b/mozilla/webtools/PLIF/Documentation.txt new file mode 100644 index 00000000000..4aafddf4c76 --- /dev/null +++ b/mozilla/webtools/PLIF/Documentation.txt @@ -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. \ No newline at end of file diff --git a/mozilla/webtools/PLIF/PLIF.pm b/mozilla/webtools/PLIF/PLIF.pm new file mode 100644 index 00000000000..be0dc290b35 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF.pm @@ -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 diff --git a/mozilla/webtools/PLIF/PLIF/Application.pm b/mozilla/webtools/PLIF/PLIF/Application.pm new file mode 100644 index 00000000000..059f3b8e776 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Application.pm @@ -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); + } +} diff --git a/mozilla/webtools/PLIF/PLIF/Controller.pm b/mozilla/webtools/PLIF/PLIF/Controller.pm new file mode 100644 index 00000000000..d6735d732e9 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Controller.pm @@ -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 diff --git a/mozilla/webtools/PLIF/PLIF/DataSource.pm b/mozilla/webtools/PLIF/PLIF/DataSource.pm new file mode 100644 index 00000000000..54736c9207d --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/DataSource.pm @@ -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(); +} diff --git a/mozilla/webtools/PLIF/PLIF/DataSource/Configuration.pm b/mozilla/webtools/PLIF/PLIF/DataSource/Configuration.pm new file mode 100644 index 00000000000..ed64a99da47 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/DataSource/Configuration.pm @@ -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)); + } +} diff --git a/mozilla/webtools/PLIF/PLIF/DataSource/Strings.pm b/mozilla/webtools/PLIF/PLIF/DataSource/Strings.pm new file mode 100644 index 00000000000..8b46224e9bf --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/DataSource/Strings.pm @@ -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(); +} diff --git a/mozilla/webtools/PLIF/PLIF/DataSource/Strings/MySQL.pm b/mozilla/webtools/PLIF/PLIF/DataSource/Strings/MySQL.pm new file mode 100644 index 00000000000..80af5a7e614 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/DataSource/Strings/MySQL.pm @@ -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; +} diff --git a/mozilla/webtools/PLIF/PLIF/Database.pm b/mozilla/webtools/PLIF/PLIF/Database.pm new file mode 100644 index 00000000000..f8109c2c8d7 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Database.pm @@ -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(@_); +} diff --git a/mozilla/webtools/PLIF/PLIF/Database/ConfigurationFile.pm b/mozilla/webtools/PLIF/PLIF/Database/ConfigurationFile.pm new file mode 100644 index 00000000000..e4531c4aafa --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Database/ConfigurationFile.pm @@ -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 = ; + $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(); + } +} diff --git a/mozilla/webtools/PLIF/PLIF/Database/DBI.pm b/mozilla/webtools/PLIF/PLIF/Database/DBI.pm new file mode 100644 index 00000000000..01bdd745f1d --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Database/DBI.pm @@ -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(@_); +} diff --git a/mozilla/webtools/PLIF/PLIF/Database/ResultsFrame/DBI.pm b/mozilla/webtools/PLIF/PLIF/Database/ResultsFrame/DBI.pm new file mode 100644 index 00000000000..863b5c3144f --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Database/ResultsFrame/DBI.pm @@ -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; + diff --git a/mozilla/webtools/PLIF/PLIF/DatabaseHelper.pm b/mozilla/webtools/PLIF/PLIF/DatabaseHelper.pm new file mode 100644 index 00000000000..2ff3f5c0465 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/DatabaseHelper.pm @@ -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(); +} diff --git a/mozilla/webtools/PLIF/PLIF/DatabaseHelper/DBI.pm b/mozilla/webtools/PLIF/PLIF/DatabaseHelper/DBI.pm new file mode 100644 index 00000000000..17bd5360054 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/DatabaseHelper/DBI.pm @@ -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 diff --git a/mozilla/webtools/PLIF/PLIF/Input.pm b/mozilla/webtools/PLIF/PLIF/Input.pm new file mode 100644 index 00000000000..78653eb7b68 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Input.pm @@ -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(); +} diff --git a/mozilla/webtools/PLIF/PLIF/Input/Arguments.pm b/mozilla/webtools/PLIF/PLIF/Input/Arguments.pm new file mode 100644 index 00000000000..54a1e98f2b7 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Input/Arguments.pm @@ -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; + # } + # } + } +} diff --git a/mozilla/webtools/PLIF/PLIF/Input/CGI.pm b/mozilla/webtools/PLIF/PLIF/Input/CGI.pm new file mode 100644 index 00000000000..4c63fcd9ece --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Input/CGI.pm @@ -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; +} diff --git a/mozilla/webtools/PLIF/PLIF/Input/CommandLine.pm b/mozilla/webtools/PLIF/PLIF/Input/CommandLine.pm new file mode 100644 index 00000000000..c5df12ca36d --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Input/CommandLine.pm @@ -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 ''; +} diff --git a/mozilla/webtools/PLIF/PLIF/Input/Default.pm b/mozilla/webtools/PLIF/PLIF/Input/Default.pm new file mode 100644 index 00000000000..923c9668516 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Input/Default.pm @@ -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 ''; +} diff --git a/mozilla/webtools/PLIF/PLIF/MagicPipingArray.pm b/mozilla/webtools/PLIF/PLIF/MagicPipingArray.pm new file mode 100644 index 00000000000..bf5ed04ee31 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/MagicPipingArray.pm @@ -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); +} diff --git a/mozilla/webtools/PLIF/PLIF/MagicSelectingArray.pm b/mozilla/webtools/PLIF/PLIF/MagicSelectingArray.pm new file mode 100644 index 00000000000..651cd9104de --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/MagicSelectingArray.pm @@ -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; +} diff --git a/mozilla/webtools/PLIF/PLIF/Output.pm b/mozilla/webtools/PLIF/PLIF/Output.pm new file mode 100644 index 00000000000..e053bd50da7 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Output.pm @@ -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(@_); +} diff --git a/mozilla/webtools/PLIF/PLIF/Output/Generic.pm b/mozilla/webtools/PLIF/PLIF/Output/Generic.pm new file mode 100644 index 00000000000..77a2fa4f14f --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Output/Generic.pm @@ -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)); +} diff --git a/mozilla/webtools/PLIF/PLIF/Output/Generic/StdOut.pm b/mozilla/webtools/PLIF/PLIF/Output/Generic/StdOut.pm new file mode 100644 index 00000000000..46e5cdadb98 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Output/Generic/StdOut.pm @@ -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; +} diff --git a/mozilla/webtools/PLIF/PLIF/Output/HTTP.pm b/mozilla/webtools/PLIF/PLIF/Output/HTTP.pm new file mode 100644 index 00000000000..682142d1c77 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Output/HTTP.pm @@ -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 (); +} diff --git a/mozilla/webtools/PLIF/PLIF/Program.pm b/mozilla/webtools/PLIF/PLIF/Program.pm new file mode 100644 index 00000000000..565493013b3 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Program.pm @@ -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(@_); +} diff --git a/mozilla/webtools/PLIF/PLIF/README b/mozilla/webtools/PLIF/PLIF/README new file mode 100644 index 00000000000..7d527d9bfd6 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/README @@ -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. - implements all of the Output API + dataSource. - 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. output.generic + | + +------------+------------+ + | | + string.expander. string.expander + | | + +------------+------------+ + | + output.generic. + + +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. diff --git a/mozilla/webtools/PLIF/PLIF/Service.pm b/mozilla/webtools/PLIF/PLIF/Service.pm new file mode 100644 index 00000000000..c57b9ac7c81 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Service.pm @@ -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 diff --git a/mozilla/webtools/PLIF/PLIF/Service/AdminCommands.pm b/mozilla/webtools/PLIF/PLIF/Service/AdminCommands.pm new file mode 100644 index 00000000000..1d7ec74be45 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Service/AdminCommands.pm @@ -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 + diff --git a/mozilla/webtools/PLIF/PLIF/Service/Coses.pm b/mozilla/webtools/PLIF/PLIF/Service/Coses.pm new file mode 100644 index 00000000000..5b9d3a4fb80 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Service/Coses.pm @@ -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; +} diff --git a/mozilla/webtools/PLIF/PLIF/Service/Coses.txt b/mozilla/webtools/PLIF/PLIF/Service/Coses.txt new file mode 100644 index 00000000000..f6c2d7fded5 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Service/Coses.txt @@ -0,0 +1,49 @@ + +Sample COSES files +================== + + + + + + =
+ + + + + + + + + + + + + + + diff --git a/mozilla/webtools/PLIF/PLIF/Service/Dispatcher.pm b/mozilla/webtools/PLIF/PLIF/Service/Dispatcher.pm new file mode 100644 index 00000000000..8ff87595955 --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Service/Dispatcher.pm @@ -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; + } +} diff --git a/mozilla/webtools/PLIF/PLIF/Service/Session.pm b/mozilla/webtools/PLIF/PLIF/Service/Session.pm new file mode 100644 index 00000000000..1df1d13495d --- /dev/null +++ b/mozilla/webtools/PLIF/PLIF/Service/Session.pm @@ -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...' +} diff --git a/mozilla/webtools/PLIF/STYLEGUIDE b/mozilla/webtools/PLIF/STYLEGUIDE new file mode 100644 index 00000000000..8adf6651e1e --- /dev/null +++ b/mozilla/webtools/PLIF/STYLEGUIDE @@ -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.