зеркало из https://github.com/mozilla/pjs.git
Fixing a gazillion syntax, logic and XML errors and adding some debug code. It compiles!
This commit is contained in:
ian%hixie.ch
Родитель
0157ac85b3
Коммит
f71bddbcc2
|
|
@ -124,7 +124,7 @@ sub getObject {
|
|||
sub getServiceList {
|
||||
my $self = shift;
|
||||
my($name) = @_;
|
||||
my @services;
|
||||
my @services = ();
|
||||
foreach my $service (@{$self->services}) {
|
||||
if ($service->provides($name)) {
|
||||
# Create the service. If it is already created, this will
|
||||
|
|
@ -137,6 +137,8 @@ sub getServiceList {
|
|||
push(@services, $service);
|
||||
}
|
||||
}
|
||||
local $" = '\', \'';
|
||||
$self->dump(10, "Created a service list for '$name' containing: '@services'");
|
||||
return @services;
|
||||
}
|
||||
|
||||
|
|
@ -145,12 +147,13 @@ sub getObjectList {
|
|||
# constructor call
|
||||
my $self = shift;
|
||||
my($name) = @_;
|
||||
my @services;
|
||||
my @services = ();
|
||||
foreach my $service (@{$self->objects}) {
|
||||
if ($service->objectProvides($name)) {
|
||||
push(@services, $service);
|
||||
}
|
||||
}
|
||||
$self->dump(10, "Created an object list for '$name' containing: '@services'");
|
||||
return @services;
|
||||
}
|
||||
|
||||
|
|
@ -213,15 +216,16 @@ sub dispatchMethod {
|
|||
my $self = shift;
|
||||
my($service, $prefix, $method, @arguments) = @_;
|
||||
# the \u makes the first letter of the $command uppercase
|
||||
$self->dump(10, "dispatching method '$prefix\u$method'...");
|
||||
return ($self->getSelectingServiceList($service)->dispatch($self, "$prefix\u$method", @arguments) or
|
||||
$self->getSelectingObjectList($service)->dispatch($self, "$prefix\u$method", @arguments));
|
||||
}
|
||||
|
||||
sub DESTROY {
|
||||
my $self = shift;
|
||||
$self->dump(9, 'At controller shutdown, there were ' .
|
||||
$self->dump(10, 'At controller shutdown, there were ' .
|
||||
# I assume there will always be > 1 and so haven't bothered to special case the singular grammar
|
||||
scalar($self->services) .
|
||||
scalar(@{$self->services}) .
|
||||
' services registered, of which ' .
|
||||
scalar(keys(%{$self->servicesHash})) .
|
||||
' had been placed in the services hash.')
|
||||
|
|
|
|||
|
|
@ -84,6 +84,9 @@ sub getDefaultString {
|
|||
<embed string="debug.dumpVars"/>
|
||||
</set>
|
||||
</set>
|
||||
<else>
|
||||
<text value=" (prefix)"/><br/>
|
||||
</else>
|
||||
</if>
|
||||
</with>
|
||||
<without variable="prefix">
|
||||
|
|
|
|||
|
|
@ -65,7 +65,7 @@ sub getUserByContactDetails {
|
|||
my($app, $contactName, $address) = @_;
|
||||
# decent databases can do this in one go. Those that can't can do
|
||||
# it in a generic two-step process:
|
||||
return $self->getUserByID($app, $self->getUserIDByContactDetails($app, $username));
|
||||
return $self->getUserByID($app, $self->getUserIDByContactDetails($app, $contactName, $address));
|
||||
# XXX no error checking! if getUserID... return undef, return ()!
|
||||
# return the same as getUserByID()
|
||||
}
|
||||
|
|
|
|||
|
|
@ -48,7 +48,7 @@ sub getUserIDByUsername {
|
|||
return $self->database($app)->execute('SELECT userData.userID
|
||||
FROM userData, userDataTypes
|
||||
WHERE userData.fieldID = userDataTypes.fieldID
|
||||
AND userDataTypes.category = 'contact'
|
||||
AND userDataTypes.category = \'contact\'
|
||||
AND CONCAT(userDataTypes.data, userData.data) = ?', $username)->row->[0];
|
||||
# XXX no error checking!
|
||||
# return userID or undef
|
||||
|
|
@ -60,7 +60,7 @@ sub getUserIDByContactDetails {
|
|||
return $self->database($app)->execute('SELECT userData.userID
|
||||
FROM userData, userDataTypes
|
||||
WHERE userData.fieldID = userDataTypes.fieldID
|
||||
AND userDataTypes.category = 'contact'
|
||||
AND userDataTypes.category = \'contact\'
|
||||
AND userDataTypes.name = ?
|
||||
AND userData.data = ?', $contactName, $address)->row->[0];
|
||||
# XXX no error checking!
|
||||
|
|
@ -231,19 +231,12 @@ sub setGroup {
|
|||
# This probably doesn't need to be too efficient...
|
||||
$self->assert(defined($groupID) or defined($groupName), 1,
|
||||
'Invalid arguments to DataSource::User::setGroup: \'groupID\' and \'groupName\' both undefined');
|
||||
|
||||
if (defined($fieldID)) {
|
||||
} else {
|
||||
return $self->database($app)->execute('INSERT INTO userDataTypes SET category=?, name=?, type=?, data=?, mode=?',
|
||||
$category, $name, $type, $data, $mode)->ID;
|
||||
}
|
||||
|
||||
if (not defined($groupID)) {
|
||||
# add a new record
|
||||
$groupID = $self->database($app)->execute('INSERT INTO groups SET name=?', $name)->ID;
|
||||
$groupID = $self->database($app)->execute('INSERT INTO groups SET name=?', $groupName)->ID;
|
||||
} elsif (defined($groupName)) {
|
||||
# replace the existing record
|
||||
$self->database($app)->execute('UPDATE groups SET name=? WHERE groupID = ?', $name, $groupID);
|
||||
$self->database($app)->execute('UPDATE groups SET name=? WHERE groupID = ?', $groupName, $groupID);
|
||||
}
|
||||
# now update the rights mapping table
|
||||
$self->database($app)->execute('DELETE FROM groupRightsMapping WHERE groupID = ?', $groupID);
|
||||
|
|
|
|||
|
|
@ -63,7 +63,7 @@ sub getArgument {
|
|||
sub getArguments {
|
||||
my $self = shift;
|
||||
my $result = {};
|
||||
foreach my $argument (keys %$self) {
|
||||
foreach my $argument (keys(%$self)) {
|
||||
if ($argument =~ /^argument (.*)$/o) {
|
||||
$result->{$1} = \@{$self->{$argument}};
|
||||
}
|
||||
|
|
|
|||
|
|
@ -86,7 +86,7 @@ sub createArgument {
|
|||
if ($self->getArgument('batch')) {
|
||||
$self->SUPER::createArgument($argument);
|
||||
} else {
|
||||
$self->dump(5, "going to request $argument from user!");
|
||||
$self->warn(5, "going to request '$argument' from user!");
|
||||
$self->app->output->request($argument);
|
||||
# get input from user :-)
|
||||
my $term = Term::ReadLine->new($self->app->name);
|
||||
|
|
|
|||
|
|
@ -134,7 +134,9 @@ sub methodMissing {
|
|||
sub fillData {
|
||||
my $self = shift;
|
||||
my($data) = @_;
|
||||
$data->{'app'} = $app->hash;
|
||||
$data->{'session'} = $self->session->hash;
|
||||
$data->{'input'} = $app->input->hash;
|
||||
$data->{'app'} = $self->app->hash;
|
||||
if (defined($self->actualSession)) {
|
||||
$data->{'session'} = $self->actualSession->hash;
|
||||
}
|
||||
$data->{'input'} = $self->app->input->hash;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@ $app->run();
|
|||
# setup everything (automatically called by the constructor, above)
|
||||
sub init {
|
||||
my $self = shift;
|
||||
$self->dump(5, '*** Started PLIF Application ***');
|
||||
$self->dump(5, '', '', '*** Started PLIF Application ***', '********************************');
|
||||
$self->SUPER::init(@_);
|
||||
$self->initInput();
|
||||
}
|
||||
|
|
@ -55,7 +55,7 @@ sub run {
|
|||
$self->objects([]);
|
||||
if ($self->verifyInput()) {
|
||||
if ($self->input->command) {
|
||||
$self->command($command);
|
||||
$self->command($self->input->command);
|
||||
$self->dispatch($self->input->command);
|
||||
} else {
|
||||
$self->command('');
|
||||
|
|
|
|||
|
|
@ -46,10 +46,13 @@ sub dispatch {
|
|||
my $self = shift;
|
||||
my($app, $name, @arguments) = @_;
|
||||
my $method = $self->can($name);
|
||||
local $" = '\', \'';
|
||||
if ($method) {
|
||||
$self->dump(10, "Attempting to dispatch method: $self->$name('$app', '@arguments')");
|
||||
&$method($self, $app, @arguments);
|
||||
return 1;
|
||||
} else {
|
||||
return undef;
|
||||
$self->dump(10, "There is no method '$name' in object '$self', skipping...");
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -93,32 +93,38 @@ sub expand {
|
|||
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};
|
||||
if (@items) {
|
||||
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
|
||||
$superscope->{'coses: last condition'} = 1;
|
||||
if ($scope == $superscope) {
|
||||
$scope = {%$scope};
|
||||
}
|
||||
$scope->{'coses: last condition'} = 0;
|
||||
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;
|
||||
} else {
|
||||
$superscope->{'coses: last condition'} = 0;
|
||||
}
|
||||
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) {
|
||||
|
|
@ -199,15 +205,16 @@ sub getString {
|
|||
sub evaluateVariable {
|
||||
my $self = shift;
|
||||
my($variable, $scope) = @_;
|
||||
my @parts = split(/\./o, $variable); # split variable at dots ('.')
|
||||
my @parts = split(/\./o, $variable, -1); # split variable at dots ('.') (the negative number prevents null trailing fields from being stripped)
|
||||
# drill down through scope
|
||||
foreach my $part (@parts) {
|
||||
if (ref($scope) eq 'HASH') {
|
||||
$scope = $scope->{$part};
|
||||
} elsif (ref($scope) eq 'ARRAY') {
|
||||
$self->assert(scalar($part =~ /^\d+$/o), 1, "Tried to drill into an array using a non-numeric key ('$part')");
|
||||
$scope = $scope->[$part];
|
||||
} else {
|
||||
$self->error(1, "Could not resolve '$variable' at '$part'");
|
||||
$self->error(1, "Could not resolve '$variable' (the part giving me trouble was '$part')");
|
||||
}
|
||||
}
|
||||
if (defined($scope)) {
|
||||
|
|
@ -361,7 +368,7 @@ sub sort {
|
|||
my $self = shift;
|
||||
my($order, @list) = @_;
|
||||
# sort the list (in reverse order!)
|
||||
if (defined($order)) {
|
||||
if (defined($order) and scalar(@list)) {
|
||||
if ($order eq 'lexical') {
|
||||
return sort { $b cmp $a } @list;
|
||||
} elsif ($order eq 'reverse lexical') {
|
||||
|
|
|
|||
|
|
@ -45,7 +45,7 @@ sub provides {
|
|||
# this is typically used by input devices
|
||||
sub outputRequest {
|
||||
my $self = shift;
|
||||
my($app, $argument) = @_;
|
||||
my($app, $output, $argument) = @_;
|
||||
$output->output(undef, 'request', {
|
||||
'command' => $app->command,
|
||||
'argument' => $argument,
|
||||
|
|
@ -55,8 +55,8 @@ sub outputRequest {
|
|||
# dispatcher.output.generic
|
||||
sub outputReportFatalError {
|
||||
my $self = shift;
|
||||
my($error) = @_;
|
||||
$self->output(undef, 'error', {
|
||||
my($app, $output, $error) = @_;
|
||||
$output->output(undef, 'error', {
|
||||
'error' => $error,
|
||||
});
|
||||
}
|
||||
|
|
@ -67,13 +67,15 @@ sub getDefaultString {
|
|||
my($app, $protocol, $string) = @_;
|
||||
if ($protocol eq 'stdout') {
|
||||
if ($string eq 'request') {
|
||||
return '<text>'<text variable="(data.argument)"/>'? </text>';
|
||||
return '<text>\'<text value="(data.argument)"/>\'? </text>';
|
||||
} elsif ($string eq 'error') {
|
||||
return '<text>Error:<br/><text variable="(data.error)"/></br/></text>';
|
||||
$self->dump(9, 'Looks like an error occured, because the string \'error\' is being requested');
|
||||
return '<text>Error:<br/><text value="(data.error)"/><br/></text>';
|
||||
}
|
||||
} elsif ($protocol eq 'http') {
|
||||
if ($string eq 'error') {
|
||||
return '<text>HTTP/1.1 500 Internal Error<br/>Content-Type: text/plain<br/><br/>Error:<br/><text variable="(data.error)"/></text>';
|
||||
$self->dump(9, 'Looks like an error occured, because the string \'error\' is being requested');
|
||||
return '<text>HTTP/1.1 500 Internal Error<br/>Content-Type: text/plain<br/><br/>Error:<br/><text value="(data.error)"/></text>';
|
||||
}
|
||||
}
|
||||
return; # nope, sorry
|
||||
|
|
|
|||
|
|
@ -50,10 +50,10 @@ sub verifyInput {
|
|||
my $self = shift;
|
||||
my($app) = @_;
|
||||
# let's see if there are any protocol-specific user authenticators
|
||||
my @result = $self->getSelectingServiceList('input.verify.user.'.$app->input->protocol)->authenticateUser($app);
|
||||
my @result = $app->getSelectingServiceList('input.verify.user.'.$app->input->defaultOutputProtocol)->authenticateUser($app);
|
||||
if (not @result) {
|
||||
# ok, let's try the generic authenticators...
|
||||
@result = $self->getSelectingServiceList('input.verify.user.generic')->authenticateUser($app);
|
||||
@result = $app->getSelectingServiceList('input.verify.user.generic')->authenticateUser($app);
|
||||
}
|
||||
# now let's see what that gave us
|
||||
if (@result) {
|
||||
|
|
@ -73,7 +73,7 @@ sub authenticateUser {
|
|||
my $self = shift;
|
||||
my($app) = @_;
|
||||
if (defined($app->input->username)) {
|
||||
return $app->getService('user.factory')->getUserByCredentials($app->input->username, $app->input->password);
|
||||
return $app->getService('user.factory')->getUserByCredentials($app, $app->input->username, $app->input->password);
|
||||
} else {
|
||||
return; # return nothing (not undef)
|
||||
}
|
||||
|
|
@ -92,7 +92,7 @@ sub cmdSendPassword {
|
|||
my($app) = @_;
|
||||
my $protocol = $app->input->getAttribute('protocol');
|
||||
my $address = $app->input->getAttribute('address');
|
||||
if (defined($method) and defined($address)) {
|
||||
if (defined($protocol) and defined($address)) {
|
||||
my $user = $app->getService('user.factory')->getUserByContactDetails($app, $protocol, $address);
|
||||
my $password;
|
||||
if (defined($user)) {
|
||||
|
|
@ -110,7 +110,7 @@ sub cmdSendPassword {
|
|||
sub hasRight {
|
||||
my $self = shift;
|
||||
my($app, $right) = @_;
|
||||
my $user = $self->getObject('user');
|
||||
my $user = $app->getObject('user');
|
||||
if (defined($user)) {
|
||||
if ($user->hasRight($right)) {
|
||||
return $user;
|
||||
|
|
@ -183,15 +183,15 @@ sub getDefaultString {
|
|||
if ($string eq 'loginAccessDenied') {
|
||||
return '<text>Access Denied<br/></text>';
|
||||
} elsif ($string eq 'loginFailed') {
|
||||
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>';
|
||||
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') {
|
||||
return '<text>Login details were sent. (Protocol: <text variable="(data.protocol)"/>; Address: <text variable="(data.address)"/>)</br/></text>';
|
||||
return '<text>Login details were sent. (Protocol: <text variable="(data.protocol)"/>; Address: <text variable="(data.address)"/>)<br/></text>';
|
||||
}
|
||||
} elsif ($protocol eq 'http') {
|
||||
if ($string eq 'loginAccessDenied') {
|
||||
return '<text>HTTP/1.1 401 Access Denied<br/>Content-Type: text/plain<br/><br/>Access Denied</text>';
|
||||
} elsif ($string eq 'loginFailed') {
|
||||
return '<text>HTTP/1.1 401 Login Required<br/>WWW-Authenticate: Basic realm="<text variable="(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>';
|
||||
return '<text>HTTP/1.1 401 Login Required<br/>WWW-Authenticate: Basic realm="<text variable="(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') {
|
||||
return '<text>HTTP/1.1 200 OK<br/>Content-Type: text/plain<br/><br/>Login details were sent.<br/>Protocol: <text variable="(data.protocol)"/><br/>Address: <text variable="(data.address)"/>)</text>';
|
||||
}
|
||||
|
|
@ -215,7 +215,7 @@ sub createUser {
|
|||
my($app, $protocol, $address) = @_;
|
||||
my($password, $crypt) = $app->getService('service.passwords')->newPassword();
|
||||
my $user = $app->getService('user.factory')->getNewUser($app, $crypt);
|
||||
$user->getField('contact', $protocol)->data = $address;
|
||||
$user->getField('contact', $protocol)->data($address);
|
||||
return ($user, $password);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -84,7 +84,7 @@ sub getUserByContactDetails {
|
|||
|
||||
sub getUserByID {
|
||||
my $self = shift;
|
||||
my($app, $id) = @_;
|
||||
my($app, $userID) = @_;
|
||||
my(@data) = $app->getService('dataSource.user')->getUserByUserID($app, $userID);
|
||||
if (@data) {
|
||||
return $self->objectCreate($app, @data);
|
||||
|
|
@ -121,7 +121,7 @@ sub objectInit {
|
|||
$self->fieldsByID({});
|
||||
# don't forget to update the 'hash' function if you add more fields
|
||||
my $fieldFactory = $app->getService('user.fieldFactory');
|
||||
foreach my $fieldID (keys($fields)) {
|
||||
foreach my $fieldID (keys(%$fields)) {
|
||||
$self->insertField($fieldFactory->createFieldByID($app, $self, $fieldID, $fields->{$fieldID}));
|
||||
}
|
||||
$self->groups({%$groups}); # hash of groupID => groupName
|
||||
|
|
@ -146,13 +146,13 @@ sub hasField {
|
|||
}
|
||||
|
||||
# if you want to add a field, you do:
|
||||
# $user->getField('category', 'name')->data = $myData;
|
||||
# $user->getField('category', 'name')->data($myData);
|
||||
sub getField {
|
||||
my $self = shift;
|
||||
my($category, $name) = @_;
|
||||
my $field = $self->hasField($category, $name);
|
||||
if (not defined($field)) {
|
||||
$field = $self->insertField($fieldFactory->createFieldByName($app, $self, $fieldCategory, $fieldName));
|
||||
$field = $self->insertField($self->app->getService('user.fieldFactory')->createFieldByName($self->app, $self, $category, $name));
|
||||
}
|
||||
return $field;
|
||||
}
|
||||
|
|
@ -199,7 +199,7 @@ sub doAddressChange {
|
|||
my $field = $self->fieldsByID->{$self->newFieldID};
|
||||
$self->assert(defined($field), 1, 'Database integrity error: newFieldID doesn\'t map to a field!');
|
||||
if (defined($password) and ($self->app->getService('service.passwords')->checkPassword($self->newFieldPassword, $password))) {
|
||||
$field->data = $self->newFieldValue;
|
||||
$field->data($self->newFieldValue);
|
||||
} elsif (not defined($field->data)) {
|
||||
$field->remove();
|
||||
}
|
||||
|
|
@ -228,7 +228,7 @@ sub hash {
|
|||
$result->{'adminMessage'} = $self->adminMessage,
|
||||
$result->{'groups'} = $self->groups,
|
||||
$result->{'rights'} = keys(%{$self->rights});
|
||||
$result->{'fields'} = {},
|
||||
$result->{'fields'} = {};
|
||||
foreach my $field (values(%{$self->fieldsByID})) {
|
||||
# XXX should we also pass the field metadata on? (e.g. typeData)
|
||||
$result->{'fields'}->{$field->fieldID} = $field->data;
|
||||
|
|
|
|||
|
|
@ -135,8 +135,8 @@ sub DESTROY {
|
|||
sub write {
|
||||
my $self = shift;
|
||||
if ($self->{'_DELETE'}) {
|
||||
$self->app->getService('dataSource.user')->removeUserField($elf->app, $self->userID, $self->fieldID);
|
||||
$self->app->getService('dataSource.user')->removeUserField($self->app, $self->userID, $self->fieldID);
|
||||
} else {
|
||||
$self->app->getService('dataSource.user')->setUserField($elf->app, $self->userID, $self->fieldID, $self->data);
|
||||
$self->app->getService('dataSource.user')->setUserField($self->app, $self->userID, $self->fieldID, $self->data);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Загрузка…
Ссылка в новой задаче