Author: spadkins
Date: Wed May 21 11:29:24 2008
New Revision: 11299
Modified:
p5ee/trunk/App-Context/CHANGES
p5ee/trunk/App-Context/lib/App/Context.pm
p5ee/trunk/App-Context/lib/App/Context/HTTP.pm
p5ee/trunk/App-Context/lib/App/Request/CGI.pm
Log:
added the ability to do RPC
Modified: p5ee/trunk/App-Context/CHANGES
==============================================================================
--- p5ee/trunk/App-Context/CHANGES (original)
+++ p5ee/trunk/App-Context/CHANGES Wed May 21 11:29:24 2008
@@ -2,6 +2,13 @@
# CHANGE LOG
#########################################
+VERSION 0.967 (not yet released)
+ x App::Storable - protect against varying versions of Storable which
may cause deserialization exceptions
+ x App::Serializer::Json - read and write JSON
+ x App::Serializer::Html - serialize output as HTML for debugging/viewing
+ x App::Context::HTTP - add support for RPC and REST (in addition to web
app support)
+ x App::Context::service_exists() - detect if a service exists in the
config/session (generalizes session_object_exists())
+
VERSION 0.9661
x updated the dependencies so that the CPAN tests don't fail
Modified: p5ee/trunk/App-Context/lib/App/Context.pm
==============================================================================
--- p5ee/trunk/App-Context/lib/App/Context.pm (original)
+++ p5ee/trunk/App-Context/lib/App/Context.pm Wed May 21 11:29:24 2008
@@ -811,7 +811,6 @@
=cut
# Standard Services: provided in the App-Context distribution
-sub serializer { my $self = shift; return
$self->service("Serializer",@_); }
sub call_dispatcher { my $self = shift; return
$self->service("CallDispatcher",@_); }
sub message_dispatcher { my $self = shift; return
$self->service("MessageDispatcher",@_); }
sub resource_locker { my $self = shift; return
$self->service("ResourceLocker",@_); }
@@ -821,6 +820,22 @@
sub session_object { my $self = shift; return
$self->service("SessionObject",@_); }
sub value_domain { my $self = shift; return
$self->service("ValueDomain",@_); }
+sub serializer {
+ my $self = shift;
+ my $name = shift;
+ my (@args);
+ if ($#_ > -1 || !$name || $self->service_exists("Serializer", $name)) {
+ @args = @_;
+ }
+ else {
+ my $class_base = ucfirst(lc($name));
+ $class_base =~ s/_([a-z])/"_" . uc($1)/eg;
+ my $class = "App::Serializer::" . $class_base;
+ @args = (class => $class);
+ }
+ return $self->service("Serializer", $name, @args);
+}
+
# Extended Services: provided in the App-Widget and App-Repository
distributions
# this is kind of cheating for the core to know about the extensions, but OK
sub template_engine { my $self = shift; return
$self->service("TemplateEngine",@_); }
@@ -903,6 +918,37 @@
return $exists;
}
+sub service_exists {
+ &App::sub_entry if ($App::trace);
+ my ($self, $service_type, $service_name) = @_;
+ my ($exists, $service_template, $service_class);
+
+ $service_class =
+ $self->{session}{cache}{$service_type}{$service_name}{class} ||
+ $self->{session}{store}{$service_type}{$service_name}{class} ||
+ $self->{conf}{$service_type}{$service_name}{class};
+
+ if (!$service_class) {
+
+ $service_template =
+ $self->{session}{cache}{$service_type}{$service_name}{type} ||
+ $self->{session}{store}{$service_type}{$service_name}{type} ||
+ $self->{conf}{$service_type}{$service_name}{type};
+
+ if ($service_template) {
+ $service_class =
$self->{conf}{"${service_type}Type"}{$service_template}{class};
+ }
+ }
+
+ $exists = $service_class ? 1 : 0;
+
+ $self->dbgprint("Context->service_exists($service_name) = $exists")
+ if ($App::DEBUG && $self->dbg(2));
+
+ &App::sub_exit($exists) if ($App::trace);
+ return $exists;
+}
+
#############################################################################
# PUBLIC METHODS
#############################################################################
Modified: p5ee/trunk/App-Context/lib/App/Context/HTTP.pm
==============================================================================
--- p5ee/trunk/App-Context/lib/App/Context/HTTP.pm (original)
+++ p5ee/trunk/App-Context/lib/App/Context/HTTP.pm Wed May 21 11:29:24 2008
@@ -145,17 +145,23 @@
my $user = $self->user();
my $authorization = $self->authorization();
my $events = $self->{events};
- my ($event, $service_type, $service_name, $method, $args);
+ my ($event, $service_type, $service_name, $method, $args,
$return_results, $return_event_results, $event_results);
my $results = "";
# my $display_current_widget = 1;
while ($#$events > -1) {
$event = shift(@$events);
- ($service_type, $service_name, $method, $args) = @$event;
+ ($service_type, $service_name, $method, $args,
$return_event_results) = @$event;
if
($authorization->is_authorized("/App/$service_type/$service_name/$method",
$user)) {
- $results = $self->call($service_type, $service_name, $method,
$args);
- $args = join(",", @$args) if (ref($args) eq "ARRAY");
-
$self->lap_timer("$service_type($service_name).$method($args)") if ($timer);
+ $event_results = $self->call($service_type, $service_name,
$method, $args);
+ if ($return_event_results) {
+ $results = $event_results;
+ $return_results = 1;
+ }
+ if ($timer) {
+ my $args_str = (ref($args) eq "ARRAY") ? join(",", @$args)
: $args;
+
$self->lap_timer("$service_type($service_name).$method($args_str)");
+ }
$user = $self->user();
}
}
@@ -174,7 +180,7 @@
}
}
- $results = $self->service($service_type, $service_name);
+ $results = $self->service($service_type, $service_name) if
(!$return_results);
my $response = $self->response();
my $ref = ref($results);
@@ -216,42 +222,6 @@
&App::sub_exit() if ($App::trace);
}
-# this code needs to be restored at the Context->dispatch_events() level
-# $name = $context->so_get("default", "name");
-# $service = $context->so_get("default", "service");
-# $returntype = $context->so_get("default", "returntype");
-# # print "name=[$curr_name] service=[$curr_service]
returntype=[$curr_returntype]\n";
-# ...
-# $context->so_set("default", "curr_service", $curr_service);
-# $context->so_set("default", "curr_name", $curr_name);
-# # $context->so_set("default", "curr_method", $curr_method);
-# # $context->so_set("default", "curr_args", $curr_args);
-# $context->so_set("default", "curr_returntype", $curr_returntype);
-# ...
-# if ($service) {
-# my $service = $context->service($service, $name);
-# my $response = $context->response();
-# if (!$service) {
-# $response->content("Service not defined: $service($name)\n");
-# }
-# elsif (!$service->can($method)) {
-# $response->content("Method not defined on Service:
$service($name).$method($args)\n");
-# }
-# else {
-# my @results = $service->$method($args);
-# if ($#results == -1) {
-# $response->content($service->internals());
-# }
-# elsif ($#results == 0) {
-# $response->content($results[0]);
-# $response->content_type($service->content_type());
-# }
-# else {
-# $response->content([EMAIL PROTECTED]);
-# }
-# }
-# }
-
sub send_error {
&App::sub_entry if ($App::trace);
my ($self, $errmsg) = @_;
@@ -347,57 +317,23 @@
=cut
-#sub send_results {
-# my ($self, $results) = @_;
-#
-# my ($serializer, $returntype);
-#
-# if (ref($results)) {
-# $returntype = $self->{returntype};
-# $serializer = $self->serializer($returntype);
-# $results = $serializer->serialize($results);
-# }
-#
-# if ($self->{messages}) {
-# my $msg = $self->{messages};
-# $self->{messages} = "";
-# $msg =~ s/<br>/\n/g;
-# print $msg;
-# }
-# else {
-# print $results;
-# }
-#}
-#
-#sub send_error {
-# my ($self, $errmsg) = @_;
-# print <<EOF;
-#-----------------------------------------------------------------------------
-#AN ERROR OCCURRED in App::Context->dispatch_events()
-#-----------------------------------------------------------------------------
-#$errmsg
-#
-#-----------------------------------------------------------------------------
-#Additional messages from earlier stages may be relevant if they exist below.
-#-----------------------------------------------------------------------------
-#$self->{messages}
-#EOF
-#}
-
sub send_response {
&App::sub_entry if ($App::trace);
my $self = shift;
- my ($serializer, $response, $ctype, $content, $content_type, $headers);
- $response = $self->response();
- $content = $response->content();
+ my ($serializer, $response, $content, $content_type, $headers);
+ $response = $self->response();
+ $content = $response->content();
+ # NOTE: $content will be a scalar if HTML is being returned
if (ref($content)) {
- $ctype = $self->so_get("default", "ctype", "default");
- $serializer = $self->serializer($ctype);
+ my $request = $self->request();
+ my $returntype = $request->get_returntype();
+ $serializer = $self->serializer($returntype);
$content = $serializer->serialize($content);
$content_type = $serializer->serialized_content_type();
}
+
$content_type = $response->content_type() if (!$content_type);
$content_type = "text/plain" if (!$content_type);
$headers = "Content-type: $content_type\n";
Modified: p5ee/trunk/App-Context/lib/App/Request/CGI.pm
==============================================================================
--- p5ee/trunk/App-Context/lib/App/Request/CGI.pm (original)
+++ p5ee/trunk/App-Context/lib/App/Request/CGI.pm Wed May 21 11:29:24 2008
@@ -280,7 +280,7 @@
# Note: the <returntype> is found in another location when it is
needed
# here, we simply need to delete the trailing :<returntype> or
.<returntype>
$path_info =~ s!:[a-zA-Z0-9_]+$!!; # delete trailing :<returntype>
- $path_info =~ s!\.(html|xml|yaml|csv|pdf|perl)$!!; # delete
trailing .<returntype>
+ $path_info =~ s!\.(html|xml|yaml|csv|pdf|perl|json)$!!; # delete
trailing .<returntype>
if ($path_info =~ s!^/([A-Z][A-Za-z0-9]*)/!/!) {
$service = $1;
@@ -349,9 +349,24 @@
if ($service && $name && $method) {
$temp = $cgi->param("args");
- $args = $temp if ($temp);
-
- if (defined $args && !ref($args)) {
+ if ($temp) {
+ $args = $temp;
+ if ($args =~ /^\s*$/) {
+ $args = [];
+ }
+ else {
+ my $argstype = $cgi->param("argstype") ||
$self->get_returntype();
+ my ($ser);
+ if ($argstype) {
+ $ser = $context->serializer($argstype);
+ }
+ else {
+ $ser = $context->serializer("one_line", class =>
"App::Serializer::OneLine");
+ }
+ $args = $ser->deserialize($args);
+ }
+ }
+ elsif (defined $args && !ref($args)) {
if ($args =~ /^\s*$/) {
$args = [];
}
@@ -363,7 +378,7 @@
if (!$options->{open_widget_urls} && (!$permissions ||
!$permissions->{$method})) {
die "Not permitted to perform the [$method] method on the
[$name] widget\n";
}
- push(@events, [ $service, $name, $method, $args ]);
+ push(@events, [ $service, $name, $method, $args, 1 ]);
}
elsif ($service && $name) {
if (!$options->{open_widget_urls} && (!$permissions ||
!$permissions->{view})) {
@@ -466,7 +481,7 @@
if ($args eq "") {
# do nothing, @args = ()
}
- elsif ($args =~ /\{/) { # } balance
+ elsif ($args =~ /\{/) {
foreach $arg (split(/ *, */,$args)) {
if ($arg =~ /^\{(.*)\}$/) {
push(@args, $context->so_get($1));
@@ -571,22 +586,26 @@
&App::sub_entry if ($App::trace);
my ($self, $cgi) = @_;
- if (!defined $cgi) {
- $cgi = $self->{cgi};
- }
- elsif (!defined $self->{cgi}) {
- $self->{cgi} = $cgi;
- }
- my ($returntype);
- if ($cgi) {
- $returntype = $cgi->param("returntype");
- }
+ my $returntype = $self->{returntype};
if (!$returntype) {
+ if (!defined $cgi) {
+ $cgi = $self->{cgi};
+ }
+ elsif (!defined $self->{cgi}) {
+ $self->{cgi} = $cgi;
+ }
+ if ($cgi) {
+ $returntype = $cgi->param("returntype");
+ }
my $context = $self->{context};
my $path_info = $ENV{PATH_INFO};
if ($path_info =~ /:([a-zA-Z0-9_]+)$/) {
$returntype = $1;
}
+ elsif ($path_info =~ m!\.(html|xml|yaml|csv|pdf|perl|json)$!) {
+ $returntype = $1;
+ }
+ $self->{returntype} = $returntype;
}
&App::sub_exit($returntype) if ($App::trace);
return($returntype);
