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

* Improved the helpfulness of the extremely verbose debugging information of PLIF.pm by quoting embedded variables

Browse Source 
* Implemented MagicCollectingArray, which acts like MagicPipingArray except that the result is collected into one big array instead of multiple arrayrefs
* Added the relevant getCollecting*List methods to the Controller class
* Added DESTROY methods to the magic array to prevent DESTROY method calls from being propagated
* Made the debug.dumpVars string more robust when the data hash includes one of the three magic characters '(', '.' or ')'
* Implemented sanitation in COSES so that any keys in the data hash containing one of the three magic characters '(', '.' or ')' will have them transliterated to '[', ':' and ']' respectively (sanitation is optional and can be bypassed)
* Changed the API of the generic output module's 'output' method to take the optional $session argument last, thus simplifying the call sites a lot
* Implemented the 'dispatcher.output' service in several classes to return strings that must be support in variants (required for a good UI in the COSES editor)
* Renamed the Login module's strings so that they use the dot-notation separating significant parts


git-svn-id: svn://10.0.0.236/trunk@96296 18797224-902f-48f8-a5cc-f745e15eee43
This commit is contained in:
ian%hixie.ch 2001-06-04 06:13:22 +00:00
parent cd7f0471b0
commit c39644bda6
12 changed files with 197 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
mozilla/webtools/PLIF/PLIF.pm
View File

