diff --git a/webtools/PLIF/PLIF/Controller.pm b/webtools/PLIF/PLIF/Controller.pm
index a2b9916dd9d6..0d413b6ca14b 100644
--- a/webtools/PLIF/PLIF/Controller.pm
+++ b/webtools/PLIF/PLIF/Controller.pm
@@ -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.')
diff --git a/webtools/PLIF/PLIF/DataSource/DebugStrings.pm b/webtools/PLIF/PLIF/DataSource/DebugStrings.pm
index f0672ba3f771..02800ae21d51 100644
--- a/webtools/PLIF/PLIF/DataSource/DebugStrings.pm
+++ b/webtools/PLIF/PLIF/DataSource/DebugStrings.pm
@@ -84,6 +84,9 @@ sub getDefaultString {
+
+
+
diff --git a/webtools/PLIF/PLIF/DataSource/User.pm b/webtools/PLIF/PLIF/DataSource/User.pm
index 034ef39d3cda..1d151ddcf9e6 100644
--- a/webtools/PLIF/PLIF/DataSource/User.pm
+++ b/webtools/PLIF/PLIF/DataSource/User.pm
@@ -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()
}
diff --git a/webtools/PLIF/PLIF/DataSource/User/MySQL.pm b/webtools/PLIF/PLIF/DataSource/User/MySQL.pm
index 37a773c7e5eb..b00e5006ed18 100644
--- a/webtools/PLIF/PLIF/DataSource/User/MySQL.pm
+++ b/webtools/PLIF/PLIF/DataSource/User/MySQL.pm
@@ -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);
diff --git a/webtools/PLIF/PLIF/Input/Arguments.pm b/webtools/PLIF/PLIF/Input/Arguments.pm
index 08feef35ef0e..5a499d7ae8ff 100644
--- a/webtools/PLIF/PLIF/Input/Arguments.pm
+++ b/webtools/PLIF/PLIF/Input/Arguments.pm
@@ -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}};
}
diff --git a/webtools/PLIF/PLIF/Input/CommandLine.pm b/webtools/PLIF/PLIF/Input/CommandLine.pm
index 6bc192ddfa62..2f7e37a85294 100644
--- a/webtools/PLIF/PLIF/Input/CommandLine.pm
+++ b/webtools/PLIF/PLIF/Input/CommandLine.pm
@@ -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);
diff --git a/webtools/PLIF/PLIF/Output/Generic.pm b/webtools/PLIF/PLIF/Output/Generic.pm
index d3772c05f64d..3dd47bdc62ad 100644
--- a/webtools/PLIF/PLIF/Output/Generic.pm
+++ b/webtools/PLIF/PLIF/Output/Generic.pm
@@ -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;
}
diff --git a/webtools/PLIF/PLIF/Program.pm b/webtools/PLIF/PLIF/Program.pm
index 84610242bb72..a9228515f02b 100644
--- a/webtools/PLIF/PLIF/Program.pm
+++ b/webtools/PLIF/PLIF/Program.pm
@@ -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('');
diff --git a/webtools/PLIF/PLIF/Service.pm b/webtools/PLIF/PLIF/Service.pm
index 9d5c48932431..0060cce88cf1 100644
--- a/webtools/PLIF/PLIF/Service.pm
+++ b/webtools/PLIF/PLIF/Service.pm
@@ -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;
}
}
diff --git a/webtools/PLIF/PLIF/Service/Coses.pm b/webtools/PLIF/PLIF/Service/Coses.pm
index 73d363bfdf47..12e139b81c31 100644
--- a/webtools/PLIF/PLIF/Service/Coses.pm
+++ b/webtools/PLIF/PLIF/Service/Coses.pm
@@ -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') {
diff --git a/webtools/PLIF/PLIF/Service/GenericOutputs.pm b/webtools/PLIF/PLIF/Service/GenericOutputs.pm
index 0797d3a2c948..82306eae87c5 100644
--- a/webtools/PLIF/PLIF/Service/GenericOutputs.pm
+++ b/webtools/PLIF/PLIF/Service/GenericOutputs.pm
@@ -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 '''? ';
+ return '\'\'? ';
} elsif ($string eq 'error') {
- return 'Error:
';
+ $self->dump(9, 'Looks like an error occured, because the string \'error\' is being requested');
+ return 'Error:
';
}
} elsif ($protocol eq 'http') {
if ($string eq 'error') {
- return 'HTTP/1.1 500 Internal Error
Content-Type: text/plain
Error:
';
+ $self->dump(9, 'Looks like an error occured, because the string \'error\' is being requested');
+ return 'HTTP/1.1 500 Internal Error
Content-Type: text/plain
Error:
';
}
}
return; # nope, sorry
diff --git a/webtools/PLIF/PLIF/Service/Login.pm b/webtools/PLIF/PLIF/Service/Login.pm
index b6b0d30888f3..a04123e5df17 100644
--- a/webtools/PLIF/PLIF/Service/Login.pm
+++ b/webtools/PLIF/PLIF/Service/Login.pm
@@ -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 'Access Denied
';
} elsif ($string eq 'loginFailed') {
- return 'Wrong username or password.You must give your username or password.
';
+ return 'Wrong username or password.You must give your username or password.
';
} elsif ($string eq 'loginDetailsSent') {
- return 'Login details were sent. (Protocol: ; Address: )';
+ return 'Login details were sent. (Protocol: ; Address: )
';
}
} elsif ($protocol eq 'http') {
if ($string eq 'loginAccessDenied') {
return 'HTTP/1.1 401 Access Denied
Content-Type: text/plain
Access Denied';
} elsif ($string eq 'loginFailed') {
- return 'HTTP/1.1 401 Login Required
WWW-Authenticate: Basic realm=""
Content-Type: text/plain
Wrong username or password.You must give your username or password.';
+ return 'HTTP/1.1 401 Login Required
WWW-Authenticate: Basic realm=""
Content-Type: text/plain
Wrong username or password.You must give your username or password.
';
} elsif ($string eq 'loginDetailsSent') {
return 'HTTP/1.1 200 OK
Content-Type: text/plain
Login details were sent.
Protocol:
Address: )';
}
@@ -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);
}
diff --git a/webtools/PLIF/PLIF/Service/User.pm b/webtools/PLIF/PLIF/Service/User.pm
index d3a9003049de..56418e787868 100644
--- a/webtools/PLIF/PLIF/Service/User.pm
+++ b/webtools/PLIF/PLIF/Service/User.pm
@@ -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;
diff --git a/webtools/PLIF/PLIF/Service/UserField.pm b/webtools/PLIF/PLIF/Service/UserField.pm
index cd8b0d53efcd..1bd0279324c6 100644
--- a/webtools/PLIF/PLIF/Service/UserField.pm
+++ b/webtools/PLIF/PLIF/Service/UserField.pm
@@ -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);
}
}