@ -103,20 +103,20 @@ sub AUTOLOAD {
$name =~ s/^.*://o; # strip fully-qualified portion
if ($self->propertyImpliedAccessAllowed($name)) {
if (scalar(@_) == 1) {
$self->dump(10, "setting implied property $name in $self");
$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");
$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");
$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");
$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->dump(10, "not treating '$name' in '$self' as an implied property, regardless of its existence");
}
$self->methodMissing($name, @_);
}
@ -133,7 +133,7 @@ sub propertyExists {
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");
$self->dump(10, "checking for existence of property '$name' in '$self'");
return exists($self->{$name});
}
@ -159,7 +159,7 @@ sub propertyGetUndefined {
sub methodMissing {
my $self = shift;
my($method) = @_;
$self->error(0, "Internal Error: Tried to access non-existent method $method in object $self");
$self->error(0, "Internal Error: Tried to access non-existent method '$method' in object '$self'");
}

19
mozilla/webtools/PLIF/PLIF/Controller.pm
View File

@ -32,6 +32,7 @@ use vars qw(@ISA);
use PLIF;
use PLIF::MagicPipingArray;
use PLIF::MagicSelectingArray;
use PLIF::MagicCollectingArray;
@ISA = qw(PLIF);
1;
@ -157,14 +158,14 @@ sub getObjectList {
return @services;
}
sub getSelectingServiceList {
sub getCollectingServiceList {
my $self = shift;
return PLIF::MagicSelectingArray->create($self->getServiceList(@_));
return PLIF::MagicCollectingArray->create($self->getServiceList(@_));
}
sub getSelectingObjectList {
sub getCollectingObjectList {
my $self = shift;
return PLIF::MagicSelectingArray->create($self->getObjectList(@_));
return PLIF::MagicCollectingArray->create($self->getObjectList(@_));
}
sub getPipingServiceList {
@ -177,6 +178,16 @@ sub getPipingObjectList {
return PLIF::MagicPipingArray->create($self->getObjectList(@_));
}
sub getSelectingServiceList {
my $self = shift;
return PLIF::MagicSelectingArray->create($self->getServiceList(@_));
}
sub getSelectingObjectList {
my $self = shift;
return PLIF::MagicSelectingArray->create($self->getObjectList(@_));
}
sub getServiceInstance {
my $self = shift;
my($name, @data) = @_;

37
mozilla/webtools/PLIF/PLIF/DataSource/DebugStrings.pm
View File

@ -49,23 +49,25 @@ sub getDefaultString {
!
! This example will dump every single string passed into it. For
! example, if you pass it a hash with one item 'data' containing two
! items 'a' and 'b' with 'a' containing 'hello' and 'b' containing
! an array of two values 'wonderful' and 'world', you would get as
! output the following:
! items 'a' and '(b)' with 'a' containing 'hello' and '(b)'
! containing an array of two values 'wonderful' and 'world', you
! would get as output the following (note that special characters
! '(' and ')' are automatically sanitised by COSES to '[' and ']'):
!
! coses: last condition = 0
! coses: white space = 1
! data.a = hello
! data.b.1 = wonderful
! data.b.2 = world
! data.[b].1 = wonderful
! data.[b].2 = world
!
! This example uses almost all the features of COSES, and so is
! quite a useful example to study. (It doesn't use <else/> or all
! the values of <set>'s attributes.) It's also a great help when
! debugging! You can use it at any point in a COSES document merely
! by nesting it, so you can, for example, study what is happening
! with a <set> statement. If you declare this example as having the
! name 'debug.dumpVars' then to embed it you would do:
! quite a useful example to study. (It doesn't use all of the values
! of <set>'s attributes nor the escaping attributes of <text>.) It's
! also a great help when debugging! You can use it at any point in a
! COSES document merely by nesting it, so you can, for example,
! study what is happening with a <set> statement. If you declare
! this example as having the name 'debug.dumpVars' then to embed it
! you would do:
!
! <embed string="debug.dumpVars"/>
!
@ -80,9 +82,16 @@ sub getDefaultString {
</if>
<if lvalue="((prefix))" condition="is not" rvalue="scalar">
<set variable="index" value="((prefix))" source="keys" order="case insensitive lexical">
<set variable="prefix" value="(prefix).(index)">
<embed string="debug.dumpVars"/>
</set>
<if lvalue="(index)" condition="=~" rvalue="'[\.\(\)]">
<!-- this can only be hit if COSES has been told to not
sanitise keys with special characters -->
<text value=" (prefix).|(index)| is inaccessible"/><br/>
</if>
<else>
<set variable="prefix" value="(prefix).(index)">
<embed string="debug.dumpVars"/>
</set>
</else>
</set>
<else>
<text value=" (prefix)"/><br/>

67
mozilla/webtools/PLIF/PLIF/MagicCollectingArray.pm Normal file
View File

@ -0,0 +1,67 @@
# -*- 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::MagicCollectingArray;
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 MagicCollectingArray 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) {
push(@allResults, &$method($object, @_));
} else {
confess("Failed to find method or property '$name' in object '$object' of MagicCollectingArray '$self', aborting"); # die with stack trace
}
}
return $self->create(@allResults);
}
sub DESTROY {} # stub to not cause infinite loop with AUTOLOAD :-)

4
mozilla/webtools/PLIF/PLIF/MagicPipingArray.pm
View File

@ -52,7 +52,7 @@ sub AUTOLOAD {
my $self = shift;
my $name = $AUTOLOAD;
$name =~ s/^.*://o; # strip fully-qualified portion
my @allResults;
my @allResults = ();
foreach my $object (@$self) {
my $method = $object->can($name);
if ($method) {
@ -70,3 +70,5 @@ sub AUTOLOAD {
}
return $self->create(@allResults);
}
sub DESTROY {} # stub to not cause infinite loop with AUTOLOAD :-)

2
mozilla/webtools/PLIF/PLIF/MagicSelectingArray.pm
View File

@ -69,3 +69,5 @@ sub AUTOLOAD {
}
return;
}
sub DESTROY {} # stub to prevent propagation to members of magic array

4
mozilla/webtools/PLIF/PLIF/Output/Generic.pm
View File

@ -88,6 +88,8 @@ use PLIF::Output;
# hard. But at least this means we can do it in HTML and SVG without
# changing the underlying code.
# To find the list of strings required, do this:
# my %strings = @{$self->getCollectingServiceList('dispatcher.output')->strings};
sub protocol {
return 'generic';
@ -104,7 +106,7 @@ sub init {
sub output {
my $self = shift;
my($session, $string, $data) = @_;
my($string, $data, $session) = @_;
if (not defined($session)) {
$session = $self->actualSession;
}

15
mozilla/webtools/PLIF/PLIF/Service/Components/AdminCommands.pm
View File

@ -46,6 +46,7 @@ sub provides {
return ($service eq 'input.verify' or
$service eq 'component.adminCommands' or
$service eq 'dispatcher.output.generic' or
$service eq 'dispatcher.output' or
$service eq 'dataSource.strings.default' or
$class->SUPER::provides($service));
}
@ -88,7 +89,7 @@ sub cmdSetup {
sub outputSetupSucceeded {
my $self = shift;
my($app, $output) = @_;
$output->output(undef, 'setup', {
$output->output('setup', {
'failed' => 0,
});
}
@ -97,7 +98,7 @@ sub outputSetupSucceeded {
sub outputSetupFailed {
my $self = shift;
my($app, $output, $result) = @_;
$output->output(undef, 'setup', {
$output->output('setup', {
'failed' => 1,
'result' => $result,
});
@ -107,11 +108,19 @@ sub outputSetupFailed {
sub outputSetupProgress {
my $self = shift;
my($app, $output, $component) = @_;
$output->output(undef, 'setup.progress', {
$output->output('setup.progress', {
'component' => $component,
});
}
# dispatcher.output
sub strings {
return (
'setup' => 'The message given at the end of the setup command (only required for stdout, since it is the only way to trigger setup); data.failed is a boolean, data.result is the error message if any',
'setup.progress' => 'Progress messages given during setup (only required for stdout); data.component is the item being set up',
);
}
# dataSource.strings.default
sub getDefaultString {
my $self = shift;

2
mozilla/webtools/PLIF/PLIF/Service/Components/CosesEditor.pm
View File

@ -54,7 +54,7 @@ sub cmdCosesEditor {
sub outputCosesEditor {
my $self = shift;
my($app, $output, $right) = @_;
$output->output(undef, 'cosesEditor', {
$output->output('cosesEditor', {
});
}

31
mozilla/webtools/PLIF/PLIF/Service/Components/Login.pm
View File

@ -42,6 +42,7 @@ sub provides {
$service eq 'component.userLogin' or
$service eq 'dispatcher.commands' or
$service eq 'dispatcher.output.generic' or
$service eq 'dispatcher.output' or
$service eq 'dataSource.strings.default' or
$class->SUPER::provides($service));
}
@ -142,7 +143,7 @@ sub requireLogin {
sub outputLoginInsufficient {
my $self = shift;
my($app, $output, $right) = @_;
$output->output(undef, 'loginAccessDenied', {
$output->output('login.accessDenied', {
'right' => $right,
});
}
@ -151,7 +152,7 @@ sub outputLoginInsufficient {
sub outputLoginFailed {
my $self = shift;
my($app, $output, $tried) = @_;
$output->output(undef, 'loginFailed', {
$output->output('login.failed', {
'tried' => $tried,
});
}
@ -160,7 +161,7 @@ sub outputLoginFailed {
sub outputLoginDetailsSent {
my $self = shift;
my($app, $output, $address, $protocol) = @_;
$output->output(undef, 'loginDetailsSent', {
$output->output('login.detailsSent', {
'address' => $address,
'protocol' => $protocol,
});
@ -170,30 +171,40 @@ sub outputLoginDetailsSent {
sub outputLoginDetails {
my $self = shift;
my($app, $output, $username, $password) = @_;
$output->output(undef, 'loginDetails', {
$output->output('login.details', {
'username' => $username,
'password' => $password,
});
}
# dispatcher.output
sub strings {
return (
'login.accessDenied' => 'Displayed when the user does not have the requisite right (namely, data.right)',
'login.failed' => 'Displayed when the user has not logged in (data.tried is false) or when the credentials were wrong (data.tried is true)',
'login.detailsSent' => 'The password was sent to data.address using data.protocol',
'login.details' => 'The message containing the data.username and data.password of a new account or when the user has forgotten his password (only required for contact protocols, e.g. e-mail)',
);
}
# dataSource.strings.default
sub getDefaultString {
my $self = shift;
my($app, $protocol, $string) = @_;
if ($protocol eq 'stdout') {
if ($string eq 'loginAccessDenied') {
if ($string eq 'login.accessDenied') {
return '<text>Access Denied<br/></text>';
} elsif ($string eq 'loginFailed') {
} elsif ($string eq 'login.failed') {
return '<text><if lvalue="(data.tried)" condition="=" rvalue="1">Wrong username or password.</if><else>You must give your username or password.</else><br/><!-- XXX offer to create an account or send the password --><br/></text>';
} elsif ($string eq 'loginDetailsSent') {
} elsif ($string eq 'login.detailsSent') {
return '<text>Login details were sent. (Protocol: <text value="(data.protocol)"/>; Address: <text value="(data.address)"/>)<br/></text>';
}
} elsif ($protocol eq 'http') {
if ($string eq 'loginAccessDenied') {
if ($string eq 'login.accessDenied') {
return '<text>HTTP/1.1 401 Access Denied<br/>Content-Type: text/plain<br/><br/>Access Denied</text>';
} elsif ($string eq 'loginFailed') {
} elsif ($string eq 'login.failed') {
return '<text>HTTP/1.1 401 Login Required<br/>WWW-Authenticate: Basic realm="<text value="(data.app.name)"/>"<br/>Content-Type: text/plain<br/><br/><if lvalue="(data.tried)" condition="=" rvalue="1">Wrong username or password.</if><else>You must give your username or password.</else><br/><!-- XXX offer to create an account or send the password --></text>';
} elsif ($string eq 'loginDetailsSent') {
} elsif ($string eq 'login.detailsSent') {
return '<text>HTTP/1.1 200 OK<br/>Content-Type: text/plain<br/><br/>Login details were sent.<br/>Protocol: <text value="(data.protocol)"/><br/>Address: <text value="(data.address)"/>)</text>';
}
}

34
mozilla/webtools/PLIF/PLIF/Service/Coses.pm
View File

@ -47,6 +47,9 @@ sub expand {
my @stack = (); my $stack = $self->parseString($self->getString($app, $session, $protocol, $string));
my @scope = (); my $scope = {'data' => $data};
my $result = '';
if (not $scope->{'coses: skip sanitation'}) {
$self->sanitiseScope($scope);
}
node: while (1) {
if ($index > $#$stack) {
# end of this level, pop the stack
@ -233,7 +236,7 @@ sub evaluateNestedVariableSafely {
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");
$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;
}
@ -266,6 +269,7 @@ sub evaluateExpression {
$ # 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))
# note that if b="x" and a="(b)" then "(a)" should be evaluated to "x"
}
# expand outer variable without safety checks, if there are any
# first, check if the result would be a single variable
@ -283,7 +287,7 @@ sub evaluateExpression {
$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
# 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.
@ -390,3 +394,29 @@ sub sort {
# else:
return reverse @list;
}
sub sanitiseScope {
my $self = shift;
my($data) = @_;
my @stack = ($data);
while (@stack) {
my $value = pop(@stack);
if (ref($value) eq 'HASH') {
push(@stack, values(%$value));
foreach my $key (keys(%$value)) {
if ($key =~ /[\(\.\)]/) {
my $backup = $value->{$key};
delete($value->{$key});
$key =~ tr/(.)/[:]/;
while (exists($value->{$key})) {
$key .= '_';
}
$value->{$key} = $backup;
}
}
} elsif (ref($value) eq 'ARRAY') {
push(@stack, @$value);
}
}
return $data;
}

13
mozilla/webtools/PLIF/PLIF/Service/GenericOutputs.pm
View File

@ -37,6 +37,7 @@ sub provides {
my $class = shift;
my($service) = @_;
return ($service eq 'dispatcher.output.generic' or
$service eq 'dispatcher.output' or
$service eq 'dataSource.strings.default' or
$class->SUPER::provides($service));
}
@ -46,7 +47,7 @@ sub provides {
sub outputRequest {
my $self = shift;
my($app, $output, $argument) = @_;
$output->output(undef, 'request', {
$output->output('request', {
'command' => $app->command,
'argument' => $argument,
});
@ -56,11 +57,19 @@ sub outputRequest {
sub outputReportFatalError {
my $self = shift;
my($app, $output, $error) = @_;
$output->output(undef, 'error', {
$output->output('error', {
'error' => $error,
});
}
# dispatcher.output
sub strings {
return (
'request' => 'A prompt for user input (only required for interactive protocols, namely stdout)',
'error' => 'The message given to the user when something goes horribly wrong',
);
}
# dataSource.strings.default
sub getDefaultString {
my $self = shift;