@@ -1,3 +1,30 @@
+3.01 Thu Jun 19 23:01:25 2014
+ - Minor refactoring of the Method argument checking; it now happens
+ in the Method itself, as opposed to be divided among other modules.
+ It should have been this way since the beginning, but oh well.
+ - Tests updated to accommodate for the Method changes
+ - ExtDirect attribute parsing is more robust now, and tested
+ - Fixed several minor but very embarrassing bugs uncovered by the
+ new attribute parser tests
+ - Assorted tiny fixes here and there
+
+3.00 Thu Jun 12 17:54:23 2014
+ - Major refactoring of the RPC::ExtDirect module internals
+ - Configuration is now instance-based with RPC::ExtDirect::Config
+ - Package global variables are deprecated
+ - API tree is now kept in an RPC::ExtDirect::API instance rather
+ than internal data structures; Action and Method are full fledged
+ objects with public API
+ - API tree can now be initialized from a hashref as an alternative
+ to sub attributes
+ - Class-based Serialize and Deserialize packages are deprecated
+ in favor of combined instance based Serializer
+ - Improved authorization support for API generation and Method
+ invocation
+ - Tests used in all gateways are now unified and shipped with the
+ core RPC::ExtDirect package
+ - Tons of other changes and fixes, and no doubt more bugs
+
2.15 Tue May 6 17:44:10 2014
- Fixed failing tests due to changes in JSON::XS error output
@@ -1,48 +1,94 @@
Changes
lib/RPC/ExtDirect.pm
+lib/RPC/ExtDirect.pod
lib/RPC/ExtDirect/API.pm
-lib/RPC/ExtDirect/BEGIN.pm
-lib/RPC/ExtDirect/CHECK.pm
+lib/RPC/ExtDirect/API.pod
+lib/RPC/ExtDirect/API/Action.pm
+lib/RPC/ExtDirect/API/Action.pod
+lib/RPC/ExtDirect/API/Hook.pm
+lib/RPC/ExtDirect/API/Hook.pod
+lib/RPC/ExtDirect/API/Method.pm
+lib/RPC/ExtDirect/API/Method.pod
lib/RPC/ExtDirect/Config.pm
+lib/RPC/ExtDirect/Config.pod
lib/RPC/ExtDirect/Demo/PollProvider.pm
lib/RPC/ExtDirect/Demo/Profile.pm
lib/RPC/ExtDirect/Demo/TestAction.pm
lib/RPC/ExtDirect/Deserialize.pm
lib/RPC/ExtDirect/Event.pm
+lib/RPC/ExtDirect/Event.pod
lib/RPC/ExtDirect/EventProvider.pm
lib/RPC/ExtDirect/Exception.pm
-lib/RPC/ExtDirect/Hook.pm
+lib/RPC/ExtDirect/Intro.pod
+lib/RPC/ExtDirect/Migration.pod
lib/RPC/ExtDirect/NoEvents.pm
lib/RPC/ExtDirect/Request.pm
lib/RPC/ExtDirect/Request/PollHandler.pm
lib/RPC/ExtDirect/Router.pm
lib/RPC/ExtDirect/Serialize.pm
+lib/RPC/ExtDirect/Serializer.pm
+lib/RPC/ExtDirect/Test/Data/API.pm
+lib/RPC/ExtDirect/Test/Data/Env.pm
+lib/RPC/ExtDirect/Test/Data/Poll.pm
+lib/RPC/ExtDirect/Test/Data/Router.pm
+lib/RPC/ExtDirect/Test/Pkg/Bar.pm
+lib/RPC/ExtDirect/Test/Pkg/Env.pm
+lib/RPC/ExtDirect/Test/Pkg/Foo.pm
+lib/RPC/ExtDirect/Test/Pkg/Hooks.pm
+lib/RPC/ExtDirect/Test/Pkg/JuiceBar.pm
+lib/RPC/ExtDirect/Test/Pkg/PollProvider.pm
+lib/RPC/ExtDirect/Test/Pkg/Qux.pm
+lib/RPC/ExtDirect/Test/Util.pm
+lib/RPC/ExtDirect/Util.pm
+lib/RPC/ExtDirect/Util/Accessor.pm
Makefile.PL
MANIFEST
README
+t/001_util.t
+t/002_attr_parser.t
t/01_conf.t
t/02_exception.t
t/03_event.t
-t/04_serialize.t
+t/04_serializer.t
t/05_attributes.t
t/061_api.t
t/062_api.t
t/063_api.t
+t/064_api.t
+t/065_api.t
+t/066_api.t
+t/067_api.t
+t/068_method.t
t/071_request.t
t/072_request.t
t/08_deserialize.t
t/09_router.t
t/10_poll.t
t/11_hook.t
-t/lib/RPC/ExtDirect/Demo/PollProvider.pm
-t/lib/RPC/ExtDirect/Demo/Profile.pm
-t/lib/RPC/ExtDirect/Demo/TestAction.pm
-t/lib/RPC/ExtDirect/Test/Bar.pm
-t/lib/RPC/ExtDirect/Test/Foo.pm
-t/lib/RPC/ExtDirect/Test/JuiceBar.pm
-t/lib/RPC/ExtDirect/Test/PollProvider.pm
-t/lib/RPC/ExtDirect/Test/Qux.pm
-t/lib/RPC/ExtDirect/Test/Hooks.pm
+t/92_01_conf.t
+t/92_02_exception.t
+t/92_03_event.t
+t/92_04_serialize.t
+t/92_05_attributes.t
+t/92_061_api.t
+t/92_062_api.t
+t/92_063_api.t
+t/92_071_request.t
+t/92_072_request.t
+t/92_08_deserialize.t
+t/92_09_router.t
+t/92_10_poll.t
+t/92_11_hook.t
+t/lib/test/hooks.pm
+t/lib2/RPC/ExtDirect/Demo/PollProvider.pm
+t/lib2/RPC/ExtDirect/Demo/Profile.pm
+t/lib2/RPC/ExtDirect/Demo/TestAction.pm
+t/lib2/RPC/ExtDirect/Test/Bar.pm
+t/lib2/RPC/ExtDirect/Test/Foo.pm
+t/lib2/RPC/ExtDirect/Test/Hooks.pm
+t/lib2/RPC/ExtDirect/Test/JuiceBar.pm
+t/lib2/RPC/ExtDirect/Test/PollProvider.pm
+t/lib2/RPC/ExtDirect/Test/Qux.pm
t/pod.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
@@ -1,10 +1,10 @@
{
- "abstract" : "Ext.Direct implementation for Perl",
+ "abstract" : "Core Ext.Direct implementation for Perl",
"author" : [
- "Alexander Tokarev <tokarev@cpan.org>"
+ "Alex Tokarev <tokarev@cpan.org>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921",
+ "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640",
"license" : [
"perl_5"
],
@@ -22,8 +22,7 @@
"prereqs" : {
"build" : {
"requires" : {
- "Test::More" : "0.48",
- "Test::Pod" : "1.00"
+ "Test::More" : "0.82"
}
},
"configure" : {
@@ -48,5 +47,5 @@
"url" : "http://github.com/nohuhu/RPC-ExtDirect"
}
},
- "version" : "2.15"
+ "version" : "3.01"
}
@@ -1,28 +1,27 @@
---
-abstract: 'Ext.Direct implementation for Perl'
+abstract: 'Core Ext.Direct implementation for Perl'
author:
- - 'Alexander Tokarev <tokarev@cpan.org>'
+ - 'Alex Tokarev <tokarev@cpan.org>'
build_requires:
- Test::More: 0.48
- Test::Pod: 1.00
+ Test::More: '0.82'
configure_requires:
- ExtUtils::MakeMaker: 0
+ ExtUtils::MakeMaker: '0'
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921'
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.140640'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: RPC-ExtDirect
no_index:
directory:
- t
- inc
requires:
- Attribute::Handlers: 0.87
- JSON: 2.0
- perl: 5.006
+ Attribute::Handlers: '0.87'
+ JSON: '2.0'
+ perl: '5.006'
resources:
bugtracker: http://github.com/nohuhu/RPC-ExtDirect/issues
repository: http://github.com/nohuhu/RPC-ExtDirect
-version: 2.15
+version: '3.01'
@@ -1,36 +1,58 @@
use 5.006000;
use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
+# Add the `devtest` target to run regression and POD tests in one go
+sub MY::postamble {
+ return <<'END';
+devtest :
+ REGRESSION_TESTS=1 POD_TESTS=1 $(MAKE) test
+
+END
+}
+
+# Override `disttest` so it would behave as `devtest`
+sub MY::dist_test {
+ return <<'END';
+disttest : distdir
+ cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL
+ cd $(DISTVNAME) && $(MAKE) $(PASTHRU)
+ cd $(DISTVNAME) && $(MAKE) devtest $(PASTHRU)
+
+END
+}
+
+my $MMVersion = $ExtUtils::MakeMaker::VERSION;
+
WriteMakefile(
NAME => 'RPC::ExtDirect',
- VERSION_FROM => 'lib/RPC/ExtDirect.pm', # finds $VERSION
- ($ExtUtils::MakeMaker::VERSION >= 6.55
+ VERSION_FROM => 'lib/RPC/ExtDirect.pm',
+ ($MMVersion >= 6.55
? ( BUILD_REQUIRES => {
- 'Test::More' => '0.48',
- 'Test::Pod' => '1.00',
+ 'Test::More' => '0.82',
},
PREREQ_PM => {
- 'Attribute::Handlers' => '0.87',
- 'JSON' => '2.0',
+ 'Attribute::Handlers' => '0.87',
+ 'JSON' => '2.0',
},
)
: ( PREREQ_PM => {
- 'Test::More' => '0.48',
- 'Test::Pod' => '1.00',
+ 'Test::More' => '0.82',
'Attribute::Handlers' => '0.87',
'JSON' => '2.0',
},
)
),
- ($] >= 5.005 ?
- (ABSTRACT => 'Ext.Direct implementation for Perl',
- AUTHOR => 'Alexander Tokarev <tokarev@cpan.org>',
- LICENSE => 'perl',
- ) : ()),
- ($ExtUtils::MakeMaker::VERSION >= 6.46
+ ABSTRACT => 'Core Ext.Direct implementation for Perl',
+ AUTHOR => 'Alex Tokarev <tokarev@cpan.org>',
+ LICENSE => 'perl',
+
+ ($MMVersion >= 6.48
+ ? ( MIN_PERL_VERSION => 5.006000, )
+ : (),
+ ),
+
+ ($MMVersion >= 6.46
? ( META_MERGE => {
resources => {
bugtracker => 'http://github.com/nohuhu/RPC-ExtDirect/issues',
@@ -40,7 +62,5 @@ WriteMakefile(
)
: ()
),
-
- MIN_PERL_VERSION => 5.006000,
);
@@ -1,45 +1,37 @@
-RPC-ExtDirect
-=============
+RPC::ExtDirect
+==============
-ABSTRACT
+ RPC::ExtDirect suite of modules provides an easy, simple and robust way
+ to write Perl server side code that could be used with HTML5 Rich
+ Internet Applications based on JavaScript frameworks Ext JS and Sencha
+ Touch.
-RPC::ExtDirect is a Perl implementation for Ext.Direct remoting protocol
-used in Ext JS JavaScript framework by Sencha Inc.
-
-WHAT IS IT FOR?
-
-There are many RPC protocols out there; Ext JS framework provides yet another
-one. In short, it is a means of calling server side code from client side
-JavaScript without having to deal with Ajax calls and form submits manually.
-
-Besides providing forward asynchronous data stream (client calls server),
-Ext.Direct also defines a mechanism for backward (server to client) event
-stream, also asynchronous. Add some perks like standartized exception
-handling, request batching and file uploads and you get an engine that
-greatly simplifies client to server interaction in JavaScript applications.
-
-For detailed explanation, see http://www.sencha.com/products/extjs/extdirect/
+ The suite consists of the core RPC::ExtDirect module that implements
+ Ext.Direct protocol and transport layer, several server
+ environment-specific peripheral gateways, a standalone pure Perl server,
+ two Perl clients, and even its own specialized testing scaffold! We've
+ got it covered front to back. :)
INSTALLATION
-To install this module type the following:
+ To install this module type the following:
- perl Makefile.PL
- make
- make test
- make install
+ perl Makefile.PL
+ make && make test
+ make install
DEPENDENCIES
-RPC::ExtDirect modules require these other modules and libraries:
+ RPC::ExtDirect is dependent on the following modules:
+ Attribute::Handlers, JSON.
- Attribute::Handlers
- JSON
+ The oldest Perl version RPC::ExtDirect is routinely tested against is
+ 5.6.2.
-COPYRIGHT AND LICENCE
+LICENSE AND COPYRIGHT
-Copyright (C) 2011-2013 by Alexander Tokarev <tokarev@cpan.org>
+ Copyright (c) 2011-2014 by Alex Tokarev.
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself. See perlartistic.
+ This module is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself. See "perlartistic".
@@ -0,0 +1,232 @@
+package RPC::ExtDirect::API::Action;
+
+use strict;
+use warnings;
+no warnings 'uninitialized'; ## no critic
+
+use Carp;
+
+use RPC::ExtDirect::Config;
+use RPC::ExtDirect::Util::Accessor;
+
+### PUBLIC CLASS METHOD (ACCESSOR) ###
+#
+# Return the hook types supported by this Action class
+#
+
+sub HOOK_TYPES { qw/ before instead after / }
+
+### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
+#
+# Create a new Action instance
+#
+
+sub new {
+ my ($class, %arg) = @_;
+
+ my $config = delete $arg{config};
+ my $hook_class = $config->api_hook_class;
+
+ # For the caller, the 'action' parameter makes sense as the Action's
+ # name, but within the Action itself it's just "name" for clarity
+ my $name = delete $arg{action};
+ my $package = delete $arg{package};
+ my $methods = delete $arg{methods} || [];
+
+ # These checks are mostly for debugging
+ croak "Can't create an Action without a name!"
+ unless defined $name;
+
+ # We accept :: in Action names so that the API would feel
+ # more natural on the Perl side, but convert them to dots
+ # anyway to be compatible with JavaScript
+ $name =~ s/::/./g;
+
+ # We avoid hard binding on the hook class
+ { local $@; eval "require $hook_class"; }
+
+ my %hooks;
+
+ for my $type ( $class->HOOK_TYPES ) {
+ my $hook = delete $arg{ $type };
+
+ $hooks{ $type } = $hook_class->new( type => $type, code => $hook )
+ if $hook;
+ }
+
+ my $self = bless {
+ config => $config,
+ name => $name,
+ package => $package,
+ methods => {},
+ %arg,
+ %hooks,
+ }, $class;
+
+ $self->add_method($_) for @$methods;
+
+ return $self;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Merge method definitions from incoming Action object
+#
+
+sub merge {
+ my ($self, $action) = @_;
+
+ # Add the methods, or replace if they exist
+ $self->add_method(@_) for $action->methods();
+
+ return $self;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Return the list of this Action's Methods' names
+#
+
+sub methods { keys %{ $_[0]->{methods} } }
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Return the list of this Action's publishable
+# (non-pollHandler) methods
+#
+
+sub remoting_methods {
+ my ($self) = @_;
+
+ my @method_names = map { $_->[0] }
+ grep { !$_->[1]->pollHandler }
+ map { [ $_, $self->method($_) ] }
+ $self->methods;
+
+ return @method_names;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Return the list of this Action's pollHandler methods
+#
+
+sub polling_methods {
+ my ($self) = @_;
+
+ my @method_names = map { $_->[0] }
+ grep { $_->[1]->pollHandler }
+ map { [ $_, $self->method($_) ] }
+ $self->methods;
+
+ return @method_names;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Return the list of API definitions for this Action's
+# remoting methods
+#
+
+sub remoting_api {
+ my ($self, $env) = @_;
+
+ # Guard against user overrides returning undefs instead of
+ # empty lists
+ my @method_names = $self->remoting_methods;
+ my @method_defs;
+
+ for my $method_name ( @method_names ) {
+ my $method = $self->method($method_name);
+ my $def = $method->get_api_definition($env);
+
+ push @method_defs, $def if $def;
+ }
+
+ return @method_defs;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Return true if this Action has any pollHandler methods
+#
+
+sub has_pollHandlers {
+ my ($self, $env) = @_;
+
+ # By default we're not using the env object here,
+ # but an user override may do so
+
+ my @methods = $self->polling_methods;
+
+ return !!@methods;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Add a method, or replace it if exists.
+# Accepts Method instances, or hashrefs to be fed
+# to Method->new()
+#
+
+sub add_method {
+ my ($self, $method) = @_;
+
+ my $config = $self->config;
+
+ if ( 'HASH' eq ref $method ) {
+ my $m_class = $config->api_method_class();
+
+ # This is to avoid hard binding on RPC::ExtDirect::API::Method
+ eval "require $m_class";
+
+ my $name = delete $method->{method} || delete $method->{name};
+
+ $method = $m_class->new(
+ config => $config,
+ package => $self->package,
+ action => $self->name,
+ name => $name,
+ %$method,
+ );
+ }
+ else {
+ $method->config($config);
+ }
+
+ my $m_name = $method->name;
+
+ $self->{methods}->{ $m_name } = $method;
+
+ return $self;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Returns a Method object by name
+#
+
+sub method {
+ my ($self, $method_name) = @_;
+
+ return $self->{methods}->{ $method_name };
+}
+
+### PUBLIC INSTANCE METHODS ###
+#
+# Simple read-write accessors
+#
+
+my $accessors = [qw/
+ config
+ name
+ package
+/,
+ __PACKAGE__->HOOK_TYPES,
+];
+
+RPC::ExtDirect::Util::Accessor::mk_accessors(
+ simple => $accessors,
+);
+
+1;
@@ -0,0 +1,140 @@
+=pod
+
+=head1 NAME
+
+RPC::ExtDirect::API::Action - Ext.Direct Action object
+
+=head1 DESCRIPTION
+
+This package implements an Ext.Direct L<Action|RPC::ExtDirect::Intro/Action>
+object that holds Action's properties, and a set of
+L<Methods|RPC::ExtDirect::Intro/Method>. You can subclass this package to
+change its behavior.
+
+This document does not provide an overview of an Action. For that information,
+see L<RPC::ExtDirect::API/"ACTIONS AND METHODS">.
+
+=head1 ACTION OBJECT INTERFACE
+
+L<RPC::ExtDirect::API::Action> provides several public methods:
+
+=over 4
+
+=item C<HOOK_TYPES>
+
+Class/instance method. Returns the list of supported hook types. See
+L<RPC::ExtDirect/HOOKS> for more information.
+
+=item C<new>
+
+Constructor. Returns a new L<RPC::ExtDirect::API::Action> object. Accepts
+named arguments in a hash.
+
+Parameters:
+
+=over 8
+
+=item C<config>
+
+A L<RPC::ExtDirect::Config> instance to be used with this Action.
+
+This parameter is mandatory.
+
+=item C<action>
+
+The name for this Action.
+
+This parameter is mandatory.
+
+=item C<package>
+
+The package this Action represents, and which this Action's Methods
+belong to.
+
+This parameter is mandatory.
+
+=item C<methods>
+
+An arrayref of L<RPC::ExtDirect::API::Method> instances to be added
+to this Action, or L<RPC::ExtDirect::API::Method/new> parameters for
+the new Methods to be instantiated and added to the Action.
+
+=item C<before|instead|after>
+
+A L<RPC::ExtDirect::API::Hook> definitions to be set in the corresponding
+slot for this Action.
+
+=back
+
+=item C<merge>
+
+Instance method. Add Methods from a passed Action instance to this Action
+object. Accepts one ordered argument, the Action to copy Methods from.
+
+=item C<methods>
+
+Instance method. Return the list of names for the Methods in this Action.
+
+=item C<remoting_methods>
+
+Instance method. Return the list of names for the remoting Methods in
+this Action (see L<Remoting API|RPC::ExtDirect::Intro/"Remoting API">).
+
+=item C<polling_methods>
+
+Instance method. Return the list of names for the polling Methods in
+this Action (see L<Polling API|RPC::ExtDirect::Intro/"Polling API">).
+
+=item C<remoting_api>
+
+Instance method. Return the list of API definitions for this Action's
+Methods. See L<RPC::ExtDirect::API::Method/get_api_definition>.
+
+=item C<has_pollHandlers>
+
+Instance method. Return true if this Action has at least one
+L<Poll Handler method|RPC::ExtDirect::Intro/"Poll Handler Method">.
+
+=item C<add_method>
+
+Instance method. Add a Method object to this Action, or create a new
+Method object, and add it. Accepts one ordered argument, an
+L<RPC::ExtDirect::API::Method> instance or a hashref of
+L<RPC::ExtDirect::API::Method/new> parameters.
+
+=item C<method>
+
+Instance method. Return the corresponding Method object by its name.
+Accepts one ordered argument: Method name.
+
+=back
+
+=head1 ACCESSOR METHODS
+
+For L<RPC::ExtDirect::API::Action>, the following
+L<accessor methods|RPC::ExtDirect::Config/"ACCESSOR METHODS"> are
+provided:
+
+=over 4
+
+=item C<config>
+
+Return the L<RPC::ExtDirect::Config> instance assigned to this Action
+object.
+
+=item C<name>
+
+Return this Action's name.
+
+=item C<package>
+
+Return this Action's package.
+
+=item C<before|instead|after>
+
+Return the L<Hook|RPC::ExtDirect::API::Hook> object for the corresponding
+hook slot assigned to this Action.
+
+=back
+
+=cut
@@ -0,0 +1,137 @@
+package RPC::ExtDirect::API::Hook;
+
+use strict;
+use warnings;
+no warnings 'uninitialized'; ## no critic
+
+use B;
+
+use RPC::ExtDirect::Util::Accessor;
+
+### PUBLIC CLASS METHOD (ACCESSOR) ###
+#
+# Return the list of supported hook types
+#
+
+sub HOOK_TYPES { qw/ before instead after / }
+
+### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
+#
+# Instantiate a new Hook object
+#
+
+sub new {
+ my ($class, %arg) = @_;
+
+ my ($type, $coderef) = @arg{qw/ type code /};
+
+ # If we're passed an undef or 'NONE' instead of a coderef,
+ # then the hook is not runnable. Otherwise, try resolving
+ # package if we have a coderef.
+ my $runnable = !('NONE' eq $coderef || !defined $coderef);
+
+ my ($package, $sub_name);
+
+ if ( 'CODE' eq ref $coderef ) {
+ $package = _package_from_coderef($coderef);
+ }
+ else {
+ my @parts = split /::/, $coderef;
+
+ $sub_name = pop @parts;
+ $package = join '::', @parts;
+
+ # We've got to have at least the sub_name part
+ die "Can't resolve '$type' hook $coderef" unless $sub_name;
+ }
+
+ my $self = bless {
+ package => $package,
+ type => $type,
+ code => $coderef,
+ sub_name => $sub_name,
+ runnable => $runnable,
+ }, $class;
+
+ return $self;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Run the hook
+#
+
+sub run {
+ my ($self, %args) = @_;
+
+ my ($api, $env, $arg, $result, $exception, $method_ref, $callee)
+ = @args{qw/api env arg result exception method_ref callee/};
+
+ my $action_name = $method_ref->action;
+ my $method_name = $method_ref->name;
+ my $method_pkg = $method_ref->package;
+ my $method_coderef = $method_ref->code;
+
+ my %hook_arg = $method_ref->get_api_definition_compat();
+
+ $hook_arg{arg} = $arg;
+ $hook_arg{env} = $env;
+ $hook_arg{code} = $method_coderef;
+ $hook_arg{method_ref} = $method_ref;
+
+ # Result and exception are passed to "after" hook only
+ @hook_arg{ qw/result exception method_called/ }
+ = ($result, $exception, $callee)
+ if $self->type eq 'after';
+
+ for my $type ( $self->HOOK_TYPES ) {
+ my $hook = $api->get_hook(
+ action => $action_name,
+ method => $method_name,
+ type => $type,
+ );
+
+ $hook_arg{ $type.'_ref' } = $hook;
+ $hook_arg{ $type } = $hook ? $hook->code : undef;
+ }
+
+ # A drop of sugar
+ $hook_arg{orig} = sub { $method_coderef->($method_pkg, @$arg) };
+
+ my $hook_coderef = $self->code;
+ my $hook_sub_name = $self->sub_name;
+ my $hook_pkg = $self->package;
+
+ # By convention, hooks are called as class methods. If we were passed
+ # a method name instead of a coderef, call it indirectly on the package
+ # so that inheritance works properly
+ return $hook_pkg && $hook_sub_name ? $hook_pkg->$hook_sub_name(%hook_arg)
+ : $hook_coderef->($hook_pkg, %hook_arg)
+ ;
+}
+
+### PUBLIC INSTANCE METHODS ###
+#
+# Simple read-write accessors
+#
+
+RPC::ExtDirect::Util::Accessor::mk_accessors(
+ simple => [qw/ type code package sub_name runnable /],
+);
+
+############## PRIVATE METHODS BELOW ##############
+
+### PRIVATE PACKAGE SUBROUTINE ###
+#
+# Return package name from coderef
+#
+
+sub _package_from_coderef {
+ my ($code) = @_;
+
+ my $pkg = eval { B::svref_2object($code)->GV->STASH->NAME };
+
+ return defined $pkg && $pkg ne '' ? $pkg : undef;
+}
+
+1;
@@ -0,0 +1,342 @@
+=pod
+
+=head1 NAME
+
+RPC::ExtDirect::API::Hook - Ext.Direct Method wrappers
+
+=head1 DESCRIPTION
+
+Hooks are L<RPC::ExtDirect>'s way of implementing
+L<Method|RPC::ExtDirect::Intro/Method> modifiers for the (relatively)
+rare cases when you need them but don't want to bring in the whole
+nine yards of L<Moose>.
+
+=head1 TYPES
+
+A hook is a Perl subroutine (can be anonymous, too). Hooks can be of
+three types:
+
+=over 4
+
+=item C<before>
+
+C<before> hook is called before a L<Method|RPC::ExtDirect::Intro/Method>
+is invoked, and can be used to change Method arguments or cancel Method
+execution. This hook must return numeric value C<1> to allow Method call.
+Any other value will be interpreted as an Ext.Direct
+L<Result|RPC::ExtDirect::Intro/Result>; it will be returned to the
+client side and the Method never gets called.
+
+Note that RPC::ExtDirect will not make any assumptions about this hook's
+return value; a false value like C<''> or C<0> will probably not look
+too helpful from the client side's point of view.
+
+If this hook throws an exception, it will be returned as an Ext.Direct
+L<Exception|RPC::ExtDirect::Intro/Exception> to the client side, and
+the Method does not execute.
+
+=item C<instead>
+
+C<instead> hook replaces the Method it is assigned to. It is
+the hook sub's responsibility to invoke (or not) the Method code
+and return appropriate L<Result|RPC::ExtDirect::Intro/Result>.
+
+If this hook throws an exception, it is interpreted as if the
+Method threw it.
+
+This hook is analogous to Moose's C<around> method modifier, except
+that C<around> would be a bit of a misnomer since the hook code is
+actually called I<instead> of the Method. Hence the name.
+
+=item C<after>
+
+C<after> hook is called after the Method code or C<instead> hook.
+This hook cannot affect Method execution, it is intended mostly for
+logging and testing purposes; its input includes Method's
+L<Result|RPC::ExtDirect::Intro/Result> or
+L<Exception|RPC::ExtDirect::Intro/Exception>.
+
+This hook's return value and thrown exceptions are ignored.
+
+=back
+
+=head1 HIERARCHY
+
+Hooks can be defined on three levels, in order of precedence: Method,
+Action, and global. For each Method, only one hook of each type can be
+applied. Hooks specified in Method definition take precedence over all
+other; if no Method hook is found then Action level hook applies; and if
+there is no Action hook then global hook gets called, if any.
+
+To avoid using hooks for a particular method, use C<"NONE"> or C<undef>
+instead of coderef; this way you can specify global and/or Action hooks
+and exclude some specific Methods piecemeal.
+
+See more in the documentation for the constructor: L</new>.
+
+=head1 CALLING CONVENTION
+
+Hook subroutine is called as a class method, i.e. first argument
+is name of the package in which this sub was defined. Ignore it
+if you don't need it.
+
+Hooks receive a hash of the following arguments:
+
+=over 4
+
+=item C<action>
+
+Ext.Direct L<Action|RPC::ExtDirect::Intro/Action> name for the
+L<Method|RPC::ExtDirect::Intro/Method>.
+
+B<DEPRECATED>. Use L<method_ref|/method_ref> instead:
+C<< $method_ref->action >>
+
+=item C<method>
+
+Ext.Direct L<Method|RPC::ExtDirect::Intro/Method> name
+
+B<DEPRECATED>. Use L<method_ref|/method_ref> instead:
+C<< $method_ref->name >>
+
+=item C<package>
+
+Name of the package (not Action) where the Method is declared
+
+B<DEPRECATED>. Use L<method_ref|/method_ref> instead:
+C<< $method_ref->package >>
+
+=item C<code>
+
+Coderef to the Method subroutine
+
+B<DEPRECATED>. Use L<method_ref|/method_ref> instead:
+C<< $method_ref->code >>
+
+=item C<param_no>
+
+Number of parameters when Method accepts ordered arguments
+
+B<DEPRECATED>. Use L<method_ref|/method_ref> instead:
+C<< $method_ref->len >>
+
+=item C<param_names>
+
+Arrayref with names of parameters when Method accepts named arguments
+
+B<DEPRECATED>. Use L<method_ref|/method_ref> instead:
+C<< $method_ref->params >>
+
+=item C<formHandler>
+
+True if Method handles form submits
+
+B<DEPRECATED>. Use L<method_ref|/method_ref> instead:
+C<< $method_ref->formHandler >>
+
+=item C<pollHandler>
+
+True if Method handles Event poll requests
+
+B<DEPRECATED>. Use L<method_ref|/method_ref> instead:
+C<< $method_ref->pollHandler >>
+
+=item C<arg>
+
+Arrayref with the invocation arguments when Method accepts ordered args,
+single L<Environment object|RPC::ExtDirect/"ENVIRONMENT OBJECTS"> for
+L<Poll handlers|RPC::ExtDirect::Intro/"Poll Handler Method">, hashref
+otherwise.
+
+Note that this is a direct link to the Method's C<@_> so it is possible
+to modify the arguments in C<before> hook if you need to.
+
+=item C<env>
+
+L<Environment object|RPC::ExtDirect/"ENVIRONMENT OBJECTS"> for the
+invocation. Like L<arg|/arg>, this is a direct reference to the same
+object that will be passed to the Method, so it's possible to modify
+the env object in the C<before> hook.
+
+=item C<before>
+
+Coderef to C<before> hook for that Method, or undef
+
+B<DEPRECATED>. Use L<before_ref|/before_ref> instead:
+C<< $before_ref->code >>
+
+=item C<instead>
+
+Coderef to C<instead> hook for that Method, or undef
+
+B<DEPRECATED>. Use L<instead_ref|/instead_ref> instead:
+C<< $instead_ref->code >>
+
+=item C<after>
+
+Coderef to "after" hook for that Method, or undef
+
+B<DEPRECATED>. Use L<after_ref|/after_ref> instead:
+C<< $after_ref->code >>
+
+=item C<result>
+
+For C<after> hooks, the L<Result|RPC::ExtDirect::Intro/Result> returned
+by the Method or C<instead> hook, whichever got called. Not defined for
+C<before> and C<instead> hooks.
+
+=item C<exception>
+
+For C<after> hooks, an exception (C<$@>) thrown by the Method or
+C<instead> hook, if any. Not defined for C<before> and C<instead> hooks.
+
+=item C<method_called>
+
+For C<after> hooks, a reference to the actual code called as Method, if
+any. Can be either the Method code itself, C<instead> hook or C<undef>
+if the invocation was canceled.
+
+=item C<orig>
+
+A closure that binds Method coderef to its current arguments, allowing to call
+it as easily as C<< $params{orig}->() >>
+
+=back
+
+=head1 HOOK OBJECT INTERFACE
+
+L<RPC::ExtDirect::API::Hook> provides several public methods:
+
+=over 4
+
+=item C<HOOK_TYPES>
+
+Class/instance method. Returns the list of supported hook types.
+
+=item C<new>
+
+Constructor. Returns a new L<RPC::ExtDirect::API::Hook> object. Accepts
+named arguments in a hash.
+
+Parameters:
+
+=over 8
+
+=item C<type>
+
+Hook L<type|/TYPES>. This parameter is mandatory.
+
+=item C<code>
+
+Hook code. This parameter is mandatory, and it can take one of the
+following forms:
+
+=over 12
+
+=item *
+
+C<'NONE'> or C<undef> to cancel hook execution for the corresponding type
+
+=item *
+
+A coderef for the hook sub to run for the corresponding type
+
+=item *
+
+Package and subroutine address to call at the hook execution time, like
+C<'Foo::Bar::baz'>. This allows late code binding without loading the
+corresponding package early.
+
+=back
+
+=back
+
+=item C<run>
+
+Run the hook and return the result. This method accepts named arguments
+in a hash.
+
+Parameters:
+
+=over 8
+
+=item C<api>
+
+An instance of L<RPC::ExtDirect::API>.
+
+This parameter is mandatory.
+
+=item C<env>
+
+An L<environment object|RPC::ExtDirect/"ENVIRONMENT OBJECTS"> for this
+hook invocation.
+
+This parameter is mandatory.
+
+=item C<arg>
+
+Method arguments, either array- or hashref depending on the Method's
+calling convention.
+
+This parameter is mandatory.
+
+=item C<result>
+
+The result of a Method's invocation for an C<after> hook.
+
+This parameter is mandatory for C<after> hooks.
+
+=item C<exception>
+
+An exception thrown by a Method or a hook. This parameter is only
+meaningful for C<after> hooks, and is optional.
+
+=item C<method_ref>
+
+An instance of L<RPC::ExtDirect::API::Method>.
+
+This parameter is mandatory.
+
+=item C<callee>
+
+A reference to the code executed for a Method; can be either the
+Method code, or its C<instead> hook code.
+
+This parameter is mandatory for C<after> hooks.
+
+=back
+
+=back
+
+=head1 ACCESSOR METHODS
+
+For L<RPC::ExtDirect::API::Hook>, the following
+L<accessor methods|RPC::ExtDirect::Config/"ACCESSOR METHODS"> are
+provided:
+
+=over 4
+
+=item C<type>
+
+Return the L</type> of this Hook object.
+
+=item C<code>
+
+Return the L</code> of this Hook object.
+
+=item C<package>
+
+Return the package name for the Hook code.
+
+=item C<sub_name>
+
+Return the subroutine name for the Hook code. This will yield meaningful
+result only when L</code> was set to a string 'Package::sub'.
+
+=item C<runnable>
+
+Return true if this Hook's code is runnable and can be executed.
+
+=back
+
+=cut
@@ -0,0 +1,456 @@
+package RPC::ExtDirect::API::Method;
+
+use strict;
+use warnings;
+no warnings 'uninitialized'; ## no critic
+
+use RPC::ExtDirect::Config;
+use RPC::ExtDirect::Util::Accessor;
+
+### PUBLIC CLASS METHOD (ACCESSOR) ###
+#
+# Return the hook types supported by this Method class
+#
+
+sub HOOK_TYPES { qw/ before instead after / }
+
+### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
+#
+# Instantiate a new Method object
+#
+
+sub new {
+ my ($class, %arg) = @_;
+
+ my $config = $arg{config};
+ my $hook_class = $config->api_hook_class;
+
+ my $pollHandler = $arg{pollHandler};
+ my $formHandler = $arg{formHandler};
+
+ my $is_named
+ = defined $arg{params} && !$pollHandler && !$formHandler;
+
+ my $is_ordered
+ = defined $arg{len} && !$pollHandler && !$formHandler;
+
+ my $processor = $pollHandler ? 'pollHandler'
+ : $formHandler ? 'formHandler'
+ : $is_named ? 'named'
+ : $is_ordered ? 'ordered'
+ : 'default'
+ ;
+
+ # We avoid hard binding on the hook class
+ eval "require $hook_class";
+
+ my %hooks;
+
+ for my $type ( $class->HOOK_TYPES ) {
+ my $hook = delete $arg{ $type };
+
+ $hooks{ $type } = $hook_class->new( type => $type, code => $hook )
+ if $hook;
+ }
+
+ return bless {
+ upload_arg => 'file_uploads',
+ is_named => $is_named,
+ is_ordered => $is_ordered,
+ argument_checker => "check_${processor}_arguments",
+ argument_preparer => "prepare_${processor}_arguments",
+ %arg,
+ %hooks,
+ }, $class;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Return a hashref with the API definition for this Method,
+# or an empty list
+#
+
+sub get_api_definition {
+ my ($self, $env) = @_;
+
+ # By default we're not using the environment object,
+ # but user can override this method to make permission
+ # and/or other kind of checks
+
+ # Poll handlers are not declared in the API
+ return if $self->pollHandler;
+
+ my $name = $self->name;
+ my $strict = $self->strict;
+
+ # Form handlers are defined like this
+ # (\1 means JSON::true and doesn't force us to `use JSON`)
+ return { name => $name, len => 0, formHandler => \1 }
+ if $self->formHandler;
+
+ # Ordinary method with positioned arguments
+ return { name => $name, len => $self->len + 0 },
+ if $self->is_ordered;
+
+ # Ordinary method with named arguments
+ return {
+ name => $name,
+ params => $self->params,
+ defined $strict ? (strict => $strict) : (),
+ } if $self->params;
+
+ # No arguments specified means we're not checking them
+ return { name => $name };
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Return a hashref with backwards-compatible API definition
+# for this Method
+#
+
+sub get_api_definition_compat {
+ my ($self) = @_;
+
+ my %attrs;
+
+ $attrs{package} = $self->package;
+ $attrs{method} = $self->name;
+ $attrs{param_names} = $self->params;
+ $attrs{param_no} = $self->len;
+ $attrs{pollHandler} = $self->pollHandler || 0;
+ $attrs{formHandler} = $self->formHandler || 0;
+ $attrs{param_no} = undef if $attrs{formHandler};
+
+ for my $type ( $self->HOOK_TYPES ) {
+ my $hook = $self->$type;
+
+ $attrs{$type} = $hook->code if $hook;
+ }
+
+ return %attrs;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Return a reference to the actual code for this Method
+#
+
+sub code {
+ my ($self) = @_;
+
+ my $package = $self->package;
+ my $name = $self->name;
+
+ return $package->can($name);
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Run the Method code using the provided Environment object
+# and input data; return the result or die with exception
+#
+# We accept named parameters here to keep the signature compatible
+# with the corresponding Hook method.
+#
+
+sub run {
+ my ($self, %args) = @_;
+
+ my $arg = $args{arg};
+ my $package = $self->package;
+ my $name = $self->name;
+
+ # pollHandler methods should always be called in list context
+ return $self->pollHandler ? [ $package->$name(@$arg) ]
+ : $package->$name(@$arg)
+ ;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Check the arguments that were passed in the Ext.Direct request
+# to make sure they conform to the API declared by this Method.
+# Arguments should be passed in a reference, either hash- or array-.
+# This method is expected to die if anything is wrong, or return 1
+# on success.
+#
+# This method is intentionally split into several submethods,
+# instead of using polymorphic subclasses with method overrides.
+# Having all these in the same class is easier to maintain and
+# augment in user subclasses.
+#
+# The same applies to `prepare_method_arguments` below.
+#
+
+sub check_method_arguments {
+ my $self = shift;
+
+ my $checker = $self->argument_checker;
+
+ return $self->$checker(@_);
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Prepare the arguments to be passed to the called Method,
+# according to the Method's expectations. This works two ways:
+# on the server side, Request will call this method to prepare
+# the arguments that are to be passed to the actual Method code
+# that does things; on the client side, Client will call this
+# method to prepare the arguments that are about to be encoded
+# in JSON and passed over to the client side.
+#
+# The difference is that the server side wants an unfolded list,
+# and the client side wants a reference, either hash- or array-.
+# Because of that, prepare_*_arguments are context sensitive.
+#
+
+sub prepare_method_arguments {
+ my $self = shift;
+
+ my $preparer = $self->argument_preparer;
+
+ return $self->$preparer(@_);
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Check the arguments for a pollHandler
+#
+
+sub check_pollHandler_arguments {
+ # pollHandlers are not supposed to receive any arguments
+ return 1;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Prepare the arguments for a pollHandler
+#
+
+sub prepare_pollHandler_arguments {
+ my ($self, %arg) = @_;
+
+ my @actual_arg = ();
+
+ # When called from the client, env_arg should not be defined
+ my $env_arg = $self->env_arg;
+
+ no warnings;
+ splice @actual_arg, $env_arg, 0, $arg{env} if defined $env_arg;
+
+ return wantarray ? @actual_arg : [ @actual_arg ];
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Check the arguments for a formHandler
+#
+
+sub check_formHandler_arguments {
+ my ($self, $arg) = @_;
+
+ # Nothing to check here really except that it's a hashref
+ die sprintf "ExtDirect formHandler Method %s.%s expects named " .
+ "arguments in hashref\n", $self->action, $self->name
+ unless 'HASH' eq ref $arg;
+
+ return 1;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Prepare the arguments for a formHandler
+#
+
+sub prepare_formHandler_arguments {
+ my ($self, %arg) = @_;
+
+ my $env = $arg{env};
+ my $input = $arg{input};
+ my $upload = $arg{upload};
+
+ # Data should be a hashref here
+ my %data = %$input;
+
+ # Ensure there are no runaway ExtDirect form parameters
+ my @runaway_params = qw(action method extAction extMethod
+ extTID extUpload _uploads);
+ delete @data{ @runaway_params };
+
+ my $upload_arg = $self->upload_arg;
+
+ # Add uploads if there are any
+ $data{ $upload_arg } = $upload if defined $upload;
+
+ my $env_arg = $self->env_arg;
+
+ $data{ $env_arg } = $env if $env_arg;
+
+ return wantarray ? %data : { %data };
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Check the arguments for a Method with named parameters
+#
+
+sub check_named_arguments {
+ my ($self, $arg) = @_;
+
+ die sprintf "ExtDirect Method %s.%s expects named arguments " .
+ "in hashref\n", $self->action, $self->name
+ unless 'HASH' eq ref $arg;
+
+ my @params = @{ $self->params };
+
+ my @missing = map { !exists $arg->{$_} ? $_ : () } @params;
+
+ die sprintf "ExtDirect Method %s.%s requires the following ".
+ "parameters: '%s'; these are missing: '%s'\n",
+ $self->action, $self->name,
+ join(', ', @params), join(', ', @missing)
+ if @missing;
+
+ return 1;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Prepare the arguments for a Method with named parameters
+#
+
+sub prepare_named_arguments {
+ my ($self, %arg) = @_;
+
+ my $env = $arg{env};
+ my $input = $arg{input};
+
+ my %actual_arg;
+
+ my $strict = $self->strict;
+ $strict = 1 unless defined $strict;
+
+ if ( $strict ) {
+ my @names = @{ $self->params };
+
+ @actual_arg{ @names } = @$input{ @names };
+ }
+ else {
+ %actual_arg = %$input;
+ }
+
+ my $env_arg = $self->env_arg;
+
+ $actual_arg{ $env_arg } = $env if defined $env_arg;
+
+ return wantarray ? %actual_arg : { %actual_arg };
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Check the arguments for a Method with ordered parameters
+#
+
+sub check_ordered_arguments {
+ my ($self, $arg) = @_;
+
+ die sprintf "ExtDirect Method %s.%s expects ordered arguments " .
+ "in arrayref\n"
+ unless 'ARRAY' eq ref $arg;
+
+ my $want_len = $self->len;
+ my $have_len = @$arg;
+
+ die sprintf "ExtDirect Method %s.%s requires %d argument(s) ".
+ "but only %d are provided\n",
+ $self->action, $self->name, $want_len, $have_len
+ unless $have_len >= $want_len;
+
+ return 1;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Prepare the arguments for a Method with ordered parameters
+#
+
+sub prepare_ordered_arguments {
+ my ($self, %arg) = @_;
+
+ my $env = $arg{env};
+ my $input = $arg{input};
+
+ my @data = @$input;
+ my @actual_arg = splice @data, 0, $self->len;
+
+ my $env_arg = $self->env_arg;
+
+ no warnings;
+ splice @actual_arg, $env_arg, 0, $env if defined $env_arg;
+
+ return wantarray ? @actual_arg : [ @actual_arg ];
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Check the arguments when the Method signature is unknown
+#
+
+sub check_default_arguments {
+ # No checking means the arguments are not checked.
+ # Sincerely, C.O.
+ return 1;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Prepare the arguments when the Method signature is unknown
+#
+
+sub prepare_default_arguments {
+ my ($self, %arg) = @_;
+
+ my @actual_arg = ( $arg{input}, $arg{env} );
+
+ return wantarray ? @actual_arg : [ @actual_arg ];
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Read-only getter for backward compatibility
+#
+
+sub is_formhandler { shift->formHandler }
+
+### PUBLIC INSTANCE METHODS ###
+#
+# Simple read-write accessors
+#
+
+my $accessors = [qw/
+ config
+ action
+ name
+ params
+ len
+ formHandler
+ pollHandler
+ is_ordered
+ is_named
+ strict
+ package
+ env_arg
+ upload_arg
+ argument_checker
+ argument_preparer
+/,
+ __PACKAGE__->HOOK_TYPES,
+];
+
+RPC::ExtDirect::Util::Accessor::mk_accessors(
+ simple => $accessors,
+);
+
+1;
@@ -0,0 +1,382 @@
+=pod
+
+=head1 NAME
+
+RPC::ExtDirect::API::Method - Ext.Direct Method object
+
+=head1 DESCRIPTION
+
+This package implements an Ext.Direct L<Method|RPC::ExtDirect::Intro/Method>
+object that holds Method's properties and can be subclassed to change
+its behavior.
+
+This document does not provide an overview of a Method. For that information,
+see L<RPC::ExtDirect::API/"ACTIONS AND METHODS">.
+
+=head1 METHOD OBJECT INTERFACE
+
+L<RPC::ExtDirect::API::Method> provides several public methods:
+
+=over 4
+
+=item C<HOOK_TYPES>
+
+Class/instance method. Returns the list of supported hook types. See
+L<RPC::ExtDirect/HOOKS> for more information.
+
+=item C<new>
+
+Constructor. Returns a new L<RPC::ExtDirect::API::Method> object. Accepts
+named arguments in a hash.
+
+Parameters:
+
+=over 8
+
+=item C<config>
+
+A L<RPC::ExtDirect::Config> instance to be used with this Method.
+
+This parameter is mandatory.
+
+=item C<action>
+
+An L<Action|RPC::ExtDirect::Intro/Action> name this Method belongs to.
+
+This parameter is mandatory.
+
+=item C<name>
+
+This Method's name. Should be unique among the methods in an Action.
+
+This parameter is mandatory.
+
+=item C<len>
+
+Number of parameters accepted by an
+L<ordered Method|RPC::ExtDirect::Intro/"Ordered Method">.
+
+This parameter is mandatory for ordered Methods, and should not
+be defined for Methods of other calling conventions.
+
+=item C<params>
+
+An arrayref with names of parameters accepted by a
+L<named Method|RPC::ExtDirect::Intro/"Named Method">.
+
+This parameter is mandatory for named Methods, and should not
+be defined for Methods of other calling conventions.
+
+=item C<formHandler>
+
+A boolean flag indicating that this Method is a
+L<Form Handler|RPC::ExtDirect::Intro/"Form Handler Method">.
+
+This parameter is mandatory for Form handler Methods, and should
+not be defined for Methods of other calling conventions.
+
+=item C<pollHandler>
+
+A boolean flag indicating that this Method is a
+L<Poll Handler|RPC::ExtDirect::Intro/"Poll Handler Method">.
+
+This parameter is mandatory for Poll handler Methods, and should
+not be defined for Methods of other calling conventions.
+
+=item C<package>
+
+Name of the package this Method's code belongs to.
+
+This parameter is mandatory.
+
+=item C<strict>
+
+A boolean flag that enables or disables
+L<lazy parameter checking|RPC::ExtDirect::API/"Lazy parameter checking">
+for a named Method.
+
+This parameter is optional and should only be used with named Methods.
+
+=item C<before|instead|after>
+
+A L<Hook|RPC::ExtDirect/HOOKS> definition of the specified type for
+this Method. See L<RPC::ExtDirect::API::Hook/code> for the list of
+supported options.
+
+All three of these parameters are optional.
+
+=item C<env_arg>
+
+Use this parameter to indicate that this Method needs an
+L<environment object|RPC::ExtDirect/"ENVIRONMENT OBJECTS"> passed to it.
+Before RPC::ExtDirect 3.0, a Method was passed an environment object on
+every invocation; this behavior caused problems in certain cases.
+
+For ordered Methods and Poll handler Methods, C<env_arg> parameter
+should be a number for the C<@_> position that the env object should be
+spliced in. To receive the env object as the first argument, use C<0>;
+to receive it as the last argument, use some number greater than
+the number of parameters accepted by the Method (e.g. C<99>).
+
+For named Methods and Form handler Methods, C<env_arg> parameter
+should be a name of the hash key in which the environment object is
+passed.
+
+=item C<upload_arg>
+
+Use this parameter to change the hash key name in which the
+L<file upload array|RPC::ExtDirect/"FILE UPLOADS"> is passed to a
+Form handler Method. Default is C<'file_uploads'>.
+
+=item other
+
+Any other hash key with the corresponding value will be stored in the
+Method object.
+
+=back
+
+=item C<get_api_definition>
+
+Instance method. Returns a hashref with the Method's definition for the
+L<API declaration|RPC::ExtDirect::Intro/"API declaration">, or an empty
+list if the Method should not be included in the remoting API published
+to the client side.
+
+If you need to affect Ext.Direct API generation, this method is the place
+to do it. One example option is running a check on the user's credentials,
+and deciding to include or exclude this particular Method from the API
+generated for this user.
+
+Parameters (by position):
+
+=over 8
+
+=item *
+
+An L<environment object|RPC::ExtDirect/"ENVIRONMENT OBJECTS"> for this
+invocation.
+
+The stock C<get_api_definition> method does not use this environment
+object; it is provided to be potentially utilized in subclasses.
+
+=back
+
+=item C<get_api_definition_compat>
+
+Instance method. Returns a hashref with the Method's definition that
+is backwards compatible with versions 1.x and 2.x of RPC::ExtDirect.
+
+This method should not be used under normal circumstances.
+
+=item C<run>
+
+Instance method. Runs the Method's subroutine code and returns the
+L<Result|RPC::ExtDirect::Intro/Result> of the invocation. Accepts named
+arguments in a hash.
+
+The Method subroutine code is always called as a class method.
+For L<Poll handlers|RPC::ExtDirect::Intro/"Poll Handler Methods">, the
+code is called in a list context; for Methods of other calling
+conventions, the code is called in scalar context.
+
+Parameters:
+
+=over 8
+
+=item C<arg>
+
+The actual arguments that should be passed to the Method's code. This
+should be an arrayref for
+L<ordered Methods|RPC::ExtDirect::Intro/"Ordered Method"> and
+L<Poll handlers|RPC::ExtDirect::Intro/"Poll Handler Method">, or a
+hashref the other calling convention.
+
+Note that the value of this parameter is the same as returned by
+L</prepare_method_arguments> method.
+
+=back
+
+=item C<check_method_arguments>
+
+Instance method. Accepts one positional argument, which is incoming
+data that should be validated as Method's arguments. A specific
+I<checker method> (see below) will be executed to run the actual
+checks on this data; that method is expected to C<die> with an error,
+or return C<1> if the arguments are valid.
+
+=item C<check_ordered_arguments>
+
+Instance method. Takes input data and checks that it's an arrayref,
+and it has enough elements to satisfy the L</len> requirement of
+the Method.
+
+=item C<check_named_arguments>
+
+Instance method. Takes input data and checks that it's a hashref,
+and that keys for all mandatory L</params> exist in that hashref.
+If the Method declares empty L</params>, the check will pass and
+effectively all arguments will be passed on to the Method call.
+
+=item C<check_formHandler_arguments>
+
+Instance method. Takes input data and checks that it's a hashref.
+Since a Form Handler arguments are not known before invocation,
+no other checks are performed.
+
+=item C<check_pollHandler_arguments>
+
+Instance method. Does not in fact run any checks, since Poll Handler
+Methods are not supposed to be called directly and do not receive
+any arguments.
+
+=item C<prepare_method_arguments>
+
+Instance method. Accepts named arguments in a hash, and runs a
+specific I<preparer method> (see below) on these arguments,
+depending on the Method's calling convention.
+
+The return value of this method is the L<arguments|/arg> fed to
+the Method's code invoked in the L</run> method.
+
+Parameters:
+
+=over 8
+
+=item C<env>
+
+An L<environment object|RPC::ExtDirect/"ENVIRONMENT OBJECTS"> that is
+to be passed to the Method's code if Method has requested it.
+
+=item C<input>
+
+Method arguments passed from the client side. The type of the input
+depends on the Method's calling convention.
+
+=item C<upload>
+
+Arrayref of file upload hashrefs. See L<RPC::ExtDirect/"FILE UPLOADS">
+for more information.
+
+This parameter is only defined for
+L<Form handler methods|RPC::ExtDirect::Intro/"Form Handler Method">
+when uploaded files are present.
+
+=back
+
+=item C<prepare_ordered_arguments>
+
+Instance method. Takes C<input> arguments for the Method and returns
+an arrayref conformant to the
+L<ordered Method's|RPC::ExtDirect::Intro/"Ordered Method"> definition.
+This arrayref will optionally contain C<env> object.
+
+=item C<prepare_named_arguments>
+
+Instance method. Takes C<input> arguments for the Method and returns
+a hashref conformant to the
+L<named Method's|RPC::ExtDirect::Intro/"Named Method"> definition.
+This hashref will optionally contain C<env> object.
+
+=item C<prepare_formHandler_arguments>
+
+Instance method. Takes C<input> arguments for the Method and returns
+a hashref conformant to the
+L<Form Handler Method's|RPC::ExtDirect::Intro/"Form Handler Method">
+definition. This hashref will optionally contain C<env> object.
+
+=item C<prepare_pollHandler_arguments>
+
+Instance method. Returns an arrayref conformant to
+L<Poll handler method's|RPC::ExtDirect::Intro/"Poll Handler Method">
+definition. This arrayref will optionally contain C<env> object.
+
+=back
+
+=head1 ACCESSOR METHODS
+
+For L<RPC::ExtDirect::API::Method>, the following
+L<accessor methods|RPC::ExtDirect::Config/"ACCESSOR METHODS"> are
+provided:
+
+=over 4
+
+=item C<config>
+
+Return the L<RPC::ExtDirect::Config> instance assigned to this
+Method object.
+
+=item C<action>
+
+Return the Action name for this Method object.
+
+=item C<name>
+
+Return the Method name for this Method object.
+
+=item C<len>
+
+Return the number of the parameters accepted by this
+L<ordered Method|RPC::ExtDirect::Intro/"Ordered Method">.
+
+For any other calling convention, C<len> should be C<undef>.
+
+=item C<params>
+
+Return the names of the mandatory parameters accepted by this
+L<named Method|RPC::ExtDirect::Intro/"Named Method">.
+
+For any other calling convention, C<params> should be C<undef>.
+
+=item C<formHandler>
+
+Return true if this Method is a
+L<Form Handler|RPC::ExtDirect::Intro/"Form Handler Method">.
+
+For any other calling convention, C<formHandler> should be C<undef>.
+
+=item C<pollHandler>
+
+Return true if this Method is a
+L<Poll Handler|RPC::ExtDirect::Intro/"Poll Handler Method">.
+
+For any other calling convention, C<pollHandler> should be C<undef>.
+
+=item C<is_ordered>
+
+Return true if this is an ordered Method.
+
+=item C<is_named>
+
+Return true if this is a named Method.
+
+=item C<strict>
+
+Return false for Named methods with
+L<lazy parameter checking|RPC::ExtDirect::API/"Lazy parameter checking">.
+
+Defaults to true.
+
+=item C<package>
+
+Return the name of the package this Method's code belongs to.
+
+=item C<env_arg>
+
+Return the name or position for the environment object parameter.
+
+See L</new>.
+
+=item C<upload_arg>
+
+Return the name of the file upload parameter for a Form handler.
+
+See L</new>.
+
+=item C<before|instead|after>
+
+Return the L<Hook|RPC::ExtDirect::API::Hook> object for the corresponding
+hook slot assigned to this Method.
+
+=back
+
+=cut
@@ -7,128 +7,231 @@ no warnings 'uninitialized'; ## no critic
use Carp;
use RPC::ExtDirect::Config;
-use RPC::ExtDirect::Serialize;
-use RPC::ExtDirect;
+use RPC::ExtDirect::Serializer;
+use RPC::ExtDirect::Util::Accessor;
### PACKAGE GLOBAL VARIABLE ###
#
# Turn this on for debugging
#
-
-our $DEBUG = 0;
-
-### PACKAGE PRIVATE VARIABLE ###
-#
-# Holds configuration parameters for API
+# DEPRECATED. Use `debug_api` or `debug` Config options instead.
#
-my %OPTION_FOR = ();
+our $DEBUG;
### PUBLIC PACKAGE SUBROUTINE ###
#
# Does not import anything to caller namespace but accepts
-# configuration parameters
+# configuration parameters. This method always operates on
+# the "default" API object stored in RPC::ExtDirect
#
sub import {
- my ($class, @parameters) = @_;
+ my ($class, @args) = @_;
# Nothing to do
- return unless @parameters;
+ return unless @args;
# Only hash-like arguments are supported
- croak 'Odd number of parameters in RPC::ExtDirect::API::import()'
- unless (@parameters % 2) == 0;
-
- my %param = @parameters;
- %param = map { lc $_ => delete $param{ $_ } } keys %param;
-
- # Hook definitions are exported to RPC::ExtDirect hash
- for my $type ( qw(before instead after) ) {
- my $code = delete $param{ $type };
+ croak 'Odd number of arguments in RPC::ExtDirect::API::import()'
+ unless (@args % 2) == 0;
- RPC::ExtDirect->add_hook( type => $type, code => $code )
+ my %arg = @args;
+ %arg = map { lc $_ => delete $arg{ $_ } } keys %arg;
+
+ # In most cases that's a formality since RPC::ExtDirect
+ # should be already required elsewhere; some test scripts
+ # may not load it on purpose so we guard against that
+ # just in case. We don't want to `use` RPC::ExtDirect above,
+ # because that would create a circular dependency.
+ require RPC::ExtDirect;
+
+ my $api = RPC::ExtDirect->get_api;
+
+ for my $type ( $class->HOOK_TYPES ) {
+ my $code = delete $arg{ $type };
+
+ $api->add_hook( type => $type, code => $code )
if $code;
};
+
+ my $api_config = $api->config;
+
+ for my $option ( keys %arg ) {
+ my $value = $arg{$option};
+
+ $api_config->$option($value);
+ }
+}
- # General options
- my @options = qw(
- namespace router_path poll_path
- auto_connect remoting_var polling_var
- no_polling
- );
+### PUBLIC CLASS METHOD (ACCESSOR) ###
+#
+# Return the hook types supported by the API
+#
+
+sub HOOK_TYPES { qw/ before instead after/ }
+
+### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
+#
+# Init a new API object
+#
+
+sub new {
+ my $class = shift;
+
+ my %arg = @_ == 1 && 'HASH' eq ref($_[0]) ? %{ $_[0] } : @_;
+
+ $arg{config} ||= RPC::ExtDirect::Config->new();
+
+ return bless {
+ %arg,
+ actions => {},
+ }, $class;
+}
- # Set defaults
- $OPTION_FOR{no_polling} = 0;
+### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
+#
+# Init a new API object and populate it from the supplied hashref
+#
- OPTION:
- for my $option ( @options ) {
- my $value = $param{ $option };
+sub new_from_hashref {
+ my ($class, %arg) = @_;
+
+ my $api_href = delete $arg{api_href};
+
+ my $self = $class->new(%arg);
+
+ $self->init_from_hashref($api_href);
+
+ return $self;
+}
- next OPTION unless defined $value;
+### PUBLIC INSTANCE METHOD ###
+#
+# Initialize the API from a hashref
+#
- $OPTION_FOR{ $option } = $value;
- };
+sub init_from_hashref {
+ my ($self, $api_href) = @_;
+
+ # Global hooks go first
+ for my $type ( $self->HOOK_TYPES ) {
+ $self->add_hook( type => $type, code => delete $api_href->{$type} )
+ if exists $api_href->{$type};
+ }
+
+ for my $key ( keys %$api_href ) {
+ my $action_def = $api_href->{ $key };
+ my $remote = $action_def->{remote};
+ my $package = $remote ? undef : $key;
+ my $action_name = $remote ? $key : $action_def->{action};
+
+ my $action = $self->add_action(
+ action => $action_name,
+ package => $package,
+ no_overwrite => 1,
+ );
+
+ for my $hook_type ( $remote ? () : $self->HOOK_TYPES ) {
+ my $hook_code = $action_def->{$hook_type};
+
+ if ( $hook_code ) {
+ $self->add_hook(
+ package => $package,
+ type => $hook_type,
+ code => $hook_code,
+ );
+ }
+ }
+
+ my $methods = $action_def->{methods};
+
+ for my $method_name ( keys %$methods ) {
+ my $method_def = $methods->{ $method_name };
+
+ $self->add_method(
+ action => $action_name,
+ package => $package,
+ method => $method_name,
+ %$method_def
+ );
+ }
+ }
}
-### PUBLIC CLASS METHOD ###
+### PUBLIC INSTANCE METHOD ###
#
-# Returns JavaScript chunk for REMOTING_API
+# Returns the JavaScript chunk for REMOTING_API
#
sub get_remoting_api {
- my ($class) = @_;
-
- # Set the debugging flag
- local $RPC::ExtDirect::Serialize::DEBUG = $DEBUG;
-
- # Get configuration class name
- my $config_class = $class->_get_config_class();
-
- # Get configurable parameters
- my %param;
- $param{namespace} = $OPTION_FOR{namespace}
- || undef;
- $param{router_path} = $OPTION_FOR{router_path}
- || $config_class->get_router_path();
- $param{poll_path} = $OPTION_FOR{poll_path}
- || $config_class->get_poll_path();
- $param{remoting_var} = $OPTION_FOR{remoting_var}
- || $config_class->get_remoting_var();
- $param{polling_var} = $OPTION_FOR{polling_var}
- || $config_class->get_polling_var();
- $param{auto_connect} = $OPTION_FOR{auto_connect};
-
+ my ($class, %arg) = @_;
+
+ my ($self, $config);
+
+ # There is an option to pass config externally; mainly for testing
+ $config = $arg{config};
+
+ # Environment object is optional
+ my $env = $arg{env};
+
+ # Backwards compatibility: if called as a class method, operate on
+ # the "global" API object instead, and create a new Config instance
+ # as well to take care of possibly-modified-since global variables
+ if ( ref $class ) {
+ $self = $class;
+ $config ||= $self->config;
+ }
+ else {
+ require RPC::ExtDirect;
+
+ $self = RPC::ExtDirect->get_api();
+ $config ||= $self->config->clone();
+
+ $config->read_global_vars();
+ }
+
# Get REMOTING_API hashref
- my $remoting_api = $class->_get_remoting_api(\%param);
+ my $remoting_api = $self->_get_remoting_api($config, $env);
# Get POLLING_API hashref
- my $polling_api = $class->_get_polling_api(\%param);
+ my $polling_api = $self->_get_polling_api($config, $env);
# Return empty string if we got nothing to declare
return '' if !$remoting_api && !$polling_api;
# Shortcuts
- my $remoting_var = $param{remoting_var};
- my $polling_var = $param{polling_var};
- my $auto_connect = $param{auto_connect};
-
- my $serializer = 'RPC::ExtDirect::Serialize';
+ my $remoting_var = $config->remoting_var;
+ my $polling_var = $config->polling_var;
+ my $auto_connect = $config->auto_connect;
+ my $no_polling = $config->no_polling;
+ my $s_class = $config->serializer_class_api;
+ my $debug_api = $config->debug_api;
+
+ my $serializer = $s_class->new( config => $config );
+
+ my $api_json = $serializer->serialize(
+ mute_exceptions => 1,
+ debug => $debug_api,
+ data => [$remoting_api],
+ );
# Compile JavaScript for REMOTING_API
- my $js_chunk = "$remoting_var = "
- . ($serializer->serialize(1, $remoting_api) || '{}')
- . ";\n";
+ my $js_chunk = "$remoting_var = " . ($api_json || '{}') . ";\n";
# If auto_connect is on, add client side initialization code
$js_chunk .= "Ext.direct.Manager.addProvider($remoting_var);\n"
if $auto_connect;
# POLLING_API is added only when there's something in it
- if ( $polling_api && !$OPTION_FOR{no_polling} ) {
- $js_chunk .= "$polling_var = "
- . ($serializer->serialize(1, $polling_api) || '{}')
- . ";\n";
+ if ( $polling_api && !$no_polling ) {
+ $api_json = $serializer->serialize(
+ mute_exceptions => 1,
+ debug => $debug_api,
+ data => [$polling_api],
+ );
+
+ $js_chunk .= "$polling_var = " . ($api_json || '{}' ) . ";\n";
# Same initialization code for POLLING_API if auto connect is on
$js_chunk .= "Ext.direct.Manager.addProvider($polling_var);\n"
@@ -138,101 +241,277 @@ sub get_remoting_api {
return $js_chunk;
}
-############## PRIVATE METHODS BELOW ##############
+### PUBLIC INSTANCE METHOD ###
+#
+# Get the list of all defined Actions' names
+#
-### PRIVATE CLASS METHOD ###
+sub actions { keys %{ $_[0]->{actions} } }
+
+### PUBLIC INSTANCE METHOD ###
#
-# Returns name of the class used to get configuration defaults
-# It should be subclassed from RPC::ExtDirect::Config
+# Add an Action (class), or update if it exists
#
-sub _get_config_class { 'RPC::ExtDirect::Config' }
+sub add_action {
+ my ($self, %arg) = @_;
+
+ $arg{action} = $self->_get_action_name( $arg{package} )
+ unless defined $arg{action};
+
+ my $action_name = $arg{action};
+
+ return $self->{actions}->{ $action_name }
+ if $arg{no_overwrite} && exists $self->{actions}->{ $action_name };
+
+ my $config = $self->config;
+ my $a_class = $config->api_action_class();
+
+ # This is to avoid hard binding on the Action class
+ eval "require $a_class";
+
+ my $action_obj = $a_class->new(
+ config => $config,
+ %arg,
+ );
+
+ $self->{actions}->{ $action_name } = $action_obj;
+
+ return $action_obj;
+}
-### PRIVATE CLASS METHOD ###
+### PUBLIC INSTANCE METHOD ###
#
-# Prepares REMOTING_API hashref
+# Return Action object by its name
#
-sub _get_remoting_api {
- my ($class, $config) = @_;
+sub get_action_by_name {
+ my ($self, $action_name) = @_;
+
+ return $self->{actions}->{ $action_name };
+}
- # Map Action names to hash keys
- my %actions = map { $_ => 1 } RPC::ExtDirect->get_action_list();
+### PUBLIC INSTANCE METHOD ###
+#
+# Return Action object by package name
+#
- # Compile the list of "actions"
- ACTION:
- for my $action ( keys %actions ) {
- # Get the list of methods for Action
- my @methods = RPC::ExtDirect->get_method_list($action);
+sub get_action_by_package {
+ my ($self, $package) = @_;
+
+ for my $action ( values %{ $self->{actions} } ) {
+ return $action if $action->package eq $package;
+ }
+
+ return;
+}
- next ACTION unless @methods;
+### PUBLIC INSTANCE METHOD ###
+#
+# Add a Method, or update if it exists.
+# Also create the Method's Action if it doesn't exist yet
+#
- my @definitions;
+sub add_method {
+ my ($self, %arg) = @_;
+
+ my $package = delete $arg{package};
+ my $action_name = delete $arg{action};
+ my $method_name = $arg{method};
+
+ # Try to find the Action by the package name
+ my $action = $action_name ? $self->get_action_by_name($action_name)
+ : $self->get_action_by_package($package)
+ ;
+
+ # If Action is not found, create a new one
+ if ( !$action ) {
+ $action_name = $self->_get_action_name($package)
+ unless $action_name;
+
+ $action = $self->add_action(
+ action => $action_name,
+ package => $package,
+ );
+ }
+
+ # Usually redefining a Method means a typo or something
+ croak "Attempting to redefine Method '$method_name' ".
+ ($package ? "in package $package" : "in Action '$action_name'")
+ if $action->can($method_name);
+
+ $action->add_method(\%arg);
+}
- # Go over each method
- METHOD:
- for my $method ( @methods ) {
- # Get the definition
- my $def_ref = $class->_define_method($action, $method);
+### PUBLIC INSTANCE METHOD ###
+#
+# Return the Method object by Action and Method name
+#
- next METHOD unless $def_ref;
+sub get_method_by_name {
+ my ($self, $action_name, $method_name) = @_;
+
+ my $action = $self->get_action_by_name($action_name);
+
+ return unless $action;
+
+ return $action->method($method_name);
+}
- # Store it if it's good
- push @definitions, $def_ref;
- };
+### PUBLIC INSTANCE METHOD ###
+#
+# Add a hook instance
+#
- # No definitions means nothing to export (all poll handlers?)
- if ( !@definitions ) {
- delete $actions{ $action };
- next ACTION;
- };
+sub add_hook {
+ my ($self, %arg) = @_;
+
+ my $package = $arg{package};
+ my $action_name = $arg{action};
+ my $method_name = $arg{method};
+ my $type = $arg{type};
+ my $code = $arg{code};
+
+ my $hook_class = $self->config->api_hook_class;
+
+ # This is to avoid hard binding on RPC::ExtDirect::API::Hook
+ { local $@; eval "require $hook_class"; }
+
+ my $hook = $hook_class->new( type => $type, code => $code );
+
+ if ( $package || $action_name ) {
+ my $action;
+
+ if ( $package ) {
+ $action = $self->get_action_by_package($package);
+
+ croak "Can't find the Action for package '$package'"
+ unless $action;
+ }
+ else {
+ $action = $self->get_action_by_name($action_name);
+
+ croak "Can't find the '$action_name' Action"
+ unless $action;
+ }
+
+ if ( $method_name ) {
+ my $method = $action->method($method_name);
+
+ croak "Can't find Method '$method_name'"
+ unless $method;
+
+ $method->$type($hook);
+ }
+ else {
+ $action->$type($hook);
+ }
+ }
+ else {
+ $self->$type($hook);
+ }
+
+ return $hook;
+}
- # Now convert it to a hashref
- $actions{ $action } = [ @definitions ];
- };
+### PUBLIC INSTANCE METHOD ###
+#
+# Return the hook object by Method name, Action or package, and type
+#
- # Compile hashref
- my $remoting_api = {
- url => $config->{router_path},
- type => 'remoting',
- actions => \%actions,
- };
+sub get_hook {
+ my ($self, %arg) = @_;
+
+ my ($action_name, $package, $method_name, $type)
+ = @arg{qw/ action package method type/};
+
+ my $action = $action_name ? $self->get_action_by_name($action_name)
+ : $self->get_action_by_package($package)
+ ;
+
+ croak "Can't find action '", ($action_name || $package),
+ "' for Method $method_name"
+ unless $action;
+
+ my $method = $action->method($method_name);
+
+ my $hook = $method->$type || $action->$type || $self->$type;
+
+ return $hook;
+}
- # Add namespace if it's defined
- $remoting_api->{namespace} = $config->{namespace}
- if $config->{namespace};
+### PUBLIC INSTANCE METHOD ###
+#
+# Return the list of all installed poll handlers
+#
- return $remoting_api;
+sub get_poll_handlers {
+ my ($self) = @_;
+
+ my @handlers;
+
+ ACTION:
+ for my $action ( values %{ $self->{actions} } ) {
+ my @methods = map { $action->method($_) }
+ $action->polling_methods();
+
+ push @handlers, @methods;
+ }
+
+ return @handlers;
}
-### PRIVATE CLASS METHOD ###
+### PUBLIC INSTANCE METHODS ###
#
-# Returns Action method definition for REMOTING_API
+# Simple read-write accessors
#
-sub _define_method {
- my ($class, $action, $method) = @_;
+my $accessors = [qw/
+ config
+/,
+ __PACKAGE__->HOOK_TYPES,
+];
- # Get the parameters
- my %param = RPC::ExtDirect->get_method_parameters($action, $method);
+RPC::ExtDirect::Util::Accessor::mk_accessors(
+ simple => $accessors,
+);
- # Skip poll handlers
- return undef if $param{pollHandler}; ## no critic
+############## PRIVATE METHODS BELOW ##############
- # Form handlers are defined like this (\1 for JSON::true)
- return { name => $method, len => 0, formHandler => \1 }
- if $param{formHandler};
+### PRIVATE CLASS METHOD ###
+#
+# Prepare REMOTING_API hashref
+#
- # Ordinary method with named arguments
- return { name => $method, params => $param{param_names} }
- if $param{param_names};
+sub _get_remoting_api {
+ my ($self, $config, $env) = @_;
- # Ordinary method with numbered arguments
- return { name => $method, len => $param{param_no} + 0 }
- if $param{param_no} =~ /\d+/;
+ my %api;
+
+ my %actions = %{ $self->{actions} };
- # No arguments specified means we're not checking them
- return { name => $method };
+ ACTION:
+ while ( my ($name, $action) = each %actions ) {
+ # Get the list of methods for Action
+ my @methods = $action->remoting_api($env);
+
+ next ACTION unless @methods;
+
+ $api{ $name } = [ @methods ];
+ };
+
+ # Compile hashref
+ my $remoting_api = {
+ url => $config->router_path,
+ type => 'remoting',
+ actions => { %api },
+ };
+
+ # Add namespace if it's defined
+ $remoting_api->{namespace} = $config->namespace
+ if $config->namespace;
+
+ return $remoting_api;
}
### PRIVATE CLASS METHOD ###
@@ -241,146 +520,46 @@ sub _define_method {
#
sub _get_polling_api {
- my ($class, $config) = @_;
-
+ my ($self, $config, $env) = @_;
+
# Check if we have any poll handlers in our definitions
my $has_poll_handlers;
+
+ my %actions = %{ $self->{actions} };
+
ACTION:
- for my $action ( RPC::ExtDirect->get_action_list() ) {
- # Don't want to depend on List::Util so grep is OK
- $has_poll_handlers = RPC::ExtDirect->get_poll_handlers();
+ while ( my ($name, $action) = each %actions ) {
+ $has_poll_handlers = $action->has_pollHandlers($env);
last ACTION if $has_poll_handlers;
};
# No sense in setting up polling if there ain't no Event providers
return undef unless $has_poll_handlers; ## no critic
-
- # Got poll handlers, return definition
+
+ # Got poll handlers, return definition hashref
return {
type => 'polling',
- url => $config->{poll_path},
+ url => $config->poll_path,
};
}
-1;
+### PRIVATE INSTANCE METHOD ###
+#
+# Make an Action name from a package name (strip namespace)
+#
-__END__
-
-=pod
-
-=head1 NAME
-
-RPC::ExtDirect::API - Remoting API generator for Ext.Direct
-
-=head1 SYNOPSIS
-
- use RPC::ExtDirect::API namespace => 'myApp',
- router_path => '/router',
- poll_path => '/events',
- remoting_var => 'Ext.app.REMOTING_API',
- polling_var => 'Ext.app.POLLING_API',
- auto_connect => 0,
- no_polling => 0,
- before => \&global_before_hook,
- after => \&global_after_hook,
- ;
-
-=head1 DESCRIPTION
-
-This module provides Ext.Direct API code generation.
-
-In order for Ext.Direct client code to know about what Actions (classes)
-and Methods are available on the server side, these should be defined in
-a chunk of JavaScript code that gets requested from the client at startup
-time. It is usually included in the index.html after main ExtJS code:
-
- <script type="text/javascript" src="extjs/ext-debug.js"></script>
- <script type="text/javascript" src="/extdirect_api"></script>
- <script type="text/javascript" src="myapp.js"></script>
-
-RPC::ExtDirect::API provides a way to configure Ext.Direct definition
-variable(s) to accomodate specific application needs. To do so, pass
-configuration options to the module when you 'use' it, like shown above.
-
-The following configuration options are supported:
-
- namespace - Declares the namespace your Actions will
- live in. To call the Methods on client side,
- you will have to qualify them with namespace:
- namespace.Action.Method, e.g.: myApp.Foo.Bar
-
- router_path - URI for Ext.Direct Router calls. For CGI
- implementation, this should be the name of
- CGI script that provides API; for more
- sophisticated environments it is an anchor
- for specified PATH_INFO.
-
- poll_path - URI for Ext.Direct Event provider calls.
- Client side will poll this URI periodically,
- hence the name.
-
- remoting_var - By default, Ext.Direct Configuration for
- remoting (forward) Methods is stored in
- Ext.app.REMOTING_API variable. If for any
- reason you would like to change that, do this
- by setting remoting_var.
- Note that in production environment you would
- probably want to use a compiled version of
- JavaScript application that consist of one
- big JavaScript file. In this case, it is
- recommended to include API declaration as the
- first script in your index.html and change
- remoting API variable name to something like
- EXT_DIRECT_API. Default variable name depends
- on Ext.app namespace being available by the
- time Ext.Direct API is downloaded, which is
- often not the case.
-
- polling_var - By default, Ext.Direct does not provide a
- standard name for Event providers to be
- advertised in. For similarity, POLLING_API
- name is used to declare Event provider so
- it can be used on client side without
- having to hardcode any URIs explicitly.
- POLLING_API configuration will only be
- advertised to client side if there are any
- Event provider Methods declared.
- Note that the same caveat applies here as
- with remoting_var.
-
- no_polling - Explicitly declare that no Event providers
- are supported by server side. This results
- in POLLING_API configuration being suppressed
- even if there are any Methods with declared
- pollHandler ExtDirect attribute.
-
- auto_connect - Generate the code that adds Remoting and
- Polling providers on the client side without
- having to do this manually.
-
- before - Global "before" hook.
-
- instead - Global "instead" hook.
-
- after - Global "after" hook.
-
- For more information on hooks and their usage, see L<RPC::ExtDirect>.
-
-=head1 SUBROUTINES/METHODS
-
-There are no methods intended for external use in this module.
-
-=head1 AUTHOR
-
-Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2011-2012 Alexander Tokarev.
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself. See L<perlartistic>.
-
-=cut
+sub _get_action_name {
+ my ($self, $action_name) = @_;
+
+ if ( $self->config->api_full_action_names ) {
+ $action_name =~ s/::/./g;
+ }
+ else {
+ $action_name =~ s/^.*:://;
+ }
+
+ return $action_name;
+}
+1;
@@ -0,0 +1,791 @@
+=pod
+
+=head1 NAME
+
+RPC::ExtDirect::API - Ext.Direct service discovery handler
+
+=head1 SYNOPSIS
+
+ use RPC::ExtDirect::Config;
+ use RPC::ExtDirect::API;
+
+ my $config = RPC::ExtDirect::Config->new(
+ namespace => 'MyApp',
+ router_path => '/router',
+ poll_path => '/events',
+ remoting_var => 'MyApp.REMOTING_API',
+ polling_var => 'MyApp.POLLING_API',
+ );
+
+ my $api = RPC::ExtDirect::API->new_from_hashref(
+ config => $config,
+ api_href => {
+ before => 'MyApp::Util::global_before_hook',
+ after => 'MyApp::Util::global_after_hook',
+
+ 'MyApp::Server::Foo' => {
+ before => 'MyApp::Server::Foo::package_before_hook',
+
+ action => 'MyApp.Server.Foo', # JavaScript style with dots
+
+ methods => {
+ foo => {
+ len => 1,
+ },
+ bar => {
+ params => [qw/ foo bar /],
+ },
+ }
+ }
+ }
+ );
+
+=head1 DESCRIPTION
+
+With Ext.Direct, the L<API|RPC::ExtDirect::Intro/API> exposed by the
+server side is published to the clients via fixed URI, a GET request
+to which produces a response with a piece of JavaScript code containing
+the API declaration. This module handles the API service discovery requests.
+
+The Ext.Direct L<API declaration|RPC::ExtDirect::Intro/"API declaration">
+is in fact a tree-like data structure (an Object in JavaScript parlance)
+containing description of L<Actions|RPC::ExtDirect::Intro/Action> and
+L<Methods|RPC::ExtDirect::Intro/Method> available to the client. This
+data structure is encoded in JavaScript code statement that is
+regenerated dynamically every time it is requested. No caching is used
+at this time.
+
+=head1 ACTIONS AND METHODS
+
+An L<Action|RPC::ExtDirect::Intro/Action> in Ext.Direct parlance is a
+collection of L<Method|RPC::ExtDirect::Intro/Method> definitions. The
+nearest similar Perl thing is a package, other languages may call it
+a Class. In L<RPC::ExtDirect>, an Action needs a unique name that can
+be nested; Methods should have unique names within their Actions.
+
+=head2 Action names
+
+If the Action name is not specified explicitly, it will be deduced from the
+package name. If
+L<api_full_action_names|RPC::ExtDirect::Config/api_full_action_names>
+Config option is truthy, Action name will be similar to the package name
+with the same level of nesting, having C<'::'> replaced with dots:
+C<'Foo::Bar::Baz' -E<gt> 'Foo.Bar.Baz'>. Starting with Ext JS version 4.2.1,
+this allows having nested API objects on the client side as well, so you
+can call the server side methods like normal JavaScript methods:
+
+ Foo.Bar.Baz.do_foo(...);
+
+However nested API objects are not supported in Ext JS below 4.2.1 as well
+as in Sencha Touch 2.x, so the default behavior is to use only the last
+chunk of the package name: C<'Foo::Bar::Baz' -E<gt> 'Baz'>.
+
+=head2 Method calling conventions
+
+L<Ext.Direct specification|www.sencha.com/products/extjs/extdirect/>
+defines four calling convention for methods:
+
+=over 4
+
+=item *
+
+With parameters passed by position
+(L<ordered Method|RPC::ExtDirect::Intro/"Ordered Method">)
+
+=item *
+
+With parameters passed by name
+(L<named Method|RPC::ExtDirect::Intro/"Named Method">)
+
+=item *
+
+L<Form Handler|RPC::ExtDirect::Intro/"Form Handler Method">. This is a
+special case of a Method that accepts field values for a submitted HTML
+form. Form handlers are used to process
+L<file uploads|RPC::ExtDirect/"FILE UPLOADS">.
+
+=item *
+
+L<Poll Handler|RPC::ExtDirect::Intro/"Poll Handler Method">. This is
+another special case of a Method. Poll Handlers do not accept any
+arguments, except L<Environment objects|RPC::ExtDirect/"ENVIRONMENT OBJECTS">
+when requested.
+
+=back
+
+When an Ext.Direct remoting method is called on the client side, the
+transport layer will perform a check on the actual arguments passed
+to the L<method stub|RPC::ExtDirect::Intro/"Method stub">, and throw
+an exception if arguments do not conform to the
+L<API declaration|RPC::ExtDirect::Intro/"API declaration">.
+
+To declare an ordered method, define the L</len> option with the number of
+parameters accepted; this number may be 0 for methods that do not accept any
+parameters at all.
+
+To declare a named method, define the L</params> option with the names of
+mandatory parameters. It is worth noting that only I<existence> of parameters
+is mandatory; their values may as well be undefined. If not all arguments
+exist, an exception will be thrown. If there are any extra arguments not
+declared for this method, an exception will be thrown as well, unless
+strict argument checking is turned off
+(L<see below|/"Lazy parameter checking">).
+
+=head2 Lazy parameter checking
+
+Starting with Ext JS 4.2.2 and RPC::ExtDirect 3.0+, it is possible to
+perform less strict parameter checking on by-name methods. All parameters
+explicitly declared for a method will still be treated as mandatory, but
+no exception will be thrown if undeclared arguments are passed into the
+L<method stub|RPC::ExtDirect::Intro/"Method stub">; these "extra" arguments
+will be transmitted to the server side and passed into the actual
+L<Method|RPC::ExtDirect::Intro/Method>. It is also possible to completely
+bypass the argument checking by not declaring any mandatory methods for
+a Method.
+
+As mentioned above, the strict checking is enabled by default; to disable
+it, set the L<strict|/strict> option to falsy value for any given method.
+
+Lazy parameter checking is not supported in Ext JS below 4.2.2, and in
+Sencha Touch 2.x.
+
+=head1 COMPILE VS RUN TIME DEFINITION
+
+There are two ways to define Ext.Direct L<API|RPC::ExtDirect::Intro/API>
+with RPC::ExtDirect: statically by using C<ExtDirect> subroutine attribute,
+or dynamically by including Actions and Methods in a hashref that is used to
+configure an API object.
+
+Both of these ways have their advantages and disadvantages. Using the
+C<ExtDirect> attribute, it's easier to keep definitions closer to the
+actual code so that when the code changes, its definition can be
+remembered to be changed as well. Also this approach is very easy to use
+and start with; just add the attribute to your code, and you're good to
+go. Also, the attribute syntax is expressive enough to be self-documenting,
+so often no other API documentation is needed.
+
+On the other hand, for larger and more centralized projects it may be easier
+to keep all API definitions in one place rather than spread over dozens of
+packages. Besides easier maintenance, using dynamic approach allows having
+more than one active API object at a given time, possibly implementing
+different APIs tailored for usage patterns of a particular application.
+
+Note that these two methods are I<not> mutually exclusive, but it is
+not recommended to mix them unless you really know how to deal with ensuing
+timing issues. You've been warned.
+
+=head1 DEFINING METHODS STATICALLY
+
+In order to add a subroutine to the Ext.Direct interface, use an attribute
+with the sub definition:
+
+ sub foo : ExtDirect(...) {}
+
+Note that there can be no space between the C<ExtDirect> attribute name and
+the opening parens; also in Perls older than 5.12, the attribute statement
+cannot span multiple lines, i.e. the whole C<ExtDirect(...)> construct
+should fit in one line.
+
+Inside the parentheses, one of the following mutually exclusive option
+keywords is B<mandatory>:
+
+=over 4
+
+=item C<n>
+
+The number of ordered arguments this L<Method|RPC::ExtDirect::Intro/Method>
+accepts. This form is considered obsolete, use L</len> keyword instead.
+If C<n> is used, this keyword should always come first in the list:
+
+ sub foo : ExtDirect(1, ...) {} # right
+ sub bar : ExtDirect(..., 1) {} # wrong
+ sub baz : ExtDirect(0) {} # right
+
+=item C<len>
+
+A more preferred way to define an Ordered Method. This keyword should be
+followed by the number of the parameters accepted by the Method:
+
+ sub foo : ExtDirect(len => 1) {} # right
+ sub bar : ExtDirect(..., len => 1) {} # also right
+ sub baz : ExtDirect(len => 0) {} # right again
+
+
+=item C<params>
+
+A list of the named parameters this method accepts. Since a
+L<Method|RPC::ExtDirect::Intro/Method> can be either
+L<ordered or named|/"Method calling conventions">, this and above options
+are mutually exclusive. This keyword should be followed by an arrayref
+with the parameter names, possibly empty:
+
+ sub foo : ExtDirect(params => ['foo', 'bar', ...], ...) {}
+ sub bar : ExtDirect(params => [], ...) {}
+
+
+=item C<formHandler>
+
+This option defines the Method as a
+L<Form Handler|RPC::ExtDirect::Intro/"Form Handler Method">.
+
+=item C<pollHandler>
+
+This option defines the Method as a
+L<Poll Handler|RPC::ExtDirect::Intro/"Poll Handler Method">.
+
+=back
+
+Having more than one calling convention keyword in the Method definition
+is not supported and will lead to undefined behavior.
+
+Besides the mandatory calling convention keyword, there are optional
+Method attributes in hash-like C<key =E<gt> value> form. Currently
+supported attributes are:
+
+=over 4
+
+=item C<strict>
+
+This option, if set to a falsy value with Named parameters, turns on
+L<lazy parameter checking|/"Lazy parameter checking">. Since the checks
+are strict by default, setting this option to truthy value will do nothing.
+
+ sub foo : ExtDirect(params => ['foo'], strict => !1, ...) {}
+
+=item C<before|instead|after>
+
+A corresponding L<Hook|RPC::ExtDirect/HOOKS> slot definition for the
+Method. This keyword should be followed by an argument that defines the
+actual Hook behavior. See L</add_hook> method documentation below.
+
+=item other
+
+Any other keyword with the corresponding value will be passed through
+to the L<Method class|RPC::ExtDirect::Config/api_method_class> constructor
+and will end up as a Method object property. Note that accessors for such
+properties will I<not> be created automatically when the stock
+L<RPC::ExtDirect::API::Method> class is used.
+
+=back
+
+=head1 DEFINING METHODS DYNAMICALLY
+
+If you find the static definition method inconvenient or hard to maintain,
+use dynamic definition instead. You can create a new API object using
+L<new_from_hashref|/new_from_hashref> constructor, or just init the
+L<global API instance|/"GLOBAL API TREE INSTANCE"> from a hashref
+containing the API definition:
+
+ my $api = RPC::ExtDirect->get_api();
+ $api->init_from_hashref({
+ 'MyApp::Server::Foo' => {
+ methods => {
+ ordered_method => {
+ len => 1,
+ },
+ named_method => {
+ params => [qw/ foo bar /],
+ strict => !1,
+ },
+ form_handler => {
+ formHandler => 1,
+ },
+ poll_handler => {
+ pollHandler => 1,
+ },
+ },
+ },
+ });
+
+Keywords and options are the same as with the static method, refer to the
+L<section above|/"DEFINING METHODS STATICALLY"> for details.
+
+=head1 GLOBAL API TREE INSTANCE
+
+Under the hood, static API definition operates on a global instance of
+C<RPC::ExtDirect::API>, created at the package compilation time and
+available globally throughout the application.
+
+Versions 1.x and 2.x of RPC::ExtDirect used package global variables to hold
+this information; version 3.0 is using a global L<RPC::ExtDirect::API> object
+instead. This object is held in a private variable and can be retrieved by
+the L<get_api|RPC::ExtDirect/get_api> method:
+
+ my $global_api = RPC::ExtDirect->get_api;
+
+This API object holds an instance of L<RPC::ExtDirect::Config> with a set
+of options used to configure the API object behavior. This Config instance
+can be retrieved to set options directly:
+
+ my $cfg = RPC::ExtDirect->get_api->config;
+ $cfg->option1('foo');
+ $cfg->option2('bar');
+
+Since the API object is a normal object, and the L<config|/config> method
+is a normal accessor, it is possible to replace that Config instance with
+a new one. However this may result in a loss of statically defined Config
+options, and is not recommended. Instead, use
+L<import package sub|/CONFIGURATION> to configure the global API when
+using static API definitions.
+
+The global API instance is used by default to generate the
+L<API declaration|RPC::ExtDirect::Intro/"API declaration"> requested by
+the client side, and for dispatching remoting calls from the client side.
+If you prefer more control over the API tree, create the API object
+explicitly as shown in the L<SYNOPSIS|/SYNOPSIS>, and pass it to the
+gateway object. Refer to the actual
+L<gateway|RPC::ExtDirect::Intro/GATEWAYS> documentation for details.
+
+Because attribute parsing happens at package compilation
+time, it is hard to predict the order in which the methods will be
+processed. To provide some help with debugging, RPC::ExtDirect will throw
+an error if you are trying to redefine a Method; usually that means a
+mistake has been made somewhere.
+
+=head1 API CONFIGURATION
+
+RPC::ExtDirect::API provides two ways to configure Ext.Direct API declaration
+variables to accommodate specific application needs: dynamic via an
+L<RPC::ExtDirect::Config> instance, and static via C<import> package
+subroutine.
+
+An example of the new dynamic configuration is available in the L</SYNOPSIS>
+above. This is the preferred way of configuring the API in large complex
+applications; it allows keeping the whole API definition in one place
+instead of distributed among the packages. It is also possible to define
+more than one API this way, for publishing to different clients.
+
+The static configuration was available since version 1.0 and will be
+supported going forward. This way it is possible to configure the API
+variables at compile time:
+
+ use RPC::ExtDirect::API namespace => 'myApp',
+ router_path => '/router',
+ poll_path => '/events',
+ remoting_var => 'Ext.app.REMOTING_API',
+ polling_var => 'Ext.app.POLLING_API',
+ auto_connect => 0,
+ no_polling => 0,
+ before => \&global_before_hook,
+ after => \&global_after_hook,
+ ;
+
+Under the hood, the above code will set specified options on the
+L<Config|RPC::ExtDirect::Config> instance held in the
+L<global API object|/"GLOBAL API TREE INSTANCE">.
+
+=head1 API CONFIGURATION OPTIONS
+
+The following configuration options are supported by RPC::ExtDirect::API:
+
+=over 4
+
+=item C<namespace>
+
+Declares the namespace your L<Actions|RPC::ExtDirect::Intro/Action> will
+reside in. To call the L<Methods|RPC::ExtDirect::Intro/Method> on client side,
+you will have to qualify them with namespace: C<namespace.Action.Method>,
+e.g.: C<myApp.Foo.Bar>
+
+=item C<router_path>
+
+URI for Ext.Direct L<Router|RPC::ExtDirect::Intro/Router> calls. For the
+L<CGI environment|CGI::ExtDirect>, this should be the name of the CGI script
+that provides the API declaration; for more sophisticated environments it is
+an anchor for the specified PATH_INFO.
+
+=item C<poll_path>
+
+URI for Ext.Direct L<Event Provider|RPC::ExtDirect::Intro/"Event Provider">
+calls. Client side will poll this URI periodically, hence the name.
+
+=item C<remoting_var>
+
+By default, Ext.Direct L<API declaration|RPC::ExtDirect::Intro/"API declaration">
+for remoting (forward) L<Methods|RPC::ExtDirect::Intro/Method> is stored in
+Ext.app.REMOTING_API variable. If for any reason you would like to change that,
+do this by setting remoting_var.
+
+Note that in production environment you would probably want to use a compiled
+version of the JavaScript application that consist of one big JavaScript file.
+In this case, it is recommended to include API declaration as the first script
+in your index.html and change the remoting API variable name to something like
+C<EXT_DIRECT_API>. Default variable name depends on Ext.app namespace being
+available by the time Ext.Direct
+L<API declaration|RPC::ExtDirect::Intro/"API declaration"> is downloaded, which is
+often not the case.
+
+=item C<polling_var>
+
+Ext.Direct does not provide a standard namespace for
+L<Event Providers|RPC::ExtDirect::Intro/"Event Provider"> to be published in.
+For similarity with L</remoting_var>, C<Ext.app.POLLING_API> name is used to
+declare an L<Event Provider|RPC::ExtDirect::Intro/"Event Provider"> so that
+it could be used on the client side without having to hardcode any URIs
+explicitly.
+
+C<Ext.app.POLLING_API> configuration will only be published to the client side
+if there is at least one L<pollHandler|RPC::ExtDirect::Config/pollHandler>
+L<Method|RPC::ExtDirect::Intro/Method> defined in the Ext.Direct
+L<API|RPC::ExtDirect::Intro/API>.
+
+Note that the same variable naming caveat applies here as with L</remoting_var>.
+
+=item C<no_polling>
+
+Explicitly prohibit the L<API declaration|RPC::ExtDirect::Intro/"API declaration">
+from containing a L</polling_var> definition. This will suppress publishing
+L<Event Providers|RPC::ExtDirect::Intro/"Event Provider"> even if there are any
+L<pollHandler|RPC::ExtDirect::Config/pollHandler> methods in the actual
+L<API|RPC::ExtDirect::Intro/API>.
+
+This option can be useful for testing.
+
+=item C<auto_connect>
+
+This option is deprecated and should not be used anymore.
+
+=item C<before>
+
+Global C<before> hook. See L<RPC::ExtDirect/HOOKS>.
+
+=item C<instead>
+
+Global C<instead> hook. See L<RPC::ExtDirect/HOOKS>.
+
+=item C<after>
+
+Global C<after> hook. See L<RPC::ExtDirect/HOOKS>.
+
+=back
+
+=head1 API OBJECT INTERFACE
+
+RPC::ExtDirect::API provides several public methods:
+
+=over 4
+
+=item C<HOOK_TYPES>
+
+Class/instance method. Returns the list of supported hook types.
+See L<RPC::ExtDirect/HOOKS> for more information.
+
+Accepts no arguments.
+
+=item C<new>
+
+Constructor. Returns a new L<RPC::ExtDirect::API> object with
+an empty L<API tree|RPC::ExtDirect::Intro/API>. Accepts named
+arguments in a hash.
+
+Parameters:
+
+=over 8
+
+=item C<config>
+
+Optional L<RPC::ExtDirect::Config> instance to be used. If not provided,
+a new Config instance will be created.
+
+=back
+
+=item C<new_from_hashref>
+
+Constructor. Returns a new L<RPC::ExtDirect::API> object with
+an L<API tree|RPC::ExtDirect::Intro/API> initialized from the
+L<api_href|/api_href> argument. Accepts named arguments in a hash.
+
+Parameters:
+
+=over 8
+
+=item C<config>
+
+Optional L<RPC::ExtDirect::Config> instance to be used. If not provided,
+a new instance will be created.
+
+=item C<api_href>
+
+Mandatory. A hashref containing the API tree. See
+L</"DEFINING METHODS DYNAMICALLY"> for more information.
+
+=back
+
+=item C<init_from_hashref>
+
+Instance method. Initializes the API tree in the object from the passed
+hashref with API definitions. This method will be called internally by
+L</new_from_hashref>.
+
+Accepts only one ordered argument:
+
+=over 8
+
+=item *
+
+API definition hashref. See L</"DEFINING METHODS DYNAMICALLY"> for
+more information.
+
+=back
+
+=item C<get_remoting_api>
+
+Instance method. Returns stringified
+L<API declaration|RPC::ExtDirect::Intro/"API declaration"> for the current
+API tree contained in the object. Accepts named arguments in a hash.
+
+Parameters:
+
+=over 8
+
+=item C<config>
+
+An optional L<RPC::ExtDirect::Config> instance to be used when generating
+the L<API declaration|RPC::ExtDirect::Intro/"API declaration">. This is
+useful for testing, but should not be used in production.
+
+=item C<env>
+
+An L<Environment object|RPC::ExtDirect/"ENVIRONMENT OBJECTS">. This object
+is not used by the stock L<RPC::ExtDirect::API> code directly; instead, it
+is passed to the Action's
+L<remoting_api|RPC::ExtDirect::API::Action/remoting_api> method, which in
+turn will pass it to the Method's
+L<get_api_definition|RPC::ExtDirect::API::Method> method that will return
+the actual Method API definition.
+
+You can subclass L<RPC::ExtDirect::API::Method> to perform some additional
+actions, e.g. checking users' authentication status before generating the
+API declaration.
+
+=back
+
+=item C<actions>
+
+Instance method. Returns the list of names for all
+L<Actions|RPC::ExtDirect::Intro/Action> defined in the API tree.
+
+=item C<add_action>
+
+Instance method. Adds or replaces an L<Action|RPC::ExtDirect::Intro/Action>
+in the current API tree. Accepts named arguments in a hash.
+
+Parameters:
+
+=over 8
+
+=item C<package>
+
+Mandatory. Package name for the Action.
+
+=item C<action>
+
+Optional name for the Action. If not provided, a new Action name will
+be generated, see L</"Action names"> for more detail.
+
+=item other
+
+The rest of the arguments is passed directly to the Action constructor.
+If no L<api_action_class|RPC::ExtDirect::Config/api_action_class> Config
+option is set, the default L<RPC::ExtDirect::API::Action> class will be
+used.
+
+=back
+
+=item C<get_action_by_name>
+
+Instance method. Returns the L<Action|RPC::ExtDirect::Intro/Action> object
+for the corresponding action name, or C<undef>. Accepts one ordered
+argument (action name).
+
+=item C<get_action_by_package>
+
+Instance method. Returns the L<Action|RPC::ExtDirect::Intro/Action> object
+for the corresponding package, or C<undef>. Accepts one ordered argument
+(package name).
+
+=item C<add_method>
+
+Instance method. Add a new Ext.Direct L<Method|RPC::ExtDirect::Intro/Method>
+object to the current API tree, creating an Action for it if necessary.
+Accepts named arguments in a hash.
+
+Parameters:
+
+=over 8
+
+=item C<action>
+
+Action name to add the Method to. Either this or C<package> parameter below
+is mandatory.
+
+=item C<package>
+
+Package name of the Action to add the Method to. Either this or C<action>
+parameter above is mandatory.
+
+=item C<method>
+
+Name of the Method to add.
+
+=item other
+
+The rest of the arguments is passed directly to the Method constructor.
+If no L<api_method_class|RPC::ExtDirect::Config/api_method_class> Config
+option is set, the default L<RPC::ExtDirect::API::Method> class will be
+used.
+
+=back
+
+=item C<get_method_by_name>
+
+Instance method. Return the L<Method|RPC::ExtDirect::Intro/Method> object
+for the corresponding Action and Method name. Accepts two ordered
+arguments:
+
+=over 8
+
+=item *
+
+Action name to look up the Method in.
+
+=item *
+
+Method name.
+
+=back
+
+=item C<add_hook>
+
+Instance method. Adds a new L<Hook|RPC::ExtDirect/HOOKS> object to the
+current API tree. Accepts named arguments in a hash.
+
+For global hooks, only C<type> and C<code> parameters are needed.
+For Action level hooks, either C<package> or C<action> parameter
+is needed as well. For Method level hooks, the C<method> parameter
+is required in addition to the above.
+
+If L<api_hook_class|RPC::ExtDirect::Config/api_hook_class> Config option
+is not set, the default L<RPC::ExtDirect::API::Hook> class will be used
+to instantiate the Hook object.
+
+Parameters:
+
+=over 8
+
+=item C<package>
+
+Package for which the hook is added. Optional for global hooks. This
+or C<action> parameter is mandatory for Action or Method level hooks.
+
+=item C<action>
+
+Action name for which the hook is added. Optional for global hooks.
+This or C<package> parameter is mandatory for Action or Method level
+hooks.
+
+=item C<method>
+
+Method name for which the hook is added. Optional for package and global
+hooks.
+
+=item C<type>
+
+Hook type. The list of hook types supported by the API class is returned
+by the L</HOOK_TYPES> method. See L<RPC::ExtDirect::API::Hook/TYPES> for
+more information on hook types.
+
+This parameter is mandatory.
+
+=item C<code>
+
+Hook code, or absence thereof. See L<RPC::ExtDirect::API::Hook/code>.
+
+This parameter is mandatory.
+
+=back
+
+=item C<get_hook>
+
+Instance method. Returns the Hook object for a given criteria. Accepts
+named arguments in a hash.
+
+When looking up Method level hook, C<action> or C<package> parameter is
+mandatory, as well as the C<method> name and hook C<type>. For Action
+level hooks, C<action> or C<package> is required to look up the Action,
+and C<type> for the hook. For global hooks, only C<type> is required.
+
+Parameters:
+
+=over 8
+
+=item C<action>
+
+Action name to return the Hook object for. This or C<package> parameter
+is required for Action or Method level hooks, and is optional for global
+hooks.
+
+=item C<package>
+
+Package name of the Action to return the Hook object for. This or
+C<action> parameter is required for Action or Method level hooks, and is
+optional for global hooks.
+
+=item C<method>
+
+Method name to return the Hook object for. Optional for Action and global
+level hooks.
+
+=item C<type>
+
+Type of the hook to return. This parameter is required.
+
+=back
+
+=item C<get_poll_handlers>
+
+Instance method. Returns the list of Method objects for all
+L<Poll handlers|RPC::ExtDirect::Intro/"Poll Handler Method"> for every
+Action in the current API tree.
+
+This method does not accept any arguments.
+
+=back
+
+=head1 ACCESSOR METHODS
+
+For L<RPC::ExtDirect::API>, the following
+L<accesor methods|RPC::ExtDirect::Config/"ACCESSOR METHODS"> are provided:
+
+=over 4
+
+=item C<config>
+
+Return the current L<RPC::ExtDirect::Config> instance held in this
+API object, or set a new one.
+
+=item C<before>
+
+Return the global C<before> L<Hook object|RPC::ExtDirect::API::Hook> if
+set, or assign a new one. See L<RPC::ExtDirect/HOOKS> for more information.
+
+=item C<instead>
+
+Return the global C<instead> L<Hook object|RPC::ExtDirect::API::Hook>
+if set, or assign a new one. See L<RPC::ExtDirect/HOOKS> for more
+information.
+
+=item C<after>
+
+Return the global C<after> L<Hook object|RPC::ExtDirect::API::Hook>
+if set, or assign a new one. See L<RPC::ExtDirect/HOOKS> for more
+information.
+
+=back
+
+=head1 SEE ALSO
+
+More information on the configuration options can be found in
+L<RPC::ExtDirect::Config> documentation.
+
+=cut
@@ -1,12 +0,0 @@
-package RPC::ExtDirect::BEGIN;
-
-no warnings 'redefine';
-
-use Attribute::Handlers;
-
-sub UNIVERSAL::ExtDirect : ATTR(CODE,BEGIN) {
- return RPC::ExtDirect::extdirect(@_);
-}
-
-1;
-
@@ -1,12 +0,0 @@
-package RPC::ExtDirect::CHECK;
-
-no warnings 'redefine';
-
-use Attribute::Handlers;
-
-sub UNIVERSAL::ExtDirect : ATTR(CODE,CHECK) {
- return RPC::ExtDirect::extdirect(@_);
-}
-
-1;
-
@@ -4,68 +4,403 @@ use strict;
use warnings;
no warnings 'uninitialized'; ## no critic
-### PUBLIC CLASS METHOD ###
+use Carp;
+
+use RPC::ExtDirect::Util::Accessor;
+use RPC::ExtDirect::Util qw/ parse_global_flags /;
+
+### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
#
-# Returns default router path
+# Create a new Config instance
#
-sub get_router_path { '/extdirectrouter' }
+sub new {
+ my $class = shift;
+
+ my %arg;
+
+ if ( @_ == 1 and 'HASH' eq ref $_[0] ) {
+ %arg = %{ $_[0] };
+ }
+ elsif ( @_ % 2 == 0 ) {
+ %arg = @_;
+ }
+ elsif ( @_ != 0 ) {
+ croak "Odd number of arguments in RPC::ExtDirect::Config->new()";
+ }
+
+ my $self = bless {}, $class;
+
+ $self->_init();
+ $self->set_options(%arg);
+
+ return $self;
+}
-### PUBLIC CLASS METHOD ###
+### PUBLIC INSTANCE METHOD (CONSTRUCTOR) ###
#
-# Returns polling (events) path
+# Create a new Config instance from existing one (clone it)
+# We're only doing shallow copying here.
#
-sub get_poll_path { '/extdirectevents' }
+sub clone {
+ my ($self) = @_;
+
+ my $clone = bless {}, ref $self;
+
+ @$clone{ keys %$self } = values %$self;
+
+ return $clone;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Re-parse the global vars
+#
+
+sub read_global_vars {
+ my ($self) = @_;
+
+ $self->_parse_global_vars();
+
+ return $self;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Add specified accessors to the Config instance class
+#
+
+sub add_accessors {
+ my ($self, %arg) = @_;
+
+ RPC::ExtDirect::Util::Accessor->mk_accessors(
+ class => ref $self || $self, # Class method, too
+ ignore => 1,
+ %arg,
+ );
+
+ return $self;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Set the options in bulk by calling relevant setters
+#
+
+sub set_options {
+ my $self = shift;
+
+ my $debug = $self->debug;
+
+ my %options = @_ == 1 && 'HASH' eq ref($_[0]) ? %{ $_[0] } : @_;
+
+ while ( my ($option, $value) = each %options ) {
+
+ # We may as well be passed some options that we don't support;
+ # that may happen by accident, or the options hash may be passed
+ # on from unknown upper level. This does not represent a problem
+ # per se, so rather than bomb out with a cryptic error if a setter
+ # happens not to be defined, we warn in debug and silently ignore
+ # such occurences when not debugging.
+ if ( $self->can($option) ) {
+ $self->$option($value);
+ }
+ elsif ( $debug ) {
+ warn ref($self)." instance was passed a config option $option ".
+ "for which there is no setter. A mistake?";
+ }
+ }
+
+ return $self;
+}
+
+#
+# Note to self: the four deprecated methods below are *intentionally*
+# left verbose and not collapsed to some helper sub.
+#
### PUBLIC CLASS METHOD ###
#
-# Returns REMOTING_API variable name
+# Return the default router path; provided for compatibility with 2.x
+#
+# DEPRECATED. Use `router_path` method on a Config instance instead.
#
-sub get_remoting_var { 'Ext.app.REMOTING_API' }
+sub get_router_path {
+ warn __PACKAGE__."->get_router_path class method is deprecated; " .
+ "use router_path instance method instead";
+
+ return __PACKAGE__->new->router_path;
+}
### PUBLIC CLASS METHOD ###
#
-# Returns POLLING_API variable name (RPC::ExtDirect extension)
+# Return the default poll path; provided for compatibility with 2.x
+#
+# DEPRECATED. Use `poll_path` method on a Config instance instead.
+#
-sub get_polling_var { 'Ext.app.POLLING_API' }
+sub get_poll_path {
+ warn __PACKAGE__."->get_poll_path class method is deprecated; " .
+ "use poll_path instance method instead";
+
+ return __PACKAGE__->new->poll_path;
+}
-############## PRIVATE METHODS BELOW ##############
+### PUBLIC CLASS METHOD ###
+#
+# Return the default remoting variable name; provided for
+# compatibility with 2.x
+#
+# DEPRECATED. Use `remoting_var` method on a Config instance instead.
+#
-1;
+sub get_remoting_var {
+ warn __PACKAGE__."->get_remoting_var class method is deprecated; " .
+ "use remoting_var instance method instead";
-__END__
+ return __PACKAGE__->new->remoting_var;
+}
-=pod
+### PUBLIC CLASS METHOD ###
+#
+# Return the default polling variable name; provided for
+# compatibility with 2.x
+#
+# DEPRECATED. Use `polling_var` method on a Config instance instead.
+#
-=head1 NAME
+sub get_polling_var {
+ warn __PACKAGE__."->get_polling_var class method is deprecated; " .
+ "use polling_var instance method instead";
+
+ return __PACKAGE__->new->polling_var;
+}
-RPC::ExtDirect::Config - Default options for ExtDirect API
+############## PRIVATE METHODS BELOW ##############
-=head1 SYNOPSIS
+#
+# This humongous hashref holds definitions for all fields,
+# accessors, default values and global variables involved
+# with config objects.
+# It's just easier to keep all this stuff in one place
+# and pluck the pieces needed for various purposes.
+#
+my $DEFINITIONS = [{
+ accessor => 'api_action_class',
+ default => 'RPC::ExtDirect::API::Action',
+}, {
+ accessor => 'api_method_class',
+ default => 'RPC::ExtDirect::API::Method',
+}, {
+ accessor => 'api_hook_class',
+ default => 'RPC::ExtDirect::API::Hook',
+}, {
+ accessor => 'api_full_action_names',
+ default => !1,
+}, {
+ accessor => 'debug',
+ default => !1,
+}, {
+ package => 'RPC::ExtDirect::API',
+ var => 'DEBUG',
+ type => 'scalar',
+ setter => 'debug_api',
+ fallback => 'debug',
+}, {
+ package => 'RPC::ExtDirect::EventProvider',
+ var => 'DEBUG',
+ type => 'scalar',
+ setter => 'debug_eventprovider',
+ fallback => 'debug',
+}, {
+ package => 'RPC::ExtDirect::Serialize',
+ var => 'DEBUG',
+ type => 'scalar',
+ setter => 'debug_serialize',
+ fallback => 'debug',
+}, {
+ package => 'RPC::ExtDirect::Deserialize',
+ var => 'DEBUG',
+ type => 'scalar',
+ setter => 'debug_deserialize',
+ fallback => 'debug',
+}, {
+ package => 'RPC::ExtDirect::Request',
+ var => 'DEBUG',
+ type => 'scalar',
+ setter => 'debug_request',
+ fallback => 'debug',
+}, {
+ package => 'RPC::ExtDirect::Router',
+ var => 'DEBUG',
+ type => 'scalar',
+ setter => 'debug_router',
+ fallback => 'debug',
+}, {
+ accessor => 'exception_class',
+ default => 'RPC::ExtDirect::Exception',
+}, {
+ package => 'RPC::ExtDirect::Serialize',
+ var => 'EXCEPTION_CLASS',
+ type => 'scalar',
+ setter => 'exception_class_serialize',
+ fallback => 'exception_class',
+}, {
+ package => 'RPC::ExtDirect::Deserialize',
+ var => 'EXCEPTION_CLASS',
+ type => 'scalar',
+ setter => 'exception_class_deserialize',
+ fallback => 'exception_class',
+}, {
+ package => 'RPC::ExtDirect::Request',
+ var => 'EXCEPTION_CLASS',
+ type => 'scalar',
+ setter => 'exception_class_request',
+ fallback => 'exception_class',
+}, {
+ accessor => 'request_class',
+ default => 'RPC::ExtDirect::Request',
+}, {
+ package => 'RPC::ExtDirect::Deserialize',
+ var => 'REQUEST_CLASS',
+ type => 'scalar',
+ setter => 'request_class_deserialize',
+ fallback => 'request_class',
+}, {
+ # This is a special case - can be overridden
+ # but doesn't fall back to request_class
+ accessor => 'request_class_eventprovider',
+ default => 'RPC::ExtDirect::Request::PollHandler',
+}, {
+ accessor => 'serializer_class',
+ default => 'RPC::ExtDirect::Serializer',
+}, {
+ setter => 'serializer_class_api',
+ fallback => 'serializer_class',
+}, {
+ package => 'RPC::ExtDirect::Router',
+ var => 'SERIALIZER_CLASS',
+ type => 'scalar',
+ setter => 'serializer_class_router',
+ fallback => 'serializer_class',
+}, {
+ package => 'RPC::ExtDirect::EventProvider',
+ var => 'SERIALIZER_CLASS',
+ type => 'scalar',
+ setter => 'serializer_class_eventprovider',
+ fallback => 'serializer_class',
+}, {
+ accessor => 'deserializer_class',
+ default => 'RPC::ExtDirect::Serializer',
+}, {
+ package => 'RPC::ExtDirect::Router',
+ var => 'DESERIALIZER_CLASS',
+ type => 'scalar',
+ setter => 'deserializer_class_router',
+ fallback => 'deserializer_class',
+}, {
+ accessor => 'json_options',
+}, {
+ setter => 'json_options_serialize',
+ fallback => 'json_options',
+}, {
+ package => 'RPC::ExtDirect::Deserialize',
+ var => 'JSON_OPTIONS',
+ type => 'hash',
+ setter => 'json_options_deserialize',
+ fallback => 'json_options',
+}, {
+ accessor => 'router_class',
+ default => 'RPC::ExtDirect::Router',
+}, {
+ accessor => 'eventprovider_class',
+ default => 'RPC::ExtDirect::EventProvider',
+}, {
+ accessor => 'verbose_exceptions',
+ default => !1, # In accordance with Ext.Direct spec
+}, {
+ accessor => 'api_path',
+ default => '/extdirectapi',
+}, {
+ accessor => 'router_path',
+ default => '/extdirectrouter',
+}, {
+ accessor => 'poll_path',
+ default => '/extdirectevents',
+}, {
+ accessor => 'remoting_var',
+ default => 'Ext.app.REMOTING_API',
+}, {
+ accessor => 'polling_var',
+ default => 'Ext.app.POLLING_API',
+}, {
+ accessor => 'namespace',
+}, {
+ accessor => 'auto_connect',
+ default => !1,
+}, {
+ accessor => 'no_polling',
+ default => !1,
+}];
-This module is not intended to be used directly.
+my @simple_accessors = map { $_->{accessor} }
+ grep { $_->{accessor} }
+ @$DEFINITIONS;
-=head1 DESCRIPTION
+my @complex_accessors = grep { $_->{fallback} } @$DEFINITIONS;
-This module should be subclassed by implementations of particular
-Web environment gateways to provide reasonable defaults.
+# Package globals are handled separately, this is only for
+# accessors with default values
+my %field_defaults = map { $_->{accessor} => $_ }
+ grep { defined $_->{default} and !exists $_->{var} }
+ @$DEFINITIONS;
-=head1 SUBROUTINES/METHODS
+my @package_globals = grep { $_->{var} } @$DEFINITIONS;
-No subroutines exported by default. None are expected to be called directly.
+### PRIVATE INSTANCE METHOD ###
+#
+# Parse global package variables
+#
-=head1 AUTHOR
+sub _parse_global_vars {
+ my ($self) = @_;
+
+ parse_global_flags(\@package_globals, $self);
+}
-Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
+### PRIVATE INSTANCE METHOD ###
+#
+# Parse global package variables and apply default values
+#
-=head1 COPYRIGHT AND LICENSE
+sub _init {
+ my ($self) = @_;
+
+ $self->_parse_global_vars();
+
+ # Apply the defaults
+ while ( my ($field, $def) = each %field_defaults ) {
+ my $default = $def->{default};
+
+ $self->$field($default) unless defined $self->$field();
+ }
+}
-Copyright (c) 2011-2012 Alexander Tokarev.
+### PRIVATE PACKAGE SUBROUTINE ###
+#
+# Export a deep copy of the definitions for testing
+#
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself. See L<perlartistic>.
+sub _get_definitions {
+ return [ map { +{ %$_ } } @$DEFINITIONS ];
+}
-=cut
+RPC::ExtDirect::Util::Accessor::mk_accessors(
+ simple => \@simple_accessors,
+ complex => \@complex_accessors,
+ overwrite => 1,
+);
+1;
@@ -0,0 +1,507 @@
+=pod
+
+=head1 NAME
+
+RPC::ExtDirect::Config - Centralized configuration handling for RPC::ExtDirect
+
+=head1 SYNOPSIS
+
+ use RPC::ExtDirect::Config;
+
+ my $cfg = RPC::ExtDirect::Config->new(
+ option1 => 'value1',
+ option2 => 42,
+ ...
+ );
+
+ my $option1 = $cfg->option1();
+ $cfg->option1('value2');
+
+=head1 DESCRIPTION
+
+This package implements configuration handling for various RPC::ExtDirect
+modules in a centralized and consistent fashion.
+
+RPC::ExtDirect::Config also supports the legacy configuration approach
+via package global variables, as implemented in RPC::ExtDirect 1.x and 2.x.
+Note that using package global vars is deprecated, and Config will emit
+a warning for every such variable. The value in the variable will still
+take effect, despite the warning.
+
+=head1 CHAINED OPTIONS
+
+Besides simple configuration options, RPC::ExtDirect::Config supports
+"chained" options that fall back to another option when no value
+is provided.
+
+Assume an option C<foo> that is chained to option C<bar>. When assigning
+values, Config will set both C<foo> and C<bar> independently. When
+retrieving value for option C<bar>, Config will first look if C<bar>
+has any value defined for it and return it if there is one. However,
+when there is no value defined for C<bar>, Config will then "fall back"
+to the value of C<foo>, and return it instead.
+
+This allows for very granular configuration of different parts of the
+RPC::ExtDirect stack. For example, you can turn on global debugging
+with the L</debug> option, and turn off Request debugging by
+setting L</debug_request> to falsy value.
+
+It is possible to add your own configuration options, both simple and
+chained. Read RPC::ExtDirect::Config source to see how it is done.
+
+=head1 ACCESSOR METHODS
+
+For every option held in a Config instance, there are two accessor
+methods created automatically: a getter/setter, and a predicate. Assuming
+an option named C<foo>, these accessors will be:
+
+=over 4
+
+=item has_foo()
+
+A predicate method is used to check if a value has been set for an option,
+even if that value is undefined. Note that a predicate is never
+L<chained|/"CHAINED OPTIONS">, and if a C<foo> value does not exist the
+predicate will return false without falling back to C<bar>.
+
+=item foo()
+
+A getter/setter method can be used to read and write the value. Called
+with no arguments, it acts as a getter and returns the value for an option;
+when called with one or more arguments, it will replace the existing
+value with the first argument, ignoring any others.
+
+=back
+
+=head1 OPTIONS
+
+The stock RPC::ExtDirect::Config supports the following options:
+
+=over 4
+
+=item api_action_class
+
+Class name to use instead of L<RPC::ExtDirect::API::Action> when creating
+the API tree. Action objects instantiated from this class will hold
+collections of Method objects.
+
+Use this option to override or inject new functionality in Action objects.
+
+Default: C<'RPC::ExtDirect::API::Action'>.
+
+=item api_method_class
+
+Class name to use instead of L<RPC::ExtDirect::API::Method> when creating
+the API tree. Method objects will be instantiated from this class.
+
+Use this option to override or inject new functionality in Method objects.
+
+Default: C<'RPC::ExtDirect::API::Method'>.
+
+=item api_hook_class
+
+Class name to be used instead of L<RPC::ExtDirect::API::Hook> when creating
+the API tree. Hook objects will be instantiated from this class.
+
+Use this option to override or inject new functionality in Hook objects.
+
+Default: C<'RPC::ExtDirect::API::Hook'>.
+
+=item api_full_action_names
+
+When set to truthy value, API L<Action|RPC::ExtDirect::Intro/Action> names
+will default to package name with C<'::'> replaced with dots:
+C<'Foo::Bar::Baz' -> 'Foo.Bar.Baz'>, instead of using only the last chunk
+of the package name: C<'Foo::Bar::Baz' -> 'Baz'>.
+
+Default: C<!1> (false).
+
+=item debug
+
+Turn global debugging flag on or off.
+
+Default: C<!1> (false).
+
+=item debug_api
+
+Turn API debugging on or off. At this time, the only effect is that the
+API JavaScript is pretty printed when debugging.
+
+Default: C<undef>, chained to: L</debug>.
+
+=item debug_eventprovider
+
+Turn debugging on/off for RPC::ExtDirect::EventProvider module.
+
+Default: C<undef>, chained to: L</debug>.
+
+=item debug_serialize
+
+Turn debugging on/off for serialization method in
+C<RPC::ExtDirect::Serializer> module. This option only affects
+"from Perl to JSON" conversion.
+
+Default: C<undef>, chained to: L</debug>.
+
+=item debug_deserialize
+
+Turn debugging on/off for deserialization method in
+C<RPC::ExtDirect::Serializer> module. This option only affects
+"from JSON to Perl" conversion.
+
+Default: C<undef>, chained to: L</debug>.
+
+=item debug_request
+
+Turn debugging on/off for C<RPC::ExtDirect::Request> module. When
+debugging is on, Request will provide verbose exceptions. There
+is no other effect at this time, but this can change in the
+future.
+
+To make exceptions informational without turning on debugging,
+set L</verbose_exceptions> option.
+
+Default: C<undef>, chained to: L</debug>.
+
+=item debug_router
+
+Turn debugging on/off for C<RPC::ExtDirect::Router> module. When
+debugging is on, all Requests or Exceptions generated in the Router
+will provide verbose exceptions. There are no other effects at this
+time, but this can change in the future.
+
+To make exceptions informational without turning on debugging,
+set L</verbose_exceptions> option.
+
+Default: C<undef>, chained to: L</debug>.
+
+=item exception_class
+
+Class name to be used instead of C<RPC::ExtDirect::Exception> when
+instantiating new Exception objects.
+
+This option will affect all places in the code that can throw
+Exceptions, unless overridden by specific options below.
+
+Default: C<'RPC::ExtDirect::Exception'>.
+
+=item exception_class_serialize
+
+Class name to be used when instantiating Exception objects thrown
+in serialization method of C<RPC::ExtDirect::Serializer> module.
+
+This option will not affect any other place in the code that can
+throw Exceptions.
+
+Default: C<undef>, chained to: L</exception_class>.
+
+=item exception_class_deserialize
+
+Class name to be used when instantiating Exception objects thrown
+in deserialization method of C<RPC::ExtDirect::Serializer> module.
+
+This option will not affect any other place in the code that can
+throw Exceptions.
+
+Default: C<undef>, chained to: L</exception_class>.
+
+=item exception_class_request
+
+Class name to be used when instantiating Exception objects thrown
+in C<RPC::ExtDirect::Request>, when a Request is being processed.
+
+This option will not affect any other place in the code that can
+throw Exceptions.
+
+Default: C<undef>, chained to: L</exception_class>.
+
+=item request_class
+
+Class name to be used instead of C<RPC::ExtDirect::Request> when
+instantiating new Request objects.
+
+Default: C<'RPC::ExtDirect::Request'>.
+
+=item request_class_deserialize
+
+Class name to be used when instantiating Request objects in
+deserialization method of C<RPC::ExtDirect::Serializer> module.
+
+This option will not affect any other place in the code.
+
+Default: C<undef>, chained to: L</request_class>.
+
+=item request_class_eventprovider
+
+Class name to be used instead of C<RPC::ExtDirect::Request::PollHandler>
+when instantiating Request objects in C<RPC::ExtDirect::EventProvider>
+module.
+
+PollHandler is a subclass of Request; when configuring this option
+use a subclass of PollHandler.
+
+Default: C<'RPC::ExtDirect::Request::PollHandler'>.
+
+=item serializer_class
+
+Class name to be used instead of C<RPC::ExtDirect::Serializer> when
+instantiating new objects to be used to serialize data (Perl to JSON).
+
+Default: C<'RPC::ExtDirect::Serializer'>.
+
+=item serializer_class_api
+
+Class name to be used when instantiating Serializer objects used to
+serialize API data.
+
+Default: C<undef>, chained to: L</serializer_class>.
+
+=item serializer_class_eventprovider
+
+Class name to be used when instantiating Serializer objects used to
+serialize Request results in C<RPC::ExtDirect::EventProvider> module.
+
+Default: C<undef>, chained to: L</serializer_class>.
+
+=item serializer_class_router
+
+Class name to be used when instantiating Serializer objects used to
+serialize Request results in C<RPC::ExtDirect::Router> module.
+
+Default: C<undef>, chained to: L</serializer_class>.
+
+=item deserializer_class
+
+Class name to be used instead of C<RPC::ExtDirect::Serializer> when
+instantiating new objects to be used to deserialize data (JSON to Perl).
+
+Default: C<'RPC::ExtDirect::Serializer'>.
+
+=item deserializer_class_router
+
+Class name to be used when instantiating Serializer objects used to
+deserialize incoming Request data in C<RPC::ExtDirect::Router> module.
+
+Default: C<undef>, chained to: L</deserializer_class>.
+
+=item json_options
+
+Hashref of options to be passed to C<JSON::to_json> and C<JSON::from_json>
+functions. This is a global option that affects both directions for all
+JSON-related operations.
+
+See L<JSON> for explanation of the options.
+
+Default: C<undef>.
+
+=item json_options_serialize
+
+Options to be passed to C<JSON::to_json> when serializing outbound data.
+This will affect only "Perl to JSON" direction.
+
+Default: C<undef>, chained to: L</json_options>.
+
+=item json_options_deserialize
+
+Options to be passed to C<JSON::from_json> function when deserializing
+inbound data. This will affect only "JSON to Perl" direction.
+
+Default: C<undef>, chained to: L</json_options>.
+
+=item router_class
+
+Class name to be used when instantiating Router objects instead of
+C<RPC::ExtDirect::Router>. This config option is not used directly by
+the core RPC::ExtDirect code, but rather by the gateways like
+L<CGI::ExtDirect> and L<Plack::Middleware::ExtDirect>.
+
+Default: C<'RPC::ExtDirect::Router'>.
+
+=item eventprovider_class
+
+Class name to be used when instantiating EventProvider objects instead of
+C<RPC::ExtDirect::EventProvider>. Similar to L</router_class>,
+this option is used by the gateway modules.
+
+Default: C<'RPC::ExtDirect::EventProvider'>.
+
+=item verbose_exceptions
+
+Turn informative exceptions on/off. For whatever reason, Ext.Direct spec
+requires server stack to return detailed exceptions in debugging mode,
+replacing them with generic "An error has occured" in production mode.
+Most probably this was done to increase application security, but as the
+result it hinders development and support greatly.
+
+RPC::ExtDirect tries to be spec compliant, but provides a way to turn on
+verbose exceptions via this config option. This will not affect debugging,
+only exceptions returned to the client side.
+
+Default: C<!1> (false).
+
+=item api_path
+
+URI path for the Ext.Direct API generator handler. This option is not
+used directly by the core RPC::ExtDirect code; gateways like
+L<CGI::ExtDirect> and L<Plack::Middleware::ExtDirect> use this option
+to map incoming HTTP GET requests to the RPC::ExtDirect::API code
+that generates the JavaScript API declaration for the client side
+service discovery request.
+
+Default: C<'/extdirectapi'>.
+
+=item router_path
+
+URI path for the Ext.Direct router handler. This path is advertised in
+the Ext.Direct API declaration generated by the API handler, to be used
+by the client side when making Ext.Direct routing requests.
+
+Default: C<'/extdirectrouter'>.
+
+=item poll_path
+
+URI path for the Ext.Direct poll handler. This path is advertised in the
+Ext.Direct API declaration generated by the API handler, to be used
+by the client side when making Ext.Direct event polling requests.
+
+Default: C<'/extdirectevents'>.
+
+=item remoting_var
+
+Name of the JavaScript variable for the remoting API declaration. The
+JavaScript code generated by the API handler will look like this:
+
+C<Ext.app.REMOTING_API={...}>
+
+Default: C<'Ext.app.REMOTING_API'>.
+
+=item polling_var
+
+Name of the JavaScript variable for the polling API declaration. The
+JavaScript code generated by the API handler will look like this:
+
+C<Ext.app.POLLING_API={...}>
+
+Default: C<'Ext.app.POLLING_API'>.
+
+=item namespace
+
+JavaScript namespace to be declared in the remoting API. See
+L<Ext.direct.RemotingProvider|http://docs-origin.sencha.com/extjs/5.0.0/apidocs/#!/api/Ext.direct.RemotingProvider-cfg-namespace>
+documentation for more detailed information on this option.
+
+Default: C<''> (empty string).
+
+=item auto_connect
+
+When set to truthy value, RPC::ExtDirect::API will add JavaScript code
+to automatically set up RemotingProvider and PollingProvider on the
+client side to the Ext.Direct declaration JavaScript chunk, so that
+JavaScript application won't need to do that.
+
+Default: C<!1> (false).
+
+=item no_polling
+
+Explicitly disable polling API advertisements in the generated Ext.Direct
+API, even if there are EventProvider modules registered with RPC::ExtDirect
+stack. This option is mostly used for testing and debugging.
+
+Default: C<!1> (false).
+
+=back
+
+=head1 CONFIG OBJECT INTERFACE
+
+L<RPC::ExtDirect::Config> provides several public methods:
+
+=over 4
+
+=item C<new>
+
+Constructor. Returns a new L<RPC::ExtDirect::Config> object populated
+with key/value pairs passed in the arguments. If an option is not
+specified, a default value will be assumed; see L</OPTIONS> for more
+information.
+
+The supported legacy package global variables will be read before the
+arguments are processed; thus any option passed directly to constructor
+will override its namesake in a package global. This won't prevent the
+warnings from being emitted; package global vars are strongly deprecated
+and should not be used. There is no way to disable the warnings.
+
+This method accepts named arguments in a hash or hashref.
+
+Parameters: see L</OPTIONS>.
+
+=item C<clone>
+
+Constructor, instance method. Returns a new L<RPC::ExtDirect::Config> object
+with options copied from the instance C<clone> was called on. This method
+only does shallow copying, i.e. any config option that is a reference will
+refer to the same underlying object.
+
+=item C<read_global_vars>
+
+Instance method. Reads legacy package global variables used to configure
+L<RPC::ExtDirect> in versions 1.x and 2.x; issues the warnings about their
+usage. The warnings cannot be turned off; change your code not to use
+package globals instead.
+
+=item C<add_accessors>
+
+Class/instance method. Adds L<accessor methods|/"ACCESSOR METHODS"> from
+arguments; this can be used in subclasses to extend the list of Config
+options. This method accepts named arguments in a hash.
+
+=item C<set_options>
+
+Instance method. Sets one or more Config options in the object it was
+called on. Accepts named arguments in a hash or hashref.
+
+Parameters: see L</OPTIONS>.
+
+=item C<get_router_path>
+
+Class method. Returns the current L</router_path> value from the
+L<global API Config instance|RPC::ExtDirect::API/"GLOBAL API TREE INSTANCE">.
+
+This method is B<DEPRECATED> and provided only for backward compatibility.
+Use C<router_path> L<accessor method|/"ACCESSOR METHODS"> on a Config
+instance instead.
+
+=item C<get_poll_path>
+
+Class method. Returns the current L</poll_path> value from the
+L<global API Config instance|RPC::ExtDirect::API/"GLOBAL API TREE INSTANCE">.
+
+This method is B<DEPRECATED> and provided only for backward compatibility.
+Use C<poll_path> L<accessor method|/"ACCESSOR METHODS"> on a Config
+instance instead.
+
+=item C<get_remoting_var>
+
+Class method. Returns the current L</remoting_var> value from the
+L<global API Config instance|RPC::ExtDirect::API/"GLOBAL API TREE INSTANCE">.
+
+This method is B<DEPRECATED> and provided only for backward compatibility.
+Use C<remoting_var> L<accessor method|/"ACCESSOR METHODS"> on a Config
+instance instead.
+
+=item C<get_polling_var>
+
+Class method. Returns the current L</polling_var> value from the
+L<global API Config instance|RPC::ExtDirect::API/"GLOBAL API TREE INSTANCE">.
+
+This method is B<DEPRECATED> and provided only for backward compatibility.
+Use C<polling_var> L<accessor method|/"ACCESSOR METHODS"> on a Config
+instance instead.
+
+=back
+
+=head1 SEE ALSO
+
+More documentation can be found in L<RPC::ExtDirect::API> and L<RPC::ExtDirect>
+modules.
+
+=cut
@@ -1,5 +1,8 @@
package RPC::ExtDirect::Demo::PollProvider;
+use strict;
+use warnings;
+
use POSIX 'strftime';
use RPC::ExtDirect;
@@ -41,7 +44,7 @@ Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
=head1 LICENSE AND COPYRIGHT
-Copyright (c) 2011-2012 by Alexander Tokarev.
+Copyright (c) 2011-2014 by Alexander Tokarev.
This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself. See L<perlartistic>.
@@ -1,5 +1,8 @@
package RPC::ExtDirect::Demo::Profile;
+use strict;
+use warnings;
+
use RPC::ExtDirect Action => 'Profile';
sub updateBasicInfo : ExtDirect(formHandler) {
@@ -88,7 +91,7 @@ Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
=head1 LICENSE AND COPYRIGHT
-Copyright (c) 2011-2012 by Alexander Tokarev.
+Copyright (c) 2011-2014 by Alexander Tokarev.
This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself. See L<perlartistic>.
@@ -1,5 +1,8 @@
package RPC::ExtDirect::Demo::TestAction;
+use strict;
+use warnings;
+
use Carp;
use RPC::ExtDirect Action => 'TestAction';
@@ -100,7 +103,7 @@ Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
=head1 LICENSE AND COPYRIGHT
-Copyright (c) 2011-2012 by Alexander Tokarev.
+Copyright (c) 2011-2014 by Alexander Tokarev.
This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself. See L<perlartistic>.
@@ -1,41 +1,53 @@
+#
+# WARNING: This package is deprecated.
+#
+# See RPC::ExtDirect::Config perldoc for the description
+# of the instance-based configuration options to be used
+# instead of the former global variables in this package.
+#
+
package RPC::ExtDirect::Deserialize;
use strict;
use warnings;
-no warnings 'uninitialized'; ## no critic
-
-use Carp;
-
-use JSON;
-
-use RPC::ExtDirect::Request;
-use RPC::ExtDirect::Exception;
+no warnings 'uninitialized'; ## no critic
### PACKAGE GLOBAL VARIABLE ###
#
# Set it to true value to turn on debugging
#
+# DEPRECATED. Use `debug_deserialize` or `debug` Config options instead.
+#
-our $DEBUG = 0;
+our $DEBUG;
### PACKAGE GLOBAL VARIABLE ###
#
# Set Exception class name so it could be configured
#
+# DEPRECATED. Use `exception_class_deserialize` or `exception_class`
+# Config options instead.
+#
-our $EXCEPTION_CLASS = 'RPC::ExtDirect::Exception';
+our $EXCEPTION_CLASS;
### PACKAGE GLOBAL VARIABLE ###
#
# Set Request class name so it could be configured
#
+# DEPRECATED. Use `request_class_deserialize` or `request_class`
+# Config options instead.
+#
-our $REQUEST_CLASS = 'RPC::ExtDirect::Request';
+our $REQUEST_CLASS;
### PACKAGE GLOBAL VARIABLE ###
#
# JSON decoding options
#
+# DEPRECATED. Use `json_options_deserialize` or `json_options`
+# Config options instead.
+#
our %JSON_OPTIONS;
@@ -45,29 +57,28 @@ our %JSON_OPTIONS;
# RPC::ExtDirect::Request (Exception) objects. Returns reference
# to array.
#
+# DEPRECATED. Use RPC::ExtDirect::Serializer->decode_post() instead.
+#
sub decode_post {
- my ($class, $post_text) = @_;
-
- # Try to decode data, return Exception upon failure
- my $data = eval { from_json $post_text, \%JSON_OPTIONS };
-
- # TODO This looks strikingly similar to what Serialize is doing,
- # time for a bit of refactoring?
- if ( $@ ) {
- my $error = $class->_clean_msg($@);
-
- my $msg = "ExtDirect error decoding POST data: '$error'";
- return [ $class->_exception({ debug => $DEBUG, message => $msg }) ];
- };
-
- # Normalize data
- $data = [ $data ] unless ref $data eq 'ARRAY';
-
- # Create array of Requests (or Exceptions)
- my @requests = map { $class->_request($_) } @$data;
-
- return \@requests;
+ shift; # class name
+
+ my $post_text = shift;
+
+ warn __PACKAGE__.'->decode_post class method is deprecated; ' .
+ 'use RPC::ExtDirect::Serializer->decode_post ' .
+ 'instance method instead';
+
+ require RPC::ExtDirect::Config;
+ require RPC::ExtDirect::Serializer;
+
+ my $config = RPC::ExtDirect::Config->new();
+ my $serializer = RPC::ExtDirect::Serializer->new( config => $config );
+
+ return $serializer->decode_post(
+ data => $post_text,
+ @_
+ );
}
### PUBLIC CLASS METHOD ###
@@ -75,82 +86,28 @@ sub decode_post {
# Instantiates Request based on form submitted to ExtDirect handler
# Returns arrayref with single Request.
#
-
-sub decode_form {
- my ($class, $form_hashref) = @_;
-
- # Create the Request (or Exception)
- my $request = $class->_request($form_hashref);
-
- return [ $request ];
-}
-
-############## PRIVATE METHODS BELOW ##############
-
-### PRIVATE INSTANCE METHOD ###
-#
-# Return new Exception object
+# DEPRECATED. Use RPC::ExtDirect::Serializer->decode_form() instead.
#
-sub _exception {
- my ($self, $params) = @_;
+sub decode_form {
+ shift; # class name
- $params->{where} ||= $EXCEPTION_CLASS->get_where(2);
+ my $form_href = shift;
- return $EXCEPTION_CLASS->new($params);
-}
-
-### PRIVATE INSTANCE METHOD ###
-#
-# Clean error message
-#
-
-sub _clean_msg {
- my ($class, $msg) = @_;
+ warn __PACKAGE__.'->decode_form class method is deprecated; ' .
+ 'use RPC::ExtDirect::Serializer->decode_form ' .
+ 'instance method instead';
- return $EXCEPTION_CLASS->clean_message($msg);
-}
-
-### PRIVATE INSTANCE METHOD ###
-#
-# Return new Request object
-#
-
-sub _request {
- my ($self, $arg) = @_;
+ require RPC::ExtDirect::Config;
+ require RPC::ExtDirect::Serializer;
+
+ my $config = RPC::ExtDirect::Config->new();
+ my $serializer = RPC::ExtDirect::Serializer->new( config => $config );
- return $REQUEST_CLASS->new($arg);
+ return $serializer->decode_form(
+ data => $form_href,
+ @_
+ );
}
1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-RPC::ExtDirect::Deserialize - Handles JSON Ext.Direct requests
-
-=head1 SYNOPSIS
-
-This module is not intended to be used directly.
-
-=head1 DEPENDENCIES
-
-RPC::ExtDirect::Deserialize is dependent on the following modules:
-L<JSON>
-
-=head1 AUTHOR
-
-Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2011-2012 Alexander Tokarev.
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
@@ -6,13 +6,41 @@ no warnings 'uninitialized'; ## no critic
use Carp;
+use RPC::ExtDirect::Util::Accessor;
+
### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
#
-# Initializes new instance of Event.
+# Initialize a new Event instance
#
sub new {
- my ($class, $name, $data) = @_;
+ my $class = shift;
+
+ # Allow passing either ordered parameters, or hashref,
+ # or even a hash. This is to allow Mooseish and other
+ # popular invocation patterns without having to pile on
+ # argument converters or doing some other nonsense.
+ my ($name, $data);
+
+ if ( @_ == 1 ) {
+ if ( 'HASH' eq ref $_[0] ) {
+ $name = $_[0]->{name};
+ $data = $_[0]->{data};
+ }
+ else {
+ $name = $_[0];
+ }
+ }
+ elsif ( @_ == 2 ) {
+ $name = $_[0];
+ $data = $_[1];
+ }
+ elsif ( @_ % 2 == 0 ) {
+ my %arg = @_;
+
+ $name = $arg{name};
+ $data = $arg{data};
+ }
croak "Ext.Direct Event name is required"
unless defined $name;
@@ -27,9 +55,7 @@ sub new {
# A stub for duck typing. Does nothing, returns failure.
#
-sub run {
- return '';
-}
+sub run { !1 }
### PUBLIC INSTANCE METHOD ###
#
@@ -49,101 +75,11 @@ sub result {
### PUBLIC INSTANCE METHODS ###
#
-# Read-only getters
+# Simple read-write accessors
#
-sub name { $_[0]->{name} }
-sub data { $_[0]->{data} }
-
-############## PRIVATE METHODS BELOW ##############
+RPC::ExtDirect::Util::Accessor::mk_accessors(
+ simple => [qw/ name data /],
+);
1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-RPC::ExtDirect::Event - The way to pass data to client side
-
-=head1 SYNOPSIS
-
- use RPC::ExtDirect;
- use RPC::ExtDirect::Event;
-
- sub foo : ExtDirect( pollHandler ) {
- my ($class) = @_;
-
- # Do something good, collect results to $good_data
- my $good_data = { ... };
-
- # Do something bad, collect results to $bad_data
- my $bad_data = [ ... ];
-
- # Return the data
- return (
- RPC::ExtDirect::Event->new('good', $good_data),
- RPC::ExtDirect::Event->new('bad', $bad_data ),
- );
- }
-
-=head1 DESCRIPTION
-
-This module implements Event object that is used to return events or some kind
-of data from EventProvider handlers to the client side.
-
-Data can be anything that is serializable to JSON. No checks are made and it
-is assumed that client side can understand format of the data sent with
-Events.
-
-Note that by default JSON will blow up if you try to feed it a blessed object
-as data payload, and for very good reason: it is not obvious how to serialize
-a self-contained object. Each case requires specific handling which is not
-feasible in a framework like this; therefore no effort was made to support
-serialization of blessed objects. If you know that your object is nothing
-more than a hash containing simple scalar values and/or structures of
-scalar values, create a copy like this:
-
- my $hashref = {};
- @$hashref{ keys %$object } = values %$object;
-
-But in reality, it almost always is not as simple as this.
-
-=head1 METHODS
-
-=over 4
-
-=item new($name, $data)
-
-Creates a new Event object with event $name and some $data.
-
-=item run()
-
-Not intended to be called directly, provided for duck type compatibility with
-Exceptions and Request.
-
-=item result()
-
-Returns Event hashref in format supported by Ext.Direct client stack. Not
-intended to be called directly.
-
-=back
-
-=head1 BUGS AND LIMITATIONS
-
-There are no known bugs in this module.
-
-=head1 AUTHOR
-
-Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2011-2012 Alexander Tokarev.
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
@@ -0,0 +1,88 @@
+=pod
+
+=head1 NAME
+
+RPC::ExtDirect::Event - Asynchronous server-to-client events
+
+=head1 SYNOPSIS
+
+ use RPC::ExtDirect;
+ use RPC::ExtDirect::Event;
+
+ sub foo : ExtDirect(pollHandler) {
+ my ($class) = @_;
+
+ # Do something good, collect results in $good_data
+ my $good_data = { ... };
+
+ # Do something bad, collect results in $bad_data
+ my $bad_data = [ ... ];
+
+ # Return the data as a list (not arrayref!)
+ return (
+ RPC::ExtDirect::Event->new('good', $good_data),
+ RPC::ExtDirect::Event->new(
+ name => 'bad',
+ data => $bad_data,
+ ),
+ );
+ }
+
+=head1 DESCRIPTION
+
+This module implements L<Event|RPC::ExtDirect::Intro/Event> object that
+is used to send asynchronous events from server to client via periodic
+polling.
+
+Data can be anything that is serializable to JSON. No checks are made
+and it is assumed that client side can understand the data format used
+with Events.
+
+Note that by default L<JSON> will blow up if you try to feed it a blessed
+object as data payload, and for very good reason: it is not obvious how
+to serialize a self-contained object. To avoid this, set a global Config
+option L<json_options|RPC::ExtDirect::Config/json_options> to include
+C<allow_blessed> flag:
+
+ my $config = RPC::ExtDirect::Config->new(
+ json_options => {
+ allow_blessed => 1,
+ },
+ );
+
+=head1 METHODS
+
+=over 4
+
+=item C<new>
+
+Constructor. Creates a new Event object with event name and some data.
+Accepts arguments by position as C<new($name, $data)>, as well as by name
+in a hash or hashref:
+
+ my $event1 = RPC::ExtDirect::Event->new( 'foo', 'bar' );
+ my $event2 = RPC::ExtDirect::Event->new({
+ name => 'foo',
+ data => 'bar',
+ });
+ my $event3 = RPC::ExtDirect::Event->new(
+ name => 'foo',
+ data => 'bar'
+ );
+
+This makes it easier to extend Event objects in a Moose(ish) environment,
+etc.
+
+=item C<run>
+
+Instance method. Not intended to be called directly, provided for duck
+typing compatibility with Exception and Request objects.
+
+=item C<result>
+
+Instance method. Returns an Event hashref in format supported by
+Ext.Direct client stack. Not intended to be called directly.
+
+=back
+
+=cut
@@ -4,129 +4,168 @@ use strict;
use warnings;
no warnings 'uninitialized'; ## no critic
-use Carp;
-
-use RPC::ExtDirect (); # No imports needed here
-use RPC::ExtDirect::Serialize;
-use RPC::ExtDirect::Event;
+use RPC::ExtDirect::Util::Accessor;
+use RPC::ExtDirect::Config;
+use RPC::ExtDirect;
use RPC::ExtDirect::NoEvents;
-use RPC::ExtDirect::Hook;
-use RPC::ExtDirect::Request::PollHandler;
### PACKAGE GLOBAL VARIABLE ###
#
# Turn this on for debugging.
#
+# DEPRECATED. Use `debug_eventprovider` Config option instead.
+# See RPC::ExtDirect::Config.
+#
-our $DEBUG = 0;
+our $DEBUG;
### PACKAGE GLOBAL VARIABLE ###
#
# Set Serializer class name so it could be configured
#
-# TODO This is hacky hack, find another way to inject
-# new functionality (all class names)
+# DEPRECATED. Use `serializer_class_eventprovider` or `serializer_class`
+# Config options instead.
#
-our $SERIALIZER_CLASS = 'RPC::ExtDirect::Serialize';
+our $SERIALIZER_CLASS;
### PACKAGE GLOBAL VARIABLE ###
#
-# Set Event class name so it could be configured
+# DEPRECATED. This option did nothing in previous versions of
+# RPC::ExtDirect library, and is ignored in 3.x+
#
-our $EVENT_CLASS = 'RPC::ExtDirect::Event';
+our $EVENT_CLASS;
### PACKAGE GLOBAL VARIABLE ###
#
# Set Request class name so it could be configured
#
+# DEPRECATED. Use `request_class_eventprovider` Config option instead.
+#
-our $REQUEST_CLASS = 'RPC::ExtDirect::Request::PollHandler';
+our $REQUEST_CLASS;
-### PUBLIC CLASS METHOD ###
+### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
+#
+# Create a new EventProvider object with default API and Config
#
-# Runs all poll handlers in succession, collects the Events returned
-# by them and returns serialized representation suitable for passing
+
+sub new {
+ my ($class, %arg) = @_;
+
+ $arg{config} ||= RPC::ExtDirect::Config->new();
+ $arg{api} ||= RPC::ExtDirect->get_api();
+
+ return bless { %arg }, $class;
+}
+
+### PUBLIC CLASS/INSTANCE METHOD ###
+#
+# Run all poll handlers in succession, collect the Events returned
+# by them and return serialized representation suitable for passing
# on to client side.
#
+# Note that the preferred way to call this method is on the EventProvider
+# object instance, but we support the class-based way for backwards
+# compatibility.
+#
+# Be aware that the only supported way to configure the EventProvider
+# is to pass a Config object to the constructor and then call poll()
+# on the instance.
+#
sub poll {
my ($class, $env) = @_;
- no strict 'refs';
-
- # First set the debug flag
- local ${$SERIALIZER_CLASS.'::DEBUG'} = $DEBUG;
-
- my @poll_handlers = $class->_get_poll_handlers();
+ my $self = ref($class) ? $class : $class->new();
+
+ my @poll_requests = $self->_get_poll_requests();
# Even if we have nothing to poll, we must return a stub Event
# or client side will throw an unhandled JavaScript exception
- return $class->_no_events unless @poll_handlers;
+ return $self->_no_events unless @poll_requests;
- # Run all the handlers and collect their outputs
- my @results = $class->_run_handlers($env, \@poll_handlers);
+ # Run all the requests and collect their results
+ my @results = $self->_run_requests($env, \@poll_requests);
- # No events returned by handlers? We still gotta return something.
- return $class->_no_events unless @results;
+ # No events returned by the handlers? We still gotta return something.
+ return $self->_no_events unless @results;
# Polling results are always JSON; no content type needed
- my $serialized = $class->_serialize_results(@results);
+ my $serialized = $self->_serialize_results(@results);
# And if serialization fails we have to return something positive
- return $serialized || $class->_no_events;
+ return $serialized || $self->_no_events;
}
+### PUBLIC INSTANCE METHODS ###
+#
+# Simple read-write accessors
+#
+
+RPC::ExtDirect::Util::Accessor::mk_accessors(
+ simple => [qw/ api config /],
+);
+
############## PRIVATE METHODS BELOW ##############
-### PRIVATE CLASS METHOD ###
+### PRIVATE INSTANCE METHOD ###
#
-# Return the list of poll handlers
+# Return a list of Request::PollHandler objects
#
-sub _get_poll_handlers {
- my ($class) = @_;
+sub _get_poll_requests {
+ my ($self) = @_;
- # Compile the list of poll handler
- my @handler_refs = RPC::ExtDirect->get_poll_handlers();
+ # Compile the list of poll handler Methods
+ my @handlers = $self->api->get_poll_handlers();
- # Compile the list of poll handler references
- my @poll_handlers;
- for my $handler_ref ( @handler_refs ) {
- my $req = $class->_create_request($handler_ref);
+ # Now create the corresponding Request objects
+ my @poll_requests;
+ for my $handler ( @handlers ) {
+ my $req = $self->_create_request($handler);
- push @poll_handlers, $req if $req;
+ push @poll_requests, $req if $req;
};
- return @poll_handlers;
+ return @poll_requests;
}
-### PRIVATE CLASS METHOD ###
+### PRIVATE INSTANCE METHOD ###
#
-# Create Request off poll handler
+# Create Request off a poll handler
#
sub _create_request {
- my ($class, $handler) = @_;
+ my ($self, $handler) = @_;
+
+ my $config = $self->config;
+ my $api = $self->api;
+ my $action_name = $handler->action;
+ my $method_name = $handler->name;
- my ($action, $method) = @$handler;
+ my $request_class = $config->request_class_eventprovider;
- my $req = $REQUEST_CLASS->new({
- action => $action,
- method => $method,
+ eval "require $request_class";
+
+ my $req = $request_class->new({
+ config => $config,
+ api => $api,
+ action => $action_name,
+ method => $method_name,
});
return $req;
}
-### PRIVATE CLASS METHOD ###
+### PRIVATE INSTANCE METHOD ###
#
-# Run poll handlers and collect results
+# Run poll requests and collect results
#
-sub _run_handlers {
- my ($class, $env, $requests) = @_;
+sub _run_requests {
+ my ($self, $env, $requests) = @_;
# Run the requests
$_->run($env) for @$requests;
@@ -139,20 +178,37 @@ sub _run_handlers {
### PRIVATE CLASS METHOD ###
#
-# Serialize result
+# Serialize results
#
sub _serialize_results {
- my ($class, @results) = @_;
-
+ my ($self, @results) = @_;
+
# Fortunately, client side does understand more than on event
# batched as array
my $final_result = @results > 1 ? [ @results ]
: $results[0]
;
+
+ my $config = $self->config;
+ my $api = $self->api;
+ my $debug = $config->debug_eventprovider;
+
+ my $serializer_class = $config->serializer_class_eventprovider;
+
+ eval "require $serializer_class";
+
+ my $serializer = $serializer_class->new(
+ config => $config,
+ api => $api,
+ );
my $json = eval {
- $SERIALIZER_CLASS->serialize( 1, $final_result )
+ $serializer->serialize(
+ mute_exceptions => 1,
+ debug => $debug,
+ data => [$final_result],
+ )
};
return $json;
@@ -164,60 +220,32 @@ sub _serialize_results {
#
sub _no_events {
- my ($class) = @_;
+ my ($self) = @_;
+
+ my $config = $self->config;
+ my $api = $self->api;
+ my $debug = $config->debug_eventprovider;
+
+ my $serializer_class = $config->serializer_class_eventprovider;
+
+ eval "require $serializer_class";
+
+ my $serializer = $serializer_class->new(
+ config => $config,
+ api => $api,
+ );
my $no_events = RPC::ExtDirect::NoEvents->new();
my $result = $no_events->result();
- my $serialized = $SERIALIZER_CLASS->serialize(0, $result);
+
+ # NoEvents result can't blow up, hence no eval
+ my $serialized = $serializer->serialize(
+ mute_exceptions => !1,
+ debug => $debug,
+ data => [$result],
+ );
return $serialized;
}
-### PRIVATE PACKAGE SUBROUTINE ###
-#
-# Run specified hook
-#
-
-sub __run_hook {
- my ($hook, $handler, $env, $output, $exception) = @_;
-
- my %params = %$handler;
-
- # Poll handlers are only passed env object as parameter
- $params{arg} = [ $env ];
-
- $params{code} = delete $params{referent};
- $params{orig} = sub {
- my ($code, $package, $arg) = @params{ qw/code package arg/ };
-
- return $code->($package, $arg);
- };
-}
-
1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-RPC::ExtDirect::EventProvider - Collects Events and returns serialized stream
-
-=head1 SYNOPSIS
-
-This module is not intended to be used directly.
-
-=head1 AUTHOR
-
-Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2011-2012 Alexander Tokarev.
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
@@ -6,31 +6,28 @@ no warnings 'uninitialized'; ## no critic
use Carp;
+use RPC::ExtDirect::Util::Accessor;
+use RPC::ExtDirect::Util qw/ clean_error_message get_caller_info /;
+
### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
#
# Initializes new instance of Exception.
#
sub new {
- my ($class, $arguments) = @_;
+ my ($class, $arg) = @_;
- # Unpack the arguments
- my $debug = $arguments->{debug};
- my $action = $arguments->{action};
- my $method = $arguments->{method};
- my $tid = $arguments->{tid};
- my $where = $arguments->{where};
- my $message = $arguments->{message};
+ my $where = $arg->{where};
+ my $message = $arg->{message};
- # Need the object to call private methods
my $self = bless {
- debug => $debug,
- action => $action,
- method => $method,
- tid => $tid,
+ debug => $arg->{debug},
+ action => $arg->{action},
+ method => $arg->{method},
+ tid => $arg->{tid},
+ verbose => $arg->{verbose},
}, $class;
- # Store the information internally
$self->_set_error($message, $where);
return $self;
@@ -41,9 +38,7 @@ sub new {
# A stub for duck typing. Always returns failure.
#
-sub run {
- return '';
-}
+sub run { '' }
### PUBLIC INSTANCE METHOD ###
#
@@ -56,43 +51,16 @@ sub result {
return $self->_get_exception_hashref();
}
-### PUBLIC CLASS METHOD ###
-#
-# Clean croak() and die() messages of file/line information
-#
-
-sub clean_message {
- my ($class, $msg) = @_;
-
- $msg =~ s/(?<![,]) at .*? line \d+(, <DATA> line \d+)?\.?\n*//ms;
-
- return $msg;
-}
-
-### PUBLIC CLASS METHOD ###
-#
-# Return formatted call stack part to use in exception
-#
-
-sub get_where {
- my ($class, $depth) = @_;
-
- my ($package, $sub) = (caller $depth)[3] =~ / \A (.*) :: (.*?) \z /xms;
-
- return $package . '->' . $sub;
-}
-
### PUBLIC INSTANCE METHODS ###
#
-# Read-only getters
+# Simple read-write accessors
#
-sub debug { $_[0]->{debug} }
-sub action { $_[0]->{action} }
-sub method { $_[0]->{method} }
-sub tid { $_[0]->{tid} }
-sub where { $_[0]->{where} }
-sub message { $_[0]->{message} }
+RPC::ExtDirect::Util::Accessor::mk_accessors(
+ simple => [qw/
+ debug action method tid where message verbose
+ /],
+);
############## PRIVATE METHODS BELOW ##############
@@ -105,11 +73,11 @@ sub _set_error {
my ($self, $message, $where) = @_;
# Store the information
- $self->{where} = defined $where ? $where : $self->get_where(3);
+ $self->{where} = defined $where ? $where : get_caller_info(3);
$self->{message} = $message;
# Ensure fall through for caller methods
- return '';
+ return !1;
}
### PRIVATE INSTANCE METHOD ###
@@ -121,10 +89,10 @@ sub _get_exception_hashref {
my ($self) = @_;
# If debug flag is not set, return generic message. This is for
- # compatibility with Ext.Direct specification
+ # compatibility with Ext.Direct specification.
my ($where, $message);
- if ( $self->debug ) {
+ if ( $self->debug || $self->verbose ) {
$where = $self->where;
$message = $self->message;
}
@@ -147,29 +115,3 @@ sub _get_exception_hashref {
}
1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-RPC::ExtDirect::Exception - Provides standard Ext.Direct Exceptions
-
-=head1 SYNOPSIS
-
-This module is not intended to be used directly.
-
-=head1 AUTHOR
-
-Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2011-2012 Alexander Tokarev.
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
@@ -1,138 +0,0 @@
-package RPC::ExtDirect::Hook;
-
-use strict;
-use warnings;
-no warnings 'uninitialized'; ## no critic
-
-use B;
-use Carp;
-
-use RPC::ExtDirect ();
-
-### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
-#
-# Instantiate new Hook object
-#
-
-sub new {
- my ($class, $type, $method_def) = @_;
-
- my $package = $method_def->{package};
- my $method = $method_def->{method};
-
- my ($before, $instead, $after)
- = map {
- RPC::ExtDirect->get_hook(
- type => $_,
- package => $package,
- method => $method,
- )
- }
- qw/ before instead after/;
-
- my $self = bless {}, $class;
-
- @$self{ qw/type method_def before instead after/ }
- = ( $type, $method_def, $before, $instead, $after );
-
- return $self->hook ? $self : undef
-}
-
-### PUBLIC INSTANCE METHOD ###
-#
-# Run the hook
-#
-
-sub run {
- my ($self, $env, $arg, $result, $exception, $method_called) = @_;
-
- my %hook_arg = %{ $self->method_def };
-
- $hook_arg{code} = delete $hook_arg{referent};
-
- my @param_names = @{ $hook_arg{param_names} || [] };
-
- $hook_arg{arg} = $arg;
- $hook_arg{env} = $env;
-
- # Result and exception are passed to "after" hook only
- @hook_arg{ qw/result exception method_called/ }
- = ($result, $exception, $method_called)
- if $self->type eq 'after';
-
- @hook_arg{ qw/before instead after/ }
- = map { $self->$_ } qw/before instead after/;
-
- # A drop of sugar
- my $code = $hook_arg{code};
- my $package = $hook_arg{package};
- $hook_arg{orig} = sub { $code->($package, @$arg) };
-
- my $hook = $self->hook;
- my $hook_pkg = _package_from_coderef($hook);
-
- # By convention, hooks are called as class methods
- return $hook->($hook_pkg, %hook_arg);
-}
-
-### PUBLIC INSTANCE METHODS ###
-#
-# Read only getters
-#
-
-sub type { shift->{type} }
-sub before { shift->{before} }
-sub instead { shift->{instead} }
-sub after { shift->{after} }
-sub method_def { shift->{method_def} }
-
-sub hook {
- my ($self) = @_;
-
- my $type = $self->type;
-
- return $self->$type;
-}
-
-############## PRIVATE METHODS BELOW ##############
-
-### PRIVATE PACKAGE SUBROUTINE ###
-#
-# Return package name from coderef
-#
-
-sub _package_from_coderef {
- my ($code) = @_;
-
- my $pkg = eval { B::svref_2object($code)->GV->STASH->NAME };
-
- return defined $pkg && $pkg ne '' ? $pkg : undef;
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-RPC::ExtDirect::Hook - Implements Ext.Direct method hooks
-
-=head1 SYNOPSIS
-
-This module is not intended to be used directly.
-
-=head1 AUTHOR
-
-Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2011-2012 Alexander Tokarev.
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
@@ -0,0 +1,468 @@
+=pod
+
+=head1 NAME
+
+RPC::ExtDirect::Intro - A gentle(ish) introduction to RPC::ExtDirect
+
+=head1 DESCRIPTION
+
+=head2 What is Ext.Direct?
+
+Ext.Direct is a high level RPC-over-HTTP protocol provided out of the box
+with L<Ext JS|http://www.sencha.com/products/extjs/> and
+L<Sencha Touch|http://www.sencha.com/products/touch/> JavaScript frameworks.
+It is server agnostic, provided that the server side stack is conformant
+to the
+L<Ext.Direct specification|http://www.sencha.com/products/extjs/extdirect/>.
+
+L<RPC::ExtDirect> is a fully featured implementation of Ext.Direct server
+stack in Perl, compatible with Ext JS 4.x and 5.x, and Sencha Touch 2.x.
+
+=head2 What Ext.Direct is for?
+
+The primary goal for Ext.Direct is easy and fast integration of server
+components with HTML5 applications. Client side stack is built in frameworks'
+cores and is used by many components like data Stores, Forms, Grids, Charts,
+etc. Ext.Direct supports request batching, file uploads, event polling and
+many other features.
+
+Besides simplicity and ease of use, Ext.Direct allows to achieve very clean
+code and issue separation both on server and client sides, which in turn
+results in simplified code, greater overall software quality and shorter
+development times.
+
+From Perl module developer perspective, Ext.Direct is just a transport layer;
+it doesn't matter if a method is called from Perl code or through
+Ext.Direct. This approach, in particular, allows for multi-tiered testing:
+
+=over 4
+
+=item *
+
+Server side methods can be tested without setting up HTTP environment
+with the usual tools like L<Test::More>
+
+=item *
+
+Server side classes can be tested as a whole via Ext.Direct calls
+using L<Test::ExtDirect>
+
+=item *
+
+Major application components can be tested with browser automation tools
+like Selenium.
+
+=back
+
+=head1 ARCHITECTURE OVERVIEW
+
+Ext.Direct is not only a transport protocol; in fact it implies a set
+of requirements for the server side to meet. There are many web server
+environments available in the Perl world, with several major interface
+conventions established over the years. These environments are common
+in the way that all of them implement HTTP request/response model;
+however the particular details can differ significantly.
+
+To deal with the web server differences, RPC::ExtDirect adopted the
+core-periphery architecture. Transport layer core, provided by the
+L<RPC::ExtDirect> CPAN distribution, is complemented by a peripheral
+distribution called a I<gateway> that works with a particular web
+server environment. The gateway is responsible for implementing the
+features missing in a web server interface, if any.
+
+Since the gateway modules implement the "lowest common denominator"
+abstraction layer, it is fairly easy to use an Ext.Direct application
+with several different gateways at the same time. The most common use
+for this is testing; the added benefit is that the application becomes
+independent of the web server environment and can be ported easily if
+such a need arises.
+
+See L<RPC::ExtDirect/GATEWAYS> for a list of available gateways.
+
+=head1 TERMINOLOGY
+
+Ext.Direct uses the following terms, followed by their descriptions:
+
+=over 4
+
+=item API
+
+Description of server side calls exposed to client side. API consists
+of L<remoting|/"Remoting API"> and L<polling|/"Polling API"> parts.
+
+=item API declaration
+
+JavaScript chunk that encodes L</API>. Usually generated
+by application server and retrieved by client once upon startup.
+Another option is to embed API declaration in client side application
+code.
+
+API declaration is generated by L<RPC::ExtDirect::API> module.
+
+=item Remoting API
+
+The main part of the L</"API declaration">, it declares the L<Actions|/Action>
+and L<Methods|/Method> available to the client, as well as their calling
+patterns, and other parameters.
+
+=item Polling API
+
+Used to declare the existence of L<Event Providers|/"Event Provider"> and
+their credentials, basically the URI to use.
+
+=item Router
+
+Server side component that receives remoting calls, dispatches requests,
+collects and returns call L<Results|/Result> or L<Exceptions|/Exception>.
+
+=item Action
+
+Namespace unit; collection of L<Methods|/Method>. The nearest Perl analog
+is a package, other languages may call it a Class.
+
+Since Ext.Direct originated in JavaScript, '::' will be replaced with dots
+for all Actions in the L</"API declaration">, and should be called as
+C<Action.Method()> instead of Perl style C<Action::Method>.
+
+=item Method
+
+Subroutine exposed through Ext.Direct API to be called by client side.
+Method is fully qualified by L</Action> and Method names using a dot as
+the delimiter: C<Action.Method>.
+
+=item Method stub
+
+JavaScript function created by the Ext.Direct transport layer on the client
+side I<in lieu> of the actual L</Method> that only exists on the server
+side. A separate stub will be created for each Method, with the parameter
+signature conforming to Method's declaration in the L</API>.
+
+=item Ordered Method
+
+A L</Method> that accepts zero or more parameters in ordered fashion, or by
+position (in a list). See more in
+L<RPC::ExtDirect/"METHODS AND CALLING CONVENTIONS">.
+
+=item Named Method
+
+A L</Method> that accepts parameters by name, in a hash. See more in
+L<RPC::ExtDirect/"METHODS AND CALLING CONVENTIONS">.
+
+=item Form Handler Method
+
+A L</Method> that accepts form submits. All form field values are passed to
+the Form handler in a hash, C<field => value>. The only practical reason to
+use Form handlers is to process file uploads; see
+L<FILE UPLOADS|RPC::ExtDirect/"FILE UPLOADS"> for more information. See also
+L<RPC::ExtDirect/"METHODS AND CALLING CONVENTIONS"> for more information on
+Form handlers calling convention.
+
+=item Poll Handler Method
+
+A L</Method> that is called by an L</"Event Provider"> to return the list of
+L<Events|/Event> to be passed on to the client side. See more in
+L<RPC::ExtDirect/"METHODS AND CALLING CONVENTIONS">.
+
+=item Result
+
+Any data returned by a L</Method> upon successful or unsuccessful call
+completion. This includes application logic errors. 'Not authenticated'
+and alike events should be returned as Results, not L<Exceptions|/Exception>.
+
+=item Exception
+
+Fatal error, or any other unrecoverable event in the application code.
+Calls that produce Exception instead of L</Result> are considered
+unsuccessful; Ext.Direct provides built in mechanism for managing
+Exceptions.
+
+Exceptions are not used to indicate errors in application logic flow,
+only for catastrophic conditions. Nearest analog is status code 500
+for HTTP responses.
+
+Examples of Exceptions are: request JSON is broken and can't be decoded;
+called Method dies because of internall error; Result cannot be encoded
+in JSON, etc.
+
+=item Event
+
+An asynchronous notification that can be generated by server side and
+passed to client side, resulting in some reaction. Events are useful
+for status updates, progress indicators and other predictably occuring
+conditions and events.
+
+=item Event Provider
+
+Server side script that gets polled by client side every C<n> seconds;
+default C<n> is 3 but it can be changed in client side configuration.
+
+=back
+
+=head1 GETTING STARTED
+
+The first step is to install and configure a
+L<gateway|RPC::ExtDirect/GATEWAYS> that works with your chosen Web
+server environment. Please refer to gateways' documentation for that.
+It is recommended to install L<Test::ExtDirect> module as well, so
+that you could write tests for your Ext.Direct code right from the
+start.
+
+When you have the gateway configured, it's time to publish some code
+in the Ext.Direct L</API>. The easiest way to do this is to use the
+C<ExtDirect> attribute with the subroutines that need to be published:
+
+ package MyApp::Math;
+
+ use RPC::ExtDirect Action => 'MyMath';
+
+ sub add : ExtDirect(len => 2) {
+ my ($class, $a, $b) = @_;
+
+ return $a + $b;
+ }
+
+In this snippet, we have published the C<MyApp::Math> package as
+an Ext.Direct L</Action> called C<MyMath>, and added one L</Method>
+to be exposed to the client side as C<MyMath.add>. In your Ext JS
+or Sencha Touch app, use the Method with an asynchronous callback
+function that will be fired when result is transmitted back to the
+browser:
+
+ MyMath.add(a, b, function(result) {
+ alert('Multiplication result: ' + result);
+ });
+
+=head1 TESTING YOUR CODE
+
+It is always a good idea to cover your code with unit tests; even
+more so for something as complex as Remote Procedure Call APIs.
+A lot of things can go wrong and break the server interface you
+provide to JavaScript applications. What is worse, these things
+rarely go wrong I<upfront>, usually the breakage creeps in gradually
+over time. The only way to ensure that your server side API keeps
+working exactly as the client side expects it to is via continuous
+testing.
+
+However, testing a server side API with the actual JavaScript code
+that will consume the API is a daunting task. You would need an
+instance of the Web server you are going to use in production, a
+headless Web browser, a ton of infrastructure to keep all this up
+to date; not even mentioning the time spent maintaining the whole
+setup. If this picture makes you cringe with frustration, that's
+totally understandable. But fear not, RPC::ExtDirect has a truly
+Perlish answer to this question (making hard things possible).
+
+L<Test::ExtDirect> is the recommended way to unit test your Ext.Direct
+code. To be precise, it is hardly right to call it unit testing when
+it involves a test HTTP server, a Perl client that makes actual RPC
+invocations over HTTP and simulates the JavaScript client; it may
+be more correct to refer to this process as integration testing instead.
+However RPC::ExtDirect tries to be completely transparent and never
+get in the way, so you can think of it as "testing functional units
+of my code, disregarding the transport".
+
+Supposed that you are sold on the idea, let's see how a unit test
+for the C<add> subroutine created above looks in practice:
+
+ # 01_math.t
+
+ use Test::More tests => 1;
+ use Test::ExtDirect;
+
+ use MyApp::Math;
+
+ my $result = call_extdirect(
+ action => 'MyMath',
+ method => 'add',
+ arg => [ 2, 2 ],
+ );
+
+ is $result, 4, "addition result matches";
+
+Now, how hard is that?!
+
+=head1 GOING FURTHER
+
+Now that we have covered the basics, let's see what else RPC::ExtDirect
+has in store:
+
+=head2 Named parameters
+
+Using named parameters is as easy as ordered ones:
+
+ sub named : ExtDirect(params => ['foo', 'bar']) {
+ my ($class, %arg) = @_;
+
+ my $foo = $arg{foo};
+ my $bar = $arg{bar};
+
+ # do something, return a scalar
+ my $result = ...;
+
+ return $result;
+ }
+
+By default, the C<named> method above will receive B<only> the parameters
+declared in the C<ExtDirect> attribute. To accept all named parameters,
+turn off strict checking:
+
+ sub named_no_strict
+ : ExtDirect(params => ['foo', 'bar'], strict => !1)
+ {
+ my ($class, %arg) = @_;
+
+ my $foo = $arg{foo};
+ my $bar = $arg{bar};
+ my $baz = $arg{baz}; # this parameter is undeclared but gets there
+
+ ...
+ }
+
+=head2 Form submits
+
+An Ext.Direct Method can be used to accept form submits in
+both C<application/x-www-form-urlencoded> and C<multipart/form-data>
+encodings. This feature can be used to accept file uploads from
+non-HTML5 browsers (think IE9 and below):
+
+ sub handle_upload : ExtDirect(formHandler, upload_arg => 'files') {
+ my ($class, %arg) = @_;
+
+ my $files = $arg{files}; # arrayref of files
+
+ for my $file ( @$files ) {
+ ...
+ }
+ }
+
+=head2 Handling errors
+
+When your server side code encounters an irrecoverable error, it is
+a Good Thing to let the client side application know about it. The
+usual way is to throw an L</Exception>:
+
+ sub dying : ExtDirect(len => 0) { # no parameters
+ die "Houston, we've got a problem!\n";
+ }
+
+L<Ext.Direct specification|http://www.sencha.com/products/extjs/extdirect>
+requires the server side stack to only send exceptions in debugging
+mode but never in production mode. The implied security concerns are valid,
+but having two sets of logic would be unwieldy; RPC::ExtDirect compromises
+by sending generic exceptions "An error has occured" in production mode
+(default).
+
+To turn on global debugging, set the L<debug option|RPC::ExtDirect::Config/debug>
+in the L<global API instance's|RPC::ExtDirect::API/"GLOBAL API TREE INSTANCE">
+Config:
+
+ # Place this in the main app server code
+ use RPC::ExtDirect;
+
+ RPC::ExtDirect->get_api->config->debug(1);
+
+If you are comfortable with exposing internal details of your app server to
+the outside world even in production mode, turn on
+L<verbose_exceptions|RPC::ExtDirect::Config/verbose_exceptions>:
+
+ # This goes to the main app server, too
+ use RPC::ExtDirect;
+
+ RPC::ExtDirect->get_api->config->verbose_exceptions(1);
+
+=head2 Using environment objects
+
+Suppose that you want to restrict some parts of the API to be accessible
+only by authenticated users. The usual way to do this is by using HTTP
+cookies. However, cookies are not exposed to every Ext.Direct Method
+by default; you need to tell RPC::ExtDirect to pass an
+L<environment object|RPC::ExtDirect/"ENVIRONMENT OBJECTS"> to your
+Method in order to get low level things like cookies or HTTP request
+headers:
+
+ sub restricted : ExtDirect(params => ['foo'], env_arg => 'env') {
+ my ($class, %arg) = @_;
+
+ my $env = $arg{env}; # Get the env object
+
+ my $user = $env->cookie('user');
+
+ # \0 is a shortcut for JSON::false
+ return { success => \0, error => 'Not authenticated' }
+ unless $user eq 'foo';
+
+ ...
+ }
+
+=head2 Using hooks
+
+In the example above, we checked the user's loginedness in the Method
+that is supposed to do some actual work. Duplicating that code for every
+restricted Method would be very tedious and error prone; what if we
+could handle such things in a centralized subroutine that would be
+called before each restricted Method's invocation and cancel it if
+the user is not authenticated?
+
+That is what L<Hooks|RPC::ExtDirect/HOOKS> are for:
+
+ sub check_user {
+ my ($class, %arg) = @_;
+
+ # Hooks always receive an env object
+ my $env = $arg{env};
+
+ my $user = $env->cookie('user');
+
+ # This hashref will be returned to the client side
+ # as if the actual Method returned it
+ return { success => \0, error => 'Not authenticated' }
+ unless $user eq 'foo';
+
+ # 1 means we're good to go
+ return 1;
+ }
+
+ # This Method won't even be called unless the user is logged in
+ sub foo : ExtDirect(params => ['foo'], before => \&check_user) {
+ my ($class, %arg) = @_;
+
+ ...
+ }
+
+ # Same thing, and no code duplication
+ sub bar : ExtDirect(len => 2, before => \&check_user) {
+ my ($class, $a, $b) = @_;
+
+ ...
+ }
+
+In the example above, individual Method level hooks were used; you can
+also assign hooks to an L</Action> (package), or globally. Global hooks
+are very useful for doing application-wide things like security audit
+logging:
+
+ package MyApp::SecurityLog;
+
+ sub log_everything {
+ my ($class, %arg) = @_;
+
+ my ($method, $result, $ex) = @arg{ qw/ method result exception / };
+
+ # Store this into database, or do something else
+ ...
+ }
+
+
+ # This goes to the main program
+ RPC::ExtDirect->get_api->after('MyApp::SecurityLog::log_everything');
+
+Set this way, C<log_everything> will be called after every Ext.Direct
+Method invocation, even if a C<before> hook canceled it. See
+L<RPC::ExtDirect::API::Hook> for the gory detail.
+
+=head1 SEE ALSO
+
+Live code examples are provided with L<CGI::ExtDirect> module in the
+C<examples> directory.
+
+=cut
@@ -0,0 +1,190 @@
+=pod
+
+=head1 NAME
+
+RPC::ExtDirect::Migration - Migration notes for RPC::ExtDirect
+
+=head1 MIGRATING TO 3.x FROM 1.X AND 2.X
+
+RPC::ExtDirect version 3.0 represents a major effort to refactor
+module internals, simplify the architecture and make the whole
+suite more robust. While every precaution has been taken to make
+the new version as much backwards compatible as possible, still
+the scale of the internal changes was so big that some things may
+have been unintentionally broken and not caught by unit tests. If
+you encounter any regressions, please file a bug report.
+
+Here is the list of things to keep in mind while upgrading to 3.0,
+in no particular order:
+
+=head2 Configuration
+
+In RPC::ExtDirect 1.x and 2.x, the preferred way to change certain
+parts of the module behavior was to use package global variables.
+One example was C<$RPC::ExtDirect::DEBUG> variable that turned on
+global debugging; there were several other variables as well.
+
+All these are now deprecated and strongly discouraged from being used.
+L<RPC::ExtDirect::Config> module is now used to hold configuration
+options, both global and local.
+
+To turn on global debugging, use the following approach:
+
+ RPC::ExtDirect->get_api->config->debug(1);
+
+In case you only need to turn on detailed exceptions but not the
+actual debugging mode, use
+L<verbose_exceptions|RPC::ExtDirect::Config/verbose_exceptions>
+Config option instead:
+
+ RPC::ExtDirect->get_api->config->verbose_exceptions(1);
+
+For every deprecated package global variable that has a non-default
+value, a warning will be issued. There is no way to turn these off;
+change your code not to use package globals instead.
+
+=head2 New Serializer
+
+In 3.0, the old C<RPC::ExtDirect::Serialize> and
+C<RPC::ExtDirect::Deserialize> classes have been deprecated in favor
+of the new C<RPC::ExtDirect::Serializer> that is intended to be
+used in an instance based fashion instead of the old class based
+way.
+
+Both modules are still provided, with their respective class methods
+changed to stubs that will provide backwards compatibility. A warning
+will be issued if these methods are called.
+
+This change may cause possible issues if you have relied on specific
+exception output in your unit tests.
+
+=head2 API tree handling
+
+In 1.x and 2.x, the Ext.Direct API tree was held in disjointed
+hash variables in RPC::ExtDirect module. In 3.0, the API is held
+in an instance of L<RPC::ExtDirect::API>; it is now possible to
+initialize the API from a hashref instead of C<ExtDirect> attributes,
+and have more than one API tree per application server.
+
+This change should not affect your code directly, unless you were
+doing something funky with RPC::ExtDirect internals.
+
+=head2 Actions, Methods, and Hooks are now objects
+
+Besides the API tree itself, the handling of Actions, Methods, and
+Hooks also changed in 3.0. Instead of hash entries they are now
+objects, with behavior fully overridable in subclasses. A new Config
+option now exists for each of these, to supply your class name instead
+of the default L<RPC::ExtDirect::API::Action>, L<RPC::ExtDirect::API::Method>,
+and L<RPC::ExtDirect::API::Hook>, respectively.
+
+=head2 Conditional API generation
+
+In 1.x and 2.x, there was no way to affect Ext.Direct API generation;
+it was always created from the defined set of Actions and Methods. In
+3.0, the API JavaScript chunk is generated by walking the API tree
+and asking every Method to return their declaration.
+
+This happens in L<RPC::ExtDirect::API::Method/get_api_definition> method,
+which also receives an L<environment object|RPC::ExtDirect/"ENVIRONMENT OBJECTS">
+when called. It is also possible to exclude any particular Method from
+being declared in the API by returning C<undef>, which makes per-user
+personalized API declarations possible.
+
+=head2 Action naming
+
+Before Ext JS 4.2.1, it was not possible to declare nested Ext.Direct
+Action names. This construct would not work properly:
+
+ package Foo::Bar;
+ use RPC::ExtDirect Action => 'Foo.Bar';
+
+ sub baz : ExtDirect(0) {}
+
+Rather, the method stub on the client side would have to be called in an
+ugly fashion:
+
+ window['Foo.Bar'].baz()
+
+This issue has been addressed in Ext JS 4.2.1 and later versions, and
+support for this feature has now been added to RPC::ExtDirect. You can
+set L<api_full_action_names|RPC::ExtDirect::Config/api_full_action_names>
+global Config option to make Action names default to full package name
+instead of the old behavior.
+
+Note that Sencha Touch 2.x does not support this feature, as well as
+Ext JS versions before 4.2.1. This is the reason why Action name
+generation defaults to using only the last portion of the namespace,
+as it was in RPC::ExtDirect since 1.x.
+
+=head2 Method code invocation
+
+Before 3.0, the actual Method code invocation happened in a private
+method of a C<RPC::ExtDirect::Request> object, making any changes
+to Method behavior to be very hard to implement. This has been changed
+to a more open way of doing things; L<RPC::ExtDirect::API::Method/run>
+is calling the code and can be easily overridden in a subclass to add
+application specific checks or enhancements.
+
+Besides changing the place where the Method code is called, the way
+it is called was also changed to be more compatible with class
+inheritance.
+
+=head2 Method argument preparation
+
+Another change has been made to the way Method arguments are
+processed; the methods that are doing this for ordered, named, and
+formHandler arguments are public and overridable now.
+
+Another addition is the new
+L<lazy parameter check|RPC::ExtDirect::API/"Lazy parameter checking">
+feature for named Methods; it allows passing all arguments to a
+Method instead of only declared ones.
+
+See L<RPC::ExtDirect::API::Method/prepare_method_arguments> for
+more information.
+
+=head2 Hook definition
+
+Starting with 3.0, it is now possible to define a Hook with a
+C<'Package::sub'> string instead of a coderef. This makes lazy hook
+code binding possible.
+
+See L<RPC::ExtDirect::API::Hook/new> for more detail.
+
+=head2 Hook invocation signature
+
+A hook subroutine used to receive several parameters that described
+the Method that was about to be invoked, as well as the other Hooks
+involved for the Method. These disjointed parameters are now deprecated,
+and the corresponding L<RPC::ExtDirect::API::Method> and
+L<RPC::ExtDirect::API::Hook> objects are passed instead, which makes
+it easier to get the information.
+
+The old parameters are still passed to Hook subroutines, but users
+are advised to change their code to take advantage of the new approach.
+See L<RPC::ExtDirect::API::Hook/"CALLING CONVENTION"> for more detail.
+
+=head2 Environment objects optional for Methods
+
+When L<Environment objects|RPC::ExtDirect/"ENVIRONMENT OBJECTS"> were
+introduced in RPC::ExtDirect 2.0, the default behavior was to pass
+them to both Methods and Hooks. This has caused problems with Moose
+generated accessors exposed through RPC::ExtDirect; a getter would
+expect exactly 0 arguments and freak out on receiving an env object.
+Besides that, passing env objects to every Method has proved to be less
+useful than thought initially.
+
+Starting with 3.0, a Method will receive an env object only when
+requested with L<env_arg|RPC::ExtDirect::API::Method/env_arg> option.
+
+=head2 Event constructor signature
+
+L<RPC::ExtDirect::Event> used to accept arguments only by position;
+this has been changed to accepting I<both> ordered and named
+arguments for the sake of easier integration with Moose and other
+environments with established calling conventions.
+
+See L<RPC::ExtDirect::Event/new> for more detail.
+
+=cut
@@ -8,7 +8,12 @@ use base 'RPC::ExtDirect::Event';
### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
#
-# Initializes new instance of NoEvents.
+# Initialize a new instance of NoEvents. This is a stub event
+# we have to return when there are no actual events returned
+# by the poll handlers. Certain Ext JS versions had a bug that
+# resulted in a JavaScript exception thrown when an empty array
+# of events was returned; returning one stub event instead
+# works around that problem.
#
sub new {
@@ -17,39 +22,4 @@ sub new {
return $class->SUPER::new('__NONE__', '');
}
-############## PRIVATE METHODS BELOW ##############
-
1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-RPC::ExtDirect::NoEvents - Something to return when there is nothing to give back
-
-=head1 SYNOPSIS
-
-This module is not intended to be used directly.
-
-=head1 DESCRIPTION
-
-This module provides a stub Event that EventProvider must return when there
-are no events returned by handlers. ExtJS implementation does not allow for
-none events returned at all so we have to return something - which is
-NoEvents.
-
-=head1 AUTHOR
-
-Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2011-2012 Alexander Tokarev.
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
@@ -7,8 +7,6 @@ use strict;
use warnings;
no warnings 'uninitialized'; ## no critic
-use Carp;
-
use base 'RPC::ExtDirect::Request';
### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
@@ -17,9 +15,9 @@ use base 'RPC::ExtDirect::Request';
#
sub new {
- my ($class, $arguments) = @_;
+ my ($class, $arg) = @_;
- my $self = $class->SUPER::new($arguments);
+ my $self = $class->SUPER::new($arg);
# We can't return exceptions from poll handler anyway
return $self->{message} ? undef : $self;
@@ -27,62 +25,34 @@ sub new {
### PUBLIC INSTANCE METHOD ###
#
-# Return Events data extracted
-#
-
-sub result {
- my ($self) = @_;
-
- my $events = $self->{result};
-
- # A hook can return something that is not event list
- $events = [] unless 'ARRAY' eq ref $events;
-
- return @$events ? map { $_->result } @$events : ();
-}
-
-############## PRIVATE METHODS BELOW ##############
-
-### PRIVATE INSTANCE METHOD ###
-#
# Checks if method arguments are in order
#
-sub _check_arguments {
- my ($self, %params) = @_;
-
+sub check_arguments {
+
# There are no parameters to poll handlers
# so we return undef which means no error
return undef; ## no critic
}
-### PRIVATE INSTANCE METHOD ###
+### PUBLIC INSTANCE METHOD ###
#
-# Prepares method arguments to be passed along to the method
+# Return Events data extracted
#
-sub _prepare_method_arguments {
- my ($self, $env) = @_;
-
- return ($env);
-}
-
-### PRIVATE INSTANCE METHOD ###
-#
-# Actually run the method or hook and return result
-#
+sub result {
+ my ($self) = @_;
-sub _do_run_method {
- my ($self, $env, $arg) = @_;
-
- my $package = $self->package;
- my $referent = $self->referent;
+ my $events = $self->{result};
- my @events = $referent->($package, @$arg);
+ # A hook can return something that is not an event list
+ $events = [] unless 'ARRAY' eq ref $events;
- return [@events];
+ return map { $_->result } @$events;
}
+############## PRIVATE METHODS BELOW ##############
+
### PRIVATE INSTANCE METHOD ###
#
# Handles errors
@@ -6,23 +6,35 @@ no warnings 'uninitialized'; ## no critic
use Carp;
-use RPC::ExtDirect (); # No imports here
-use RPC::ExtDirect::Exception; # Nothing gets imported there anyway
-use RPC::ExtDirect::Hook;
+use RPC::ExtDirect::Config;
+use RPC::ExtDirect::Util::Accessor;
+use RPC::ExtDirect::Util qw/ clean_error_message /;
### PACKAGE GLOBAL VARIABLE ###
#
# Turn on for debugging
#
+# DEPRECATED. Use `debug_request` or `debug` Config options instead.
+#
-our $DEBUG = 0;
+our $DEBUG;
### PACKAGE GLOBAL VARIABLE ###
#
# Set Exception class name so it could be configured
#
+# DEPRECATED. Use `exception_class_request` or
+# `exception_class` Config options instead.
+#
+
+our $EXCEPTION_CLASS;
+
+### PUBLIC CLASS METHOD (ACCESSOR) ###
+#
+# Return the list of supported hook types
+#
-our $EXCEPTION_CLASS = 'RPC::ExtDirect::Exception';
+sub HOOK_TYPES { qw/ before instead after / }
### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
#
@@ -30,64 +42,137 @@ our $EXCEPTION_CLASS = 'RPC::ExtDirect::Exception';
#
sub new {
- my ($class, $arguments) = @_;
+ my ($class, $arg) = @_;
+
+ my $api = delete $arg->{api} || RPC::ExtDirect->get_api();
+ my $config = delete $arg->{config} || RPC::ExtDirect::Config->new();
+
+ my $debug = defined $arg->{debug} ? delete $arg->{debug}
+ : $config->debug_request
+ ;
# Need blessed object to call private methods
- my $self = bless {}, $class;
+ my $self = bless {
+ api => $api,
+ config => $config,
+ debug => $debug,
+ }, $class;
# Unpack and validate arguments
- my ($action, $method, $tid, $data, $type, $upload)
- = eval { $self->_unpack_arguments($arguments) };
+ my ($action_name, $method_name, $tid, $data, $type, $upload)
+ = eval { $self->_unpack_arguments($arg) };
return $self->_exception({
- debug => $DEBUG,
- action => $action,
- method => $method,
+ action => $action_name,
+ method => $method_name,
tid => $tid,
- message => $@->[0]
+ message => $@->[0],
}) if $@;
- # Look up method parameters
- my %parameters = eval {
- $self->_get_method_parameters(
- action => $action,
- method => $method
- )
- };
+ # Look up the Method
+ my $method_ref = $api->get_method_by_name($action_name, $method_name);
return $self->_exception({
- debug => $DEBUG,
- action => $action,
- method => $method,
+ action => $action_name,
+ method => $method_name,
tid => $tid,
message => 'ExtDirect action or method not found'
- }) if $@;
+ }) unless $method_ref;
# Check if arguments passed in $data are of right kind
- my $exception = $self->_check_arguments(
- action => $action,
- method => $method,
- tid => $tid,
- data => $data,
- parameters =>\%parameters
+ my $exception = $self->check_arguments(
+ action_name => $action_name,
+ method_name => $method_name,
+ method_ref => $method_ref,
+ tid => $tid,
+ data => $data,
);
return $exception if defined $exception;
+
+ # Bulk assignment for brevity
+ @$self{ qw/ tid type data upload method_ref run_count/ }
+ = ( $tid, $type, $data, $upload, $method_ref, 0 );
+
+ # Finally, resolve the hooks; it's easier to do that upfront
+ # since it involves API lookup
+ for my $hook_type ( $class->HOOK_TYPES ) {
+ my $hook = $api->get_hook(
+ action => $action_name,
+ method => $method_name,
+ type => $hook_type,
+ );
+
+ $self->$hook_type($hook) if $hook;
+ }
+
+ return $self;
+}
- # Assign attributes
- my @attrs = qw(action method package referent param_no
- param_names formHandler pollHandler
- tid arguments type data upload run_count);
- @$self{ @attrs } = ($action, $method, $parameters{package},
- $parameters{referent}, $parameters{param_no},
- $parameters{param_names}, $parameters{formHandler},
- $parameters{pollHandler},
- $tid, $data, $type, $data, $upload, 0);
+### PUBLIC INSTANCE METHOD ###
+#
+# Checks if method arguments are in order
+#
- # Hooks should be already defined by now
- $self->_init_hooks(%parameters);
+sub check_arguments {
+ my ($self, %arg) = @_;
+
+ my $action_name = $arg{action_name};
+ my $method_name = $arg{method_name};
+ my $method_ref = $arg{method_ref};
+ my $tid = $arg{tid};
+ my $data = $arg{data};
- return $self;
+ # Event poll handlers return Event objects instead of plain data;
+ # there is no sense in calling them directly
+ if ( $method_ref->pollHandler ) {
+ return $self->_exception({
+ action => $action_name,
+ method => $method_name,
+ tid => $tid,
+ message => "ExtDirect pollHandler method ".
+ "$action_name.$method_name should not ".
+ "be called directly"
+ });
+ }
+
+ # There's not much to check for formHandler methods
+ elsif ( $method_ref->formHandler ) {
+ if ( 'HASH' ne ref($data) || !exists $data->{extAction} ||
+ !exists $data->{extMethod} )
+ {
+ return $self->_exception({
+ action => $action_name,
+ method => $method_name,
+ tid => $tid,
+ message => "ExtDirect formHandler method ".
+ "$action_name.$method_name should only ".
+ "be called with form submits"
+ })
+ }
+ }
+
+ # The actual heavy lifting happens in the Method itself
+ else {
+ local $@;
+
+ my $result = eval { $method_ref->check_method_arguments($data) };
+
+ if ( my $error = $@ ) {
+ $error =~ s/\n$//;
+
+ return $self->_exception({
+ action => $action_name,
+ method => $method_name,
+ tid => $tid,
+ message => $error,
+ where => ref($method_ref) .'->check_method_arguments',
+ });
+ }
+ }
+
+ # undef means no exception
+ return undef; ## no critic
}
### PUBLIC INSTANCE METHOD ###
@@ -104,30 +189,41 @@ sub run {
if $self->run_count > 0;
# Set the flag
- $self->{run_count} = 1;
+ $self->run_count(1);
+
+ my $method_ref = $self->method_ref;
# Prepare the arguments
- my @arg = $self->_prepare_method_arguments($env);
+ my @method_arg = $method_ref->prepare_method_arguments(
+ env => $env,
+ input => $self->{data},
+ upload => $self->upload,
+ );
+
+ my %params = (
+ api => $self->api,
+ method_ref => $method_ref,
+ env => $env,
+ arg => \@method_arg,
+ );
my ($run_method, $callee, $result, $exception) = (1);
# Run "before" hook if we got one
- ($result, $exception, $run_method)
- = $self->_run_before_hook(env => $env, arg => \@arg)
- if $self->before;
+ ($result, $exception, $run_method) = $self->_run_before_hook(%params)
+ if $self->before && $self->before->runnable;
# If there is "instead" hook, call it instead of the method
- ($result, $exception, $callee) = $self->_run_method(env => $env, arg => \@arg)
- if $run_method;
+ ($result, $exception, $callee) = $self->_run_method(%params)
+ if $run_method;
# Finally, run "after" hook if we got one
$self->_run_after_hook(
- env => $env,
- arg => \@arg,
+ %params,
result => $result,
exception => $exception,
callee => $callee
- ) if $self->after;
+ ) if $self->after && $self->after->runnable;
# Fail gracefully if method call was unsuccessful
return $self->_process_exception($env, $exception)
@@ -143,9 +239,9 @@ sub run {
#
# If method call was successful, returns result hashref.
# If an error occured, returns exception hashref. It will contain
-# error-specific message only if $DEBUG is set. This is somewhat weird
-# requirement in ExtDirect specification. If $DEBUG is not set, exception
-# hashref will contain generic error message.
+# error-specific message only if we're debugging. This is somewhat weird
+# requirement in ExtDirect specification. If the debug config option
+# is not set, the exception hashref will contain generic error message.
#
sub result {
@@ -154,29 +250,10 @@ sub result {
return $self->_get_result_hashref();
}
-### PUBLIC INSTANCE METHODS ###
+### PUBLIC INSTANCE METHOD ###
+#
+# Return the data represented as a list
#
-# Read-only getters.
-#
-
-sub action { $_[0]->{action} }
-sub method { $_[0]->{method} }
-sub package { $_[0]->{package} }
-sub referent { $_[0]->{referent} }
-sub param_no { $_[0]->{param_no} }
-sub type { $_[0]->{type} }
-sub tid { $_[0]->{tid} }
-sub state { $_[0]->{state} }
-sub where { $_[0]->{where} }
-sub message { $_[0]->{message} }
-sub upload { $_[0]->{upload} }
-sub run_count { $_[0]->{run_count} }
-sub formHandler { $_[0]->{formHandler} }
-sub pollHandler { $_[0]->{pollHandler} }
-sub before { $_[0]->{before} }
-sub instead { $_[0]->{instead} }
-sub after { $_[0]->{after} }
-sub param_names { @{ $_[0]->{param_names} || [] } }
sub data {
my ($self) = @_;
@@ -187,6 +264,31 @@ sub data {
;
}
+### PUBLIC INSTANCE METHODS ###
+#
+# Simple read-write accessors.
+#
+
+my $accessors = [qw/
+ config
+ api
+ debug
+ method_ref
+ type
+ tid
+ state
+ where
+ message
+ upload
+ run_count
+/,
+ __PACKAGE__->HOOK_TYPES,
+];
+
+RPC::ExtDirect::Util::Accessor::mk_accessors(
+ simple => $accessors,
+);
+
############## PRIVATE METHODS BELOW ##############
### PRIVATE INSTANCE METHOD ###
@@ -195,31 +297,27 @@ sub data {
#
sub _exception {
- my ($self, $params) = @_;
+ my ($self, $arg) = @_;
+
+ my $config = $self->config;
+ my $ex_class = $config->exception_class_request;
+
+ eval "require $ex_class";
- my $where = $params->{where};
+ my $where = $arg->{where};
if ( !$where ) {
my ($package, $sub)
= (caller 1)[3] =~ / \A (.*) :: (.*?) \z /xms;
- $params->{where} = $package . '->' . $sub;
+ $arg->{where} = $package . '->' . $sub;
};
- return $EXCEPTION_CLASS->new($params);
-}
-
-### PRIVATE INSTANCE METHOD ###
-#
-# Return parameters for method being called.
-#
-
-sub _get_method_parameters {
- my ($self, %params) = @_;
-
- my $action = $params{action};
- my $method = $params{method};
-
- return RPC::ExtDirect->get_method_parameters($action, $method);
+ return $ex_class->new({
+ config => $config,
+ debug => $self->debug,
+ verbose => $config->verbose_exceptions,
+ %$arg
+ });
}
### PRIVATE INSTANCE METHOD ###
@@ -235,15 +333,17 @@ sub _set_error {
my ($package, $sub) = (caller 1)[3] =~ / \A (.*) :: (.*?) \z /xms;
$where = $package . '->' . $sub;
};
+
+ my $method_ref = $self->method_ref;
# We need newborn Exception object to tear its guts out
my $ex = $self->_exception({
- debug => $DEBUG,
- action => $self->action,
- method => $self->method,
+ action => $method_ref->action,
+ method => $method_ref->name,
tid => $self->tid,
message => $msg,
- where => $where
+ where => $where,
+ debug => $self->debug,
});
# Now the black voodoo magiKC part, live on stage
@@ -254,7 +354,7 @@ sub _set_error {
bless $self, ref $ex;
# Humbly return failure to be propagated upwards
- return '';
+ return !1;
}
### PRIVATE INSTANCE METHOD ###
@@ -265,10 +365,6 @@ sub _set_error {
sub _unpack_arguments {
my ($self, $arg) = @_;
- # Check if $arg is valid
- croak [ "ExtDirect input error: invalid input" ]
- if !defined $arg || ref $arg ne 'HASH';
-
# Unpack and normalize arguments
my $action = $arg->{extAction} || $arg->{action};
my $method = $arg->{extMethod} || $arg->{method};
@@ -279,11 +375,11 @@ sub _unpack_arguments {
: undef
;
- # Check required arguments
- croak [ "ExtDirect action (class name) required" ]
+ # Throwing arrayref so that die() wouldn't add file/line to the string
+ die [ "ExtDirect action (class name) required" ]
unless defined $action && length $action > 0;
- croak [ "ExtDirect method name required" ]
+ die [ "ExtDirect method name required" ]
unless defined $method && length $method > 0;
return ($action, $method, $tid, $data, $type, $upload);
@@ -291,204 +387,30 @@ sub _unpack_arguments {
### PRIVATE INSTANCE METHOD ###
#
-# Checks if method arguments are in order
-#
-
-sub _check_arguments {
- my ($self, %params) = @_;
-
- my $action = $params{action};
- my $method = $params{method};
- my $tid = $params{tid};
- my $data = $params{data};
- my $method_def = $params{parameters};
-
- # Check if we have right $data type for method's calling convention
- if ( defined $method_def->{param_names} ) {
- my $param_names = $method_def->{param_names};
-
- if ( not $self->_check_params($param_names, $data) ) {
- return $self->_exception({
- debug => $DEBUG,
- action => $action,
- method => $method,
- tid => $tid,
- message => "ExtDirect method $action.$method ".
- "needs named parameters: " .
- join( ', ', @$param_names )
- });
- }
- };
-
- # Check if we have enough data for the method with numbered arguments
- if ( $method_def->{param_no} ) {
- my $defined_param_no = $method_def->{param_no};
- my $real_param_no = @$data;
-
- if ( $real_param_no < $defined_param_no ) {
- return $self->_exception({
- debug => $DEBUG,
- action => $action,
- method => $method,
- tid => $tid,
- message => "ExtDirect method $action.$method ".
- "needs $defined_param_no ".
- "arguments instead of $real_param_no"
- });
- }
- };
-
- # There's not much to check for formHandler methods
- if ( $method_def->{formHandler} ) {
- if ( ref $data ne 'HASH' || !exists $data->{extAction} ||
- !exists $data->{extMethod} )
- {
- return $self->_exception({
- debug => $DEBUG,
- action => $action,
- method => $method,
- tid => $tid,
- message => "ExtDirect formHandler method ".
- "$action.$method should only ".
- "be called with form submits"
- })
- }
- };
-
- # Event poll handlers return Event objects instead of plain data;
- # there is no sense in calling them directly
- if ( $method_def->{pollHandler} ) {
- return $self->_exception({
- debug => $DEBUG,
- action => $action,
- method => $method,
- tid => $tid,
- message => "ExtDirect pollHandler method ".
- "$action.$method should not ".
- "be called directly"
- });
- };
-
- # undef means no exception
- return undef; ## no critic
-}
-
-### PRIVATE INSTANCE METHOD ###
-#
-# Checks if data passed to method has all named parameters
-# defined for the method
-#
-
-sub _check_params {
- my ($self, $param_names, $data) = @_;
-
- # $data should be a hashref
- return unless ref $data eq 'HASH';
-
- # Note that we don't check definedness -- a parameter
- # may be optional for all we care
- for my $param ( @$param_names ) {
- return unless exists $data->{ $param };
- };
-
- # Got 'em all
- return 1;
-}
-
-### PRIVATE INSTANCE METHOD ###
-#
-# Prepares method arguments to be passed along to the method
-#
-
-sub _prepare_method_arguments {
- my ($self, $env) = @_;
-
- my @arg;
-
- # Deal with form handlers first
- if ( $self->formHandler ) {
- # Data should be hashref here
- my $data = $self->{data};
-
- # Ensure there are no runaway ExtDirect generic parameters
- my @runaway_params = qw(action method extAction extMethod
- extTID extUpload _uploads);
- delete @$data{ @runaway_params };
-
- # Add uploads if there are any
- $data->{file_uploads} = $self->upload
- if $self->upload;
-
- $data->{_env} = $env;
-
- @arg = %$data;
- }
-
- # Pluck the named arguments and stash them into @arg
- elsif ( $self->param_names ) {
- my @names = $self->param_names;
- my $data = $self->{data};
- my %tmp;
- @tmp{ @names } = @$data{ @names };
- $tmp{_env} = $env;
-
- @arg = %tmp;
- }
-
- # Ensure we're passing the right number of arguments
- elsif ( defined $self->param_no ) {
- my @data = $self->data;
- @arg = splice @data, 0, $self->param_no;
-
- push @arg, $env;
- };
-
- return @arg;
-}
-
-### PRIVATE INSTANCE METHOD ###
-#
-# Init Request hooks
-#
-
-sub _init_hooks {
- my ($self, %params) = @_;
-
- my @hook_types = qw/ before instead after /;
- @$self{ @hook_types }
- = map { RPC::ExtDirect::Hook->new($_, \%params) } @hook_types;
-
- return $self;
-}
-
-### PRIVATE INSTANCE METHOD ###
-#
# Run "before" hook
#
sub _run_before_hook {
- my ($self, %params) = @_;
-
- my $env = $params{env};
- my $arg = $params{arg};
+ my ($self, %arg) = @_;
my ($run_method, $result, $exception) = (1);
# This hook may die() with an Exception
- my $hook_result = eval { $self->before->run($env, $arg) };
+ local $@;
+ my $hook_result = eval { $self->before->run(%arg) };
# If "before" hook died, cancel Method call
if ( $@ ) {
$exception = $@;
- $run_method = '';
+ $run_method = !1;
};
# If "before" hook returns anything but number 1,
- # treat it as Ext.Direct response and do not call
+ # treat it as an Ext.Direct response and do not call
# the actual method
if ( $hook_result ne '1' ) {
$result = $hook_result;
- $run_method = '';
+ $run_method = !1;
};
return ($result, $exception, $run_method);
@@ -496,42 +418,22 @@ sub _run_before_hook {
### PRIVATE INSTANCE METHOD ###
#
-# Runs "instead" hook if it exists, or the mehtod itself
+# Runs "instead" hook if it exists, or the method itself
#
sub _run_method {
- my ($self, %params) = @_;
-
- my $env = $params{env};
- my $arg = $params{arg};
+ my ($self, %arg) = @_;
- # We call methods by code reference
- my $package = $self->package;
- my $referent = $self->referent;
-
- my $callee = $self->instead ? $self->instead->instead
- : $referent
- ;
-
- my $result = $self->instead ? eval { $self->instead->run($env, $arg) }
- : eval { $self->_do_run_method($env, $arg) }
- ;
-
- return ($result, $@, $callee);
-}
-
-### PRIVATE INSTANCE METHOD ###
-#
-# Actually run the method or hook and return result
-#
-
-sub _do_run_method {
- my ($self, $env, $arg) = @_;
+ # We call methods by code reference
+ my $hook = $self->instead;
+ my $run_hook = $hook && $hook->runnable;
+ my $callee = $run_hook ? $hook : $self->method_ref;
- my $package = $self->package;
- my $referent = $self->referent;
+ local $@;
+ my $result = eval { $callee->run(%arg) };
+ my $exception = $@;
- return $referent->($package, @$arg);
+ return ($result, $exception, $callee->code);
}
### PRIVATE INSTANCE METHOD ###
@@ -540,34 +442,30 @@ sub _do_run_method {
#
sub _run_after_hook {
- my ($self, %params) = @_;
+ my ($self, %arg) = @_;
+
+ # Localize so that we don't clobber the $@
+ local $@;
- my $env = $params{env};
- my $arg = $params{arg};
- my $result = $params{result};
- my $exception = $params{exception};
- my $callee = $params{callee};
-
# Return value and exceptions are ignored
- eval {
- $self->after->run($env, $arg, $result, $exception, $callee)
- };
- $@ = '';
+ eval { $self->after->run(%arg) };
}
### PRIVATE INSTANCE METHOD ###
#
-# Returns result hashref
+# Return result hashref
#
sub _get_result_hashref {
my ($self) = @_;
+
+ my $method_ref = $self->method_ref;
my $result_ref = {
type => 'rpc',
tid => $self->tid,
- action => $self->action,
- method => $self->method,
+ action => $method_ref->action,
+ method => $method_ref->name,
result => $self->{result}, # To avoid collisions
};
@@ -583,38 +481,13 @@ sub _process_exception {
my ($self, $env, $exception) = @_;
# Stringify exception and treat it as error message
- my $msg = $EXCEPTION_CLASS->clean_message("$exception");
-
+ my $msg = clean_error_message("$exception");
+
# Report actual package and method in case we're debugging
- my $where = $self->package .'->'. $self->method;
+ my $method_ref = $self->method_ref;
+ my $where = $method_ref->package .'->'. $method_ref->name;
return $self->_set_error($msg, $where);
}
1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-RPC::ExtDirect::Request - Implements Ext.Direct Request objects
-
-=head1 SYNOPSIS
-
-This module is not intended to be used directly.
-
-=head1 AUTHOR
-
-Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2011-2012 Alexander Tokarev.
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
@@ -4,91 +4,114 @@ use strict;
use warnings;
no warnings 'uninitialized'; ## no critic
-use Carp;
-
-use RPC::ExtDirect::Deserialize;
-use RPC::ExtDirect::Serialize;
-use RPC::ExtDirect::Request;
-use RPC::ExtDirect::Exception;
+use RPC::ExtDirect::Util::Accessor;
+use RPC::ExtDirect::Config;
+use RPC::ExtDirect;
### PACKAGE GLOBAL VARIABLE ###
#
# Turn this on for debug output
#
+# DEPRECATED. Use `debug_router` or `debug` Config options instead.
+#
-our $DEBUG = 0;
+our $DEBUG;
### PACKAGE GLOBAL VARIABLE ###
#
# Set Serializer class name so it could be configured
#
-# TODO This is hacky hack, find another way to inject
-# new functionality (all class names)
+# DEPRECATED. Use `serializer_class_router` or `serializer_class`
+# Config options instead.
#
-our $SERIALIZER_CLASS = 'RPC::ExtDirect::Serialize';
+our $SERIALIZER_CLASS;
### PACKAGE GLOBAL VARIABLE ###
#
# Set Deserializer class name so it could be configured
#
+# DEPRECATED. Use `deserializer_class_router` or `deserializer_class`
+# Config options instead.
+#
-our $DESERIALIZER_CLASS = 'RPC::ExtDirect::Deserialize';
+our $DESERIALIZER_CLASS;
### PACKAGE GLOBAL VARIABLE ###
#
# Set Exception class name so it could be configured
#
+# DEPRECATED. Use `exception_class_deserialize` or `exception_class`
+# Config options instead.
+#
-our $EXCEPTION_CLASS = 'RPC::ExtDirect::Exception';
+our $EXCEPTION_CLASS;
### PACKAGE GLOBAL VARIABLE ###
#
# Set Request class name so it could be configured
#
+# DEPRECATED. Use `request_class_deserialize` or `request_class`
+# Config options instead.
+#
-our $REQUEST_CLASS = 'RPC::ExtDirect::Request';
+our $REQUEST_CLASS;
-### PUBLIC CLASS METHOD ###
+### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
#
-# Routes the request(s) and returns serialized responses
+# Create a new Router object with default API and Config
#
-sub route {
- my ($class, $input, $env) = @_;
+sub new {
+ my ($class, %arg) = @_;
+
+ $arg{config} ||= RPC::ExtDirect::Config->new();
+ $arg{api} ||= RPC::ExtDirect->get_api();
+
+ return bless { %arg }, $class;
+}
- #
- # It's a bit awkward to turn this off for the whole sub,
- # but enclosing `local` in a block won't work
- #
- no strict 'refs'; ## no critic
+### PUBLIC CLASS/INSTANCE METHOD ###
+#
+# Route the request(s) and return serialized responses
+#
+# Note that the preferred way to call this method is on the Router
+# object instance, but we support the class-based way for backwards
+# compatibility.
+#
+# Be aware that the only supported way to configure the Router
+# is to pass a Config object to the constructor and then call route()
+# on the instance.
+#
- # Set debug flags
- local ${$DESERIALIZER_CLASS.'::DEBUG'} = $DEBUG;
- local ${$SERIALIZER_CLASS.'::DEBUG'} = $DEBUG;
- local ${$EXCEPTION_CLASS.'::DEBUG'} = $DEBUG;
- local ${$REQUEST_CLASS.'::DEBUG'} = $DEBUG;
+sub route {
+ my ($class, $input, $env) = @_;
- # Propagate class names
- local ${$DESERIALIZER_CLASS.'::REQUEST_CLASS'} = $REQUEST_CLASS;
- local ${$DESERIALIZER_CLASS.'::EXCEPTION_CLASS'} = $EXCEPTION_CLASS;
- local ${$SERIALIZER_CLASS.'::EXCEPTION_CLASS'} = $EXCEPTION_CLASS;
- local ${$REQUEST_CLASS.'::EXCEPTION_CLASS'} = $EXCEPTION_CLASS;
+ my $self = ref($class) ? $class : $class->new();
# Decode requests
- my ($has_upload, $requests) = $class->_decode_requests($input);
+ my ($has_upload, $requests) = $self->_decode_requests($input);
# Run requests and collect responses
- my $responses = $class->_run_requests($env, $requests);
+ my $responses = $self->_run_requests($env, $requests);
# Serialize responses
- my $result = $class->_serialize_responses($responses);
+ my $result = $self->_serialize_responses($responses);
- my $http_response = $class->_format_response($result, $has_upload);
+ my $http_response = $self->_format_response($result, $has_upload);
return $http_response;
}
+### PUBLIC INSTANCE METHODS ###
+#
+# Read-write accessors.
+#
+
+RPC::ExtDirect::Util::Accessor::mk_accessors(
+ simple => [qw/ api config /],
+);
+
############## PRIVATE METHODS BELOW ##############
### PRIVATE INSTANCE METHOD ###
@@ -97,16 +120,27 @@ sub route {
#
sub _decode_requests {
- my ($class, $input) = @_;
+ my ($self, $input) = @_;
# $input can be scalar containing POST data,
# or a hashref containing form data
my $has_form = ref $input eq 'HASH';
my $has_upload = $has_form && $input->{extUpload} eq 'true';
+
+ my $config = $self->config;
+ my $api = $self->api;
+ my $debug = $config->debug_router;
+
+ my $deserializer_class = $config->deserializer_class_router;
+
+ eval "require $deserializer_class";
+
+ my $dser = $deserializer_class->new( config => $config, api => $api );
- my $requests = $has_form ? $DESERIALIZER_CLASS->decode_form($input)
- : $DESERIALIZER_CLASS->decode_post($input)
- ;
+ my $requests
+ = $has_form ? $dser->decode_form(data => $input, debug => $debug)
+ : $dser->decode_post(data => $input, debug => $debug)
+ ;
return ($has_upload, $requests);
}
@@ -117,15 +151,17 @@ sub _decode_requests {
#
sub _run_requests {
- my ($class, $env, $requests) = @_;
-
- # Run the requests
- $_->run($env) for @$requests;
+ my ($self, $env, $requests) = @_;
- # Collect responses
- my $responses = [ map { $_->result() } @$requests ];
+ my @responses;
- return $responses;
+ # Run the requests, collect the responses
+ for my $request ( @$requests ) {
+ $request->run($env);
+ push @responses, $request->result();
+ }
+
+ return \@responses;
}
### PRIVATE INSTANCE METHOD ###
@@ -134,9 +170,24 @@ sub _run_requests {
#
sub _serialize_responses {
- my ($class, $responses) = @_;
-
- my $result = $SERIALIZER_CLASS->serialize(0, @$responses);
+ my ($self, $responses) = @_;
+
+ my $api = $self->api;
+ my $config = $self->config;
+ my $debug = $config->debug_router;
+
+ my $serializer_class = $config->serializer_class_router;
+
+ eval "require $serializer_class";
+
+ my $serializer
+ = $serializer_class->new( config => $config, api => $api );
+
+ my $result = $serializer->serialize(
+ mute_exceptions => !1,
+ debug => $debug,
+ data => $responses,
+ );
return $result;
}
@@ -147,10 +198,11 @@ sub _serialize_responses {
#
sub _format_response {
- my ($class, $result, $has_upload) = @_;
+ my ($self, $result, $has_upload) = @_;
# Wrap in HTML if that was form upload request
- $result = _wrap_in_html($result) if $has_upload;
+ $result = "<html><body><textarea>$result</textarea></body></html>"
+ if $has_upload;
# Form upload responses are JSON wrapped in HTML, not plain JSON
my $content_type = $has_upload ? 'text/html' : 'application/json';
@@ -168,44 +220,4 @@ sub _format_response {
];
}
-### PRIVATE INSTANCE METHOD ###
-#
-# Wraps response text in HTML; used with form requests
-#
-
-sub _wrap_in_html {
- my ($json) = @_;
-
- # Actually wrap in soft HTML blankets
- my $html = "<html><body><textarea>$json</textarea></body></html>";
-
- return $html;
-}
-
1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-RPC::ExtDirect::Router - Ext.Direct request dispatcher
-
-=head1 SYNOPSIS
-
-This module is not intended to be used directly.
-
-=head1 AUTHOR
-
-Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2011-2012 Alexander Tokarev.
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
@@ -1,141 +1,64 @@
+#
+# WARNING: This package is deprecated.
+#
+# See RPC::ExtDirect::Config perldoc for the description
+# of the instance-based configuration options to be used
+# instead of the former global variables in this package.
+#
+
package RPC::ExtDirect::Serialize;
use strict;
use warnings;
-no warnings 'uninitialized'; ## no critic
-
-use Carp;
-
-use RPC::ExtDirect::Exception;
-
-use JSON;
+no warnings 'uninitialized'; ## no critic
### PACKAGE GLOBAL VARIABLE ###
#
# Turn on for debugging
#
+# DEPRECATED. Use `debug_serialize` or `debug` Config options instead.
+#
-our $DEBUG = 0;
+our $DEBUG;
### PACKAGE GLOBAL VARIABLE ###
#
# Set Exception class name so it could be configured
#
+# DEPRECATED. Use `exception_class_serialize` or `exception_class`
+# Config options instead.
+#
-our $EXCEPTION_CLASS = 'RPC::ExtDirect::Exception';
+our $EXCEPTION_CLASS;
### PUBLIC CLASS METHOD ###
#
-# Serializes the data passed to it in JSON
-#
-
-sub serialize {
- my ($class, $suppress_exceptions, @data) = @_;
-
- # Try to serialize each response separately;
- # if one fails it's better to return an exception
- # for one response than fail all of them
- my @serialized = map { $class->_encode_response($_, $suppress_exceptions) }
- @data;
-
- my $text = @serialized == 1 ? shift @serialized
- : '[' . join(',', @serialized) . ']'
- ;
-
- return $text;
-}
-
-############## PRIVATE METHODS BELOW ##############
-
-### PRIVATE INSTANCE METHOD ###
+# Serialize the passed data into JSON form
#
-# Return new Exception object
+# DEPRECATED. Use RPC::ExtDirect::Serializer->serializer instance method
+# instead.
#
-sub _exception {
- my $self = shift;
+sub serialize {
+ # Class name
+ shift;
- return $EXCEPTION_CLASS->new(@_);
-}
-
-### PRIVATE INSTANCE METHOD ###
-#
-# Clean error message
-#
-
-sub _clean_msg {
- my ($class, $msg) = @_;
+ my $mute_exceptions = shift;
- return $EXCEPTION_CLASS->clean_message($msg);
-}
-
-### PRIVATE INSTANCE METHOD ###
-#
-# Try encoding response into JSON
-#
-
-sub _encode_response {
- my ($class, $response, $suppress_exceptions) = @_;
+ warn __PACKAGE__.'->serialize class method is deprecated; ' .
+ 'use RPC::ExtDirect::Serializer->serialize ' .
+ 'instance method instead';
- my $text = eval { $class->_encode_json($response) };
-
- if ( $@ and not $suppress_exceptions ) {
- my $msg = $class->_clean_msg($@);
-
- my $exception = $class->_exception({
- debug => $DEBUG,
- action => $response->{action},
- method => $response->{method},
- tid => $response->{tid},
- where => __PACKAGE__,
- message => $msg,
- });
-
- $text = eval { $class->_encode_json( $exception->result() ) };
- };
+ require RPC::ExtDirect::Config;
+ require RPC::ExtDirect::Serializer;
- return $text;
-}
-
-### PRIVATE INSTANCE METHOD ###
-#
-# Actually encode JSON
-#
-
-sub _encode_json {
- my ($class, $data) = @_;
+ my $config = RPC::ExtDirect::Config->new();
+ my $serializer = RPC::ExtDirect::Serializer->new( config => $config );
- return JSON->new->utf8->canonical($DEBUG)->encode($data);
+ return $serializer->serialize(
+ mute_exceptions => $mute_exceptions,
+ data => [ @_ ],
+ );
}
1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-RPC::ExtDirect::Serialize - Provides data serialization into JSON
-
-=head1 SYNOPSIS
-
-This module is not intended to be used directly.
-
-=head1 DEPENDENCIES
-
-RPC::ExtDirect::Serialize is dependent on the following modules: L<JSON>.
-
-=head1 AUTHOR
-
-Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (c) 2011-2012 Alexander Tokarev.
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
@@ -0,0 +1,245 @@
+package RPC::ExtDirect::Serializer;
+
+use strict;
+use warnings;
+no warnings 'uninitialized'; ## no critic
+
+use Carp;
+use JSON ();
+
+use RPC::ExtDirect::Config;
+
+use RPC::ExtDirect::Util::Accessor;
+use RPC::ExtDirect::Util qw/
+ clean_error_message get_caller_info parse_global_flags
+/;
+
+### PUBLIC CLASS METHOD (CONSTRUCTOR) ###
+#
+# Instantiate a new Serializer
+#
+
+sub new {
+ my ($class, %arg) = @_;
+
+ my $self = bless { %arg }, $class;
+
+ return $self;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Serialize the data passed to it in JSON
+#
+
+sub serialize {
+ my ($self, %arg) = @_;
+
+ my $data = delete $arg{data} || [];
+
+ # Try to serialize each response separately;
+ # if one fails it's better to return an exception
+ # for one response than fail all of them
+ my @serialized = map { $self->_encode_response($_, %arg) }
+ @$data;
+
+ my $text = @serialized == 1 ? shift @serialized
+ : '[' . join(',', @serialized) . ']'
+ ;
+
+ return $text;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Turns JSONified POST request(s) into array of instantiated
+# RPC::ExtDirect::Request (Exception) objects. Returns arrayref.
+#
+
+sub decode_post {
+ my ($self, %arg) = @_;
+
+ my $post_text = delete $arg{data};
+
+ # Try to decode data, return Exception upon failure
+ local $@;
+ my $data = eval { $self->_decode_json($post_text) };
+
+ if ( $@ ) {
+ my $error = $self->_clean_msg($@);
+
+ my $msg = "ExtDirect error decoding POST data: '$error'";
+ my $xcpt = $self->_exception({
+ direction => 'deserialize',
+ message => $msg,
+ %arg,
+ });
+
+ return [ $xcpt ];
+ };
+
+ $data = [ $data ] unless ref $data eq 'ARRAY';
+
+ my @requests = map { $self->_request({ %$_, %arg }) } @$data;
+
+ return \@requests;
+}
+
+### PUBLIC INSTANCE METHOD ###
+#
+# Instantiates Request based on form submitted to ExtDirect handler
+# Returns arrayref with single Request.
+#
+
+sub decode_form {
+ my ($self, %arg) = @_;
+
+ my $form_href = delete $arg{data};
+
+ # Create the Request (or Exception)
+ my $request = $self->_request({ %$form_href, %arg });
+
+ return [ $request ];
+}
+
+RPC::ExtDirect::Util::Accessor::mk_accessors(
+ simple => [qw/ config api /],
+);
+
+############## PRIVATE METHODS BELOW ##############
+
+### PRIVATE INSTANCE METHOD ###
+#
+# Clean error message
+#
+
+sub _clean_msg {
+ my ($self, $msg) = @_;
+
+ return clean_error_message($msg);
+}
+
+### PRIVATE INSTANCE METHOD ###
+#
+# Try encoding one response into JSON
+#
+
+sub _encode_response {
+ my ($self, $response, %arg) = @_;
+
+ my $mute_exceptions = $arg{mute_exceptions};
+
+ local $@;
+ my $text = eval { $self->_encode_json($response, %arg) };
+
+ if ( $@ and not $mute_exceptions ) {
+ my $msg = $self->_clean_msg($@);
+
+ # It's not a given that response/exception hashrefs
+ # will be actual blessed objects, so we have to peek
+ # into them instead of using accessors
+ my $exception = $self->_exception({
+ direction => 'serialize',
+ action => $response->{action},
+ method => $response->{method},
+ tid => $response->{tid},
+ where => __PACKAGE__,
+ message => $msg,
+ %arg,
+ });
+
+ local $@;
+ $text = eval {
+ $self->_encode_json( $exception->result(), %arg )
+ };
+ };
+
+ return $text;
+}
+
+### PRIVATE INSTANCE METHOD ###
+#
+# Actually encode JSON
+#
+
+sub _encode_json {
+ my ($self, $data, %arg) = @_;
+
+ my $config = $arg{config} || $self->config;
+ my $options = defined $arg{json_options} ? $arg{json_options}
+ : $config->json_options_serialize
+ ;
+ my $debug = defined $arg{debug} ? $arg{debug}
+ : $config->debug_serialize
+ ;
+
+ # We force UTF-8 as per Ext.Direct spec
+ $options->{utf8} = 1;
+ $options->{canonical} = $debug
+ unless defined $options->{canonical};
+
+ return JSON::to_json($data, $options);
+}
+
+### PRIVATE INSTANCE METHOD ###
+#
+# Actually decode JSON
+#
+
+sub _decode_json {
+ my ($self, $text) = @_;
+
+ my $options = $self->config->json_options_deserialize;
+
+ return JSON::from_json($text, $options);
+}
+
+### PRIVATE INSTANCE METHOD ###
+#
+# Return a new Request object
+#
+
+sub _request {
+ my ($self, $arg) = @_;
+
+ my $api = $self->api;
+ my $config = $self->config;
+ my $request_class = $config->request_class_deserialize;
+
+ eval "require $request_class";
+
+ return $request_class->new({
+ config => $config,
+ api => $api,
+ %$arg
+ });
+}
+
+### PRIVATE INSTANCE METHOD ###
+#
+# Return a new Exception object
+#
+
+sub _exception {
+ my ($self, $arg) = @_;
+
+ my $direction = $arg->{direction};
+
+ my $config = $self->config;
+ my $getter_class = "exception_class_$direction";
+ my $getter_debug = "debug_$direction";
+
+ my $exception_class = $config->$getter_class();
+ my $debug = $config->$getter_debug();
+
+ eval "require $exception_class";
+
+ $arg->{debug} = !!$debug unless defined $arg->{debug};
+ $arg->{where} = get_caller_info(2) unless defined $arg->{where};
+
+ $arg->{verbose} = $config->verbose_exceptions();
+
+ return $exception_class->new($arg);
+}
+
+1;
@@ -0,0 +1,182 @@
+package RPC::ExtDirect::Test::Data::API;
+
+use strict;
+use warnings;
+
+# This aref contains definitions/data for API tests
+my $tests = [{
+ name => 'API 1',
+
+ config => {
+ api_path => '/api',
+ debug => 1,
+ no_polling => 1,
+ router_path => '/extdirectrouter',
+ poll_path => '/events',
+ },
+
+ input => {
+ method => 'GET',
+ url => '/api',
+ cgi_url => '/api1',
+
+ content => undef,
+ },
+
+ # Expected test output
+ output => {
+ status => 200,
+ content_type => qr|^application/javascript\b|,
+ comparator => 'cmp_api',
+ content => q~
+ Ext.app.REMOTING_API = {
+ "actions": {
+ "Bar": [
+ { "len":5, "name":"bar_bar" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":4, "name":"bar_foo" }
+ ],
+ "Foo": [
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":1, "name":"foo_foo" },
+ { "len":0, "name":"foo_zero" },
+ { "name":"foo_blessed" }
+ ],
+ "Qux": [
+ { "len":5, "name":"bar_bar" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":4, "name":"bar_foo" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":1, "name":"foo_foo" }
+ ]
+ },
+ "type":"remoting",
+ "url":"/extdirectrouter"
+ };
+ ~,
+ },
+}, {
+ name => 'API 2',
+
+ config => {
+ api_path => '/api',
+ namespace => 'myApp.ns',
+ auto_connect => 1,
+ router_path => '/router.cgi',
+ debug => 1,
+ remoting_var => 'Ext.app.REMOTE_CALL',
+ no_polling => 1,
+ poll_path => '/events',
+ },
+
+ input => {
+ method => 'GET',
+ url => '/api',
+ cgi_url => '/api2',
+
+ content => undef,
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/javascript\b|,
+ comparator => 'cmp_api',
+ content => q~
+ Ext.app.REMOTE_CALL = {
+ "actions": {
+ "Bar": [
+ { "len":5, "name":"bar_bar" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":4, "name":"bar_foo" }
+ ],
+ "Foo": [
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":1, "name":"foo_foo" },
+ { "len":0, "name":"foo_zero" },
+ { "name":"foo_blessed" }
+ ],
+ "Qux": [
+ { "len":5, "name":"bar_bar" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":4, "name":"bar_foo" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":1, "name":"foo_foo" }
+ ]
+ },
+ "namespace":"myApp.ns",
+ "type":"remoting",
+ "url":"/router.cgi"
+ };
+ Ext.direct.Manager.addProvider(Ext.app.REMOTE_CALL);
+ ~,
+ },
+}, {
+ name => 'API 3',
+
+ config => {
+ remoting_var => 'Ext.app.CALL',
+ debug => 1,
+ polling_var => 'Ext.app.POLL',
+ auto_connect => !1,
+ router_path => '/cgi-bin/router.cgi',
+ poll_path => '/cgi-bin/events.cgi',
+ namespace => 'Namespace',
+ api_path => '/api',
+ no_polling => !1,
+ },
+
+ input => {
+ method => 'GET',
+ url => '/api',
+ cgi_url => '/api3',
+
+ content => undef,
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/javascript\b|,
+ comparator => 'cmp_api',
+ content => q~
+ Ext.app.CALL = {
+ "actions": {
+ "Bar": [
+ { "len":5, "name":"bar_bar" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":4, "name":"bar_foo" }
+ ],
+ "Foo": [
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":1, "name":"foo_foo" },
+ { "len":0, "name":"foo_zero" },
+ { "name":"foo_blessed" }
+ ],
+ "Qux": [
+ { "len":5, "name":"bar_bar" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":4, "name":"bar_foo" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":1, "name":"foo_foo" }
+ ]
+ },
+ "namespace":"Namespace",
+ "type":"remoting",
+ "url":"/cgi-bin/router.cgi"
+ };
+ Ext.app.POLL = {
+ "type":"polling",
+ "url":"/cgi-bin/events.cgi"
+ };
+ ~,
+ },
+}];
+
+sub get_tests { return $tests };
+
+1;
@@ -0,0 +1,269 @@
+package RPC::ExtDirect::Test::Data::Env;
+
+use strict;
+use warnings;
+
+# This aref contains definitions/data for Env tests
+my $tests = [{
+ name => 'http list',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+
+ -cgi_env => {
+ HTTP_COOKIE => 'foo=bar',
+ },
+ },
+
+ input => {
+ method => 'POST',
+ url => '/router',
+ cgi_url => '/env',
+
+ content => {
+ type => 'raw_post',
+ arg => [
+ 'http://localhost/router',
+ '{"type":"rpc","tid":1,"action":"Env",'.
+ ' "method":"http_list","data":[]}',
+ ],
+ },
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_json',
+ cgi_content =>
+ q|{"action":"Env","method":"http_list","result":|.
+ q|["HTTP_ACCEPT","HTTP_ACCEPT_CHARSET","HTTP_CONNECTION",|.
+ q|"HTTP_COOKIE","HTTP_HOST","HTTP_USER_AGENT"],|.
+ q|"tid":1,"type":"rpc"}|,
+ plack_content =>
+ q|{"action":"Env","method":"http_list","result":|.
+ q|["COOKIE","Content-Length","Content-Type","Host"],|.
+ q|"tid":1,"type":"rpc"}|,
+ anyevent_content =>
+ q|{"action":"Env","method":"http_list","result":|.
+ q|["content-length","content-type","cookie"],|.
+ q|"tid":1,"type":"rpc"}|,
+ },
+}, {
+ name => 'http header',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+
+ -cgi_env => {
+ HTTP_COOKIE => 'foo=bar',
+ },
+ },
+
+ input => {
+ method => 'POST',
+ url => '/router',
+ cgi_url => '/env',
+
+ cgi_content => {
+ type => 'raw_post',
+ arg => [
+ 'http://localhost/router',
+ '{"type":"rpc","tid":1,"action":"Env",'.
+ ' "method":"http_header","data":["HTTP_USER_AGENT"]}',
+ ],
+ },
+
+ content => {
+ type => 'raw_post',
+ arg => [
+ 'http://localhost/router',
+ '{"type":"rpc","tid":1,"action":"Env",'.
+ ' "method":"http_header","data":["Content-Type"]}',
+ ],
+ }
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_json',
+ cgi_content =>
+ q|{"action":"Env","method":"http_header","result":|.
+ q|"CGI::Test",|.
+ q|"tid":1,"type":"rpc"}|,
+ content =>
+ q|{"action":"Env","method":"http_header","result":|.
+ q|"application/json",|.
+ q|"tid":1,"type":"rpc"}|,
+ },
+}, {
+ name => 'param list',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+
+ -cgi_env => {
+ HTTP_COOKIE => 'foo=bar',
+ },
+ },
+
+ input => {
+ method => 'POST',
+ url => '/router',
+ cgi_url => '/env',
+
+ content => {
+ type => 'raw_post',
+ arg => [
+ 'http://localhost/router',
+ '{"type":"rpc","tid":1,"action":"Env",'.
+ ' "method":"param_list","data":[]}',
+ ],
+ },
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_json',
+ anyevent_content =>
+ q|{"action":"Env","method":"param_list","result":|.
+ q|[],|.
+ q|"tid":1,"type":"rpc"}|,
+ content =>
+ q|{"action":"Env","method":"param_list","result":|.
+ q|["POSTDATA"],|.
+ q|"tid":1,"type":"rpc"}|,
+ },
+}, {
+ name => 'param get',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+
+ -cgi_env => {
+ HTTP_COOKIE => 'foo=bar',
+ },
+ },
+
+ input => {
+ method => 'POST',
+ url => '/router',
+ cgi_url => '/env',
+
+ content => {
+ type => 'raw_post',
+ arg => [
+ 'http://localhost/router',
+ '{"type":"rpc","tid":1,"action":"Env",'.
+ ' "method":"param_get","data":["POSTDATA"]}',
+ ],
+ },
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_json',
+ anyevent_content =>
+ q|{"action":"Env","method":"param_get","result":|.
+ q|null,|.
+ q|"tid":1,"type":"rpc"}|,
+ content =>
+ q|{"action":"Env","method":"param_get","result":|.
+ q|"{\"type\":\"rpc\",\"tid\":1,\"action\":\"Env\",\"method\":\"param_get\",\"data\":[\"POSTDATA\"]}",|.
+ q|"tid":1,"type":"rpc"}|,
+ },
+}, {
+ name => 'cookie list',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+
+ -cgi_env => {
+ HTTP_COOKIE => 'foo=bar',
+ },
+ },
+
+ input => {
+ method => 'POST',
+ url => '/router',
+ cgi_url => '/env',
+
+ content => {
+ type => 'raw_post',
+ arg => [
+ 'http://localhost/router',
+ '{"type":"rpc","tid":1,"action":"Env",'.
+ ' "method":"cookie_list","data":[]}',
+ ],
+ },
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_json',
+ content =>
+ q|{"action":"Env","method":"cookie_list","result":|.
+ q|["foo"],|.
+ q|"tid":1,"type":"rpc"}|,
+ },
+}, {
+ name => 'cookie get',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+
+ -cgi_env => {
+ HTTP_COOKIE => 'foo=bar',
+ },
+ },
+
+ input => {
+ method => 'POST',
+ url => '/router',
+ cgi_url => '/env',
+
+ content => {
+ type => 'raw_post',
+ arg => [
+ 'http://localhost/router',
+ '{"type":"rpc","tid":1,"action":"Env",'.
+ ' "method":"cookie_get","data":["foo"]}',
+ ],
+ },
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_json',
+ content =>
+ q|{"action":"Env","method":"cookie_get","result":|.
+ q|"bar",|.
+ q|"tid":1,"type":"rpc"}|,
+ },
+}];
+
+sub get_tests { return $tests };
+
+1;
@@ -0,0 +1,145 @@
+package RPC::ExtDirect::Test::Data::Poll;
+
+use strict;
+use warnings;
+
+# This aref contains definitions/data for Poll tests
+my $tests = [{
+ name => 'Two events',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+ password => 'Usual, please',
+ },
+
+ input => {
+ method => 'POST',
+ url => '/events',
+ cgi_url => '/poll1',
+
+ content => undef,
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_json',
+ content =>
+ q|[{"data":["foo"],|.
+ q| "name":"foo_event",|.
+ q| "type":"event"},|.
+ q| {"data":{"foo":"bar"},|.
+ q| "name":"bar_event",|.
+ q| "type":"event"}]|,
+ },
+}, {
+ name => 'One event',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+ password => 'Ein kaffe bitte',
+ },
+
+ input => {
+ method => 'POST',
+ url => '/events',
+ cgi_url => '/poll2',
+
+ content => undef,
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_json',
+ content =>
+ q|{"data":"Uno cappuccino, presto!",|.
+ q| "name":"coffee",|.
+ q| "type":"event"}|,
+ },
+}, {
+ name => 'Failed method',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+ password => 'Whiskey, straight away!',
+ },
+
+ input => {
+ method => 'POST',
+ url => '/events',
+ cgi_url => '/poll3',
+
+ content => undef,
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_json',
+ content => q|{"data":"","name":"__NONE__","type":"event"}|,
+ },
+}, {
+ name => 'No events at all',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+ password => "Sorry sir, but that's not on the menu?",
+ },
+
+ input => {
+ method => 'POST',
+ url => '/events',
+ cgi_url => '/poll4',
+
+ input => undef,
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_json',
+ content => q|{"data":"","name":"__NONE__","type":"event"}|,
+ },
+}, {
+ name => 'Invalid Event provider output',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+ password => "Hey man! There's a roach in my soup!",
+ },
+
+ input => {
+ method => 'POST',
+ url => '/events',
+ cgi_url => '/poll5',
+
+ input => undef,
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_json',
+ content => q|{"data":"","name":"__NONE__","type":"event"}|,
+ },
+}];
+
+sub get_tests { return $tests };
+
+1;
@@ -0,0 +1,260 @@
+package RPC::ExtDirect::Test::Data::Router;
+
+use strict;
+use warnings;
+
+# This aref contains definitions/data for Router tests
+my $tests = [{
+ name => 'Invalid raw POST',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+ },
+
+ input => {
+ method => 'POST',
+ url => '/router',
+ cgi_url => '/router1',
+
+ content => {
+ type => 'raw_post',
+ arg => [
+ 'http://localhost/router',
+ '{"something":"invalid":"here"}',
+ ],
+ },
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_json',
+ content =>
+ q|{"action":null,"message":"ExtDirect error decoding POST data: |.
+ q| ', or } expected while parsing object/hash,|.
+ q| at character offset 22 (before \":\"here\"}\")'",|.
+ q| "method":null, "tid": null, "type":"exception",|.
+ q| "where":"RPC::ExtDirect::Serializer->decode_post"}|,
+ },
+}, {
+ name => 'Valid raw POST, single request',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+ },
+
+ input => {
+ method => 'POST',
+ url => '/router',
+ cgi_url => '/router1',
+
+ content => {
+ type => 'raw_post',
+ arg => [
+ 'http://localhost/router',
+ q|{"type":"rpc","tid":1,"action":"Foo",|.
+ q| "method":"foo_foo","data":["bar"]}|,
+ ],
+ },
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_json',
+ content =>
+ q|{"action":"Foo","method":"foo_foo",|.
+ q|"result":"foo! 'bar'","tid":1,"type":"rpc"}|,
+ },
+}, {
+ name => 'Valid raw POST, multiple requests',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+ },
+
+ input => {
+ method => 'POST',
+ url => '/router',
+ cgi_url => '/router1',
+
+ content => {
+ type => 'raw_post',
+ arg => [
+ 'http://localhost/router',
+ q|[{"tid":1,"action":"Qux","method":"foo_foo",|.
+ q| "data":["foo"],"type":"rpc"},|.
+ q| {"tid":2,"action":"Qux","method":"foo_bar",|.
+ q| "data":["bar1","bar2"],"type":"rpc"},|.
+ q| {"tid":3,"action":"Qux","method":"foo_baz",|.
+ q| "data":{"foo":"baz1","bar":"baz2",|.
+ q| "baz":"baz3"},"type":"rpc"}]|,
+ ],
+ },
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_str',
+ content =>
+ q|[{"action":"Qux","method":"foo_foo",|.
+ q|"result":"foo! 'foo'","tid":1,"type":"rpc"},|.
+ q|{"action":"Qux","method":"foo_bar",|.
+ q|"result":["foo! bar!","bar1","bar2"],"tid":2,"type":"rpc"},|.
+ q|{"action":"Qux","method":"foo_baz",|.
+ q|"result":{"bar":"baz2","baz":"baz3","foo":"baz1",|.
+ q|"msg":"foo! bar! baz!"},"tid":3,"type":"rpc"}]|,
+ },
+}, {
+ name => 'Form request, no uploads',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+ },
+
+ input => {
+ method => 'POST',
+ url => '/router',
+ cgi_url => '/router1',
+
+ content => {
+ type => 'form_post',
+ arg => [
+ 'http://localhost/router',
+ action => '/router.cgi',
+ method => 'POST',
+ extAction => 'Bar',
+ extMethod => 'bar_baz',
+ extTID => 123,
+ field1 => 'foo',
+ field2 => 'bar',
+ extType => 'rpc',
+ ],
+ },
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^application/json\b|,
+ comparator => 'cmp_str',
+ content =>
+ q|{"action":"Bar","method":"bar_baz",|.
+ q|"result":{"field1":"foo","field2":"bar"},|.
+ q|"tid":123,"type":"rpc"}|,
+ },
+}, {
+ name => 'Form request, one upload',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+ },
+
+ input => {
+ method => 'POST',
+ url => '/router',
+ cgi_url => '/router2',
+
+ content => {
+ type => 'form_upload',
+ arg => [
+ 'http://localhost/router',
+ ['qux.txt'],
+ action => '/router.cgi',
+ method => 'POST',
+ extAction => 'JuiceBar',
+ extMethod => 'bar_baz',
+ extTID => 7,
+ extType => 'rpc',
+ foo_field => 'foo',
+ bar_field => 'bar',
+ extUpload => 'true',
+ ],
+ },
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^text/html\b|,
+ comparator => 'cmp_str',
+ content =>
+ q|<html><body><textarea>|.
+ q|{"action":"JuiceBar","method":"bar_baz",|.
+ q|"result":{"bar_field":"bar",|.
+ q|"foo_field":"foo",|.
+ q|"upload_response":"The following files were |.
+ q|processed:\n|.
+ q|qux.txt application/octet-stream 31 ok\n"|.
+ q|},"tid":7,|.
+ q|"type":"rpc"}|.
+ q|</textarea></body></html>|,
+ },
+}, {
+ name => 'Form request, multiple uploads',
+
+ config => {
+ api_path => '/api',
+ router_path => '/router',
+ poll_path => '/events',
+ debug => 1,
+ },
+
+ input => {
+ method => 'POST',
+ cgi_url => '/router2',
+ url => '/router',
+
+ content => {
+ type => 'form_upload',
+ arg => [
+ 'http://localhost/router',
+ ['foo.jpg', 'bar.png', 'script.js'],
+ action => '/router.cgi',
+ method => 'POST',
+ extAction => 'JuiceBar',
+ extMethod => 'bar_baz',
+ extTID => 8,
+ field => 'value',
+ extUpload => 'true',
+ extType => 'rpc',
+ ],
+ },
+ },
+
+ output => {
+ status => 200,
+ content_type => qr|^text/html\b|,
+ comparator => 'cmp_str',
+ content =>
+ q|<html><body><textarea>|.
+ q|{"action":"JuiceBar","method":"bar_baz",|.
+ q|"result":{|.
+ q|"field":"value",|.
+ q|"upload_response":"The following files were |.
+ q|processed:\n|.
+ q|foo.jpg application/octet-stream 16159 ok\n|.
+ q|bar.png application/octet-stream 20693 ok\n|.
+ q|script.js application/octet-stream 80 ok\n"|.
+ q|},"tid":8,"type":"rpc"}|.
+ q|</textarea></body></html>|,
+ },
+}];
+
+sub get_tests { return $tests };
+
+1;
@@ -0,0 +1,62 @@
+#
+# WARNING WARNING WARNING
+#
+# DO NOT CHANGE ANYTHING IN THIS MODULE. OTHERWISE, A LOT OF API
+# AND OTHER TESTS MAY BREAK.
+#
+# This module is here to test certain behaviors. If you need
+# to test something else, add another test module.
+# It's that simple.
+#
+
+package RPC::ExtDirect::Test::Pkg::Bar;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use base 'RPC::ExtDirect::Test::Pkg::Foo';
+
+# Define package scope hooks
+use RPC::ExtDirect BEFORE => \&bar_before, after => \&bar_after;
+
+use Carp;
+
+# This one croaks merrily
+sub bar_foo : ExtDirect(4) { croak 'bar foo!' }
+
+# Return the number of passed arguments
+sub bar_bar : ExtDirect(5) { shift; return scalar @_; }
+
+# This is a form handler
+sub bar_baz : ExtDirect( formHandler ) {
+ my ($class, %param) = @_;
+
+ # Simulate uploaded file handling
+ my $uploads = $param{file_uploads};
+ return \%param unless $uploads;
+
+ # Return 'uploads' data
+ my $response = "The following files were processed:\n";
+ for my $upload ( @$uploads ) {
+ my $name = $upload->{basename};
+ my $type = $upload->{type};
+ my $size = $upload->{size};
+
+ $response .= "$name $type $size\n";
+ };
+
+ delete $param{file_uploads};
+ $param{upload_response} = $response;
+
+ return \%param;
+}
+
+sub bar_before {
+ return 1;
+}
+
+sub bar_after {
+}
+
+1;
@@ -0,0 +1,63 @@
+#
+# WARNING WARNING WARNING
+#
+# DO NOT CHANGE ANYTHING IN THIS MODULE. OTHERWISE, A LOT OF API
+# AND OTHER TESTS MAY BREAK.
+#
+# This module is here to test certain behaviors. If you need
+# to test something else, add another test module.
+# It's that simple.
+#
+
+package RPC::ExtDirect::Test::Pkg::Env;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use RPC::ExtDirect class => 'Env';
+
+sub http_list : ExtDirect(0, env_arg => 1) {
+ my ($class, $env) = @_;
+
+ my @list = sort $env->http();
+
+ return [ @list ];
+}
+
+sub http_header : ExtDirect(1, env_arg => 1) {
+ my ($class, $header, $env) = @_;
+
+ return $env->http($header);
+}
+
+sub param_list : ExtDirect(0, env_arg => 1) {
+ my ($class, $env) = @_;
+
+ my @list = sort $env->param();
+
+ return [ @list ];
+}
+
+sub param_get : ExtDirect(1, env_arg => 1) {
+ my ($class, $name, $env) = @_;
+
+ return $env->param($name);
+}
+
+sub cookie_list : ExtDirect(0, env_arg => 1) {
+ my ($class, $env) = @_;
+
+ my @cookies = sort $env->cookie();
+
+ return [ @cookies ];
+}
+
+sub cookie_get : ExtDirect(1, env_arg => 1) {
+ my ($class, $name, $env) = @_;
+
+ return $env->cookie($name);
+}
+
+1;
+
@@ -0,0 +1,75 @@
+#
+# WARNING WARNING WARNING
+#
+# DO NOT CHANGE ANYTHING IN THIS MODULE. OTHERWISE, A LOT OF API
+# AND OTHER TESTS MAY BREAK.
+#
+# This module is here to test certain behaviors. If you need
+# to test something else, add another test module.
+# It's that simple.
+#
+
+package RPC::ExtDirect::Test::Pkg::Foo;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use RPC::ExtDirect;
+
+# Return scalar result
+sub foo_foo : ExtDirect(1, before => \&foo_before) {
+ return "foo! '${_[1]}'"
+}
+
+# Return arrayref result
+sub foo_bar
+ : ExtDirect(2, instead => \&foo_instead)
+{
+ return [ 'foo! bar!', @_[1, 2], ];
+}
+
+# Return hashref result
+sub foo_baz : ExtDirect( params => [foo, bar, baz], before => \&foo_before, after => \&foo_after) {
+ my $class = shift;
+ my %param = @_;
+
+ my $ret = { msg => 'foo! bar! baz!', foo => $param{foo},
+ bar => $param{bar}, baz => $param{baz},
+ };
+
+ delete @param{ qw(foo bar baz) };
+ @$ret{ keys %param } = values %param;
+
+ return $ret;
+}
+
+# Testing zero parameters
+sub foo_zero : ExtDirect(0) {
+ my ($class) = @_;
+
+ my $ret = [ @_ ];
+
+ return $ret;
+}
+
+# Testing blessed object return
+sub foo_blessed : ExtDirect {
+ return bless {}, 'foo';
+}
+
+# Testing hooks
+sub foo_before {
+ return 1;
+}
+
+sub foo_instead {
+ my ($class, %params) = @_;
+
+ return $params{orig}->();
+}
+
+sub foo_after {
+}
+
+1;
@@ -0,0 +1,63 @@
+#
+# WARNING WARNING WARNING
+#
+# DO NOT CHANGE ANYTHING IN THIS MODULE. OTHERWISE, A LOT OF API
+# AND OTHER TESTS MAY BREAK.
+#
+# This module is here to test certain behaviors. If you need
+# to test something else, add another test module.
+# It's that simple.
+#
+
+package RPC::ExtDirect::Test::Pkg::Hooks;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use RPC::ExtDirect before => \&nonexistent_before_hook;
+
+our ($foo_foo_called, $foo_bar_called, $foo_baz_called);
+
+sub foo_foo : ExtDirect(1) {
+ $foo_foo_called = 1;
+}
+
+sub foo_bar : ExtDirect(2, before => 'NONE') {
+ $foo_bar_called = 1;
+}
+
+# This hook will simply raise a flag and die
+sub foo_baz_after {
+ $foo_baz_called = 1;
+
+ die;
+}
+
+# Return hashref result
+sub foo_baz : ExtDirect( params => [foo, bar, baz], before => 'NONE', after => \&foo_baz_after)
+{
+ my $class = shift;
+ my %param = @_;
+
+ my $ret = { msg => 'foo! bar! baz!', foo => $param{foo},
+ bar => $param{bar}, baz => $param{baz},
+ };
+
+ delete @param{ qw(foo bar baz) };
+ @$ret{ keys %param } = values %param;
+
+ return $ret;
+}
+
+# Testing hook changing parameters
+sub foo_hook : ExtDirect(1) {
+ my ($class, $foo) = @_;
+
+ my $ret = [ @_ ];
+
+ return $ret;
+}
+
+1;
+
@@ -0,0 +1,73 @@
+#
+# WARNING WARNING WARNING
+#
+# DO NOT CHANGE ANYTHING IN THIS MODULE. OTHERWISE, A LOT OF API
+# AND OTHER TESTS MAY BREAK.
+#
+# This module is here to test certain behaviors. If you need
+# to test something else, add another test module.
+# It's that simple.
+#
+
+package RPC::ExtDirect::Test::Pkg::JuiceBar;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use base 'RPC::ExtDirect::Test::Pkg::Foo';
+
+use RPC::ExtDirect;
+
+use Carp;
+
+our $CHEAT = 0;
+
+# This one croaks merrily
+sub bar_foo : ExtDirect(4) { croak 'bar foo!' }
+
+# Return number of passed arguments
+sub bar_bar : ExtDirect(5) { shift; pop; return scalar @_; }
+
+# This is a form handler
+sub bar_baz : ExtDirect( formHandler ) {
+ my ($class, %param) = @_;
+
+ # We don't use the env object here, but have to remove it
+ # so that it doesn't leak in the response
+ my $env = delete $param{_env};
+
+ # Simulate uploaded file handling
+ my $uploads = $param{file_uploads};
+ return \%param unless $uploads;
+
+ # Return 'uploads' data
+ my $response = "The following files were processed:\n";
+ for my $upload ( @$uploads ) {
+ my $name = $upload->{basename};
+ my $type = $upload->{type};
+ my $size = $upload->{size};
+
+ #
+ # CTI::Test somehow uploads files so that
+ # they are 2 bytes shorter than actual size
+ # This allows for the same test results to be
+ # applied across all gateways and test frameworks
+ #
+ # TODO Investigate why this is happening and fix
+ #
+ $size += 2 if $CHEAT;
+
+ my $ok = (defined $upload->{handle} &&
+ $upload->{handle}->opened) ? "ok" : "not ok";
+
+ $response .= "$name $type $size $ok\n";
+ };
+
+ delete $param{file_uploads};
+ $param{upload_response} = $response;
+
+ return \%param;
+}
+
+1;
@@ -0,0 +1,68 @@
+#
+# WARNING WARNING WARNING
+#
+# DO NOT CHANGE ANYTHING IN THIS MODULE. OTHERWISE, A LOT OF API
+# AND OTHER TESTS MAY BREAK.
+#
+# This module is here to test certain behaviors. If you need
+# to test something else, add another test module.
+# It's that simple.
+#
+
+package # avoid indexing by the nosy PAUSE
+ TheBug;
+
+use strict;
+use warnings;
+
+sub new { bless { message => $_[1] }, $_[0] }
+sub result { $_[0] }
+
+package RPC::ExtDirect::Test::Pkg::PollProvider;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use Carp;
+
+use RPC::ExtDirect;
+use RPC::ExtDirect::Event;
+
+# This is to control what gets returned
+our $WHAT_YOURE_HAVING = 'Usual, please';
+
+sub foo : ExtDirect( pollHandler ) {
+ my ($class) = @_;
+
+ # There ought to be something more substantive, but...
+ if ( $WHAT_YOURE_HAVING eq 'Usual, please' ) {
+ return (
+ RPC::ExtDirect::Event->new('foo_event', [ 'foo' ]),
+ RPC::ExtDirect::Event->new('bar_event', { foo => 'bar' }),
+ );
+ }
+
+ elsif ( $WHAT_YOURE_HAVING eq 'Ein kaffe bitte' ) {
+ return (
+ RPC::ExtDirect::Event->new('coffee',
+ 'Uno cappuccino, presto!'),
+ );
+ }
+
+ elsif ( $WHAT_YOURE_HAVING eq 'Whiskey, straight away!' ) {
+ croak "Burp!";
+ }
+
+ elsif ( $WHAT_YOURE_HAVING eq "Hey man! There's a roach in my soup!" ) {
+ my $bug = new TheBug 'TIGER ROACH!! WHOA!';
+ return $bug;
+ }
+
+ else {
+ # Nothing special to report in our Special News Report!
+ return ();
+ };
+}
+
+1;
@@ -0,0 +1,34 @@
+#
+# WARNING WARNING WARNING
+#
+# DO NOT CHANGE ANYTHING IN THIS MODULE. OTHERWISE, A LOT OF API
+# AND OTHER TESTS MAY BREAK.
+#
+# This module is here to test certain behaviors. If you need
+# to test something else, add another test module.
+# It's that simple.
+#
+
+package RPC::ExtDirect::Test::Pkg::Qux;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use base 'RPC::ExtDirect::Test::Pkg::Bar';
+
+use RPC::ExtDirect Action => 'Qux';
+
+# Redefine subs into Qux package without actually changing them
+sub foo_foo : ExtDirect( 1 ) { shift; __PACKAGE__->SUPER::foo_foo(@_); }
+sub foo_bar : ExtDirect( 2 ) { shift; __PACKAGE__->SUPER::foo_bar(@_); }
+sub foo_baz : ExtDirect( params => [ qw( foo bar baz ) ] )
+ { shift; __PACKAGE__->SUPER::foo_baz(@_); }
+sub bar_foo : ExtDirect( 4 ) { shift; __PACKAGE__->SUPER::bar_foo(@_); }
+sub bar_bar : ExtDirect( 5 ) { shift; __PACKAGE__->SUPER::bar_bar(@_); }
+sub bar_baz : ExtDirect( formHandler ) {
+ shift;
+ __PACKAGE__->SUPER::bar_baz(@_);
+}
+
+1;
@@ -0,0 +1,166 @@
+package RPC::ExtDirect::Test::Util;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use base 'Exporter';
+
+use Test::More;
+use JSON;
+
+our @EXPORT = qw/
+ is_deep
+ cmp_api
+ prepare_input
+/;
+
+our @EXPORT_OK = qw/
+ cmp_json
+/;
+
+### EXPORTED PUBLIC PACKAGE SUBROUTINE ###
+#
+# A wrapper around Test::More::is_deeply() that will print
+# the diagnostics if a test fails
+#
+
+sub is_deep {
+ is_deeply @_ or diag explain "Expected: ", $_[1], "Actual: ", $_[0];
+}
+
+### EXPORTED PUBLIC PACKAGE SUBROUTINE ###
+#
+# Compare two JavaScript API declarations
+#
+
+sub cmp_api {
+ # This can be called either as a class method, or a plain sub
+ shift if $_[0] eq __PACKAGE__;
+
+ my ($have, $want, $desc) = @_;
+
+ $have = deparse_api($have) unless ref $have;
+ $want = deparse_api($want) unless ref $want;
+
+ is_deep $have, $want, $desc;
+}
+
+### EXPORTED PUBLIC PACKAGE SUBROUTINE ###
+#
+# Compare two strings ignoring the whitespace
+#
+
+sub cmp_str {
+ # This can be called either as a class method, or a plain sub
+ shift if $_[0] eq __PACKAGE__;
+
+ my ($have, $want, $desc) = @_;
+
+ $_ =~ s/\s//g for ($have, $want);
+
+ is $have, $want, $desc;
+}
+
+### EXPORTED PUBLIC PACKAGE SUBROUTINE ###
+#
+# Compare two JSON structures, ignoring the whitespace
+#
+
+sub cmp_json {
+ # This can be called either as a class method, or a plain sub
+ shift if $_[0] eq __PACKAGE__;
+
+ my ($have_json, $want_json, $desc) = @_;
+
+ $_ =~ s/\s//g for ($have_json, $want_json);
+
+ my $have = JSON::from_json($have_json);
+ my $want = JSON::from_json($want_json);
+
+ is_deep $have, $want, $desc;
+}
+
+### NON EXPORTED PUBLIC PACKAGE SUBROUTINE ###
+#
+# Deparse and normalize a JavaScript string with Ext.Direct API
+# declaration into Perl data structures suitable for deep comparison
+#
+
+sub deparse_api {
+ my ($api_str) = @_;
+
+ $api_str =~ s/\s*//gms;
+
+ my @parts = split /;\s*/, $api_str;
+
+ for my $part ( @parts ) {
+ next unless $part =~ /={/;
+
+ my ($var, $json) = split /=/, $part;
+
+ my $api_def = JSON::from_json($json);
+
+ my $actions = sort_action_methods($api_def->{actions});
+
+ if ( defined $actions ) {
+ $api_def->{actions} = $actions;
+ }
+
+ $part = { $var => $api_def };
+ }
+
+ return [ @parts ];
+}
+
+### EXPORTED PUBLIC PACKAGE SUBROUTINE ###
+#
+# Convert a test input hashref into the actual object
+#
+
+sub prepare_input {
+ my ($mod, $input) = @_;
+
+ return $input unless ref $input;
+
+ # Package name should be in the RPC::ExtDirect::Test::Util namespace
+ my $pkg = __PACKAGE__.'::'.$mod;
+
+ # Convertor sub name goes first
+ my $conv = $input->{type};
+ my $arg = $input->{arg};
+
+ # Calling the sub as a class method is easier
+ # than taking its ref, blah blah
+ my $result = $pkg->$conv(@$arg);
+
+ return $result;
+}
+
+### NON EXPORTED PUBLIC PACKAGE SUBROUTINE ###
+#
+# Sort the Method hashrefs on an Action object
+#
+
+sub sort_action_methods {
+ my ($api_href) = @_;
+
+ # %$api_href will auto-vivify if $api_href is undef
+ # This can bite your ass.
+ return unless $api_href;
+
+ my $new_href = {};
+
+ # map() looks too unwieldy here
+ for my $action_name ( keys %$api_href ) {
+ my @methods = @{ $api_href->{ $action_name } };
+
+ $new_href->{ $action_name }
+ = [ sort { $a->{name} cmp $b->{name} } @methods ];
+ }
+
+ return $new_href;
+}
+
+1;
+
@@ -0,0 +1,167 @@
+package RPC::ExtDirect::Util::Accessor;
+
+use strict;
+use warnings;
+no warnings 'uninitialized'; ## no critic
+
+use Carp;
+
+### NON-EXPORTED PUBLIC PACKAGE SUBROUTINE ###
+#
+# Generate either simple accessors, or complex ones, or both
+#
+
+sub mk_accessors {
+ # Support class method calling convention for convenience
+ shift if $_[0] eq __PACKAGE__;
+
+ my (%arg) = @_;
+
+ $arg{class} ||= caller();
+
+ my $simplexes = $arg{simple};
+
+ $simplexes = [ $simplexes ] unless 'ARRAY' eq ref $simplexes;
+
+ for my $accessor ( @$simplexes ) {
+ next unless defined $accessor;
+
+ _create_accessor(
+ type => 'simple',
+ accessor => $accessor,
+ %arg,
+ );
+ }
+
+ my $complexes = $arg{complex};
+
+ for my $prop ( @$complexes ) {
+ my $setters = $prop->{setter} || $prop->{accessor};
+
+ $setters = [ $setters ] unless 'ARRAY' eq ref $setters;
+
+ for my $specific ( @$setters ) {
+ _create_accessor(
+ type => 'complex',
+ accessor => $specific,
+ fallback => $prop->{fallback},
+ %arg,
+ );
+ }
+ }
+}
+
+# This is a convenience shortcut, too, as I always forget if
+# the sub name is singular or plural...
+*mk_accessor = *mk_accessors;
+
+############## PRIVATE METHODS BELOW ##############
+
+### PRIVATE PACKAGE SUBROUTINE ###
+#
+# Create an accessor
+#
+
+sub _create_accessor {
+ my (%arg) = @_;
+
+ my $class = $arg{class};
+ my $overwrite = $arg{overwrite};
+ my $ignore = $arg{ignore};
+ my $type = $arg{type};
+ my $accessor = $arg{accessor};
+ my $fallback = $arg{fallback};
+
+ return unless defined $accessor;
+
+ if ( $class->can($accessor) ) {
+ croak "Accessor $accessor already exists in class $class"
+ if !$overwrite && !$ignore;
+
+ return if $ignore && !$overwrite;
+ }
+
+ my $accessor_fn = $type eq 'complex' ? _complex($accessor, $fallback)
+ : _simplex($accessor)
+ ;
+ my $predicate_fn = _predicate($accessor);
+
+ eval "package $class; no warnings 'redefine'; " .
+ "$accessor_fn; $predicate_fn; 1";
+}
+
+### PRIVATE PACKAGE SUBROUTINE ###
+#
+# Return the text for a predicate method
+#
+
+sub _predicate {
+ my ($prop) = @_;
+
+ return "
+ sub has_$prop {
+ my \$self = shift;
+
+ return exists \$self->{$prop};
+ }
+ ";
+}
+
+### PRIVATE PACKAGE SUBROUTINE ###
+#
+# Return the text for a simple accessor method that acts as both getter
+# when there are no arguments passed to it, and as a setter when there is
+# at least one argument.
+# When used as a setter, only the first argument will be assigned
+# to the object property, the rest will be ignored.
+#
+
+sub _simplex {
+ my ($prop) = @_;
+
+ return "
+ sub $prop {
+ my \$self = shift;
+
+ if ( \@_ ) {
+ \$self->{$prop} = shift;
+ return \$self;
+ }
+ else {
+ return \$self->{$prop};
+ }
+ }
+ ";
+}
+
+### PRIVATE PACKAGE SUBROUTINE ###
+#
+# Return an accessor that will query the 'specific' object property
+# first and return it if it's defined, falling back to the 'fallback'
+# property getter otherwise when called with no arguments.
+# Setter will set the 'specific' property for the object when called
+# with one argument.
+#
+
+sub _complex {
+ my ($specific, $fallback) = @_;
+
+ return "
+ sub $specific {
+ my \$self = shift;
+
+ if ( \@_ ) {
+ \$self->{$specific} = shift;
+ return \$self;
+ }
+ else {
+ return exists \$self->{$specific}
+ ? \$self->{$specific}
+ : \$self->$fallback()
+ ;
+ }
+ }
+ ";
+}
+
+1;
@@ -0,0 +1,275 @@
+package RPC::ExtDirect::Util;
+
+use strict;
+use warnings;
+no warnings 'uninitialized'; ## no critic
+
+use Carp;
+
+use base 'Exporter';
+
+our @EXPORT_OK = qw/
+ clean_error_message
+ get_caller_info
+ parse_global_flags
+/;
+
+### EXPORTED PUBLIC PACKAGE SUBROUTINE ###
+#
+# Clean croak() and die() messages of file/line information
+#
+
+sub clean_error_message {
+ my ($msg) = @_;
+
+ $msg =~ s/
+ (?<![,]) \s
+ at
+ .*?
+ line \s \d+(, \s <DATA> \s line \s \d+)? \.? \n*
+ (?:\s*eval \s {...} \s called \s at \s .*? line \s \d+ \n*)?
+ //msx;
+
+ return $msg;
+}
+
+### EXPORTED PUBLIC PACKAGE SUBROUTINE ###
+#
+# Return formatted call stack part to use in exceptions
+#
+
+sub get_caller_info {
+ my ($depth) = @_;
+
+ my ($package, $sub) = (caller $depth)[3] =~ / \A (.*) :: (.*?) \z /xms;
+
+ return $package . '->' . $sub;
+}
+
+### EXPORTED PUBLIC PACKAGE SUBROUTINE ###
+#
+# Fetch the values of the (deprecated) global flags into an object,
+# giving a warning when they're used
+#
+
+sub parse_global_flags {
+ my ($flags, $obj) = @_;
+
+ my $caller_pkg = caller;
+
+ for my $flag ( @$flags ) {
+ my $package = $flag->{package};
+ my $var = $flag->{var};
+ my $type = $flag->{type};
+ my $fields = $flag->{setter};
+ my $default = $flag->{default};
+
+ my $have_default = exists $flag->{default};
+ my $full_var = $package . '::' . $var;
+
+ my ($value, $have_value);
+
+ {
+ no strict 'refs';
+ no warnings 'once';
+
+ if ( $type eq 'scalar' ) {
+ $have_value = defined ${ $full_var };
+ $value = $have_value ? ${ $full_var } : $default;
+ }
+ elsif ( $type eq 'hash' ) {
+ $have_value = %{ $full_var };
+ $value = $have_value ? { %{ $full_var } }
+ : 'HASH' eq ref $default ? { %$default }
+ : undef
+ ;
+ }
+ elsif ( $type eq 'array' ) {
+ $have_value = @{ $full_var };
+ $value = $have_value ? [ @{ $full_var } ]
+ : 'ARRAY' eq ref $default ? [ @$default ]
+ : undef
+ ;
+ }
+ else {
+ die "Unknown global variable type: '$type'"; # Debug mostly
+ }
+ }
+
+ if ( $have_value ) {
+ my $warning = <<"END";
+
+The package global variable $full_var is deprecated
+and is going to be removed in the next RPC::ExtDirect version.
+END
+
+ if ( 'ARRAY' eq ref $fields ) {
+
+ my $tpl = <<"END";
+Use $caller_pkg instance with the following config options instead:
+%s
+
+ my \$config = $caller_pkg->new(
+%s
+ );
+
+END
+ my $w1 = join ', ', map { "`$_`" } @$fields;
+ my $w2 = join "\n", map { "\t\t$_ => ..." } @$fields;
+
+ $warning .= sprintf $tpl, $w1, $w2;
+ }
+ else {
+ $warning .= <<"END";
+Use the `$fields` config option with the $caller_pkg
+instance instead:
+
+ my \$config = $caller_pkg->new(
+ $fields => ...
+ );
+
+END
+ }
+
+ warn $warning;
+ }
+
+ croak "Can't resolve the field name for var $full_var"
+ unless $fields;
+
+ $fields = [ $fields ] unless 'ARRAY' eq ref $fields;
+
+ for my $field ( @$fields ) {
+ my $predicate = "has_$field";
+
+ $obj->$field($value)
+ if $have_value || ($have_default && !$obj->$predicate());
+ }
+ }
+}
+
+### NON-EXPORTED PUBLIC PACKAGE SUBROUTINE ###
+#
+# Parse ExtDirect attribute, perform sanity checks and return
+# the attribute hashref
+#
+
+sub parse_attribute {
+ my ($package, $symbol, $referent, $attr, $data, $phase, $file, $line)
+ = @_;
+
+ croak "Method attribute is not ExtDirect at $file line $line"
+ unless $attr eq 'ExtDirect';
+
+ # Attribute::Handlers automagically parses the data into arrayref
+ # *if* it is parseable Perl (which it should be). If not, the data
+ # is going to be a garbled string which is kaput for us. However,
+ # an *empty* string means the bare attribute was used with no
+ # parameters, which is strange but is not an error.
+ croak "Malformed ExtDirect attribute '$data' at $file line $line"
+ if $data ne '' && 'ARRAY' ne ref $data;
+
+ my $symbol_name = eval { no strict 'refs'; *{$symbol}{NAME} };
+ croak "Can't resolve symbol '$symbol' for package '$package' ".
+ "at $file line $line: $@"
+ if $@;
+
+ # Attribute may be empty, means no argument checking
+ $data ||= [];
+
+ # Calling convention attributes are mutually exclusive
+ my @calling_convention;
+
+ my %attr;
+
+ # Compatibility form (n, ...), where n stands for (len => n)
+ if ( $data->[0] =~ / \A \d+ \z /xms ) {
+ $attr{len} = shift @$data;
+ push @calling_convention, 'len';
+ }
+
+ while ( @$data ) {
+ my $param_def = shift @$data;
+
+ # len means ordered (by position) arguments
+ if ( $param_def =~ / \A len \z /xms ) {
+ $attr{len} = shift @$data;
+
+ croak "ExtDirect attribute 'len' should be followed ".
+ "by a number of ordered arguments at file $file ".
+ "line $line"
+ unless $attr{len} =~ / \A \d+ \z /xms;
+
+ push @calling_convention, 'len';
+ }
+
+ # formHandler means exactly that, a handler for form requests
+ elsif ( $param_def =~ / \A formHandler \z /xms ) {
+ $attr{formHandler} = 1;
+ push @calling_convention, 'formHandler';
+ }
+
+ # pollHandlers are used with EventProvider
+ elsif ( $param_def =~ / \A pollHandler \z /xms ) {
+ $attr{pollHandler} = 1;
+ push @calling_convention, 'pollHandler';
+ }
+
+ # named arguments for the method
+ elsif ( $param_def =~ / \A params \z /ixms ) {
+ my $arg_names = shift @$data;
+
+ croak "ExtDirect attribute 'params' must be followed by ".
+ "arrayref containing at least one parameter name ".
+ "at $file line $line"
+ if ref $arg_names ne 'ARRAY' || @$arg_names < 1;
+
+ # Copy the names
+ $attr{params} = [ @{ $arg_names } ];
+
+ push @calling_convention, 'params';
+ }
+
+ # Hooks
+ elsif ( $param_def =~ / \A (before|instead|after) \z /ixms ) {
+ my $type = $1;
+ my $code = shift @$data;
+
+ croak "ExtDirect attribute '$type' must be followed by coderef, ".
+ "undef, or 'NONE' at $file line $line"
+ if defined $code && $code ne 'NONE' && 'CODE' ne ref $code;
+
+ $attr{ $type } = $code;
+ }
+
+ # Strict is a boolean attribute, but let's be flexible about it
+ elsif ( $param_def =~ / \A strict \z /ixms ) {
+ $attr{strict} = !!(shift @$data);
+ }
+
+ # Assume a generic foo => 'bar' attribute and fall through
+ else {
+ $attr{ $param_def } = shift @$data;
+ }
+
+ # There should be at most one calling convention attribute defined,
+ # but we don't care how many exactly if more than one
+ croak sprintf "ExtDirect attributes '%s' and '%s' are ".
+ "mutually exclusive at file $file line $line",
+ @calling_convention
+ if @calling_convention > 1;
+ };
+
+ # strict should only be defined for named methods
+ croak "ExtDirect attribute 'strict' should be used with 'params' ".
+ "for named Methods at file $file line $line"
+ if exists $attr{strict} && !defined $attr{params};
+
+ return {
+ package => $package,
+ method => $symbol_name,
+ %attr,
+ };
+}
+
+1;
@@ -1,9 +1,5 @@
package RPC::ExtDirect;
-use 5.006;
-
-# ABSTRACT: Ext.Direct implementation for Perl
-
use strict;
use warnings;
no warnings 'uninitialized'; ## no critic
@@ -11,244 +7,174 @@ no warnings 'uninitialized'; ## no critic
use Carp;
use Attribute::Handlers;
+use RPC::ExtDirect::API;
+use RPC::ExtDirect::Util;
+
### PACKAGE VARIABLE ###
#
-# Version of this module.
+# Version of this module. This should be kept as a string
+# because otherwise 'make dist' strips "insignificant" digits
+# at the end.
#
-our $VERSION = '2.15';
+our $VERSION = '3.01';
### PACKAGE GLOBAL VARIABLE ###
#
# Debugging; defaults to off.
#
-
-our $DEBUG = 0;
-
-### PACKAGE PRIVATE VARIABLE ###
-#
-# Holds Action names for corresponding Packages
-#
-
-my %ACTION_NAME_FOR = ();
-
-### PACKAGE PRIVATE VARIABLE ###
-#
-# Contains attribute definitions for methods published via ExtDirect
-# interface.
-#
-
-my %PARAMETERS_FOR = ();
-
-### PACKAGE PRIVATE VARIABLE ###
-#
-# Contains poll handler method names in order that they were defined
-#
-
-my @POLL_HANDLERS = ();
-
-### PACKAGE PRIVATE VARIABLE ###
-#
-# Holds hook definitions. It has to be stored separately from
-# method definitions because global scope hooks can be added
-# *after* package attributes are processed.
-#
-
-my %HOOK_FOR = ();
-
-### PUBLIC ATTRIBUTE DEFINITION ###
-#
-# Defines ExtDirect attribute subroutine and exports it into UNIVERSAL
-# namespace.
+# DEPRECATED. Use `debug` Config option instead.
#
-# This here is to choose proper function declaration for Perl we're running
-use if !$^V || $^V lt v5.12.0, 'RPC::ExtDirect::CHECK';
-use if $^V && $^V ge v5.12.0, 'RPC::ExtDirect::BEGIN';
-
-sub extdirect {
- my ($package, $symbol, $referent, $attr, $data, $phase, $file, $line)
- = @_;
-
- croak "Method attribute is not ExtDirect at $file line $line"
- unless $attr eq 'ExtDirect';
-
- my $symbol_name = eval { no strict 'refs'; *{$symbol}{NAME} };
- croak "Can't resolve symbol '$symbol' for package '$package' ".
- "at $file line $line: $@"
- if $@;
-
- # These parameters depend on attribute input
- my $param_no = undef;
- my $param_names = undef;
- my $formHandler = 0;
- my $pollHandler = 0;
- my %hooks = ();
- $data = $data || [];
-
- while ( @$data ) {
- my $param_def = shift @$data;
-
- # Digits means number of unnamed arguments
- if ( $param_def =~ / \A (\d+) \z /xms ) {
- $param_no = $1;
- }
-
- # formHandler means exactly that, a handler for form requests
- elsif ( $param_def =~ / \A formHandler \z /xms ) {
- $formHandler = 1;
- }
-
- # pollHandlers are a bit tricky but are defined here anyway
- elsif ( $param_def =~ / \A pollHandler \z /xms ) {
- $pollHandler = 1;
- }
-
- elsif ( $param_def =~ / \A params \z /ixms ) {
- my $arg_names = shift @$data;
+our $DEBUG;
- croak "ExtDirect attribute 'params' must be followed by ".
- "arrayref containing at least one parameter name ".
- "at $file line $line"
- if ref $arg_names ne 'ARRAY' || @$arg_names < 1;
-
- # Copy the names
- $param_names = [ @{ $arg_names } ];
- }
-
- # Hooks
- elsif ( $param_def =~ / \A (before|instead|after) \z /ixms ) {
- my $type = $1;
- my $code = shift @$data;
-
- croak "ExtDirect attribute '$type' must be followed by coderef ".
- "or 'NONE' at $file line $line"
- if $code ne 'NONE' && 'CODE' ne ref $code;
-
- $hooks{ $type } = {
- package => $package,
- method => $symbol_name,
- type => $type,
- code => $code,
- };
- };
- };
-
- my $attribute_ref = {
- package => $package,
- method => $symbol_name,
- referent => $referent,
- param_no => $param_no,
- param_names => $param_names,
- formHandler => $formHandler,
- pollHandler => $pollHandler,
- };
-
- @$attribute_ref{ keys %hooks } = values %hooks;
-
- RPC::ExtDirect->add_method($attribute_ref);
+# This is a bit hacky, but we've got to keep a reference to the API object
+# so that *compilation time* attributes would work as expected,
+# as well as the configuration options for the RPC::ExtDirect::API class.
+{
+ my $api = RPC::ExtDirect::API->new();
+
+ ### PUBLIC CLASS METHOD ###
+ #
+ # Return the global API instance
+ #
+
+ sub get_api { $api }
}
+
### PUBLIC PACKAGE SUBROUTINE ###
#
-# Provides facility to assign package-level (action) properties.
-# Despite its name, does not import anything in caller package
+# Provides a facility to assign package-level (action) properties.
+# Despite its name, does not import anything to the caller package's
+# namespace.
#
sub import {
- my ($class, @params) = @_;
+ my ($class, @args) = @_;
# Nothing to do
- return unless @params;
+ return unless @args;
# Only hash-like arguments are supported
- croak "Odd number of parameters in RPC::ExtDirect::import()"
- unless (@params % 2) == 0;
+ croak "Odd number of arguments in RPC::ExtDirect::import()"
+ unless (@args % 2) == 0;
- my %param = @params;
- %param = map { lc $_ => delete $param{ $_ } } keys %param;
+ my %arg = @args;
+ %arg = map { lc $_ => delete $arg{ $_ } } keys %arg;
my ($package, $filename, $line) = caller();
+
+ my $api = $class->get_api;
# Store Action (class) name as an alias for a package
- if ( exists $param{action} or exists $param{class} ) {
- my $alias = defined $param{action} ? $param{action} : $param{class};
-
- RPC::ExtDirect->add_action($package, $alias);
- };
+ my $action_name = defined $arg{action} ? $arg{action}
+ : defined $arg{class} ? $arg{class}
+ : undef
+ ;
+
+ # We don't want to overwrite the existing Action, if any
+ $api->add_action(
+ package => $package,
+ action => $action_name,
+ no_overwrite => 1,
+ );
# Store package level hooks
- for my $type ( qw/ before instead after / ) {
- my $code = $param{ $type };
+ for my $type ( $api->HOOK_TYPES ) {
+ my $code = $arg{ $type };
- $class->add_hook( package => $package, type => $type, code => $code )
- if $code;
+ $api->add_hook( package => $package, type => $type, code => $code )
+ if defined $code;
};
}
-### PUBLIC CLASS METHOD ###
+### PUBLIC ATTRIBUTE DEFINITION ###
#
-# Add a hook to global hash
+# Define ExtDirect attribute subroutine and export it into UNIVERSAL
+# namespace. Attribute processing phase depends on the perl version
+# we're running under.
#
-sub add_hook {
- my ($class, %params) = @_;
+{
+ my $phase = $] >= 5.012 ? 'BEGIN' : 'CHECK';
+ my $pkg = __PACKAGE__;
+
+ eval <<END;
+ sub UNIVERSAL::ExtDirect : ATTR(CODE,$phase) {
+ my \$attr = RPC::ExtDirect::Util::parse_attribute(\@_);
+
+ ${pkg}->add_method(\$attr);
+ }
+END
+}
- my $package = $params{package};
- my $method = $params{method};
- my $type = $params{type};
- my $code = $params{code};
+### PUBLIC CLASS METHOD ###
+#
+# Add a hook to the global API
+#
+# DEPRECATED. See RPC::ExtDirect::API for replacement.
+#
- my $hook_key = $method ? $package . '::' . $method . '::' . $type
- : $package ? $package . '::' . 'global' . '::' . $type
- : 'global' . '::' . $type
- ;
+sub add_hook {
+ my ($class, %arg) = @_;
- $HOOK_FOR{ $hook_key } = $code;
+ my $api = $class->get_api();
+
+ $api->add_hook(%arg);
- return $code;
+ return $arg{code};
}
### PUBLIC CLASS METHOD ###
#
# Return hook coderef by package and method, with hierarchical lookup.
#
+# DEPRECATED. See RPC::ExtDirect::API for replacement.
+#
sub get_hook {
- my ($class, %params) = @_;
-
- my $package = $params{package};
- my $method = $params{method};
- my $type = $params{type};
-
- my $code = $HOOK_FOR{ $package . '::' . $method . '::' . $type }
- || $HOOK_FOR{ $package . '::' . 'global' . '::' . $type }
- || $HOOK_FOR{ 'global' . '::' . $type }
- ;
+ my ($class, %arg) = @_;
- return $code eq 'NONE' ? undef : $code;
+ my $api = $class->get_api();
+ my $hook = $api->get_hook(%arg);
+
+ return $hook ? $hook->code : undef;
}
### PUBLIC CLASS METHOD ###
#
# Adds Action name as an alias for a package
#
+# DEPRECATED. See RPC::ExtDirect::API for replacement.
+#
sub add_action {
my ($class, $package, $action_for_pkg) = @_;
-
- $ACTION_NAME_FOR{ $package } = $action_for_pkg;
+
+ my $api = $class->get_api();
+
+ return $api->add_action(
+ package => $package,
+ action => $action_for_pkg,
+ );
}
### PUBLIC CLASS METHOD ###
#
# Returns the list of Actions that have ExtDirect methods
#
+# DEPRECATED. See RPC::ExtDirect::API for replacement.
+#
sub get_action_list {
- my %action = map { / \A (.*) :: /xms; $1 => 1 }
- keys %PARAMETERS_FOR;
- return sort keys %action; ## no critic
+ my ($class) = @_;
+
+ my $api = $class->get_api();
+
+ my @actions = sort $api->actions();
+
+ return @actions;
}
### PUBLIC CLASS METHOD ###
@@ -256,85 +182,73 @@ sub get_action_list {
# Returns the list of poll handler methods as list of
# arrayrefs: [ $action, $method ]
#
+# DEPRECATED. See RPC::ExtDirect::API for replacement.
+#
sub get_poll_handlers {
- return map { / \A (.*) :: (.*) /xms; [ $1 => $2 ] } @POLL_HANDLERS;
+ my ($class) = @_;
+
+ my $api = $class->get_api();
+ my @actions = $class->get_api->actions;
+ my @handlers;
+
+ for my $name ( @actions ) {
+ my $action = $api->get_action_by_name($name);
+ my @methods = $action->polling_methods;
+
+ push @handlers, [ $name, $_ ] for @methods;
+ }
+
+ return @handlers;
}
### PUBLIC CLASS METHOD ###
#
-# Adds a method to internal storage
+# Adds a method to the global API
+#
+# DEPRECATED. See RPC::ExtDirect::API for replacement.
#
sub add_method {
my ($class, $attribute_ref) = @_;
-
- # Unpack for clarity
- my $package = $attribute_ref->{package};
- my $method = $attribute_ref->{method };
-
- # If Action alias is not defined, use last chunk of the package name
- my $action
- = exists $ACTION_NAME_FOR{ $package } ? $ACTION_NAME_FOR{ $package }
- : _strip_name( $package )
- ;
-
- # Methods are addressed by qualified names
- my $qualified_name = $action .'::'. $method;
-
- # Make a copy of the hashref
- my $attribute_def = {};
- @$attribute_def{ keys %$attribute_ref } = values %$attribute_ref;
-
- #
- # Our internal variable specifying the number of ordered arguments
- # is called param_no, but in JavaScript API definition it's called
- # len; it is very easy to make a mistake when adding methods
- # directly (not via ExtDirect attribute) so we better accommodate
- # for that.
- #
- $attribute_def->{param_no} = delete $attribute_def->{len}
- if exists $attribute_def->{len} and not
- exists $attribute_def->{param_no};
-
- # The same as above goes for param_names (params in JS)
- $attribute_def->{param_names} = delete $attribute_def->{params}
- if exists $attribute_def->{params} and not
- exists $attribute_def->{param_names};
- # Go over the hooks and add them
- for my $hook_type ( qw/ before instead after / ) {
- next unless my $hook = $attribute_def->{$hook_type};
-
- $attribute_def->{$hook_type} = $class->add_hook(%$hook);
- }
-
- $PARAMETERS_FOR{ $qualified_name } = $attribute_def;
-
- # We use the array to keep track of the order
- push @POLL_HANDLERS, $qualified_name
- if $attribute_def->{pollHandler};
+ my $api = $class->get_api;
+
+ return $api->add_method( %$attribute_ref );
}
### PUBLIC CLASS METHOD ###
#
-# Returns the list of method names with ExtDirect attribute for $action
+# Returns the list of method names with ExtDirect attribute
+# for $action_name, or all methods for all actions if $action_name
+# is empty
+#
+# DEPRECATED. See RPC::ExtDirect::API for replacement.
#
sub get_method_list {
- my ($class, $action) = @_;
-
- # Action and method names are keys of %PARAMETERS_FOR
- my @keys = sort keys %PARAMETERS_FOR;
+ my ($class, $action_name) = @_;
+
+ my $api = $class->get_api;
+
+ my @actions = $action_name ? ( $action_name ) : $api->actions;
my @list;
- if ( $action ) {
- @list = grep { / \A $action :: /xms } @keys;
- s/ \A $action :: //msx for @list;
+
+ for my $name ( @actions ) {
+ my $action = $api->get_action_by_name($name);
+
+ # The output of this method is inconsistent:
+ # when called with $action_name it returns the list of
+ # method names; when it is called with empty @_
+ # it returns the list of Action::method pairs.
+ # I don't remember what was the original intent here but
+ # we've got to keep up compatibility. The whole method is
+ # deprecated anyway...
+ my $tpl = $action_name ? "" : $name.'::';
+
+ push @list, map { $tpl.$_ } $action->methods;
}
- else {
- @list = @keys;
- };
-
+
return wantarray ? @list : shift @list;
}
@@ -346,717 +260,28 @@ sub get_method_list {
# Returns full attribute hash in list context.
# Croaks if called in scalar context.
#
-
-sub get_method_parameters {
- my ($class, $action, $method) = @_;
-
- croak "Wrong context" unless wantarray;
-
- croak "ExtDirect action name is required" unless defined $action;
- croak "ExtDirect method name is required" unless defined $method;
-
- # Retrieve properties
- my $attribute_ref = $PARAMETERS_FOR{ $action .'::'. $method };
-
- croak "Can't find ExtDirect properties for method $method"
- unless $attribute_ref;
-
- return %$attribute_ref;
-}
-
-############## PRIVATE METHODS BELOW ##############
-
-### PRIVATE PACKAGE SUBROUTINE ###
-#
-# Strip all but the last :: chunk from package name
+# DEPRECATED. See RPC::ExtDirect::API for replacement.
#
-sub _strip_name {
- my ($name) = @_;
-
- $name =~ s/ \A .* :: //xms;
-
- return $name;
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-RPC::ExtDirect - Expose Perl code to Ext JS RIA applications through Ext.Direct remoting
-
-=head1 SYNOPSIS
-
- package Foo::Bar;
-
- use RPC::ExtDirect Action => 'Fubar',
- before => \&package_before_hook,
- after => \&package_after_hook,
- ;
-
- sub foo_custom_hook {
- # Check something, return true
- return 1;
- }
-
- sub foo : ExtDirect(2, before => \&foo_custom_hook) {
- my ($class, $arg1, $arg2) = @_;
-
- # do something, store results in scalar
- my $result = ...;
-
- return $result;
- }
-
- # This method doesn't need hooks for some reason
- sub bar
- : ExtDirect(
- params => ['foo', 'bar'], before => 'NONE', after => 'NONE',
- )
- {
- my ($class, %arg) = @_;
-
- my $foo = $arg{foo};
- my $bar = $arg{bar};
-
- # do something, returning scalar
- my $result = eval { ... };
-
- # or throw an exception if something's wrong
- die "Houston, we've got a problem: $@\n" if $@;
-
- return $result;
- }
-
- sub baz : ExtDirect(formHandler) {
- my ($class, %arg) = @_;
-
- my @form_fields = grep { !/^file_uploads$/ } keys %arg;
- my @uploaded_files = @{ $arg{file_uploads} };
-
- # do something with form fields and files
- my $result = { ... };
-
- return $result;
- }
-
- sub package_before_hook {
- my ($class, %params) = @_;
-
- # Unpack parameters
- my ($method, $env) = @params{ qw/method _env/ };
-
- # Decide if user is authorized to call this method
- my $authorized = check_authorization($method, $env);
-
- # Positive
- return 1 if $authorized;
-
- # Negative, return error string
- return 'Not authorized';
- }
-
- sub package_after_hook {
- my ($class, %params) = @_;
-
- # Unpack parameters
- my ($method, $result, $ex) = @params{ qw/method result exception/ };
-
- # Log the action
- security_audit_log($method, $result, $ex);
- }
-
-=head1 DESCRIPTION
-
-=head2 Abstract
-
-This module provides an easy way to map Perl code to Ext.Direct RPC
-interface used with Ext JS JavaScript framework.
-
-=head2 What Ext.Direct is for?
-
-Ext.Direct is a high level RPC protocol that allows easy and fast
-integration of server components with JavaScript interface. Client side
-stack is built in Ext JS core and is used by many components like data Stores,
-Forms, Grids, Charts, etc. Ext.Direct supports request batching, file uploads,
-event polling and many other features.
-
-Besides simplicity and ease of use, Ext.Direct allows to achieve very clean
-code and issue separation both on server and client sides, which in turn
-results in simplified code, greater overall software quality and shorter
-development times.
-
-From Perl module developer perspective, Ext.Direct is just a method
-attribute; it doesn't matter if it's called from Perl code or through
-Ext.Direct. This approach, in particular, allows for multi-tiered testing:
-
-=over 4
-
-=item *
-
-Server side methods can be tested without setting up HTTP environment
-with the usual tools like Test::More
-
-=item *
-
-Server side classes can be tested as a whole via Ext.Direct calls
-using Perl client
-
-=item *
-
-Major application components are tested with browser automation tools
-like Selenium.
-
-=back
-
-For more information on Ext.Direct, see
-L<http://www.sencha.com/products/extjs/extdirect/>.
-
-=head2 Terminology
-
-Ext.Direct uses the following terms, followed by their descriptions:
-
-=over 4
-
-=item Configuration
-
-Description of server side calls exposed to client side. Includes
-information on Action and Method names, as well as argument number
-and/or names
-
-=item API
-
-JavaScript chunk that encodes Configuration. Usually generated
-by application server and retrieved by client once upon startup.
-Another option is to embed API declaration in client side application
-code.
-
-=item Router
-
-Server side component that receives remoting calls, dispatches requests,
-collects and returns call Results or Exceptions.
-
-=item Action
-
-Namespace unit; collection of Methods. The nearest Perl analog is package,
-other languages may call it a Class. Since the actual calling code is
-JavaScript, Action names should conform to JavaScript naming rules
-(i.e. no '::', use dots instead).
-
-=item Method
-
-Subroutine exposed through Ext.Direct API to be called by client side.
-Method is fully qualified by Action and Method names using dot as
-delimiter: Action.Method.
-
-=item Result
-
-Any data returned by Method upon successful or unsuccessful call completion.
-This includes application logic errors. 'Not authenticated' and alike events
-should be returned as Results, not Exceptions.
-
-=item Exception
-
-Fatal error, or any other unrecoverable event in application code. Calls
-that produce Exception instead of Result are considered unsuccessful;
-Ext.Direct provides built in mechanism for managing Exceptions.
-
-Exceptions are not used to indicate errors in application logic flow,
-only for catastrophic conditions. Nearest analog is status code 500
-for HTTP responses.
-
-Examples of Exceptions are: request JSON is broken and can't be decoded;
-called Method dies because of internall error; Result cannot be encoded
-in JSON, etc.
-
-=item Event
-
-An asynchronous notification that can be generated by server side and
-passed to client side, resulting in some reaction. Events are useful
-for status updates, progress indicators and other predictably occuring
-conditions and events.
-
-=item Event Provider
-
-Server side script that gets polled by client side every N seconds;
-default N is 3 but it can be changed in client side configuration.
-
-=back
-
-=head1 USING RPC::EXTDIRECT
-
-In order to export subroutine to ExtDirect interface, use C<ExtDirect(n, ...)>
-attribute in sub declaration. Note that there can be no space between
-attribute name and opening parentheses. In Perls older than 5.12, attribute
-declaration can't span multiple lines, i.e. the whole C<ExtDirect(n, ...)>
-should fit in one line.
-
-n is mandatory calling convention declaration; it may be one of the following
-options:
-
-=over 4
-
-=item *
-
-Number of arguments to be passed as ordered list
-
-=item *
-
-Names of arguments to be passed as hash
-
-=item *
-
-formHandler: method will receive hash of fields and file uploads
-
-=item *
-
-pollHandler: method that provides Events when polled by client
-
-=back
-
-Optional method attributes can be specified after calling convention
-declaration, in hash-like C<key =E<gt> value> form. Optional attributes
-are:
-
-=over 4
-
-=item *
-
-before: code reference to use as "before" hook. See L</HOOKS>
-
-=item *
-
-instead: code reference to "instead" hook
-
-=item *
-
-after: code reference to "after" hook.
-
-=back
-
-=head1 METHODS
-
-Unlike Ext.Direct specification (and reference PHP implementation, too)
-RPC::ExtDirect does not impose strict architectural notation on server
-side code. There is no mandatory object instantiation and no assumption
-about the code called. That said, an RPC::ExtDirect Method should conform
-to the following conventions:
-
-=over 4
-
-=item *
-
-Be a class method, i.e. be aware that its first argument will be package name.
-Just ignore it if you don't want it.
-
-=item *
-
-Ordered (numbered) arguments are passed as list in @_, so $_[1] is the first
-argument. No more than number of arguments declared in ExtDirect attribute
-will be passed to Method; any extra will be dropped silently. Less actual
-arguments than declared will result in Exception returned to client side,
-and Method never gets called.
-
-The last argument is an environment object (see L<ENVIRONMENT OBJECTS>).
-For methods that take 0 arguments, it will be the first argument after
-class name.
-
-=item *
-
-Named arguments are passed as hash in @_. No arguments other than declared
-will be passed to Method; extra arguments will be dropped silently. If not
-all arguments are present in actual call, an Exception will be returned and
-Method never gets called.
-
-Environment object will be passed in '_env' key.
-
-=item *
-
-Form handlers are passed their arguments as hash in @_. Standard Ext.Direct
-form fields are removed from argument hash; uploaded file(s) will be passed
-in file_uploads hash element. It will only be present when there are uploaded
-files. For more info, see L</UPLOADS>.
-
-Environment object will be passed in '_env' key.
-
-=item *
-
-All remoting Methods are called in scalar context. Returning one scalar value
-is OK; returning array- or hashref is OK too.
-
-Do not return blessed objects; it is almost always not obvious how to
-serialize them into JSON that is expected by
-client side; JSON encoder will choke and an Exception will
-be returned to the client.
-
-=item *
-
-If an error is encountered while processing request, throw
-an exception: die "My error string\n". Note that "\n" at
-the end of error string; if you don't add it, die() will
-append file name and line number to the error message;
-which is probably not the best idea for errors that are not
-shown in console but rather passed on to JavaScript client.
-
-RPC::ExtDirect will trim that last "\n" for you before
-sending Exception back to client side.
-
-=item *
-
-Poll handler methods are called in list context and do not
-receive any arguments except environment object. Return values
-must be instantiated Event object(s), see L<RPC::ExtDirect::Event>
-for more detail.
-
-=back
-
-=head1 HOOKS
-
-Hooks provide an option to intercept method calls and modify arguments
-passed to the methods, or cancel their execution. Hooks are intended
-to be used as a shim between task-oriented Methods and Web specifics.
-
-Methods should not, to the reasonable extent, be aware of their
-environment or care about it; Hooks are expected to know how to deal with
-Web intricacies but not be task oriented.
-
-The best uses for Hooks are: application or package-wide pre-call setup,
-user authorization, logging, cleanup, testing, etc.
-
-A hook is a Perl subroutine (can be anonymous, too). Hooks can be of three
-types:
-
-=over 4
-
-=item *
-
-"Before" hook is called before the Method, and can be used
-to change Method arguments or cancel Method execution. This
-hook must return numeric value 1 to allow Method call. Any
-other value will be interpreted as Ext.Direct Result; it
-will be returned to client side and Method never gets called.
-
-Note that RPC::ExtDirect will not make any assumptions about
-this hook's return value; returning a false value like '' or 0
-will probably look not too helpful from client side code.
-
-If this hook throws an exception, it is returned as Ext.Direct
-Exception to the client side, and the Method does not execute.
-
-=item *
-
-"Instead" hook replaces the Method it is assigned to. It is
-the hook sub's responsibility to call (or not call) the Method
-and return appropriate Result.
-
-If this hook throws an exception, it is interpreted as if the
-Method trew it.
-
-=item *
-
-"After" hook is called after the Method or "instead" hook. This
-hook cannot affect Method execution, it is intended mostly for
-logging and testing purposes; its input include Method's
-Result or Exception.
-
-This hook's return value and thrown exceptions are ignored.
-
-=back
-
-Hooks can be defined on three levels, in order of precedence: method,
-package and global. For each Method, only one hook of each type can be
-applied. Hooks specified in Method definition take precedence over all
-other; if no method hook is found then package hook applies; and if
-there is no package hook then global hook gets called, if any. To avoid
-using hooks for a particular method, use 'NONE' instead of coderef;
-this way you can specify global and/or package hooks and exclude some
-specific Methods piecemeal.
-
-Hooks are subject to the following calling conventions:
-
-=over 4
-
-=item *
-
-Hook subroutine is called as class method, i.e. first argument
-is name of the package in which this sub was defined. Ignore it
-if you don't need it.
-
-=item *
-
-Hooks receive a hash of the following arguments:
-
-=over 8
-
-=item action
-
-Ext.Direct Action name for the Method
-
-=item method
-
-Ext.Direct Method name
-
-=item package
-
-Name of the package (not Action) where the Method is declared
-
-=item code
-
-Coderef to the Method subroutine
-
-=item param_no
-
-Number of parameters when Method accepts ordered arguments
-
-=item param_names
-
-Arrayref with names of parameters when Method accepts named arguments
-
-=item formHandler
-
-True if Method handles form submits
-
-=item pollHandler
-
-True if Method handles Event poll requests
-
-=item arg
-
-Arrayref with actual arguments when Method
-accepts ordered args, single Environment
-object for poll handlers, hashref otherwise.
-
-Note that this is a direct link to Method's @_
-so it is possible to modify the arguments
-in "before" hook
-
-=item env
-
-Environment object, see below. Like arg,
-this is direct reference to the same object
-that will be passed to Method, so it's
-possible to modify it in "before" hook
-
-=item before
-
-Coderef to "before" hook for that Method, or undef
-
-=item instead
-
-Coderef to "instead" hook for that Method, or undef
-
-=item after
-
-Coderef to "after" hook for that Method, or undef
-
-=item result
-
-For "after" hooks, the Result returned by
-Method or "instead" hook, if any. Does not
-exist for "before" and "instead" hooks
-
-=item exception
-
-For "after" hooks, an exception ($@) thrown
-by Method or "instead" hook, if any. Does
-not exist for "before" and "instead" hooks
-
-=item method_called
-
-For "after" hooks, the reference to actual
-code called as Method, if any. Can be either
-Method itself, "instead" hook or undef if
-the call was canceled.
-
-=item orig
-
-A closure that binds Method coderef to
-its current arguments, allowing to call it
-as easily as $params{orig}->()
-
-=back
-
-=back
-
-=head1 ENVIRONMENT OBJECTS
-
-Since Hooks, and sometimes Methods too, need to be aware of their Web
-environment, it is necessary to give them access to it in some way
-without locking on platform specifics. The answer for this problem is
-environment objects.
-
-An environment object provides platform-agnostic interface for accessing
-HTTP headers, cookies, form fields, etc, by duck typing. Such object is
-guaranteed to have the same set of methods that behave the same way
-across all platforms supported by RPC::ExtDirect, avoiding portability
-issues.
-
-The interface is modeled after de facto standard CGI.pm:
-
-=over 4
-
-=item *
-
-C<$value = $env-E<gt>param('name')> will retrieve parameter by name
-
-=item *
-
-C<@list = $env-E<gt>param()> will get the list of available parameters
-
-=item *
-
-C<$cookie = $env-E<gt>cookie('name')> will retrieve a cookie
-
-=item *
-
-C<@cookies = $env-E<gt>cookie()> will return the list of cookies
-
-=item *
-
-C<$header = $env-E<gt>http('name')> will return HTTP header
-
-=item *
-
-C<@headers = $env-E<gt>http()> will return the list of HTTP headers
-
-=back
-
-Of course it is possible to use environment object in a more sophisticated
-way if you like to, however do not rely on it having a well-known class
-name as it is not guaranteed.
-
-=head1 FILE UPLOADS
-
-Ext.Direct offers native support for file uploading by using temporary
-forms. RPC::ExtDirect supports this feature; upload requests can be
-processed in a formHandler Method. The interface aims to be platform
-agnostic and will try to do its best to provide the same results in all
-HTTP environments supported by RPC::ExtDirect.
-
-In a formHandler Method, arguments are passed as a hash. If one or more
-file uploads were associated with request, the argument hash will contain
-'file_uploads' key with value set to arrayref of file hashrefs. Each file
-hashref will have the following keys:
-
-=over 4
-
-=item type
-
-MIME type of the file
-
-=item size
-
-file size, in octets
-
-=item path
-
-path to temporary file that holds uploaded content
-
-=item handle
-
-opened IO::Handle for temporary file
-
-=item basename
-
-name portion of original file name
-
-=item filename
-
-full original path as sent by client
-
-=back
-
-All files passed to a Method need to be processed in that Method; existence
-of temporary files is not guaranteed after Method returns.
-
-=head1 CAVEATS
-
-In order to keep this module as simple as possible, I had to sacrifice the
-ability to automatically distinguish inherited class methods. In order to
-declare inherited class methods as Ext.Direct exportable you have to override
-them in subclass, like that:
-
- package foo;
- use RPC::ExtDirect;
-
- sub foo_sub : ExtDirect(1) {
- my ($class, $arg) = @_;
-
- # do something
- ...
- }
+sub get_method_parameters {
+ my ($class, $action_name, $method_name) = @_;
- package bar;
- use base 'foo';
+ croak "Wrong context" unless wantarray;
- sub foo_sub : ExtDirect(1) {
- my ($class, $arg) = @_;
+ croak "ExtDirect action name is required" unless defined $action_name;
+ croak "ExtDirect method name is required" unless defined $method_name;
- # call inherited method
- return __PACKAGE__->SUPER::foo_sub($arg);
- }
+ my $action = $class->get_api->get_action_by_name($action_name);
- sub bar_sub : ExtDirect(2) {
- my ($class, $arg1, $arg2) = @_;
+ croak "Can't find ExtDirect action $action"
+ unless $action;
- # do something
- ...
- }
-
-On the other hand if you don't like class-based approach, just don't inherit
-your packages from one another. In any case, declare your Methods explicitly
-every time and there never will be any doubt about what Method gets called in
-any given Action.
-
-=head1 DEPENDENCIES
-
-RPC::ExtDirect is dependent on the following modules: L<Attribute::Handlers>,
-L<"JSON">.
-
-=head1 BUGS AND LIMITATIONS
-
-In version 2.0, ExtDirect attribute was moved to BEGIN phase instead of
-default CHECK phase. While this improves compatibility with
-Apache/mod_perl environments, this also causes backwards compatibility
-problems with Perl older than 5.12. Please let me know if you need to
-run RPC::ExtDirect 2.0 with older Perls; meanwhile RPC::ExtDirect 1.x
-will provide compatibility with Perl 5.6.0 and newer.
-
-There are no known bugs in this module. Please report problems to author,
-patches are welcome.
-
-=head1 SEE ALSO
-
-Alternative Ext.Direct implementations for Perl:
-L<CatalystX::ExtJS::Direct> by Moritz Onken,
-L<http://github.com/scottp/extjs-direct-perl> by Scott Penrose,
-L<Dancer::Plugin::ExtDirect> by Alessandro Ranellucci.
-
-For Web server gateway implementations, see L<CGI::ExtDirect> and
-L<Plack::Middleware::ExtDirect> modules based on RPC::ExtDirect engine.
-
-For configurable Ext.Direct API options, see L<RPC::ExtDirect::API>
-module.
+ my $method = $action->method($method_name);
-=head1 AUTHOR
-
-Alexander Tokarev E<lt>tokarev@cpan.orgE<gt>
-
-=head1 ACKNOWLEDGEMENTS
-
-I would like to thank IntelliSurvey, Inc for sponsoring my work
-on version 2.0 of RPC::ExtDirect suite of modules.
-
-=head1 LICENSE AND COPYRIGHT
-
-Copyright (c) 2011-2012 by Alexander Tokarev.
-
-This module is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself. See L<"perlartistic">.
-
-=cut
+ croak "Can't find ExtDirect properties for method $method_name"
+ unless $method;
+
+ return $method->get_api_definition_compat();
+}
+1;
@@ -0,0 +1,485 @@
+=pod
+
+=begin readme text
+
+RPC::ExtDirect
+==============
+
+=end readme
+
+=for readme stop
+
+=head1 NAME
+
+RPC::ExtDirect - Easily integrate Perl server code with JavaScript apps
+
+=head1 SYNOPSIS
+
+ package Foo::Bar;
+
+ use RPC::ExtDirect Action => 'FooBar';
+
+ sub sum : ExtDirect( len => 2 ) {
+ my ($class, $a, $b) = @_;
+
+ return $a + $b;
+ }
+
+ sub login : ExtDirect( params => [qw/ user pass /] ) {
+ my ($class, %arg) = @_;
+
+ if ( $arg{user} eq 'foo' && $arg{pass} eq 'bar' ) {
+ return {
+ success => \1, # JSON::true
+ };
+ }
+ else {
+ return {
+ success => \0, # JSON::false
+ error => "You shall not pass!"
+ };
+ }
+ }
+
+=head1 DESCRIPTION
+
+=for readme continue
+
+RPC::ExtDirect suite of modules provides an easy, simple and robust way to
+write Perl server side code that could be used with HTML5 Rich Internet
+Applications based on JavaScript frameworks
+L<Ext JS|http://www.sencha.com/products/extjs/> and
+L<Sencha Touch|http://www.sencha.com/products/touch/>.
+
+The suite consists of the core RPC::ExtDirect module that implements Ext.Direct
+protocol and transport layer, several server environment-specific peripheral
+gateways, a standalone pure Perl server, two Perl clients, and even its own
+specialized testing scaffold! We've got it covered front to back. :)
+
+=for readme stop
+
+=head1 INTRODUCTION AND EXAMPLES
+
+If you are not familiar with Ext.Direct, start with L<RPC::ExtDirect::Intro>
+for more explanations and a few examples, both easy and more advanced.
+
+=head1 WHEN TO USE IT, AND WHY
+
+Ext.Direct is a Remote Procedure Call (RPC) protocol provided out of the box
+with JavaScript frameworks by L<Sencha|http://www.sencha.com>. It is deeply
+integrated in the data services, and is supported by a slew of components.
+Besides that, Ext.Direct also has several major advantages over similar
+protocols like XML-RPC and JSON-RPC:
+
+=over 4
+
+=item *
+
+Built in service discovery mechanism: server side API is published to the
+client via GET requests to a preconfigured URI
+
+=item *
+
+Dead simple client side invocation via functional stubs created from the
+API declaration
+
+=item *
+
+Support for request batching with configurable timeout
+
+=item *
+
+Easy file uploads via form submits, with all the complexity handled behind
+the curtains by the framework and the server side stack
+
+=item *
+
+Asynchronous push notifications via event polling
+
+=back
+
+All this makes Ext.Direct a no-brainer when developing Web apps with Ext JS or
+Sencha Touch. And with RPC::ExtDirect, choosing Perl to write server side code
+for Web apps comes naturally, too. :)
+
+=for readme stop
+
+=head1 HOW TO USE
+
+Since Ext.Direct is just a transport layer, you don't need to change your app
+architecture to work around it. If you have an existing server side API you
+can publish it with minimal effort; if you're starting from scratch, add the
+classes and methods as you go.
+
+Note that with Ext.Direct, we're talking about classes and methods - that owes
+to the fact that Ext.Direct originated in Ext JS framework, which itself is
+written in JavaScript with object-oriented approach in mind. This does not mean
+you can't go functional or even procedural with RPC::ExtDirect; it is perfectly
+possible to cook your own flavor of spaghetti code under the light OOP sauce that
+RPC::ExtDirect provides.
+
+In order for a method to be published to the outside world, it needs to be
+declared in the L<Ext.Direct API|RPC::ExtDirect::Intro/API>. As of version 3.0,
+it can be done in two ways: either with C<ExtDirect> attribute as shown in the
+L</SYNOPSIS>, or by including the method in a hashref fed to L<RPC::ExtDirect::API>
+constructor. See L<RPC::ExtDirect::API/"COMPILE VS RUN TIME DEFINITION"> for more
+detail.
+
+=head1 METHODS AND CALLING CONVENTIONS
+
+Unlike Ext.Direct specification (and reference PHP implementation, too)
+RPC::ExtDirect does not impose strict architectural notation on server
+side code. There is no mandatory object instantiation and no assumption
+about the code called. That said, an RPC::ExtDirect Method should conform
+to the following conventions:
+
+=over 4
+
+=item *
+
+Be a class method, i.e. be aware that its first argument will be the package
+(class) name. Just ignore it if you don't want it.
+
+=item *
+
+Ordered (numbered) arguments are passed as list in C<@_>, so C<$_[1]> is
+the first argument. No more than number of arguments declared in the
+L<Method|RPC::ExtDirect::Intro/Method> definition will be passed to the
+Method; any extra will be dropped silently. Less arguments than declared
+will result in an L<Exception|RPC::ExtDirect::Intro/Exception> returned
+to the client side, and Method never gets called.
+
+=item *
+
+Named arguments are passed as a hash in C<@_>. No arguments other than
+declared will be passed to the L<Method|RPC::ExtDirect::Intro/Method>;
+extra arguments will be dropped silently. If not all arguments are
+present for the remoting invocation, an
+L<Exception|RPC::ExtDirect::Intro/Exception> will be returned and the
+Method never gets called.
+
+Starting with Ext JS 4.2.2, it is possble to relax the argument checking
+requirements; see L<RPC::ExtDirect::API/"Lazy parameter checking"> for
+more information.
+
+=item *
+
+Form handlers are passed their arguments as a hash in C<@_>. Standard
+Ext.Direct form field values are removed from the argument hash;
+uploaded file(s) will be passed in the C<file_uploads> hash element.
+It will only be present when there are uploaded files. For more info,
+see L</"FILE UPLOADS">.
+
+Note that any field values in a submitted form will be JSON encoded
+by the client side.
+
+=item *
+
+All remoting Methods are called in scalar context. Returning one scalar
+value is OK; returning array- or hashref is OK too.
+
+Do not return blessed objects; it is almost always not obvious how to
+serialize them into JSON that is expected by the client side. JSON
+encoder will choke and an L<Exception|RPC::ExtDirect::Intro/Exception>
+will be returned to the client. Having said that, if you know what you
+are doing, it is possible to adjust the Serializer's behavior with
+L<RPC::ExtDirect::Config/json_options> Config option.
+
+=item *
+
+If an error is encountered while processing request, throw
+an exception: C<die "My error string\n">. Note that C<"\n"> at
+the end of error string; if you don't add it, C<die()> will
+append file name and line number to the error message
+which is probably not the best idea for errors that are not
+shown in server console but rather passed on to the JavaScript client.
+
+RPC::ExtDirect will trim that last C<"\n"> for you before
+sending the L<Exception|RPC::ExtDirect::Intro/Exception> back to the
+client side.
+
+=item *
+
+Poll handler methods are called in list context and do not
+receive any arguments except an environment object. Return value
+must be a list of instantiated L<Event|RPC::ExtDirect::Intro/Event>
+objects, see L<RPC::ExtDirect::Event> for more detail.
+
+=back
+
+=head1 HOOKS
+
+Hooks provide an option to intercept method calls and modify arguments
+passed to the methods, or cancel their execution. Hooks are intended
+to be used as a shim between task-oriented Methods and Web specifics.
+
+Methods should not, to the reasonable extent, be aware of their
+environment or care about it; Hooks are expected to know how to deal with
+Web intricacies but not be task oriented.
+
+The best uses for Hooks are: application or package-wide pre-call setup,
+user authorization, logging, cleanup, testing, etc. Or you can think of
+the Hooks as poor man's method wrappers without L<Moose's|Moose> power
+(and associated costs).
+
+See more in L<RPC::ExtDirect::API::Hook>.
+
+=head1 ENVIRONMENT OBJECTS
+
+Since Hooks, and sometimes Methods too, need to be aware of their Web
+environment, it is necessary to give them access to it in some way
+without locking in on platform specifics. RPC::ExtDirect's answer to
+this problem is environment objects.
+
+An environment object provides platform-agnostic interface for accessing
+HTTP headers, cookies, form field values, etc. Such object is guaranteed
+to have the same set of methods that behave the same way across all
+platforms supported by RPC::ExtDirect, avoiding portability issues.
+
+The interface is modeled after the de facto standard CGI.pm:
+
+=over 4
+
+=item *
+
+C<$value = $env-E<gt>param('name')> will retrieve a parameter by name
+
+=item *
+
+C<@list = $env-E<gt>param()> will get the list of available parameters
+
+=item *
+
+C<$cookie = $env-E<gt>cookie('name')> will retrieve a cookie
+
+=item *
+
+C<@cookies = $env-E<gt>cookie()> will return the list of cookies
+
+=item *
+
+C<$header = $env-E<gt>http('name')> will return an HTTP header
+
+=item *
+
+C<@headers = $env-E<gt>http()> will return the list of HTTP headers
+
+=back
+
+Of course it is possible to use environment object in a more sophisticated
+way if you like to, however do not rely on it having a well-known class
+name as it is not guaranteed. Environment objects are simple helpers
+held together by duck type.
+
+Starting with RPC::ExtDirect 3.0, only L<Hooks|/HOOKS> will receive
+an environment object by default. For Methods to receive them as well,
+you need to specify a L<RPC::ExtDirect::API::Method/env_arg> parameter
+in Method definition.
+
+=head1 FILE UPLOADS
+
+Ext.Direct offers native support for file uploading by using temporary
+HTML forms. RPC::ExtDirect supports this feature; upload requests can be
+processed in a
+L<Form Handler Method|RPC::ExtDirect::Intro/"Form Handler Method">.
+The interface aims to be platform agnostic and will try to do its best
+to provide the same results in all HTTP environments supported by
+RPC::ExtDirect.
+
+In a Form Handler Method, arguments are passed as a hash. If one or more
+file uploads were associated with request, the argument hash will contain
+a key with value set to arrayref of file hashrefs. The default name for
+this key is C<file_uploads>; this can be configured using
+L<upload_arg|RPC::ExtDirect::API::Method/upload_arg> Method parameter.
+
+Each file hashref will have the following keys:
+
+=over 4
+
+=item C<type>
+
+MIME type of the file, if provided
+
+=item C<size>
+
+File size, in octets
+
+=item C<path>
+
+Path to a temporary file that holds uploaded content
+
+=item C<handle>
+
+Open IO::Handle for the temporary file
+
+=item C<basename>
+
+Name portion of the originally submitted file name, if provided by the
+client side
+
+=item C<filename>
+
+Full original path as sent by the client, if any
+
+=back
+
+All files passed to a Method need to be processed in that Method;
+existence of temporary files is not guaranteed after Method returns.
+
+=head1 GATEWAYS
+
+In RPC::ExtDirect parlance, a Gateway is a module that deals with the
+specifics of a particular Web server environment. At the time of writing
+this documentation, the following gateways are available for
+RPC::ExtDirect:
+
+=over 4
+
+=item CGI gateway
+
+L<CGI::ExtDirect> is used with the ole goode L<CGI> environment; it is
+also compatible with the newer L<CGI::Simple> module that is a drop-in
+replacement for C<CGI.pm>.
+
+This gateway is most often used for testing Ext.Direct interfaces, usually
+with L<Test::ExtDirect> helper module. However, CGI environment is easy
+to use and set up practically anywhere, and it can be used in the variety
+of situations where a full blown Perl application server is not feasible.
+
+One example of such usage would be retrofitting a legacy system with a
+modern HTML5 Web interface.
+
+=item Plack gateway
+
+L<Plack::Middleware::ExtDirect> implements an RPC::ExtDirect interface
+for L<Plack> application server environment. This gateway should also be
+used instead of the L<Apache gateway|/"Apache gateway"> in L<mod_perl>
+environment.
+
+=item AnyEvent::HTTPD gateway
+
+L<AnyEvent::HTTPD::ExtDirect> implements a completely asynchronous
+interface for RPC::ExtDirect, based on L<AnyEvent::HTTPD> module.
+
+=item Apache gateway
+
+L<Apache::ExtDirect> is a legacy gateway for Apache/L<mod_perl>
+environment. Since it was written, Apache has fallen out of usage with
+the author and so the gateway is mostly unsupported. You can use
+L<Plack gateway|/"Plack gateway"> instead, with one of the built in
+Apache/Plack handlers.
+
+=back
+
+=head1 MIGRATING FROM PREVIOUS VERSIONS
+
+If you are using less than current RPC::ExtDirect version, please
+refer to L<RPC::ExtDirect::Migration> document for the notes and
+explanations that might prove useful for migration.
+
+=begin readme
+
+=head1 INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make && make test
+ make install
+
+=end readme
+
+=for readme continue
+
+=head1 DEPENDENCIES
+
+RPC::ExtDirect is dependent on the following modules:
+L<Attribute::Handlers>, L<JSON>.
+
+The oldest Perl version RPC::ExtDirect is routinely tested against
+is 5.6.2.
+
+=for readme stop
+
+=head1 BUGS AND LIMITATIONS
+
+At this time there are no known bugs in this module. Please report
+problems to the author, patches are always welcome.
+
+Use L<Github tracker|https://github.com/nohuhu/RPC-ExtDirect/issues>
+to open bug reports, this is the easiest and quickest way to get your
+issue fixed.
+
+=head1 SEE ALSO
+
+Take a look at these useful modules that are a part of RPC::ExtDirect
+family:
+
+=over 4
+
+=item *
+
+L<RPC::ExtDirect::Server> - a prebuilt Ext.Direct server in Perl, based on
+L<HTTP::Server::Simple>.
+
+=item *
+
+L<RPC::ExtDirect::Client> - a synchronous Ext.Direct client in Perl.
+
+=item *
+
+L<RPC::ExtDirect::Client::Async> - a fully asynchronous Ext.Direct client
+in Perl, with API compatible to L<RPC::ExtDirect::Client>.
+
+=item *
+
+L<Test::ExtDirect> - a set of helper subroutines that make unit testing
+Ext.Direct APIs a breeze.
+
+=back
+
+Also you can find additional information in the following Web site links:
+
+=over 4
+
+=item *
+
+L<Ext JS product website|http://www.sencha.com/products/extjs/>
+
+=item *
+
+L<Sencha Touch product website|http://www.sencha.com/products/touch/>
+
+=item *
+
+L<Ext.Direct specification|http://www.sencha.com/products/extjs/extdirect/>
+
+=item *
+
+L<Ext.Direct support forum|http://www.sencha.com/forum/forumdisplay.php?47>
+
+=item *
+
+L<Ext.Direct plugin for jQuery|https://github.com/ha-sash/jquery-ext-direct-client>
+
+=back
+
+=head1 AUTHOR
+
+Alex Tokarev E<lt>tokarev@cpan.orgE<gt>
+
+=head1 ACKNOWLEDGEMENTS
+
+I would like to thank IntelliSurvey, Inc for sponsoring my work
+on versions 2.x and 3.x of the RPC::ExtDirect suite of modules.
+
+=for readme continue
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2011-2014 by Alex Tokarev.
+
+This module is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself. See L<"perlartistic">.
+
+=cut
@@ -0,0 +1,365 @@
+use strict;
+use warnings;
+
+use Carp;
+use Test::More tests => 70;
+
+use RPC::ExtDirect::Test::Util;
+use RPC::ExtDirect::Util;
+use RPC::ExtDirect::Util::Accessor;
+
+# Simple accessors
+
+package Foo;
+
+sub new {
+ my ($class, %params) = @_;
+
+ return bless {%params}, $class;
+}
+
+sub bleh {
+ return RPC::ExtDirect::Util::get_caller_info($_[1]);
+}
+
+# This one is to test existing sub handling
+sub fred {}
+
+RPC::ExtDirect::Util::Accessor::mk_accessors( simple => ['bar', 'baz'] );
+
+package main;
+
+my $foo = Foo->new( bar => 'baz' );
+
+my $res = eval { $foo->bar() };
+
+is $@, '', "Simple getter didn't die";
+is $res, 'baz', "Simple getter value match";
+
+$res = eval { $foo->has_bar() };
+
+is $@, '', "Simple accessor 1 predicate didn't die";
+is $res, 1, "Simple accessor 1 predicate match";
+
+$res = eval { $foo->has_baz() };
+
+is $@, '', "Simple accessor 2 predicate didn't die";
+is $res, !1, "Simple accessor 2 predicate match";
+
+$res = eval { $foo->bar('qux'); };
+
+is $@, '', "Simple setter didn't die";
+is $res, $foo, "Simple setter return the object";
+is $foo->{bar}, 'qux', "Simple setter value match";
+
+$res = eval { $foo->bar() };
+
+is $res, 'qux', "Simple getter after setter value match";
+
+# Existing methods w/o overwrite
+
+eval {
+ RPC::ExtDirect::Util::Accessor::mk_accessors(
+ class => 'Foo',
+ simple => ['fred'],
+ )
+};
+
+my $regex = qr/^Accessor fred already exists in class Foo/;
+
+like $@, $regex, "Existing method w/o overwrite died";
+
+# Existing methods w/o overwrite but w/ ignore
+
+eval {
+ RPC::ExtDirect::Util::Accessor->mk_accessor(
+ class => 'Foo',
+ simple => 'fred',
+ ignore => 1,
+ )
+};
+
+is $@, '', "Existing method w/o ovr w/ ignore didn't die";
+
+$foo->fred('frob');
+
+is $foo->fred(), undef, "Existing method w/o ovr w/ ignore didn't ovr";
+
+# Existing methods w/ overwrite
+
+eval {
+ RPC::ExtDirect::Util::Accessor->mk_accessors(
+ class => 'Foo',
+ simple => ['fred'],
+ overwrite => 1,
+ );
+};
+
+is $@, '', "Existing method w/ overwrite didn't die";
+
+$foo->fred('blerg');
+
+is $foo->fred(), 'blerg', "Existing method overwritten";
+
+# Complex accessors
+
+package Complex;
+
+our @ISA = qw/ Foo /;
+
+RPC::ExtDirect::Util::Accessor::mk_accessors(
+ complex => [{
+ setter => 'bar_baz',
+ fallback => 'bar',
+ }, {
+ setter => 'baz_baz',
+ fallback => 'bar_baz',
+ }]
+);
+
+package main;
+
+my $baz = Complex->new( bar_baz => 'bleh' );
+
+$res = eval { $baz->bar_baz() };
+
+is $@, '', "Complex getter w/ specific didn't die";
+is $res, 'bleh', "Complex getter w/ specific value match";
+
+$res = eval { $baz->has_bar_baz() };
+
+is $@, '', "Complex accessor 1 predicate didn't die";
+is $res, 1, "Complex accessor 1 predicate match";
+
+$res = eval { $baz->has_baz_baz() };
+
+is $@, '', "Complex accessor 2 predicate didn't die";
+is $res, !1, "Complex accessor 2 predicate match";
+
+$res = eval { $baz->bar_baz('mumble') };
+
+is $@, '', "Complex setter w/ specific didn't die";
+is $res, $baz, "Complex setter w/ specific return the object";
+is $baz->{bar_baz}, 'mumble', "Complex setter w/ specific specific object value";
+is $baz->{bar}, undef, "Complex setter w/ specific default object value";
+
+$baz = Complex->new( bar => 'bloom' );
+
+$res = eval { $baz->bar_baz() };
+
+is $@, '', "Complex getter w/ default didn't die";
+is $res, 'bloom', "Complex getter w/ default value match";
+
+$res = eval { $baz->bar_baz('croffle') };
+
+is $@, '', "Complex setter didn't die";
+is $res, $baz, "Complex setter w/ default return the object";
+is $baz->{bar_baz}, 'croffle', "Complex setter w/ default specific object value";
+is $baz->{bar}, 'bloom', "Complex setter w/ default default object value";
+
+$res = eval { $baz->bar_baz() };
+
+is $@, '', "Complex getter after setter didn't die";
+is $res, 'croffle', "Complex getter after setter value match";
+
+$res = eval { $baz->bar() };
+
+is $@, '', "Complex getter after setter default didn't die";
+is $res, 'bloom', "Complex getter after setter default value match";
+
+# Caller info retrieval
+
+my $info = $foo->bleh(1);
+
+is $info, "Foo->bleh", "caller info";
+
+# die() message cleaning
+
+eval { die "foo bar" };
+
+my $msg = RPC::ExtDirect::Util::clean_error_message($@);
+
+is $msg, "foo bar", "die() message clean";
+
+# croak() message cleaning
+
+eval { croak "moo fred" };
+
+$msg = RPC::ExtDirect::Util::clean_error_message($@);
+
+is $msg, "moo fred", "croak() message clean";
+
+# Package flags parsing
+
+package Bar;
+
+no warnings;
+
+my @accessors = qw/ scalar_value empty_scalar
+ array_value empty_array
+ hash_value empty_hash/;
+
+our $SCALAR_VALUE = 1;
+our $EMPTY_SCALAR;
+
+our @ARRAY_VALUE = qw/foo bar/;
+our @EMPTY_ARRAY;
+
+our %HASH_VALUE = ( foo => 'bar' );
+our %EMPTY_HASH = ();
+
+sub new {
+ my $class = shift;
+
+ return bless {@_}, $class;
+}
+
+RPC::ExtDirect::Util::Accessor::mk_accessors( simple => \@accessors );
+
+package main;
+
+my $tests = [{
+ name => 'scalar w/ value',
+ regex => qr/^.*?Bar::SCALAR_VALUE.*?scalar_value/ms,
+ result => 1,
+ flag => {
+ package => 'Bar',
+ var => 'SCALAR_VALUE',
+ type => 'scalar',
+ setter => 'scalar_value',
+ default => 'foo',
+ },
+}, {
+ name => 'scalar w/o value',
+ regex => '', # Should be no warning
+ result => 'bar',
+ flag => {
+ package => 'Bar',
+ var => 'EMPTY_SCALAR',
+ type => 'scalar',
+ setter => 'empty_scalar',
+ default => 'bar',
+ },
+}, {
+ name => 'array w/ values',
+ regex => qr/^.*Bar::ARRAY_VALUE.*?array_value/ms,
+ result => [qw/ foo bar /],
+ flag => {
+ package => 'Bar',
+ var => 'ARRAY_VALUE',
+ type => 'array',
+ setter => 'array_value',
+ default => [qw/ baz qux /],
+ },
+}, {
+ name => 'empty array',
+ regex => '',
+ result => [qw/ moo fuy /],
+ flag => {
+ package => 'Bar',
+ var => 'EMPTY_ARRAY',
+ type => 'array',
+ setter => 'empty_array',
+ default => [qw/ moo fuy /],
+ },
+}, {
+ name => 'empty array no default',
+ regex => '',
+ result => undef,
+ flag => {
+ package => 'Bar',
+ var => 'EMPTY_ARRAY',
+ type => 'array',
+ setter => 'empty_array',
+ },
+}, {
+ name => 'hash w/ values',
+ regex => qr/^.*Bar::HASH_VALUE.*?hash_value/ms,
+ result => { foo => 'bar' },
+ flag => {
+ package => 'Bar',
+ var => 'HASH_VALUE',
+ type => 'hash',
+ setter => 'hash_value',
+ default => { baz => 'qux' },
+ },
+}, {
+ name => 'empty hash',
+ regex => '',
+ result => { mymse => 'fumble' },
+ flag => {
+ package => 'Bar',
+ var => 'EMPTY_HASH',
+ type => 'hash',
+ setter => 'empty_hash',
+ default => { mymse => 'fumble' },
+ },
+}, {
+ name => 'empty hash no default',
+ regex => '',
+ result => undef,
+ flag => {
+ package => 'Bar',
+ var => 'EMPTY_HASH',
+ type => 'hash',
+ setter => 'empty_hash',
+ default => undef,
+ },
+}];
+
+our $warn_msg;
+
+$SIG{__WARN__} = sub { $warn_msg = shift };
+
+for my $test ( @$tests ) {
+ my $name = $test->{name};
+ my $regex = $test->{regex};
+ my $result = $test->{result};
+ my $flag = $test->{flag};
+ my $type = $flag->{type};
+ my $field = $flag->{setter};
+ my $has_def = exists $flag->{default};
+
+ my $obj = new Bar;
+
+ $warn_msg = '';
+
+ eval { RPC::ExtDirect::Util::parse_global_flags( [$flag], $obj ) };
+
+ is $@, '', "Var $name didn't die";
+
+ if ( $regex ) {
+ like $warn_msg, $regex, "Var $name warning matches";
+ }
+ else {
+ is $warn_msg, '', "Var $name warning empty";
+ }
+
+ my $value = $obj->$field();
+
+ if ( $type eq 'scalar' ) {
+ is ref($value), '', "Var $name type matches";
+ is $value, $result, "Var $name value matches";
+ }
+ else {
+ if ( defined $result ) {
+ is ref($value), uc $type, "Var $name type matches";
+ }
+ is_deep $value, $result, "Var $name value matches";
+ }
+
+ if ( !$has_def ) {
+ my $predicate = "has_$field";
+
+ is $obj->$predicate(), !1, "Var $name not defaulted";
+ }
+};
+
+my $bar = Bar->new( scalar_value => 'fred' );
+
+my $flag = $tests->[0]->{flag};
+
+RPC::ExtDirect::Util::parse_global_flags( [ $flag ], $bar );
+
+is $bar->scalar_value, 1, "Existing object value overwritten";
+
@@ -0,0 +1,262 @@
+use strict;
+use warnings;
+
+use Test::More tests => 75;
+
+use RPC::ExtDirect::Test::Util;
+use RPC::ExtDirect::Util;
+use RPC::ExtDirect;
+
+# Dummy subs to use as the referent and the hook
+sub foo {}
+sub hook {}
+
+# A shortcut for brevity
+*p_attr = *RPC::ExtDirect::Util::parse_attribute;
+
+# This should not be even remotely possible, but magic happens on Christmas
+eval { p_attr('foo', *foo, \&foo, 'blerg') };
+like $@, qr/^Method attribute is not ExtDirect/, 'Attribute check';
+
+# Unparseable attribute *can* happen, easily enough
+eval { p_attr('foo', *foo, \&foo, 'ExtDirect', 'bleh blah') };
+like $@, qr/^Malformed ExtDirect attribute/, 'Attribute data check';
+
+# ... unless it's a completely empty attribute, which is acceptable
+eval { p_attr('foo', *foo, \&foo, 'ExtDirect', '') };
+is $@, '', 'Empty string attribute data';
+
+# *Theoretically* this should not be possible too, but who knows
+eval { p_attr('foo', sub {}, sub {}, 'ExtDirect', []) };
+like $@, qr/^Can't resolve symbol/, 'Symbol name resolution';
+
+# The rest is automated
+my $tests = eval do { local $/; <DATA> } or die "Can't eval DATA: '$@'";
+
+my @run_only = @ARGV;
+
+TEST:
+for my $test ( @$tests ) {
+ my $name = $test->{name};
+ my $input = $test->{input};
+ my $xcpt = $test->{xcpt};
+ my $want = $test->{want};
+
+ # This is fixed
+ $want->{package} = 'bar';
+ $want->{method} = 'foo';
+
+ next TEST if @run_only && !grep { lc $name eq lc $_ } @run_only;
+
+ my $have = eval {
+ p_attr('bar', *foo, \&foo, 'ExtDirect', $input, 'CHECK', 'foo.pm', 42)
+ };
+
+ if ( $xcpt ) {
+ like $@, $xcpt, "$name: exception matches";
+ }
+ else {
+ is $@, '', "$name: did not die";
+ is_deep $have, $want, "$name: result matches";
+ }
+}
+
+__DATA__
+[{
+ name => 'Empty arrayref attribute data',
+ input => [],
+ want => {},
+}, {
+ name => 'Empty string attribute data',
+ input => '',
+ want => {},
+}, {
+ name => 'Compatibility len',
+ input => [42],
+ want => { len => 42, },
+}, {
+ name => 'Compatibility len w/ generics',
+ input => [42, foo => 'bar', baz => 'qux',],
+ want => { len => 42, foo => 'bar', baz => 'qux', },
+}, {
+ name => 'len',
+ input => [len => 42],
+ want => { len => 42, },
+}, {
+ name => 'len w/ generics',
+ input => [foo => 'bar', len => 42, baz => 'qux',],
+ want => { len => 42, foo => 'bar', baz => 'qux', },
+}, {
+ name => 'len garbled',
+ input => [len => 'foo'],
+ xcpt => qr/attribute 'len' should be followed by a number/,
+}, {
+ name => 'len undef',
+ input => [42, 'len'],
+ xcpt => qr/attribute 'len' should be followed by a number/,
+}, {
+ name => 'params',
+ input => [ params => [qw/ foo bar /], ],
+ want => { params => [qw/ foo bar /], },
+}, {
+ name => 'params garbled',
+ input => [ 'params' ],
+ xcpt => qr{attribute 'params' must be followed},
+}, {
+ name => 'params no arrayref',
+ input => [ params => {} ],
+ xcpt => qr{attribute 'params' must be followed},
+}, {
+ name => 'params empty arrayref',
+ input => [ params => [] ],
+ xcpt => qr{attribute 'params' must be followed},
+}, {
+ name => 'formHandler',
+ input => ['formHandler'],
+ want => { formHandler => 1, },
+}, {
+ name => 'pollHandler',
+ input => ['pollHandler'],
+ want => { pollHandler => 1, },
+}, {
+ name => 'before hook NONE',
+ input => [ before => 'NONE' ],
+ want => { before => 'NONE' },
+}, {
+ name => 'before hook undef',
+ input => [ before => undef, ],
+ want => { before => undef, },
+}, {
+ name => 'before hook coderef',
+ input => [ before => \&hook, ],
+ want => { before => \&hook, },
+}, {
+ name => 'before hook garbled',
+ input => [ before => 'foo', ],
+ xcpt => qr{attribute 'before' must be followed},
+}, {
+ name => 'instead hook NONE',
+ input => [ instead => 'NONE' ],
+ want => { instead => 'NONE' },
+}, {
+ name => 'instead hook undef',
+ input => [ instead => undef, ],
+ want => { instead => undef, },
+}, {
+ name => 'instead hook coderef',
+ input => [ instead => \&hook, ],
+ want => { instead => \&hook, },
+}, {
+ name => 'instead hook garbled',
+ input => [ instead => 'foo', ],
+ xcpt => qr{attribute 'instead' must be followed},
+}, {
+ name => 'after hook NONE',
+ input => [ before => 'NONE' ],
+ want => { before => 'NONE' },
+}, {
+ name => 'after hook undef',
+ input => [ after => undef, ],
+ want => { after => undef, },
+}, {
+ name => 'after hook coderef',
+ input => [ after => \&hook, ],
+ want => { after => \&hook, },
+}, {
+ name => 'after hook garbled',
+ input => [ after => 'foo', ],
+ xcpt => qr{attribute 'after' must be followed},
+}, {
+ name => 'strict truthy',
+ input => [ strict => 1, params => ['foo'], ],
+ want => { strict => 1, params => ['foo'], },
+}, {
+ name => 'strict falsy',
+ input => [ params => ['bar'], strict => !1, ],
+ want => { params => ['bar'], strict => !1, },
+}, {
+ name => 'Compatibility len and params',
+ input => [42, params => ['foo']],
+ xcpt => qr/attributes 'len' and 'params' are mutually exclusive/,
+}, {
+ name => 'len and params',
+ input => [len => 42, params => ['foo']],
+ xcpt => qr/attributes 'len' and 'params' are mutually exclusive/,
+}, {
+ name => 'Compatibility len and formHandler',
+ input => [42, 'formHandler'],
+ xcpt => qr/attributes 'len' and 'formHandler' are mutually exclusive/,
+}, {
+ name => 'len and formHandler',
+ input => ['formHandler', len => 42],
+ xcpt => qr/attributes 'formHandler' and 'len' are mutually exclusive/,
+}, {
+ name => 'Compatibility len and pollHandler',
+ input => [42, 'pollHandler'],
+ xcpt => qr/attributes 'len' and 'pollHandler' are mutually exclusive/,
+}, {
+ name => 'len and pollHandler',
+ input => ['pollHandler', len => 42],
+ xcpt => qr/attributes 'pollHandler' and 'len' are mutually exclusive/,
+}, {
+ name => 'params and formHandler',
+ input => ['formHandler', params => ['foo']],
+ xcpt => qr/attributes 'formHandler' and 'params' are mutually exclusive/,
+}, {
+ name => 'params and pollHandler',
+ input => [params => ['bar'], 'pollHandler'],
+ xcpt => qr/attributes 'params' and 'pollHandler' are mutually exclusive/,
+}, {
+ name => 'formHandler and pollHandler',
+ input => [qw/ formHandler pollHandler /],
+ xcpt => qr/attributes 'formHandler' and 'pollHandler'.*?exclusive/,
+}, {
+ name => 'Compatibility len and strict',
+ input => [42, strict => 1],
+ xcpt => qr/attribute 'strict' should be used with 'params'/,
+}, {
+ name => 'len and strict',
+ input => [strict => !1, len => 42],
+ xcpt => qr/attribute 'strict' should be used with 'params'/,
+}, {
+ name => 'formHandler and strict',
+ input => ['formHandler', strict => 1],
+ xcpt => qr/attribute 'strict' should be used with 'params'/,
+}, {
+ name => 'pollHandler and strict',
+ input => [strict => !1, 'pollHandler'],
+ xcpt => qr/attribute 'strict' should be used with 'params'/,
+}, {
+ name => 'Compatibility len w/ hooks',
+ input => [42, before => \&hook, instead => \&hook, after => \&hook,],
+ want => {len => 42, before => \&hook, instead => \&hook, after => \&hook},
+}, {
+ name => 'len w/ hooks',
+ input => [before => \&hook, instead => \&hook, after => \&hook, len => 42],
+ want => {len => 42, before => \&hook, instead => \&hook, after => \&hook},
+}, {
+ name => 'params w/ hooks',
+ input => [
+ params => ['bar'], before => undef, after => undef, instead => undef
+ ],
+ want => {
+ params => ['bar'], before => undef, after => undef, instead => undef
+ },
+}, {
+ name => 'formHandler w/ hooks',
+ input => [
+ 'formHandler', instead => 'NONE', before => 'NONE', after => 'NONE',
+ ],
+ want => {
+ formHandler => 1, instead => 'NONE', before => 'NONE', after => 'NONE'
+ },
+}, {
+ name => 'pollHandler w/ hooks',
+ input => [
+ after => \&hook, instead => undef, before => 'NONE', 'pollHandler'
+ ],
+ want => {
+ pollHandler => 1, before => 'NONE', instead => undef, after => \&hook
+ },
+}]
+
@@ -1,26 +1,116 @@
use strict;
use warnings;
-use Test::More tests => 9;
+use Test::More tests => 84;
-BEGIN { use_ok 'RPC::ExtDirect::Config'; }
+use RPC::ExtDirect::Test::Util;
-my @methods = qw(router_path poll_path remoting_var polling_var);
+# A stub for testing global vars handling
+package RPC::ExtDirect::API;
-my %expected_get_for = (
- router_path => '/extdirectrouter',
- poll_path => '/extdirectevents',
- remoting_var => 'Ext.app.REMOTING_API',
- polling_var => 'Ext.app.POLLING_API',
+our $DEBUG;
+
+package main;
+
+use RPC::ExtDirect::Config;
+
+my $cfg_class = 'RPC::ExtDirect::Config';
+my $defs = RPC::ExtDirect::Config::_get_definitions;
+
+for my $def ( @$defs ) {
+ my $accessor = $def->{accessor};
+ my $package = $def->{package};
+ my $var = $def->{var};
+ my $type = $def->{type};
+ my $specific = $def->{setter};
+ my $fallback = $def->{fallback};
+ my $default = $def->{default};
+ my $have_def = exists $def->{default};
+
+ # Simple accessor, test existence and default value
+ if ($accessor) {
+ my $config = $cfg_class->new();
+ my $value = eval { $config->$accessor() };
+
+ is $@, '', "$accessor: simple accessor exists";
+
+ if ($have_def) {
+ is $value, $default, "$accessor: simple accessor default value";
+ }
+ }
+
+ # Defaultable accessor, check existence of specific getter
+ if ( $specific ) {
+ my $setters = 'ARRAY' eq ref($specific) ? $specific
+ : [ $specific ]
+ ;
+
+ my $config = $cfg_class->new();
+
+ for my $setter ( @$setters ) {
+ eval { $config->$setter() };
+
+ is $@, '', "$setter: defaultable specific accessor exists";
+ }
+ }
+
+ if ($fallback) {
+ my $config = $cfg_class->new();
+
+ eval { $config->$fallback() };
+
+ is $@, '', "$fallback: defaultable fallback accessor exists";
+ }
+}
+
+# Adding accessors on the fly
+
+my $config = $cfg_class->new();
+
+$config->add_accessors(
+ simple => 'blerg',
+ complex => [{
+ accessor => 'frob',
+ fallback => 'blerg',
+ }],
);
-for my $method ( @methods ) {
- my $get_sub = 'get_'.$method;
+ok $config->can('blerg'), "Added simple accessor";
+ok $config->can('frob'), "Added complex accessor";
+
+$config->blerg('cluck');
+
+is $config->frob(), 'cluck', "Complex accessor fallback value matches";
+
+$config->frob('blurb');
+
+is $config->frob(), 'blurb', "Complex accessor own value matches";
+
+# Setting options in bulk
+
+$config->set_options(
+ blerg => 'blam',
+ frob => 'frab',
+);
+
+is $config->blerg(), 'blam', "Bulk setter value 1 matches";
+is $config->frob(), 'frab', "Bulk setter value 2 matches";
+
+# Cloning
+$config = $cfg_class->new();
+my $clone = $config->clone();
+
+ok $config ne $clone, "Clone is not self";
+is_deep $clone, $config, "Clone values match";
+
+$SIG{__WARN__} = sub {};
+
+package main;
+
+is $config->debug_api, !1, "Default global var value";
- my $result = eval { RPC::ExtDirect::Config->$get_sub() };
- my $expected = $expected_get_for{ $method };
+$RPC::ExtDirect::API::DEBUG = 'foo';
- is $@, '', "$method get eval $@";
- is $result, $expected, "$method get result";
-};
+$config->read_global_vars();
+is $config->debug_api, 'foo', "Changed global var value";
@@ -1,10 +1,10 @@
use strict;
use warnings;
-use Data::Dumper;
-use Test::More tests => 25;
+use Test::More tests => 32;
-BEGIN { use_ok 'RPC::ExtDirect::Exception'; }
+use RPC::ExtDirect::Test::Util;
+use RPC::ExtDirect::Exception;
package RPC::ExtDirect::Test;
@@ -26,18 +26,54 @@ sub bar {
message => 'bar fail' });
}
+sub baz {
+ return RPC::ExtDirect::Exception->new({ debug => !1,
+ verbose => 1,
+ action => 'Test',
+ method => 'baz',
+ tid => 3,
+ message => 'baz fail' });
+}
+
sub qux {
return RPC::ExtDirect::Exception->new({ debug => 1,
action => 'Test',
method => 'qux',
- tid => 3,
+ tid => 4,
message => 'qux fail',
where => 'X->qux' });
}
package main;
-my $tests = [
+my $tests = eval do { local $/; <DATA>; } ## no critic
+ or die "Can't eval DATA: '$@'";
+
+for my $test ( @$tests ) {
+ my $method = $test->{method};
+ my $expect = $test->{ex};
+
+ my $ex = eval { RPC::ExtDirect::Test->$method() };
+
+ is $@, '', "$method() new eval $@";
+ ok $ex, "$method() exception not null";
+ isa_ok $ex, 'RPC::ExtDirect::Exception';
+
+ my $run = eval { $ex->run() };
+
+ is $@, '', "$method() run eval $@";
+ ok !$run, "$method() run error returned";
+
+ my $result = eval { $ex->result() };
+
+ is $@, '', "$method() result eval $@";
+ ok $result, "$method() result not empty";
+ is_deep $result, $expect, "$method() exception deep";
+};
+
+__DATA__
+
+[
{ method => 'foo',
ex => { type => 'exception',
action => 'Test',
@@ -56,38 +92,22 @@ my $tests = [
message => 'bar fail',
},
},
+ { method => 'baz',
+ ex => { type => 'exception',
+ action => 'Test',
+ method => 'baz',
+ tid => 3,
+ where => 'RPC::ExtDirect::Test->baz',
+ message => 'baz fail',
+ },
+ },
{ method => 'qux',
ex => { type => 'exception',
action => 'Test',
method => 'qux',
- tid => 3,
+ tid => 4,
where => 'X->qux',
message => 'qux fail',
},
},
-];
-
-for my $test ( @$tests ) {
- my $method = $test->{method};
- my $expect = $test->{ex};
-
- my $ex = eval { RPC::ExtDirect::Test->$method() };
-
- is $@, '', "$method() new eval $@";
- ok $ex, "$method() exception not null";
- isa_ok $ex, 'RPC::ExtDirect::Exception';
-
- my $run = eval { $ex->run() };
-
- is $@, '', "$method() run eval $@";
- ok !$run, "$method() run error returned";
-
- my $result = eval { $ex->result() };
-
- is $@, '', "$method() result eval $@";
- ok $result, "$method() result not empty";
- is_deeply $result, $expect, "$method() exception deep"
- or diag( Data::Dumper->Dump( [ $result ], [ 'result' ] ) );
-};
-
-exit 0;
+]
@@ -1,52 +1,41 @@
use strict;
use warnings;
-use Test::More tests => 20;
+use Test::More tests => 31;
-BEGIN {
- use_ok 'RPC::ExtDirect::Event';
- use_ok 'RPC::ExtDirect::NoEvents';
-}
-
-# Test Event with data
-
-my $event = eval { RPC::ExtDirect::Event->new('foo', 'bar') };
-
-is $@, '', "Event new() eval $@";
-ok $event, "Event object created";
-isa_ok $event, 'RPC::ExtDirect::Event';
+use RPC::ExtDirect::Test::Util;
-my $expected_result = {
- type => 'event',
- name => 'foo',
- data => 'bar',
-};
+use RPC::ExtDirect::Event;
+use RPC::ExtDirect::NoEvents;
-my $real_result = eval { $event->result() };
+# Test Events with data
-is $@, '', "Event result() eval $@";
-ok $real_result, "Event result() not empty";
-is_deeply $real_result, $expected_result, "Event result() deep";
+my $tests = eval do { local $/; <DATA>; } ## no critic
+ or die "Can't eval DATA: '$@'";
-# Test Event without data
+for my $test ( @$tests ) {
+ my $name = $test->{name};
+ my @arg = @{ $test->{arg} };
+ my $exp = $test->{res};
+
+ my $event = eval { RPC::ExtDirect::Event->new(@arg) };
-$event = eval { RPC::ExtDirect::Event->new('baz') };
+ is $@, '', "$name event new() eval $@";
+ ok $event, "$name event object created";
+ isa_ok $event, 'RPC::ExtDirect::Event';
+
+ my $result = eval { $event->result() };
-is $@, '', "Event new() eval $@";
-ok $event, "Event object created";
-isa_ok $event, 'RPC::ExtDirect::Event';
+ is $@, '', "$name event result() eval $@";
+ ok $result, "$name event result() not empty";
+ is_deep $result, $exp, "$name event result() deep";
+}
-$expected_result = {
- type => 'event',
- name => 'baz',
- data => undef,
-};
+# Test argument checking
-$real_result = eval { $event->result() };
+my $event = eval { RPC::ExtDirect::Event->new() };
-is $@, '', "Event result() eval $@";
-ok $real_result, "Event result() not empty";
-is_deeply $real_result, $expected_result, "Event result() deep";
+like $@, qr/^Ext.Direct Event name is required/, "Argument check";
# Test the stub
@@ -56,16 +45,55 @@ is $@, '', "NoEvents new() eval $@";
ok $no_events, "NoEvents new() object created";
isa_ok $no_events, 'RPC::ExtDirect::NoEvents';
-$expected_result = {
+my $expected_result = {
type => 'event',
name => '__NONE__',
data => '',
};
-$real_result = eval { $no_events->result() };
-
-is $@, '', "NoEvents result() eval $@";
-ok $real_result, "NoEvents result() not empty";
-is_deeply $real_result, $expected_result, "NoEvents result() deep";
-
-exit 0;
+my $real_result = eval { $no_events->result() };
+
+is $@, '', "NoEvents result() eval $@";
+ok $real_result, "NoEvents result() not empty";
+is_deep $real_result, $expected_result, "NoEvents result() deep";
+
+__DATA__
+
+[
+ {
+ name => 'ordered',
+ arg => ['foo', 'bar'],
+ res => {
+ type => 'event',
+ name => 'foo',
+ data => 'bar',
+ },
+ },
+ {
+ name => 'hashref',
+ arg => [{ name => 'bar', data => 'baz' }],
+ res => {
+ type => 'event',
+ name => 'bar',
+ data => 'baz',
+ },
+ },
+ {
+ name => 'hash',
+ arg => [name => 'baz', data => 'qux'],
+ res => {
+ type => 'event',
+ name => 'baz',
+ data => 'qux',
+ },
+ },
+ {
+ name => 'w/o data',
+ arg => ['burr'],
+ res => {
+ type => 'event',
+ name => 'burr',
+ data => undef,
+ },
+ }
+]
@@ -1,32 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More tests => 4;
-
-BEGIN { use_ok 'RPC::ExtDirect::Serialize'; }
-
-local $RPC::ExtDirect::Serialize::DEBUG = 1;
-
-my $data = { foo => 'foo', qux => 'qux', bar => 'bar' };
-my $expected = '{"bar":"bar","foo":"foo","qux":"qux"}';
-
-my $json = RPC::ExtDirect::Serialize->serialize(0, $data);
-
-is $json, $expected, "Canonical output";
-
-$data = bless { foo => 'foo', };
-$expected = q|{"action":null,"message":"encountered object 'main=HASH(blessed)'","method":null,"tid":null,"type":"exception","where":"RPC::ExtDirect::Serialize"}|;
-
-$json = RPC::ExtDirect::Serialize->serialize(0, $data);
-
-$json =~ s/HASH\([^\)]+\)[^"]+/HASH(blessed)'/;
-
-is $json, $expected, 'Invalid data, exceptions on';
-
-$expected = undef;
-
-$json = RPC::ExtDirect::Serialize->serialize(1, $data);
-
-is $json, $expected, 'Ivalid data, exceptions off';
-
-exit 0;
@@ -0,0 +1,113 @@
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+
+use RPC::ExtDirect::Config;
+use RPC::ExtDirect::Serializer;
+
+my $cfg_class = 'RPC::ExtDirect::Config';
+my $ser_class = 'RPC::ExtDirect::Serializer';
+
+package Request;
+
+sub new {
+ my ($class, $params) = @_;
+
+ return $params, $class;
+}
+
+package main;
+
+my $config = $cfg_class->new(request_class => 'Request');
+my $serializer = $ser_class->new(config => $config);
+
+my $req = $serializer->_request({ foo => 'bar' });
+
+isa_ok $req, 'Request', "Honors request_class";
+
+$config = $cfg_class->new(
+ exception_class_serialize => 'Request',
+ exception_class => 'Foo',
+);
+$serializer = $ser_class->new(config => $config);
+
+my $ex1 = $serializer->_exception({
+ direction => 'serialize',
+ foo => 'bar',
+});
+
+isa_ok $ex1, 'Request', "Honors exception_class_serialize";
+
+$config = $cfg_class->new(
+ exception_class_deserialize => 'Request',
+ exception_class => 'Foo',
+);
+$serializer = $ser_class->new(config => $config);
+
+my $ex2 = $serializer->_exception({
+ direction => 'deserialize',
+ foo => 'bar',
+});
+
+isa_ok $ex2, 'Request', "Honors exception_class_deserialize";
+
+$config = $cfg_class->new( exception_class => 'Request' );
+$serializer = $ser_class->new( config => $config );
+
+my $ex3 = $serializer->_exception({
+ direction => 'serialize',
+ foo => 'bar',
+});
+
+isa_ok $ex3, 'Request', "Falls back to exception_class for serializer";
+
+my $ex4 = $serializer->_exception({
+ direction => 'deserialize',
+ foo => 'bar',
+});
+
+isa_ok $ex4, 'Request', "Falls back to exception_class for deserializer";
+
+my $json_options = { canonical => 1 };
+
+my $data = { foo => 'foo', qux => 'qux', bar => 'bar' };
+my $expected = '{"bar":"bar","foo":"foo","qux":"qux"}';
+
+$config = $cfg_class->new(json_options => $json_options);
+
+my $json = $ser_class->new(config => $config)->serialize(
+ mute_exceptions => !1,
+ data => [$data],
+);
+
+is $json, $expected, "Canonical output";
+
+$data = bless { foo => 'foo', };
+$expected = q|{"action":null,"message":"encountered object 'main=HASH(blessed)'","method":null,"tid":null,"type":"exception","where":"RPC::ExtDirect::Serializer"}|;
+
+for my $option ( qw/ debug verbose_exceptions / ) {
+ # verbose_exceptions will turn on verboseness only,
+ # but we also need debug to produce canonical JSON
+ # for comparison, or the test will never pass :)
+ my $config = $cfg_class->new($option => 1, debug => 1);
+
+ my $json = $ser_class->new(config => $config)->serialize(
+ mute_exceptions => !1,
+ data => [$data],
+ );
+
+ $json =~ s/HASH\([^\)]+\)[^"]+/HASH(blessed)'/;
+
+ is $json, $expected, "Invalid data, $option on";
+}
+
+$expected = undef;
+
+$json = $ser_class->new(debug => 1)->serialize(
+ mute_exceptions => 1,
+ data => [$data],
+);
+
+is $json, $expected, 'Ivalid data, exceptions off';
+
@@ -2,130 +2,36 @@ use strict;
use warnings;
use Carp;
-use Test::More tests => 71;
+use Test::More tests => 69;
-sub global_before {
-}
+use RPC::ExtDirect::Test::Util;
-sub global_after {
-}
+sub global_before {}
-BEGIN {
- use_ok 'RPC::ExtDirect'; # Checking case insensitiveness, too
- use_ok 'RPC::ExtDirect::API', Before => \&global_before,
- aFtEr => \&global_after,
- ;
-};
+sub global_after {}
-use lib 't/lib';
-
-use RPC::ExtDirect::Test::Foo;
-use RPC::ExtDirect::Test::Bar;
-use RPC::ExtDirect::Test::Qux;
-use RPC::ExtDirect::Test::PollProvider;
-
-my %test_for = (
- # foo is plain basic package with ExtDirect methods and hooks
- 'Foo' => {
- methods => [ sort qw( foo_foo foo_bar foo_baz foo_zero foo_blessed ) ],
- list => {
- foo_foo => { package => 'RPC::ExtDirect::Test::Foo',
- method => 'foo_foo', param_no => 1,
- formHandler => 0, pollHandler => 0,
- param_names => undef,
- before => \&RPC::ExtDirect::Test::Foo::foo_before,
- },
- foo_bar => { package => 'RPC::ExtDirect::Test::Foo',
- method => 'foo_bar', param_no => 2,
- formHandler => 0, pollHandler => 0,
- param_names => undef,
- instead => \&RPC::ExtDirect::Test::Foo::foo_instead,
- },
- foo_baz => { package => 'RPC::ExtDirect::Test::Foo',
- method => 'foo_baz', param_no => undef,
- formHandler => 0, pollHandler => 0,
- param_names => [ qw( foo bar baz ) ],
- before => \&RPC::ExtDirect::Test::Foo::foo_before,
- after => \&RPC::ExtDirect::Test::Foo::foo_after,
- },
- foo_zero =>{ package => 'RPC::ExtDirect::Test::Foo',
- method => 'foo_zero', param_no => 0,
- formHandler => 0, pollHandler => 0,
- param_names => undef, },
- foo_blessed => { package => 'RPC::ExtDirect::Test::Foo',
- method => 'foo_blessed', param_no => undef,
- formHandler => 0, pollHandler => 0,
- param_names => undef, },
+use RPC::ExtDirect; # Checking case insensitiveness, too
+use RPC::ExtDirect::API Before => \&global_before,
+ aFtEr => \&global_after,
+ ;
- },
- },
- # bar package has only its own methods as we don't support inheritance
- 'Bar' => {
- methods => [ sort qw( bar_foo bar_bar bar_baz ) ],
- list => {
- bar_foo => { package => 'RPC::ExtDirect::Test::Bar',
- method => 'bar_foo', param_no => 4,
- formHandler => 0, pollHandler => 0,
- param_names => undef, },
- bar_bar => { package => 'RPC::ExtDirect::Test::Bar',
- method => 'bar_bar', param_no => 5,
- formHandler => 0, pollHandler => 0,
- param_names => undef, },
- bar_baz => { package => 'RPC::ExtDirect::Test::Bar',
- method => 'bar_baz', param_no => undef,
- formHandler => 1, pollHandler => 0,
- param_names => undef, },
- },
- },
- # Now, qux package redefines all methods so we have 'em here
- 'Qux' => {
- methods => [sort qw(foo_foo foo_bar foo_baz bar_foo bar_bar bar_baz)],
- list => {
- foo_foo => { package => 'RPC::ExtDirect::Test::Qux',
- method => 'foo_foo', param_no => 1,
- formHandler => 0, pollHandler => 0,
- param_names => undef, },
- foo_bar => { package => 'RPC::ExtDirect::Test::Qux',
- method => 'foo_bar', param_no => 2,
- formHandler => 0, pollHandler => 0,
- param_names => undef, },
- foo_baz => { package => 'RPC::ExtDirect::Test::Qux',
- method => 'foo_baz', param_no => undef,
- formHandler => 0, pollHandler => 0,
- param_names => [ qw( foo bar baz ) ], },
- bar_foo => { package => 'RPC::ExtDirect::Test::Qux',
- method => 'bar_foo', param_no => 4,
- formHandler => 0, pollHandler => 0,
- param_names => undef, },
- bar_bar => { package => 'RPC::ExtDirect::Test::Qux',
- method => 'bar_bar', param_no => 5,
- formHandler => 0, pollHandler => 0,
- param_names => undef, },
- bar_baz => { package => 'RPC::ExtDirect::Test::Qux',
- method => 'bar_baz', param_no => undef,
- formHandler => 1, pollHandler => 0,
- param_names => undef, },
- },
- },
- # PollProvider implements Event provider for polling mechanism
- 'PollProvider' => {
- methods => [ sort qw( foo ) ],
- list => {
- foo => { package => 'RPC::ExtDirect::Test::PollProvider',
- method => 'foo', param_no => undef,
- formHandler => 0, pollHandler => 1,
- param_names => undef, },
- },
- },
-);
+use RPC::ExtDirect::Test::Pkg::Foo;
+use RPC::ExtDirect::Test::Pkg::Bar;
+use RPC::ExtDirect::Test::Pkg::Qux;
+use RPC::ExtDirect::Test::Pkg::PollProvider;
+
+my $tests = eval do { local $/; <DATA>; } ## no critic
+ or die "Can't eval DATA: '$@'";
+
+my %test_for = %{ $tests->{main_tests} };
my @expected_classes = sort qw( Foo Bar Qux PollProvider );
my @full_classes = sort eval { RPC::ExtDirect->get_action_list() };
-is $@, '', "full get_action_list() eval $@";
-ok @full_classes, "full get_action_list() not empty";
-is_deeply \@full_classes, \@expected_classes, "full get_action_list() deep";
+is $@, '', "full get_action_list() eval $@";
+ok @full_classes, "full get_action_list() not empty";
+is_deep \@full_classes, \@expected_classes, "full get_action_list() deep";
my @expected_methods = sort qw(
Qux::bar_bar Qux::bar_baz Qux::bar_foo
@@ -138,30 +44,29 @@ my @expected_methods = sort qw(
my @full_methods = sort eval { RPC::ExtDirect->get_method_list() };
-is $@, '', "full get_method_list() eval $@";
-ok @full_methods, "full get_method_list() not empty";
-is_deeply \@full_methods, \@expected_methods, "full get_method_list() deep";
+is $@, '', "full get_method_list() eval $@";
+ok @full_methods, "full get_method_list() not empty";
+is_deep \@full_methods, \@expected_methods, "full get_method_list() deep";
my @expected_poll_handlers = ( [ 'PollProvider', 'foo' ] );
my @full_poll_handlers = eval { RPC::ExtDirect->get_poll_handlers() };
-is $@, '', "full get_poll_handlers() eval $@";
-ok @full_poll_handlers, "full get_poll_handlers() not empty";
-is_deeply \@full_poll_handlers, \@expected_poll_handlers,
+is $@, '', "full get_poll_handlers() eval $@";
+ok @full_poll_handlers, "full get_poll_handlers() not empty";
+is_deep \@full_poll_handlers, \@expected_poll_handlers,
"full get_poll_handlers() deep";
# We have RPC::ExtDirect already loaded so let's go
for my $module ( sort keys %test_for ) {
my $test = $test_for{ $module };
- my @method_list = eval { RPC::ExtDirect->get_method_list($module) };
+ my @method_list = sort eval { RPC::ExtDirect->get_method_list($module) };
is $@, '', "$module get_method_list eval $@";
- my @expected_list = @{ $test->{methods} };
+ my @expected_list = sort @{ $test->{methods} };
- is_deeply \@method_list, \@expected_list,
- "$module get_method_list() deeply";
+ is_deep \@method_list, \@expected_list, "$module get_method_list() deeply";
my %expected_parameter_for = %{ $test->{list } };
@@ -177,168 +82,13 @@ for my $module ( sort keys %test_for ) {
# No way to compare referents (and no sense in that, too);
delete $parameters{referent};
- is_deeply \%parameters, $expected_ref,
+ is_deep \%parameters, $expected_ref,
"$module get_method_parameters() deeply";
};
};
# Check if we have hooks properly defined
-my $hook_tests = [
- {
- name => 'foo_foo method scope before hook',
- package => 'RPC::ExtDirect::Test::Foo',
- method => 'foo_foo',
- type => 'before',
- code => \&RPC::ExtDirect::Test::Foo::foo_before,
- },
- {
- name => 'foo_baz method scope instead hook',
- package => 'RPC::ExtDirect::Test::Foo',
- method => 'foo_bar',
- type => 'instead',
- code => \&RPC::ExtDirect::Test::Foo::foo_instead,
- },
- {
- name => 'foo_baz method scope before hook',
- package => 'RPC::ExtDirect::Test::Foo',
- method => 'foo_baz',
- type => 'before',
- code => \&RPC::ExtDirect::Test::Foo::foo_before,
- },
- {
- name => 'foo_baz method scope after hook',
- package => 'RPC::ExtDirect::Test::Foo',
- method => 'foo_baz',
- type => 'after',
- code => \&RPC::ExtDirect::Test::Foo::foo_after,
- },
- {
- name => 'bar_foo package scope before hook',
- package => 'RPC::ExtDirect::Test::Bar',
- method => 'bar_foo',
- type => 'before',
- code => \&RPC::ExtDirect::Test::Bar::bar_before,
- },
- {
- name => 'bar_foo package scope after hook',
- package => 'RPC::ExtDirect::Test::Bar',
- method => 'bar_foo',
- type => 'after',
- code => \&RPC::ExtDirect::Test::Bar::bar_after,
- },
- {
- name => 'bar_bar package scope before hook',
- package => 'RPC::ExtDirect::Test::Bar',
- method => 'bar_bar',
- type => 'before',
- code => \&RPC::ExtDirect::Test::Bar::bar_before,
- },
- {
- name => 'bar_bar package scope after hook',
- package => 'RPC::ExtDirect::Test::Bar',
- method => 'bar_bar',
- type => 'after',
- code => \&RPC::ExtDirect::Test::Bar::bar_after,
- },
- {
- name => 'bar_baz package scope before hook',
- package => 'RPC::ExtDirect::Test::Bar',
- method => 'bar_baz',
- type => 'before',
- code => \&RPC::ExtDirect::Test::Bar::bar_before,
- },
- {
- name => 'bar_baz package scope after hook',
- package => 'RPC::ExtDirect::Test::Bar',
- method => 'bar_baz',
- type => 'after',
- code => \&RPC::ExtDirect::Test::Bar::bar_after,
- },
- {
- name => 'Global scope Qux foo_foo before hook',
- package => 'RPC::ExtDirect::Test::Qux',
- method => 'foo_foo',
- type => 'before',
- code => \&global_before,
- },
- {
- name => 'Global scope Qux foo_foo after hook',
- package => 'RPC::ExtDirect::Test::Qux',
- method => 'foo_foo',
- type => 'after',
- code => \&global_after,
- },
- {
- name => 'Global scope Qux foo_bar before hook',
- package => 'RPC::ExtDirect::Test::Qux',
- method => 'foo_bar',
- type => 'before',
- code => \&global_before,
- },
- {
- name => 'Global scope Qux foo_bar after hook',
- package => 'RPC::ExtDirect::Test::Qux',
- method => 'foo_bar',
- type => 'after',
- code => \&global_after,
- },
- {
- name => 'Global scope Qux foo_baz before hook',
- package => 'RPC::ExtDirect::Test::Qux',
- method => 'foo_baz',
- type => 'before',
- code => \&global_before,
- },
- {
- name => 'Global scope Qux foo_baz after hook',
- package => 'RPC::ExtDirect::Test::Qux',
- method => 'foo_baz',
- type => 'after',
- code => \&global_after,
- },
- {
- name => 'Global scope Qux bar_foo before hook',
- package => 'RPC::ExtDirect::Test::Qux',
- method => 'bar_foo',
- type => 'before',
- code => \&global_before,
- },
- {
- name => 'Global scope Qux bar_foo after hook',
- package => 'RPC::ExtDirect::Test::Qux',
- method => 'bar_foo',
- type => 'after',
- code => \&global_after,
- },
- {
- name => 'Global scope Qux bar_bar before hook',
- package => 'RPC::ExtDirect::Test::Qux',
- method => 'bar_bar',
- type => 'before',
- code => \&global_before,
- },
- {
- name => 'Global scope Qux bar_bar after hook',
- package => 'RPC::ExtDirect::Test::Qux',
- method => 'bar_bar',
- type => 'after',
- code => \&global_after,
- },
- {
- name => 'Global scope Qux bar_baz before hook',
- package => 'RPC::ExtDirect::Test::Qux',
- method => 'bar_baz',
- type => 'before',
- code => \&global_before,
- },
- {
- name => 'Global scope Qux bar_baz after hook',
- package => 'RPC::ExtDirect::Test::Qux',
- method => 'bar_baz',
- type => 'after',
- code => \&global_after,
- },
-];
+my $hook_tests = $tests->{hook_tests};
for my $test ( @$hook_tests ) {
my $name = $test->{name};
@@ -352,5 +102,258 @@ for my $test ( @$hook_tests ) {
is $code, $test->{code}, "$name code matches";
};
-exit 0;
-
+__DATA__
+
+{
+ main_tests => {
+ # foo is plain basic package with ExtDirect methods and hooks
+ 'Foo' => {
+ methods => [ sort qw( foo_foo foo_bar foo_baz foo_zero foo_blessed ) ],
+ list => {
+ foo_foo => { package => 'RPC::ExtDirect::Test::Pkg::Foo',
+ method => 'foo_foo', param_no => 1,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef,
+ before => \&RPC::ExtDirect::Test::Pkg::Foo::foo_before,
+ },
+ foo_bar => { package => 'RPC::ExtDirect::Test::Pkg::Foo',
+ method => 'foo_bar', param_no => 2,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef,
+ instead => \&RPC::ExtDirect::Test::Pkg::Foo::foo_instead,
+ },
+ foo_baz => { package => 'RPC::ExtDirect::Test::Pkg::Foo',
+ method => 'foo_baz', param_no => undef,
+ formHandler => 0, pollHandler => 0,
+ param_names => [ qw( foo bar baz ) ],
+ before => \&RPC::ExtDirect::Test::Pkg::Foo::foo_before,
+ after => \&RPC::ExtDirect::Test::Pkg::Foo::foo_after,
+ },
+ foo_zero =>{ package => 'RPC::ExtDirect::Test::Pkg::Foo',
+ method => 'foo_zero', param_no => 0,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+ foo_blessed => { package => 'RPC::ExtDirect::Test::Pkg::Foo',
+ method => 'foo_blessed', param_no => undef,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+
+ },
+ },
+ # bar package has only its own methods as we don't support inheritance
+ 'Bar' => {
+ methods => [ sort qw( bar_foo bar_bar bar_baz ) ],
+ list => {
+ bar_foo => { package => 'RPC::ExtDirect::Test::Pkg::Bar',
+ method => 'bar_foo', param_no => 4,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+ bar_bar => { package => 'RPC::ExtDirect::Test::Pkg::Bar',
+ method => 'bar_bar', param_no => 5,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+ bar_baz => { package => 'RPC::ExtDirect::Test::Pkg::Bar',
+ method => 'bar_baz', param_no => undef,
+ formHandler => 1, pollHandler => 0,
+ param_names => undef, },
+ },
+ },
+ # Now, qux package redefines all methods so we have 'em here
+ 'Qux' => {
+ methods => [sort qw(foo_foo foo_bar foo_baz bar_foo bar_bar bar_baz)],
+ list => {
+ foo_foo => { package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'foo_foo', param_no => 1,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+ foo_bar => { package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'foo_bar', param_no => 2,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+ foo_baz => { package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'foo_baz', param_no => undef,
+ formHandler => 0, pollHandler => 0,
+ param_names => [ qw( foo bar baz ) ], },
+ bar_foo => { package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'bar_foo', param_no => 4,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+ bar_bar => { package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'bar_bar', param_no => 5,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+ bar_baz => { package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'bar_baz', param_no => undef,
+ formHandler => 1, pollHandler => 0,
+ param_names => undef, },
+ },
+ },
+ # PollProvider implements Event provider for polling mechanism
+ 'PollProvider' => {
+ methods => [ sort qw( foo ) ],
+ list => {
+ foo => { package => 'RPC::ExtDirect::Test::Pkg::PollProvider',
+ method => 'foo', param_no => undef,
+ formHandler => 0, pollHandler => 1,
+ param_names => undef, },
+ },
+ },
+ },
+
+ hook_tests => [
+ {
+ name => 'foo_foo method scope before hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Foo',
+ method => 'foo_foo',
+ type => 'before',
+ code => \&RPC::ExtDirect::Test::Pkg::Foo::foo_before,
+ },
+ {
+ name => 'foo_baz method scope instead hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Foo',
+ method => 'foo_bar',
+ type => 'instead',
+ code => \&RPC::ExtDirect::Test::Pkg::Foo::foo_instead,
+ },
+ {
+ name => 'foo_baz method scope before hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Foo',
+ method => 'foo_baz',
+ type => 'before',
+ code => \&RPC::ExtDirect::Test::Pkg::Foo::foo_before,
+ },
+ {
+ name => 'foo_baz method scope after hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Foo',
+ method => 'foo_baz',
+ type => 'after',
+ code => \&RPC::ExtDirect::Test::Pkg::Foo::foo_after,
+ },
+ {
+ name => 'bar_foo package scope before hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Bar',
+ method => 'bar_foo',
+ type => 'before',
+ code => \&RPC::ExtDirect::Test::Pkg::Bar::bar_before,
+ },
+ {
+ name => 'bar_foo package scope after hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Bar',
+ method => 'bar_foo',
+ type => 'after',
+ code => \&RPC::ExtDirect::Test::Pkg::Bar::bar_after,
+ },
+ {
+ name => 'bar_bar package scope before hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Bar',
+ method => 'bar_bar',
+ type => 'before',
+ code => \&RPC::ExtDirect::Test::Pkg::Bar::bar_before,
+ },
+ {
+ name => 'bar_bar package scope after hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Bar',
+ method => 'bar_bar',
+ type => 'after',
+ code => \&RPC::ExtDirect::Test::Pkg::Bar::bar_after,
+ },
+ {
+ name => 'bar_baz package scope before hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Bar',
+ method => 'bar_baz',
+ type => 'before',
+ code => \&RPC::ExtDirect::Test::Pkg::Bar::bar_before,
+ },
+ {
+ name => 'bar_baz package scope after hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Bar',
+ method => 'bar_baz',
+ type => 'after',
+ code => \&RPC::ExtDirect::Test::Pkg::Bar::bar_after,
+ },
+ {
+ name => 'Global scope Qux foo_foo before hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'foo_foo',
+ type => 'before',
+ code => \&global_before,
+ },
+ {
+ name => 'Global scope Qux foo_foo after hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'foo_foo',
+ type => 'after',
+ code => \&global_after,
+ },
+ {
+ name => 'Global scope Qux foo_bar before hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'foo_bar',
+ type => 'before',
+ code => \&global_before,
+ },
+ {
+ name => 'Global scope Qux foo_bar after hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'foo_bar',
+ type => 'after',
+ code => \&global_after,
+ },
+ {
+ name => 'Global scope Qux foo_baz before hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'foo_baz',
+ type => 'before',
+ code => \&global_before,
+ },
+ {
+ name => 'Global scope Qux foo_baz after hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'foo_baz',
+ type => 'after',
+ code => \&global_after,
+ },
+ {
+ name => 'Global scope Qux bar_foo before hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'bar_foo',
+ type => 'before',
+ code => \&global_before,
+ },
+ {
+ name => 'Global scope Qux bar_foo after hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'bar_foo',
+ type => 'after',
+ code => \&global_after,
+ },
+ {
+ name => 'Global scope Qux bar_bar before hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'bar_bar',
+ type => 'before',
+ code => \&global_before,
+ },
+ {
+ name => 'Global scope Qux bar_bar after hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'bar_bar',
+ type => 'after',
+ code => \&global_after,
+ },
+ {
+ name => 'Global scope Qux bar_baz before hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'bar_baz',
+ type => 'before',
+ code => \&global_before,
+ },
+ {
+ name => 'Global scope Qux bar_baz after hook',
+ package => 'RPC::ExtDirect::Test::Pkg::Qux',
+ method => 'bar_baz',
+ type => 'after',
+ code => \&global_after,
+ },
+ ],
+}
@@ -1,105 +1,112 @@
+# Static (compile time) remoting API generation
+
use strict;
use warnings;
-use Test::More tests => 5;
-
-use lib 't/lib';
-
-# Test modules are so simple they can't be broken
-use RPC::ExtDirect::Test::Foo;
-use RPC::ExtDirect::Test::Bar;
-use RPC::ExtDirect::Test::Qux;
-
-BEGIN { use_ok 'RPC::ExtDirect::API'; }
-
-# Set the debug flag
-local $RPC::ExtDirect::API::DEBUG = 1;
-
-my $expected = q~
-Ext.app.REMOTING_API = {
- "actions":{
- "Bar":[
- { "len":5, "name":"bar_bar" },
- { "formHandler":true, "len":0, "name":"bar_baz" },
- { "len":4, "name":"bar_foo" }
- ],
- "Foo":[
- { "len":2, "name":"foo_bar" },
- { "name":"foo_baz", "params":["foo","bar","baz"] },
- { "name":"foo_blessed" },
- { "len":1, "name":"foo_foo" },
- { "len":0, "name":"foo_zero" }
- ],
- "Qux":[
- { "len":5, "name":"bar_bar" },
- { "formHandler":true, "len":0, "name":"bar_baz" },
- { "len":4, "name":"bar_foo" },
- { "len":2, "name":"foo_bar" },
- { "name":"foo_baz", "params":["foo","bar","baz"] },
- { "len":1, "name":"foo_foo" }
- ]
- },
- "type":"remoting",
- "url":"/extdirectrouter"
-};
-~;
+use Test::More tests => 4;
-my $remoting_api = eval { RPC::ExtDirect::API->get_remoting_api() };
+use RPC::ExtDirect::Test::Util;
+use RPC::ExtDirect::Config;
-# Remove whitespace
-s/\s//g for ( $expected, $remoting_api );
+use RPC::ExtDirect::Test::Pkg::Foo;
+use RPC::ExtDirect::Test::Pkg::Bar;
+use RPC::ExtDirect::Test::Pkg::Qux;
-is $@, '', "remoting_api() 1 eval $@";
-is $remoting_api, $expected, "remoting_api() 1 result";
+use RPC::ExtDirect::API;
-# "Reimport" with parameters
+my $tests = eval do { local $/; <DATA>; } or die "Can't eval DATA: '$@'";
-RPC::ExtDirect::API->import(
- namespace => 'myApp.Server',
- router_path => '/router.cgi',
- poll_path => '/poll.cgi',
- remoting_var => 'Ext.app.REMOTE_CALL_API',
- polling_var => 'Ext.app.REMOTE_EVENT_API',
- auto_connect => 'HELL YEAH!',
-);
+my $want = shift @$tests;
-$expected = q~
-Ext.app.REMOTE_CALL_API = {
- "actions":{
- "Bar":[
- { "len":5, "name":"bar_bar" },
- { "formHandler":true, "len":0, "name":"bar_baz" },
- { "len":4, "name":"bar_foo" }
- ],
- "Foo":[
- { "len":2, "name":"foo_bar" },
- { "name":"foo_baz", "params":["foo","bar","baz"] },
- { "name":"foo_blessed" },
- { "len":1, "name":"foo_foo" },
- { "len":0, "name":"foo_zero" }
- ],
- "Qux":[
- { "len":5, "name":"bar_bar" },
- { "formHandler":true, "len":0, "name":"bar_baz" },
- { "len":4, "name":"bar_foo" },
- { "len":2, "name":"foo_bar" },
- { "name":"foo_baz", "params":["foo","bar","baz"] },
- { "len":1, "name":"foo_foo" }
- ]
- },
- "namespace":"myApp.Server",
- "type":"remoting",
- "url":"/router.cgi"
-};
-Ext.direct.Manager.addProvider(Ext.app.REMOTE_CALL_API);
-~;
+my $api = RPC::ExtDirect->get_api;
+$api->config->debug_serialize(1);
-$remoting_api = eval { RPC::ExtDirect::API->get_remoting_api() };
+my $have = eval { $api->get_remoting_api() };
-# Remove whitespace
-s/\s//g for ( $expected, $remoting_api );
+is $@, '', "remoting_api() 1 eval $@";
+cmp_api $have, $want, "remoting_api() 1 result";
-is $@, '', "remoting_api() 2 eval $@";
-is $remoting_api, $expected, "remoting_api() 2 result";
+# "Reimport" with parameters
+
+my $config = RPC::ExtDirect::Config->new(
+ debug_api => 1,
+ debug_serialize => 1,
+ namespace => 'myApp.Server',
+ router_path => '/router.cgi',
+ poll_path => '/poll.cgi',
+ remoting_var => 'Ext.app.REMOTE_CALL_API',
+ polling_var => 'Ext.app.REMOTE_EVENT_API',
+ auto_connect => 'HELL YEAH!',
+);
+
+$want = shift @$tests;
+$have = eval {
+ RPC::ExtDirect::API->get_remoting_api(config => $config)
+};
-exit 0;
+is $@, '', "remoting_api() 2 eval $@";
+cmp_api $have, $want, "remoting_api() 2 result";
+
+__DATA__
+
+[
+ q~
+ Ext.app.REMOTING_API = {
+ "actions":{
+ "Bar":[
+ { "len":5, "name":"bar_bar" },
+ { "len":4, "name":"bar_foo" },
+ { "formHandler":true, "len":0, "name":"bar_baz" }
+ ],
+ "Foo":[
+ { "len":1, "name":"foo_foo" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_blessed" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":0, "name":"foo_zero" }
+ ],
+ "Qux":[
+ { "len":1, "name":"foo_foo" },
+ { "len":5, "name":"bar_bar" },
+ { "len":4, "name":"bar_foo" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] }
+ ]
+ },
+ "type":"remoting",
+ "url":"/extdirectrouter"
+ };
+ ~,
+
+ q~
+ Ext.app.REMOTE_CALL_API = {
+ "actions":{
+ "Bar":[
+ { "len":5, "name":"bar_bar" },
+ { "len":4, "name":"bar_foo" },
+ { "formHandler":true, "len":0, "name":"bar_baz" }
+ ],
+ "Foo":[
+ { "len":1, "name":"foo_foo" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_blessed" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":0, "name":"foo_zero" }
+ ],
+ "Qux":[
+ { "len":1, "name":"foo_foo" },
+ { "len":5, "name":"bar_bar" },
+ { "len":4, "name":"bar_foo" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] }
+ ]
+ },
+ "namespace":"myApp.Server",
+ "type":"remoting",
+ "url":"/router.cgi"
+ };
+ Ext.direct.Manager.addProvider(Ext.app.REMOTE_CALL_API);
+ ~,
+]
@@ -1,15 +1,16 @@
+# Static (compile time) remoting/polling API configuration via import
+
use strict;
use warnings;
use Test::More tests => 2;
-use lib 't/lib';
+use RPC::ExtDirect::Test::Util;
-# Test modules are so simple they can't be broken
-use RPC::ExtDirect::Test::Foo;
-use RPC::ExtDirect::Test::Bar;
-use RPC::ExtDirect::Test::Qux;
-use RPC::ExtDirect::Test::PollProvider;
+use RPC::ExtDirect::Test::Pkg::Foo;
+use RPC::ExtDirect::Test::Pkg::Bar;
+use RPC::ExtDirect::Test::Pkg::Qux;
+use RPC::ExtDirect::Test::Pkg::PollProvider;
use RPC::ExtDirect::API namespace => 'myApp.Server',
router_path => '/router.cgi',
@@ -20,48 +21,53 @@ use RPC::ExtDirect::API namespace => 'myApp.Server',
local $RPC::ExtDirect::API::DEBUG = 1;
-my $expected = q~
-Ext.app.REMOTE_CALL_API = {
- "actions":{
- "Bar":[
- { "len":5, "name":"bar_bar" },
- { "formHandler":true, "len":0, "name":"bar_baz" },
- { "len":4, "name":"bar_foo" }
- ],
- "Foo":[
- { "len":2, "name":"foo_bar" },
- { "name":"foo_baz", "params":["foo","bar","baz"] },
- { "name":"foo_blessed" },
- { "len":1, "name":"foo_foo" },
- { "len":0, "name":"foo_zero" }
- ],
- "Qux":[
- { "len":5, "name":"bar_bar" },
- { "formHandler":true, "len":0, "name":"bar_baz" },
- { "len":4, "name":"bar_foo" },
- { "len":2, "name":"foo_bar" },
- { "name":"foo_baz", "params":["foo","bar","baz"] },
- { "len":1, "name":"foo_foo" }
- ]
- },
- "namespace":"myApp.Server",
- "type":"remoting",
- "url":"/router.cgi"
-};
-Ext.direct.Manager.addProvider(Ext.app.REMOTE_CALL_API);
-Ext.app.REMOTE_EVENT_API = {
- "type":"polling",
- "url":"/poll.cgi"
-};
-Ext.direct.Manager.addProvider(Ext.app.REMOTE_EVENT_API);
-~;
+my $tests = eval do { local $/; <DATA>; } or die "Can't eval DATA: '$@'";
+
+# Silence the package globals warning
+$SIG{__WARN__} = sub {};
-my $remoting_api = eval { RPC::ExtDirect::API->get_remoting_api() };
+my $want = shift @$tests;
+my $have = eval { RPC::ExtDirect::API->get_remoting_api() };
-# Remove whitespace
-s/\s//g for ( $expected, $remoting_api );
+is $@, '', "remoting_api() eval $@";
+cmp_api $have, $want, "remoting_api() result";
-is $@, '', "remoting_api() 3 eval $@";
-is $remoting_api, $expected, "remoting_api() 3 result";
+__DATA__
-exit 0;
+[
+ q~
+ Ext.app.REMOTE_CALL_API = {
+ "actions":{
+ "Bar":[
+ { "len":5, "name":"bar_bar" },
+ { "len":4, "name":"bar_foo" },
+ { "formHandler":true, "len":0, "name":"bar_baz" }
+ ],
+ "Foo":[
+ { "len":1, "name":"foo_foo" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_blessed" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":0, "name":"foo_zero" }
+ ],
+ "Qux":[
+ { "len":1, "name":"foo_foo" },
+ { "len":5, "name":"bar_bar" },
+ { "len":4, "name":"bar_foo" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] }
+ ]
+ },
+ "namespace":"myApp.Server",
+ "type":"remoting",
+ "url":"/router.cgi"
+ };
+ Ext.direct.Manager.addProvider(Ext.app.REMOTE_CALL_API);
+ Ext.app.REMOTE_EVENT_API = {
+ "type":"polling",
+ "url":"/poll.cgi"
+ };
+ Ext.direct.Manager.addProvider(Ext.app.REMOTE_EVENT_API);
+ ~,
+]
@@ -1,67 +1,42 @@
+# Statically (compile time) defined Hooks with lazy code resolution
+
use strict;
use warnings;
use Test::More tests => 2;
+use RPC::ExtDirect::Test::Util;
-use lib 't/lib';
+use RPC::ExtDirect::Test::Pkg::Foo;
+use RPC::ExtDirect::Test::Pkg::Bar;
+
+our $WAS_THERE;
-# Test modules are so simple they can't be broken
-use RPC::ExtDirect::Test::Foo;
-use RPC::ExtDirect::Test::Bar;
-use RPC::ExtDirect::Test::Qux;
-use RPC::ExtDirect::Test::PollProvider;
+sub global_after {
+ $WAS_THERE = 1;
+}
-use RPC::ExtDirect::API namespace => 'myApp.Server',
- router_path => '/router.cgi',
- poll_path => '/poll.cgi',
- remoting_var => 'Ext.app.REMOTE_CALL_API',
- polling_var => 'Ext.app.REMOTE_EVENT_API',
- auto_connect => 'HELL YEAH!';
+use RPC::ExtDirect;
+use RPC::ExtDirect::API
+ before => 'test::hooks::global_before',
+ after => \&global_after;
+
+use lib 't/lib';
+use test::hooks;
-local $RPC::ExtDirect::API::DEBUG = 1;
+my $api = RPC::ExtDirect->get_api();
+my $method_ref = $api->get_method_by_name('Foo', 'foo_zero');
-my $expected = q~
-Ext.app.REMOTE_CALL_API = {
- "actions":{
- "Bar":[
- { "len":5, "name":"bar_bar" },
- { "formHandler":true, "len":0, "name":"bar_baz" },
- { "len":4, "name":"bar_foo" }
- ],
- "Foo":[
- { "len":2, "name":"foo_bar" },
- { "name":"foo_baz", "params":["foo","bar","baz"] },
- { "name":"foo_blessed" },
- { "len":1, "name":"foo_foo" },
- { "len":0, "name":"foo_zero" }
- ],
- "Qux":[
- { "len":5, "name":"bar_bar" },
- { "formHandler":true, "len":0, "name":"bar_baz" },
- { "len":4, "name":"bar_foo" },
- { "len":2, "name":"foo_bar" },
- { "name":"foo_baz", "params":["foo","bar","baz"] },
- { "len":1, "name":"foo_foo" }
- ]
- },
- "namespace":"myApp.Server",
- "type":"remoting",
- "url":"/router.cgi"
-};
-Ext.direct.Manager.addProvider(Ext.app.REMOTE_CALL_API);
-Ext.app.REMOTE_EVENT_API = {
- "type":"polling",
- "url":"/poll.cgi"
-};
-Ext.direct.Manager.addProvider(Ext.app.REMOTE_EVENT_API);
-~;
+$api->before->run(
+ api => $api,
+ method_ref => $method_ref,
+);
-my $remoting_api = eval { RPC::ExtDirect::API->get_remoting_api() };
+ok $test::hooks::WAS_THERE, "Before hook resolved";
-# Remove whitespace
-s/\s//g for ( $expected, $remoting_api );
+$api->after->run(
+ api => $api,
+ method_ref => $method_ref,
+);
-is $@, '', "remoting_api() 3 eval $@";
-is $remoting_api, $expected, "remoting_api() 3 result";
+ok $::WAS_THERE, "After hook resolved";
-exit 0;
@@ -0,0 +1,48 @@
+# Dynamically defined Hooks with eager and lazy code resolution
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+use RPC::ExtDirect::Test::Util;
+
+our $WAS_THERE;
+
+sub global_after {
+ $WAS_THERE = 1;
+}
+
+use RPC::ExtDirect::API;
+
+use lib 't/lib';
+use test::hooks;
+
+my $api = RPC::ExtDirect::API->new_from_hashref(
+ api_href => {
+ before => 'test::hooks::global_before',
+ after => \&global_after,
+
+ Foo => {
+ methods => {
+ foo_zero => { len => 0 },
+ },
+ }
+ }
+);
+
+my $method_ref = $api->get_method_by_name('Foo', 'foo_zero');
+
+$api->before->run(
+ api => $api,
+ method_ref => $method_ref,
+);
+
+ok $test::hooks::WAS_THERE, "Before hook resolved";
+
+$api->after->run(
+ api => $api,
+ method_ref => $method_ref,
+);
+
+ok $::WAS_THERE, "After hook resolved";
+
@@ -0,0 +1,119 @@
+# API initialization from a hashref
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+use RPC::ExtDirect::Test::Util;
+use RPC::ExtDirect::Config;
+use RPC::ExtDirect::API;
+
+my $test_data = eval do { local $/; <DATA>; } or die "Can't eval DATA: '$@'";
+
+my $api_def = $test_data->{api_def};
+my $tests = $test_data->{tests};
+
+my $config = RPC::ExtDirect::Config->new(
+ debug_serialize => 1,
+ namespace => 'myApp.Server',
+ router_path => '/router.cgi',
+ poll_path => '/poll.cgi',
+ remoting_var => 'Ext.app.REMOTE_CALL_API',
+ polling_var => 'Ext.app.REMOTE_EVENT_API',
+ auto_connect => 'HELL YEAH!',
+);
+
+my $api = eval {
+ RPC::ExtDirect::API->new_from_hashref(
+ config => $config,
+ api_href => $api_def,
+ )
+};
+
+is $@, '', "new_from_hashref eval $@";
+isa_ok $api, 'RPC::ExtDirect::API';
+
+$api->config->debug_serialize(1);
+
+my $want = shift @$tests;
+my $have = eval { $api->get_remoting_api() };
+
+is $@, '', "remoting_api() eval $@";
+cmp_api $have, $want, "remoting_api() result";
+
+__DATA__
+
+{
+ api_def => {
+ 'RPC::ExtDirect::Test::Foo' => {
+ methods => {
+ foo_foo => { len => 1 },
+ foo_bar => { len => 2 },
+ foo_blessed => { },
+ foo_baz => { params => [qw/ foo bar baz /] },
+ foo_zero => { len => 0 },
+ },
+ },
+ 'RPC::ExtDirect::Test::Bar' => {
+ methods => {
+ bar_bar => { len => 5 },
+ bar_foo => { len => 4 },
+ bar_baz => { formHandler => 1 },
+ },
+ },
+ 'RPC::ExtDirect::Test::Qux' => {
+ methods => {
+ foo_foo => { len => 1 },
+ bar_bar => { len => 5 },
+ bar_foo => { len => 4 },
+ bar_baz => { formHandler => 1 },
+ foo_bar => { len => 2 },
+ foo_baz => { params => [qw/ foo bar baz /] },
+ },
+ },
+ 'RPC::ExtDirect::Test::PollProvider' => {
+ methods => {
+ foo => { pollHandler => 1 },
+ },
+ },
+ },
+
+ tests => [
+ q~
+ Ext.app.REMOTE_CALL_API = {
+ "actions":{
+ "Bar":[
+ { "len":5, "name":"bar_bar" },
+ { "len":4, "name":"bar_foo" },
+ { "formHandler":true, "len":0, "name":"bar_baz" }
+ ],
+ "Foo":[
+ { "len":1, "name":"foo_foo" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_blessed" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":0, "name":"foo_zero" }
+ ],
+ "Qux":[
+ { "len":1, "name":"foo_foo" },
+ { "len":5, "name":"bar_bar" },
+ { "len":4, "name":"bar_foo" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] }
+ ]
+ },
+ "namespace":"myApp.Server",
+ "type":"remoting",
+ "url":"/router.cgi"
+ };
+ Ext.direct.Manager.addProvider(Ext.app.REMOTE_CALL_API);
+ Ext.app.REMOTE_EVENT_API = {
+ "type":"polling",
+ "url":"/poll.cgi"
+ };
+ Ext.direct.Manager.addProvider(Ext.app.REMOTE_EVENT_API);
+ ~,
+ ],
+}
@@ -0,0 +1,123 @@
+# Remote API initialization from a hashref (no packages)
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+use RPC::ExtDirect::Test::Util;
+use RPC::ExtDirect::Config;
+use RPC::ExtDirect::API;
+
+my $test_data = eval do { local $/; <DATA>; } or die "Can't eval DATA: '$@'";
+
+my $api_def = $test_data->{api_def};
+my $tests = $test_data->{tests};
+
+my $config = RPC::ExtDirect::Config->new(
+ debug_serialize => 1,
+ namespace => 'myApp.Server',
+ router_path => '/router.cgi',
+ poll_path => '/poll.cgi',
+ remoting_var => 'Ext.app.REMOTE_CALL_API',
+ polling_var => 'Ext.app.REMOTE_EVENT_API',
+ auto_connect => 'HELL YEAH!',
+);
+
+my $api = eval {
+ RPC::ExtDirect::API->new_from_hashref(
+ config => $config,
+ api_href => $api_def,
+ )
+};
+
+is $@, '', "new_from_hashref eval $@";
+isa_ok $api, 'RPC::ExtDirect::API';
+
+$api->config->debug_serialize(1);
+
+my $want = shift @$tests;
+my $have = eval { $api->get_remoting_api() };
+
+is $@, '', "remoting_api() eval $@";
+cmp_api $have, $want, "remoting_api() result";
+
+__DATA__
+
+{
+ api_def => {
+ 'Foo' => {
+ remote => 1,
+ methods => {
+ foo_foo => { len => 1 },
+ foo_bar => { len => 2 },
+ foo_blessed => { },
+ foo_baz => { params => [qw/ foo bar baz /] },
+ foo_zero => { len => 0 },
+ },
+ },
+ 'Bar' => {
+ remote => 1,
+ methods => {
+ bar_bar => { len => 5 },
+ bar_foo => { len => 4 },
+ bar_baz => { formHandler => 1 },
+ },
+ },
+ 'Qux' => {
+ remote => 1,
+ methods => {
+ foo_foo => { len => 1 },
+ bar_bar => { len => 5 },
+ bar_foo => { len => 4 },
+ bar_baz => { formHandler => 1 },
+ foo_bar => { len => 2 },
+ foo_baz => { params => [qw/ foo bar baz /] },
+ },
+ },
+ 'PollProvider' => {
+ remote => 1,
+ methods => {
+ foo => { pollHandler => 1 },
+ },
+ },
+ },
+
+ tests => [
+ q~
+ Ext.app.REMOTE_CALL_API = {
+ "actions":{
+ "Bar":[
+ { "len":5, "name":"bar_bar" },
+ { "len":4, "name":"bar_foo" },
+ { "formHandler":true, "len":0, "name":"bar_baz" }
+ ],
+ "Foo":[
+ { "len":1, "name":"foo_foo" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_blessed" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":0, "name":"foo_zero" }
+ ],
+ "Qux":[
+ { "len":1, "name":"foo_foo" },
+ { "len":5, "name":"bar_bar" },
+ { "len":4, "name":"bar_foo" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] }
+ ]
+ },
+ "namespace":"myApp.Server",
+ "type":"remoting",
+ "url":"/router.cgi"
+ };
+ Ext.direct.Manager.addProvider(Ext.app.REMOTE_CALL_API);
+ Ext.app.REMOTE_EVENT_API = {
+ "type":"polling",
+ "url":"/poll.cgi"
+ };
+ Ext.direct.Manager.addProvider(Ext.app.REMOTE_EVENT_API);
+ ~,
+ ],
+}
@@ -0,0 +1,165 @@
+# Selective API publishing based on env objects
+
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+
+use RPC::ExtDirect::Test::Util;
+use RPC::ExtDirect::Config;
+use RPC::ExtDirect::API;
+
+package RPC::ExtDirect::API::Method::Foo;
+
+use base 'RPC::ExtDirect::API::Method';
+
+sub get_api_definition {
+ my ($self, $env) = @_;
+
+ my $user = 'HASH' eq ref($env) && $env->{user};
+ my $action = $self->action;
+
+ return if $user ne 'foo' && $action ne 'Foo';
+
+ return $self->SUPER::get_api_definition($env);
+}
+
+package main;
+
+my $test_data = eval do { local $/; <DATA>; } or die "Can't eval DATA: '$@'";
+
+my $api_def = $test_data->{api_def};
+my $tests = $test_data->{tests};
+
+my $config = RPC::ExtDirect::Config->new(
+ debug_serialize => 1,
+ namespace => 'myApp.Server',
+ router_path => '/router.cgi',
+ poll_path => '/poll.cgi',
+ remoting_var => 'Ext.app.REMOTE_CALL_API',
+ polling_var => 'Ext.app.REMOTE_EVENT_API',
+ api_method_class => 'RPC::ExtDirect::API::Method::Foo',
+);
+
+my $api = eval {
+ RPC::ExtDirect::API->new_from_hashref(
+ config => $config,
+ api_href => $api_def,
+ )
+};
+
+is $@, '', "new_from_hashref eval $@";
+isa_ok $api, 'RPC::ExtDirect::API';
+
+$api->config->debug_serialize(1);
+
+my $want = shift @$tests;
+my $have = eval { $api->get_remoting_api() };
+
+is $@, '', "anon remoting_api() eval $@";
+cmp_api $have, $want, "anon remoting_api() result";
+
+$want = shift @$tests;
+$have = eval { $api->get_remoting_api( env => { user => 'foo' } ) };
+
+is $@, '', "authz remoting_api eval $@";
+cmp_api $have, $want, "authz remoting_api result";
+
+__DATA__
+
+{
+ api_def => {
+ 'Foo' => {
+ remote => 1,
+ methods => {
+ foo_foo => { len => 1 },
+ foo_bar => { len => 2 },
+ foo_blessed => { },
+ foo_baz => { params => [qw/ foo bar baz /] },
+ foo_zero => { len => 0 },
+ },
+ },
+ 'Bar' => {
+ remote => 1,
+ methods => {
+ bar_bar => { len => 5 },
+ bar_foo => { len => 4 },
+ bar_baz => { formHandler => 1 },
+ },
+ },
+ 'Qux' => {
+ remote => 1,
+ methods => {
+ foo_foo => { len => 1 },
+ bar_bar => { len => 5 },
+ bar_foo => { len => 4 },
+ bar_baz => { formHandler => 1 },
+ foo_bar => { len => 2 },
+ foo_baz => { params => [qw/ foo bar baz /] },
+ },
+ },
+ 'PollProvider' => {
+ remote => 1,
+ methods => {
+ foo => { pollHandler => 1 },
+ },
+ },
+ },
+
+ tests => [
+ q~
+ Ext.app.REMOTE_CALL_API = {
+ "actions":{
+ "Foo":[
+ { "len":1, "name":"foo_foo" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_blessed" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":0, "name":"foo_zero" }
+ ]
+ },
+ "namespace":"myApp.Server",
+ "type":"remoting",
+ "url":"/router.cgi"
+ };
+ Ext.app.REMOTE_EVENT_API = {
+ "type":"polling",
+ "url":"/poll.cgi"
+ };
+ ~,
+
+ q~
+ Ext.app.REMOTE_CALL_API = {
+ "actions":{
+ "Bar":[
+ { "len":5, "name":"bar_bar" },
+ { "len":4, "name":"bar_foo" },
+ { "formHandler":true, "len":0, "name":"bar_baz" }
+ ],
+ "Foo":[
+ { "len":1, "name":"foo_foo" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_blessed" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":0, "name":"foo_zero" }
+ ],
+ "Qux":[
+ { "len":1, "name":"foo_foo" },
+ { "len":5, "name":"bar_bar" },
+ { "len":4, "name":"bar_foo" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] }
+ ]
+ },
+ "namespace":"myApp.Server",
+ "type":"remoting",
+ "url":"/router.cgi"
+ };
+ Ext.app.REMOTE_EVENT_API = {
+ "type":"polling",
+ "url":"/poll.cgi"
+ };
+ ~,
+ ],
+}
@@ -0,0 +1,549 @@
+# Method argument checking preparation
+
+use strict;
+use warnings;
+
+use Test::More tests => 59;
+
+use RPC::ExtDirect::Test::Util;
+use RPC::ExtDirect::Config;
+use RPC::ExtDirect::API;
+use RPC::ExtDirect::API::Method;
+
+my $tests = eval do { local $/; <DATA>; } or die "Can't eval DATA: '$@'";
+
+my @run_only = @ARGV;
+
+my $config = RPC::ExtDirect::Config->new();
+
+TEST:
+for my $test ( @$tests ) {
+ my $name = $test->{name};
+ my $type = $test->{type};
+ my $method_arg = $test->{method};
+ my $input = $test->{input};
+ my $out_type = $test->{out_type};
+ my $output = $test->{output};
+ my $exception = $test->{exception};
+
+ next TEST if @run_only && !grep { lc $name eq lc $_ } @run_only;
+
+ my $method = RPC::ExtDirect::API::Method->new(
+ config => $config,
+ %$method_arg,
+ );
+
+ if ( $type eq 'check' ) {
+ my $result = eval { $method->check_method_arguments($input) };
+
+ if ( $exception ) {
+ like $@, $exception, "$name: check exception";
+ }
+ else {
+ is_deep $result, $output, "$name: check result";
+ }
+ }
+ else {
+ my @prep_out = $method->prepare_method_arguments(%$input);
+ my $prep_out = $method->prepare_method_arguments(%$input);
+
+ is ref($prep_out), uc $out_type, "$name: scalar context ref";
+ is_deep $prep_out, $output, "$name: prepare output";
+ }
+}
+
+__DATA__
+
+[
+ {
+ name => 'Ordered passed {}',
+ type => 'check',
+ method => {
+ len => 0,
+ },
+ input => { foo => 'bar' },
+ exception => qr/expects ordered arguments in arrayref/,
+ },
+ {
+ name => 'Ordered zero passed [0]',
+ type => 'check',
+ method => {
+ len => 0,
+ },
+ input => [],
+ output => 1,
+ },
+ {
+ name => 'Ordered zero passed [1]',
+ type => 'check',
+ method => {
+ len => 0,
+ },
+ input => [42],
+ output => 1,
+ },
+ {
+ name => 'Ordered 1 passed [0]',
+ type => 'check',
+ method => {
+ len => 1,
+ },
+ input => [],
+ exception => qr/requires 1 argument\(s\) but only 0 are provided/,
+ },
+ {
+ name => 'Ordered 1 passed [1]',
+ type => 'check',
+ method => {
+ len => 1,
+ },
+ input => [42],
+ output => 1,
+ },
+ {
+ name => 'Ordered 1 passed [2]',
+ type => 'check',
+ method => {
+ len => 1,
+ },
+ input => [42, 39],
+ output => 1,
+ },
+ {
+ name => 'Ordered 3 passed [0]',
+ type => 'check',
+ method => {
+ len => 3,
+ },
+ input => [],
+ exception => qr/requires 3 argument\(s\) but only 0 are provided/,
+ },
+ {
+ name => 'Ordered 3 passed [2]',
+ type => 'check',
+ method => {
+ len => 3,
+ },
+ input => [111, 222],
+ exception => qr/requires 3 argument\(s\) but only 2 are provided/,
+ },
+ {
+ name => 'Ordered 3 passed [3]',
+ type => 'check',
+ method => {
+ len => 3,
+ },
+ input => [111, 222, 333],
+ output => 1,
+ },
+ {
+ name => 'Ordered 3 passed [4]',
+ type => 'check',
+ method => {
+ len => 3,
+ },
+ input => [111, 222, 333, 444],
+ output => 1,
+ },
+ {
+ name => 'Named passed []',
+ type => 'check',
+ method => {
+ params => [qw/ foo bar /],
+ },
+ input => [],
+ exception => qr/expects named arguments in hashref/,
+ },
+ {
+ name => 'Named strict passed empty {}',
+ type => 'check',
+ method => {
+ params => [qw/ foo bar /],
+ },
+ input => {},
+ exception => qr/parameters: 'foo, bar'; these are missing: 'foo, bar'/,
+ },
+ {
+ name => 'Named strict empty params, passed empty {}',
+ type => 'check',
+ method => {
+ params => [],
+ },
+ input => {},
+ output => 1,
+ },
+ {
+ name => 'Named !strict empty params, passed empty {}',
+ type => 'check',
+ method => {
+ params => [],
+ strict => !1,
+ },
+ input => {},
+ output => 1,
+ },
+ {
+ name => 'Named strict empty params, passed non-empty {}',
+ type => 'check',
+ method => {
+ params => [],
+ },
+ input => { foo => 'bar', fred => 'frob', },
+ output => 1,
+ },
+ {
+ name => 'Named strict empty params, passed non-empty {}',
+ type => 'check',
+ method => {
+ params => [],
+ },
+ input => { foo => 'bar', fred => 'frob', },
+ output => 1,
+ },
+ {
+ name => 'Named !strict passed empty {}',
+ type => 'check',
+ method => {
+ params => [qw/ foo bar /],
+ strict => !1,
+ },
+ input => {},
+ exception => qr/parameters: 'foo, bar'; these are missing: 'foo, bar'/,
+ },
+ {
+ name => 'Named strict not enough arguments',
+ type => 'check',
+ method => {
+ params => [qw/ foo bar /],
+ },
+ input => { foo => 'bar', },
+ exception => qr/parameters: 'foo, bar'; these are missing: 'bar'/,
+ },
+ {
+ name => 'Named !strict not enough arguments',
+ type => 'check',
+ method => {
+ params => [qw/ foo bar /],
+ strict => !1,
+ },
+ input => { foo => 'bar', },
+ exception => qr/parameters: 'foo, bar'; these are missing: 'bar'/,
+ },
+ {
+ name => 'Named strict not enough required args',
+ type => 'check',
+ method => {
+ params => [qw/ foo bar /],
+ },
+ input => { foo => 'bar', baz => 'blerg', fred => 'frob', },
+ exception => qr/parameters: 'foo, bar'; these are missing: 'bar'/,
+ },
+ {
+ name => 'Named !strict not enough required args',
+ type => 'check',
+ method => {
+ params => [qw/ foo bar /],
+ strict => !1,
+ },
+ input => { foo => 'bar', baz => 'blerg', fred => 'frob', },
+ exception => qr/parameters: 'foo, bar'; these are missing: 'bar'/,
+ },
+ {
+ name => 'Named strict enough args',
+ type => 'check',
+ method => {
+ params => [qw/ foo bar /],
+ },
+ input => { foo => 'bar', bar => 'baz', },
+ output => 1,
+ },
+ {
+ name => 'Named !strict enough args',
+ type => 'check',
+ method => {
+ params => [qw/ foo bar /],
+ strict => !1,
+ },
+ input => { foo => 'bar', bar => 'baz', },
+ output => 1,
+ },
+ {
+ name => 'Named strict extra args',
+ type => 'check',
+ method => {
+ params => [qw/ foo bar /],
+ },
+ input => { foo => 'bar', bar => 'baz', fred => 'frob', },
+ output => 1,
+ },
+ {
+ name => 'Named !strict extra args',
+ type => 'check',
+ method => {
+ params => [qw/ foo bar /],
+ strict => !1,
+ },
+ input => { foo => 'bar', bar => 'baz', fred => 'frob', },
+ output => 1,
+ },
+ {
+ name => 'formHandler passed []',
+ type => 'check',
+ method => {
+ formHandler => 1,
+ },
+ input => [],
+ exception => qr/expects named arguments in hashref/,
+ },
+ {
+ name => 'formHandler passed {}',
+ type => 'check',
+ method => {
+ formHandler => 1,
+ },
+ input => {},
+ output => 1,
+ },
+ {
+ name => 'pollHandler passed []',
+ type => 'check',
+ method => {
+ pollHandler => 1,
+ },
+ input => [],
+ output => 1,
+ },
+ {
+ name => 'pollHandler passed {}',
+ type => 'check',
+ method => {
+ pollHandler => 1,
+ },
+ input => {},
+ output => 1,
+ },
+ {
+ name => 'Ordered zero no env_arg',
+ type => 'prepare',
+ method => {
+ len => 0,
+ },
+ input => {
+ env => 'env',
+ input => [qw/ 1 2 3 /],
+ },
+ out_type => 'array',
+ output => [],
+ },
+ {
+ name => 'Ordered zero env_arg',
+ type => 'prepare',
+ method => {
+ len => 0,
+ env_arg => 0,
+ },
+ input => {
+ env => 'env',
+ input => [qw/ 1 2 3 /],
+ },
+ out_type => 'array',
+ output => ['env'],
+ },
+ {
+ name => 'Ordered multi 1 no env_arg',
+ type => 'prepare',
+ method => {
+ len => 1,
+ },
+ input => {
+ env => 'env',
+ input => [qw/ 1 2 3 /],
+ },
+ out_type => 'array',
+ output => [1],
+ },
+ {
+ name => 'Ordered multi 1 env_arg front',
+ type => 'prepare',
+ method => {
+ len => 1,
+ env_arg => 0,
+ },
+ input => {
+ env => 'env',
+ input => [qw/ 1 2 3 /],
+ },
+ out_type => 'array',
+ output => ['env', 1],
+ },
+ {
+ name => 'Ordered multi 1 env_arg back',
+ type => 'prepare',
+ method => {
+ len => 1,
+ env_arg => 99,
+ },
+ input => {
+ env => 'env',
+ input => [qw/ 1 2 3 /],
+ },
+ out_type => 'array',
+ output => [1, 'env'],
+ },
+ {
+ name => 'Ordered multi 2 env_arg middle',
+ type => 'prepare',
+ method => {
+ len => 2,
+ env_arg => -1,
+ },
+ input => {
+ env => 'env',
+ input => [qw/ 1 2 3 /],
+ },
+ out_type => 'array',
+ output => [1, 'env', 2],
+ },
+ {
+ name => 'Named strict no env',
+ type => 'prepare',
+ method => {
+ params => [qw/ foo bar /],
+ },
+ input => {
+ env => 'env',
+ input => { foo => 1, bar => 2, baz => 3 },
+ },
+ out_type => 'hash',
+ output => { foo => 1, bar => 2, },
+ },
+ {
+ name => 'Named lazy no env',
+ type => 'prepare',
+ method => {
+ params => [qw/ foo bar /],
+ strict => !1,
+ },
+ input => {
+ env => 'env',
+ input => { foo => 1, bar => 2, baz => 3, },
+ },
+ out_type => 'hash',
+ output => { foo => 1, bar => 2, baz => 3, },
+ },
+ {
+ name => 'Named lazy env',
+ type => 'prepare',
+ method => {
+ params => [qw/ foo bar /],
+ env_arg => 'env',
+ strict => !1,
+ },
+ input => {
+ env => 'env',
+ input => { foo => 1, bar => 2, baz => 3, },
+ },
+ out_type => 'hash',
+ output => { foo => 1, bar => 2, baz => 3, env => 'env' },
+ },
+ {
+ name => 'formHandler no uploads no env',
+ type => 'prepare',
+ method => {
+ formHandler => 1,
+ },
+ input => {
+ env => 'env',
+
+ # Test stripping of the standard Ext.Direct fields
+ input => {
+ action => 'Foo',
+ method => 'bar',
+ extAction => 'Foo',
+ extMethod => 'bar',
+ extTID => 1,
+ extUpload => 'true',
+ _uploads => 'foo',
+ foo => 'bar',
+ },
+ },
+ out_type => 'hash',
+ output => { foo => 'bar' },
+ },
+ {
+ name => 'formHandler no uploads w/ env',
+ type => 'prepare',
+ method => {
+ formHandler => 1,
+ env_arg => '_env',
+ },
+ input => {
+ env => 'env',
+ input => { foo => 'bar' },
+ },
+ out_type => 'hash',
+ output => { foo => 'bar', _env => 'env' },
+ },
+ {
+ name => 'formHandler w/def uploads w/ env',
+ type => 'prepare',
+ method => {
+ formHandler => 1,
+ env_arg => 'env_',
+ },
+ input => {
+ env => 'env',
+ input => { foo => 'bar' },
+ upload => [{ baz => 'qux' }],
+ },
+ out_type => 'hash',
+ output => {
+ env_ => 'env',
+ foo => 'bar',
+ file_uploads => [{ baz => 'qux' }],
+ },
+ },
+ {
+ name => 'formHandler w/cust uploads w/ env',
+ type => 'prepare',
+ method => {
+ formHandler => 1,
+ env_arg => 'env',
+ upload_arg => 'files',
+ },
+ input => {
+ env => 'env',
+ input => { foo => 'bar', baz => 'bam', },
+ upload => [{ baz => 'qux' }],
+ },
+ out_type => 'hash',
+ output => {
+ env => 'env',
+ foo => 'bar',
+ baz => 'bam',
+ files => [{ baz => 'qux' }],
+ },
+ },
+ {
+ name => 'pollHandler no env',
+ type => 'prepare',
+ method => {
+ pollHandler => 1,
+ },
+ input => { env => 'env', input => [qw/ foo bar /], },
+ out_type => 'array',
+ output => [],
+ },
+ {
+ name => 'pollHandler w/ env',
+ type => 'prepare',
+ method => {
+ pollHandler => 1,
+ env_arg => 0,
+ },
+ input => { env => 'env', input => { foo => 'bar' }, },
+ out_type => 'array',
+ output => ['env'],
+ },
+];
+
@@ -1,20 +1,19 @@
use strict;
use warnings;
-use Data::Dumper;
-local $Data::Dumper::Indent = 1;
+use RPC::ExtDirect::Test::Util;
+use RPC::ExtDirect::Config;
+use RPC::ExtDirect;
### Testing successful requests
-use Test::More tests => 65;
+use Test::More tests => 64;
-BEGIN { use_ok 'RPC::ExtDirect::Request'; }
+use RPC::ExtDirect::Request;
-# Test modules are so simple they can't fail
-use lib 't/lib';
-use RPC::ExtDirect::Test::Foo;
-use RPC::ExtDirect::Test::Bar;
-use RPC::ExtDirect::Test::Qux;
+use RPC::ExtDirect::Test::Pkg::Foo;
+use RPC::ExtDirect::Test::Pkg::Bar;
+use RPC::ExtDirect::Test::Pkg::Qux;
my $tests = eval do { local $/; <DATA>; } ## no critic
or die "Can't eval test data: $@";
@@ -27,7 +26,8 @@ for my $test ( @$tests ) {
};
# Set debug flag according to test
- local $RPC::ExtDirect::Request::DEBUG = $debug;
+ $data->{config} = RPC::ExtDirect::Config->new( debug_request => $debug, );
+ $data->{api} = RPC::ExtDirect->get_api();
# Try to create object
my $request = eval { RPC::ExtDirect::Request->new($data) };
@@ -48,10 +48,9 @@ for my $test ( @$tests ) {
# Try to get results
my $result = eval { $request->result() };
- is $@, '', "$name result() eval $@";
- ok $result, "$name result() not empty";
- is_deeply $result, $expected_result, "$name result() deep"
- or diag( Data::Dumper->Dump( [$result], ['result'] ) );
+ is $@, '', "$name result() eval $@";
+ ok $result, "$name result() not empty";
+ is_deep $result, $expected_result, "$name result() deep";
};
__DATA__
@@ -1,22 +1,21 @@
use strict;
use warnings;
-use Data::Dumper;
-local $Data::Dumper::Indent = 1;
+use RPC::ExtDirect::Test::Util;
+use RPC::ExtDirect::Config;
+use RPC::ExtDirect;
### Testing invalid inputs
-use Test::More tests => 102;
+use Test::More tests => 94;
-BEGIN { use_ok 'RPC::ExtDirect::Request'; }
+use RPC::ExtDirect::Request;
-# Test modules are so simple they can't fail
-use lib 't/lib';
-use RPC::ExtDirect::Test::Foo;
-use RPC::ExtDirect::Test::Bar;
-use RPC::ExtDirect::Test::Qux;
-use RPC::ExtDirect::Test::Hooks;
-use RPC::ExtDirect::Test::PollProvider;
+use RPC::ExtDirect::Test::Pkg::Foo;
+use RPC::ExtDirect::Test::Pkg::Bar;
+use RPC::ExtDirect::Test::Pkg::Qux;
+use RPC::ExtDirect::Test::Pkg::Hooks;
+use RPC::ExtDirect::Test::Pkg::PollProvider;
my $tests = eval do { local $/; <DATA>; } ## no critic
or die "Can't eval test data: $@";
@@ -29,8 +28,9 @@ for my $test ( @$tests ) {
= @$test{ qw(name data ran_ok result debug run_twice isa code xcpt)
};
- # Set debug flag according to test
- local $RPC::ExtDirect::Request::DEBUG = $debug;
+ # Set debug flag according to the test
+ $data->{config} = RPC::ExtDirect::Config->new( debug_request => $debug );
+ $data->{api} = RPC::ExtDirect->get_api();
# Try to create object
my $request = eval { RPC::ExtDirect::Request->new($data) };
@@ -44,8 +44,8 @@ for my $test ( @$tests ) {
$exception ||= '';
- is_deeply $@, $exception, "$name run() eval";
- is $ran_ok, $expected_ran, "$name run() no error";
+ is_deep $@, $exception, "$name run() eval";
+ is $ran_ok, $expected_ran, "$name run() no error";
# Try to run method second time, no result checks this time
$ran_ok = eval { $request->run() } if $run_twice;
@@ -56,8 +56,7 @@ for my $test ( @$tests ) {
is $@, '', "$name result() eval $@";
if ( $expected_result ) {
- is_deeply $result, $expected_result, "$name result() deep"
- or print Data::Dumper->Dump( [$result], ['result'] );
+ is_deep $result, $expected_result, "$name result() deep";
};
ok $code->(), "$name custom check" if $code;
@@ -95,18 +94,6 @@ __DATA__
message => 'An error has occured while processing '.
'request', },
},
- # Null input, debug on
- {
- name => 'Null input, debug on', debug => 1, ran_ok => '',
- data => undef,
- isa => 'RPC::ExtDirect::Exception',
- result => { type => 'exception',
- action => undef,
- method => undef,
- tid => undef,
- where => 'RPC::ExtDirect::Request->new',
- message => 'ExtDirect input error: invalid input', },
- },
# Invalid input 1, debug on
{
name => 'Invalid input 1, debug on', debug => 1, ran_ok => '',
@@ -157,9 +144,11 @@ __DATA__
action => 'Qux',
method => 'bar_foo',
tid => 222,
- where => 'RPC::ExtDirect::Request->_check_arguments',
- message => 'ExtDirect method Qux.bar_foo '.
- 'needs 4 arguments instead of 3', },
+ where => 'RPC::ExtDirect::API::Method->'.
+ 'check_method_arguments',
+ message => 'ExtDirect Method Qux.bar_foo '.
+ 'requires 4 argument(s) but only 3 '.
+ 'are provided', },
},
# Tried to run method twice
{
@@ -186,7 +175,7 @@ __DATA__
action => 'Qux',
method => 'bar_foo',
tid => 444,
- where => 'RPC::ExtDirect::Test::Qux->bar_foo',
+ where => 'RPC::ExtDirect::Test::Pkg::Qux->bar_foo',
message => "bar foo!", },
},
# Form handler called directly
@@ -199,7 +188,7 @@ __DATA__
action => 'Bar',
method => 'bar_baz',
tid => 555,
- where => 'RPC::ExtDirect::Request->_check_arguments',
+ where => 'RPC::ExtDirect::Request->check_arguments',
message => "ExtDirect formHandler method ".
"Bar.bar_baz should only be called ".
"with form submits", },
@@ -214,7 +203,7 @@ __DATA__
action => 'PollProvider',
method => 'foo',
tid => 666,
- where => 'RPC::ExtDirect::Request->_check_arguments',
+ where => 'RPC::ExtDirect::Request->check_arguments',
message => "ExtDirect pollHandler method ".
"PollProvider.foo should not ".
"be called directly", },
@@ -230,12 +219,12 @@ __DATA__
action => 'Hooks',
method => 'foo_foo',
tid => 777,
- where => 'RPC::ExtDirect::Test::Hooks->foo_foo',
+ where => 'RPC::ExtDirect::Test::Pkg::Hooks->foo_foo',
message => 'Undefined subroutine '.
- '&RPC::ExtDirect::Test::Hooks::'.
+ '&RPC::ExtDirect::Test::Pkg::Hooks::'.
'nonexistent_before_hook called',
},
- code => sub { !$RPC::ExtDirect::Test::Hooks::foo_foo_called },
+ code => sub { !$RPC::ExtDirect::Test::Pkg::Hooks::foo_foo_called },
},
# Before hook unset (NONE)
@@ -246,7 +235,7 @@ __DATA__
isa => 'RPC::ExtDirect::Request',
result => { type => 'rpc', action => 'Hooks', method => 'foo_bar',
tid => 888, result => 1 },
- code => sub { $RPC::ExtDirect::Test::Hooks::foo_bar_called },
+ code => sub { $RPC::ExtDirect::Test::Pkg::Hooks::foo_bar_called },
},
# After hook
@@ -260,7 +249,7 @@ __DATA__
action => 'Hooks', method => 'foo_baz',
result => { msg => 'foo! bar! baz!',
foo => 111, bar => 222, baz => 333 }, },
- code => sub { !!$RPC::ExtDirect::Test::Hooks::foo_baz_called },
+ code => sub { !!$RPC::ExtDirect::Test::Pkg::Hooks::foo_baz_called },
},
]
@@ -1,16 +1,16 @@
use strict;
use warnings;
-use Test::More tests => 65;
+use Test::More tests => 64;
-use Data::Dumper;
-$Data::Dumper::Indent = 1;
+use RPC::ExtDirect::Test::Util;
+use RPC::ExtDirect::Config;
+use RPC::ExtDirect;
-BEGIN { use_ok 'RPC::ExtDirect::Deserialize'; }
+use RPC::ExtDirect::Serializer;
# Test modules are simple and effective
-use lib 't/lib';
-use RPC::ExtDirect::Test::Qux;
+use RPC::ExtDirect::Test::Pkg::Qux;
my $tests = eval do { local $/; <DATA>; } ## no critic
or die "Can't eval DATA: $@";
@@ -23,11 +23,22 @@ for my $test ( @$tests ) {
my $expect = $test->{result};
my $run_exp = $test->{run};
- # Set the debug flags
- local $RPC::ExtDirect::Request::DEBUG = $debug;
- local $RPC::ExtDirect::Deserialize::DEBUG = $debug;
-
- my $requests = eval { RPC::ExtDirect::Deserialize->$method($data) };
+ my $api = RPC::ExtDirect->get_api;
+ my $config = RPC::ExtDirect::Config->new(
+ debug_request => $debug,
+ debug_deserialize => $debug,
+ );
+
+ my $serializer = RPC::ExtDirect::Serializer->new(
+ api => $api,
+ config => $config,
+ );
+
+ my $requests = eval {
+ $serializer->$method(
+ data => $data
+ )
+ };
is $@, '', "$name $method() requests eval $@";
ok ref $requests eq 'ARRAY', "$name $method requests is ARRAY";
@@ -39,21 +50,17 @@ for my $test ( @$tests ) {
my $runs = eval { [ map { $_->run() } @$requests ] };
- is $@, '', "$name $method() runs eval $@";
- ok ref $runs eq 'ARRAY', "$name $method() runs is ARRAY";
- is_deeply $runs, $run_exp, "$name $method() runs deep";
+ is $@, '', "$name $method() runs eval $@";
+ ok ref $runs eq 'ARRAY', "$name $method() runs is ARRAY";
+ is_deep $runs, $run_exp, "$name $method() runs deep";
my $results = eval { [ map { $_->result() } @$requests ] };
- is $@, '', "$name $method() results eval $@";
- ok ref $results eq 'ARRAY', "$name $method() results is ARRAY";
-
- is_deeply $results, $expect, "$name $method() results deep"
- or print Data::Dumper->Dump( [$results], ['results'] );
+ is $@, '', "$name $method() results eval $@";
+ ok ref $results eq 'ARRAY', "$name $method() results is ARRAY";
+ is_deep $results, $expect, "$name $method() results deep";
};
-exit 0;
-
__DATA__
[
{ name => 'Invalid post data, debug off', debug => 0,
@@ -71,7 +78,7 @@ __DATA__
run => [ '' ],
result => [ { type => 'exception', action => undef,
tid => undef, method => undef,
- where => 'RPC::ExtDirect::Deserialize->decode_post',
+ where => 'RPC::ExtDirect::Serializer->decode_post',
message => q!ExtDirect error decoding POST data: '!.
q!, or } expected while parsing object/hash!.
q!, at character offset 16 (before !.
@@ -1,14 +1,15 @@
use strict;
use warnings;
-no warnings 'uninitialized';
-use Test::More tests => 25;
+use Test::More tests => 24;
-BEGIN { use_ok 'RPC::ExtDirect::Router'; }
+use RPC::ExtDirect::Test::Util;
+use RPC::ExtDirect::Config;
+
+use RPC::ExtDirect::Router;
# Test modules are simple
-use lib 't/lib';
-use RPC::ExtDirect::Test::Qux;
+use RPC::ExtDirect::Test::Pkg::Qux;
my $tests = eval do { local $/; <DATA>; } ## no critic
or die "Can't eval DATA: $@";
@@ -19,35 +20,36 @@ for my $test ( @$tests ) {
my $input = $test->{input};
my $expect = $test->{output};
- local $RPC::ExtDirect::Router::DEBUG = $debug;
+ my $config = RPC::ExtDirect::Config->new(
+ debug_router => $debug,
+ );
+
+ my $router = RPC::ExtDirect::Router->new(
+ config => $config,
+ );
- my $result = eval { RPC::ExtDirect::Router->route($input) };
+ my $result = eval { $router->route($input) };
# Remove whitespace
s/\s//g for ( $expect->[2]->[0], $result->[2]->[0] );
# Remove reference addresses. On different platforms
# stringified reference has different length so we're
- # trying to compensate for it here.
+ # trying to compensate for that here.
# Additionally, JSON error output may change (again) and
# that will break this test (again), so we cheat instead.
if ( $result->[2]->[0] =~ /HASH\(/ ) {
- my $ref_len = length({} . '') - length 'HASH(blessed)';
-
s/HASH\([^\)]+\)[^"]+/HASH(blessed)'/g
for ( $expect->[2]->[0], $result->[2]->[0] );
$result->[1]->[3] = $expect->[1]->[3] = length $expect->[2]->[0];
};
- is $@, '', "$name eval $@";
- is ref $result, 'ARRAY', "$name result ARRAY";
- is_deeply $result, $expect, "$name result deep"
- or diag explain "Expected:", $expect, "Actual:", $result;
+ is $@, '', "$name eval $@";
+ is ref $result, 'ARRAY', "$name result ARRAY";
+ is_deep $result, $expect, "$name result deep";
};
-exit 0;
-
__DATA__
[
{ name => 'Invalid result', debug => 1,
@@ -57,14 +59,14 @@ __DATA__
200,
[
'Content-Type', 'application/json',
- 'Content-Length', 221,
+ 'Content-Length', 222,
],
[
q|{"action":"Foo","message":"encountered object |.
q|'foo=HASH(0x10088fca0)', but neither allow_blessed|.
q| nor convert_blessed settings are enabled","method"|.
q|:"foo_blessed","tid":1,"type":"exception","where":|.
- q|"RPC::ExtDirect::Serialize"}|,
+ q|"RPC::ExtDirect::Serializer"}|,
],
],
},
@@ -72,7 +74,7 @@ __DATA__
input => '{"something":"invalid":"here"}',
output => [ 200,
[ 'Content-Type', 'application/json',
- 'Content-Length', 250,
+ 'Content-Length', 249,
],
[ q|{"action":null,|.
q|"message":"ExtDirect error decoding POST data: |.
@@ -80,7 +82,7 @@ __DATA__
q|character offset 22 (before \":\"here\"}\")'",|.
q|"method":null,"tid":null,|.
q|"type":"exception",|.
- q|"where":"RPC::ExtDirect::Deserialize->decode_post"}|
+ q|"where":"RPC::ExtDirect::Serializer->decode_post"}|
],
],
},
@@ -123,14 +125,14 @@ __DATA__
input => { extTID => 100, action => 'Bar', method => 'bar_baz',
type => 'rpc', data => undef, },
output => [ 200, [ 'Content-Type', 'application/json',
- 'Content-Length', 209, ],
+ 'Content-Length', 208, ],
[
q|{"action":"Bar",|.
q|"message":"ExtDirect formHandler method |.
q|Bar.bar_baz should only be called with form submits",|.
q|"method":"bar_baz","tid":100,|.
q|"type":"exception",|.
- q|"where":"RPC::ExtDirect::Request->_check_arguments"}|,
+ q|"where":"RPC::ExtDirect::Request->check_arguments"}|,
],
],
},
@@ -1,14 +1,14 @@
use strict;
use warnings;
-use Test::More tests => 11;
+use Test::More tests => 10;
-use lib 't/lib';
-use RPC::ExtDirect::Test::PollProvider;
+use RPC::ExtDirect::Test::Pkg::PollProvider;
-BEGIN { use_ok 'RPC::ExtDirect::EventProvider'; }
+use RPC::ExtDirect::Test::Util qw/ cmp_json /;
+use RPC::ExtDirect::Config;
-local $RPC::ExtDirect::EventProvider::DEBUG = 1;
+use RPC::ExtDirect::EventProvider;
my $tests = eval do { local $/; <DATA>; } ## no critic
or die "Can't eval DATA: '$@'";
@@ -18,19 +18,22 @@ for my $test ( @$tests ) {
my $password = $test->{password};
my $expect = $test->{result};
- local $RPC::ExtDirect::Test::PollProvider::WHAT_YOURE_HAVING
+ local $RPC::ExtDirect::Test::Pkg::PollProvider::WHAT_YOURE_HAVING
= $password;
- my $result = eval { RPC::ExtDirect::EventProvider->poll() };
+ my $config = RPC::ExtDirect::Config->new(
+ debug_serialize => 1,
+ );
- # Remove whitespace
- s/\s//g for ( $expect, $result );
+ my $provider = RPC::ExtDirect::EventProvider->new(
+ config => $config,
+ );
- is $@, '', "$name eval $@";
- is $result, $expect, "$name result";
-};
+ my $result = eval { $provider->poll() };
-exit 0;
+ is $@, '', "$name eval $@";
+ cmp_json $result, $expect, "$name result";
+};
__DATA__
[
@@ -1,15 +1,12 @@
use strict;
use warnings;
-no warnings 'uninitialized';
-use Test::More tests => 17;
+use Test::More tests => 16;
-use Data::Dumper;
-local $Data::Dumper::Indent = 1;
+use RPC::ExtDirect::Test::Util;
-use lib 't/lib';
-use RPC::ExtDirect::Test::Hooks;
-use RPC::ExtDirect::Test::PollProvider;
+use RPC::ExtDirect::Test::Pkg::Hooks;
+use RPC::ExtDirect::Test::Pkg::PollProvider;
use RPC::ExtDirect::Router;
use RPC::ExtDirect::EventProvider;
@@ -46,14 +43,14 @@ use RPC::ExtDirect::API before => \&before_hook, after => \&after_hook;
# This cheating is to avoid rewriting test modules
- package RPC::ExtDirect::Test::Hooks;
+ package RPC::ExtDirect::Test::Pkg::Hooks;
RPC::ExtDirect->import( Action => 'Hooks',
before => \&main::before_hook,
after => \&main::after_hook );
}
-BEGIN { use_ok 'RPC::ExtDirect::Hook' };
+use RPC::ExtDirect::API::Hook;
# These variables get set when hooks are called
my ($before, $after, $modify, $throw_up, $cancel);
@@ -104,14 +101,30 @@ for my $test ( @$tests ) {
eval { delete $before->[1]->{orig}; delete $after->[1]->{orig}; };
$@ = undef;
- is_deeply $before, $exp_before, "$name: before data"
- or diag( Data::Dumper->Dump( [$before], ['before'] ) );
-
- is_deeply $after, $exp_after, "$name: after data"
- or diag( Data::Dumper->Dump( [$after], ['after'] ) );
-
+ is_deep $before, $exp_before, "$name: before data";
+ is_deep $after, $exp_after, "$name: after data";
};
+sub get_method_ref {
+ my ($action_name, $method_name) = @_;
+
+ my $api = RPC::ExtDirect->get_api;
+
+ return $api->get_method_by_name($action_name, $method_name);
+}
+
+sub get_hook_ref {
+ my ($action_name, $method_name, $type) = @_;
+
+ my $api = RPC::ExtDirect->get_api;
+
+ return $api->get_hook(
+ action => $action_name,
+ method => $method_name,
+ type => $type,
+ );
+}
+
__DATA__
[
# Cancel Method call by throwing error
@@ -126,29 +139,36 @@ __DATA__
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ Hooks foo_hook before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::Hooks',
+ after_ref => get_hook_ref(qw/ Hooks foo_hook after /),
+ package => 'RPC::ExtDirect::Test::Pkg::Hooks',
method => 'foo_hook',
- code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
- arg => [ 'foo', 'env' ],
+ code => \&RPC::ExtDirect::Test::Pkg::Hooks::foo_hook,
+ arg => [ 'foo' ],
env => 'env',
param_names => undef,
param_no => 1,
pollHandler => 0,
formHandler => 0,
+ method_ref => get_method_ref(qw/ Hooks foo_hook /),
},
],
expected_after => [
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ Hooks foo_hook before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::Hooks',
+ after_ref => get_hook_ref(qw/ Hooks foo_hook after /),
+ package => 'RPC::ExtDirect::Test::Pkg::Hooks',
method => 'foo_hook',
- code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
- arg => [ 'foo', 'env' ],
+ code => \&RPC::ExtDirect::Test::Pkg::Hooks::foo_hook,
+ arg => [ 'foo' ],
env => 'env',
result => undef,
exception => "Exception\n",
@@ -157,6 +177,7 @@ __DATA__
pollHandler => 0,
formHandler => 0,
method_called => undef,
+ method_ref => get_method_ref(qw/ Hooks foo_hook /),
},
],
},
@@ -173,29 +194,36 @@ __DATA__
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ Hooks foo_hook before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::Hooks',
+ after_ref => get_hook_ref(qw/ Hooks foo_hook after /),
+ package => 'RPC::ExtDirect::Test::Pkg::Hooks',
method => 'foo_hook',
- code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
- arg => [ 'foo', 'env' ],
+ code => \&RPC::ExtDirect::Test::Pkg::Hooks::foo_hook,
+ arg => [ 'foo' ],
env => 'env',
param_names => undef,
param_no => 1,
pollHandler => 0,
formHandler => 0,
+ method_ref => get_method_ref(qw/ Hooks foo_hook /),
},
],
expected_after => [
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ Hooks foo_hook before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::Hooks',
+ after_ref => get_hook_ref(qw/ Hooks foo_hook after /),
+ package => 'RPC::ExtDirect::Test::Pkg::Hooks',
method => 'foo_hook',
- code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
- arg => [ 'foo', 'env' ],
+ code => \&RPC::ExtDirect::Test::Pkg::Hooks::foo_hook,
+ arg => [ 'foo' ],
env => 'env',
result => 'Method canceled',
exception => undef,
@@ -204,6 +232,7 @@ __DATA__
pollHandler => 0,
formHandler => 0,
method_called => undef,
+ method_ref => get_method_ref(qw/ Hooks foo_hook /),
},
],
},
@@ -219,37 +248,45 @@ __DATA__
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ Hooks foo_hook before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::Hooks',
+ after_ref => get_hook_ref(qw/ Hooks foo_hook after /),
+ package => 'RPC::ExtDirect::Test::Pkg::Hooks',
method => 'foo_hook',
- code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
- arg => [ 'foo', 'env' ],
+ code => \&RPC::ExtDirect::Test::Pkg::Hooks::foo_hook,
+ arg => [ 'foo' ],
env => 'env',
param_names => undef,
param_no => 1,
pollHandler => 0,
formHandler => 0,
+ method_ref => get_method_ref(qw/ Hooks foo_hook /),
},
],
expected_after => [
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ Hooks foo_hook before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::Hooks',
+ after_ref => get_hook_ref(qw/ Hooks foo_hook after /),
+ package => 'RPC::ExtDirect::Test::Pkg::Hooks',
method => 'foo_hook',
- code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
- arg => [ 'foo', 'env' ],
+ code => \&RPC::ExtDirect::Test::Pkg::Hooks::foo_hook,
+ arg => [ 'foo' ],
env => 'env',
- result => [ 'RPC::ExtDirect::Test::Hooks', 'foo', 'env' ],
+ result => [ 'RPC::ExtDirect::Test::Pkg::Hooks', 'foo' ],
exception => '',
param_names => undef,
param_no => 1,
pollHandler => 0,
formHandler => 0,
- method_called => \&RPC::ExtDirect::Test::Hooks::foo_hook,
+ method_called => \&RPC::ExtDirect::Test::Pkg::Hooks::foo_hook,
+ method_ref => get_method_ref(qw/ Hooks foo_hook /),
},
],
},
@@ -266,37 +303,45 @@ __DATA__
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ Hooks foo_hook before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::Hooks',
+ after_ref => get_hook_ref(qw/ Hooks foo_hook after /),
+ package => 'RPC::ExtDirect::Test::Pkg::Hooks',
method => 'foo_hook',
- code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
- arg => [ 'bar', 'env' ],
+ code => \&RPC::ExtDirect::Test::Pkg::Hooks::foo_hook,
+ arg => [ 'bar' ],
env => 'env',
param_names => undef,
param_no => 1,
pollHandler => 0,
formHandler => 0,
+ method_ref => get_method_ref(qw/ Hooks foo_hook /),
},
],
expected_after => [
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ Hooks foo_hook before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::Hooks',
+ after_ref => get_hook_ref(qw/ Hooks foo_hook after /),
+ package => 'RPC::ExtDirect::Test::Pkg::Hooks',
method => 'foo_hook',
- code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
- arg => [ 'bar', 'env' ],
+ code => \&RPC::ExtDirect::Test::Pkg::Hooks::foo_hook,
+ arg => [ 'bar' ],
env => 'env',
- result => [ 'RPC::ExtDirect::Test::Hooks', 'bar', 'env' ],
+ result => [ 'RPC::ExtDirect::Test::Pkg::Hooks', 'bar' ],
exception => '',
param_names => undef,
param_no => 1,
pollHandler => 0,
formHandler => 0,
- method_called => \&RPC::ExtDirect::Test::Hooks::foo_hook,
+ method_called => \&RPC::ExtDirect::Test::Pkg::Hooks::foo_hook,
+ method_ref => get_method_ref(qw/ Hooks foo_hook /),
},
],
},
@@ -311,29 +356,36 @@ __DATA__
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ PollProvider foo before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::PollProvider',
+ after_ref => get_hook_ref(qw/ PollProvider foo after /),
+ package => 'RPC::ExtDirect::Test::Pkg::PollProvider',
method => 'foo',
- code => \&RPC::ExtDirect::Test::PollProvider::foo,
- arg => [ 'env' ],
+ code => \&RPC::ExtDirect::Test::Pkg::PollProvider::foo,
+ arg => [ ],
env => 'env',
param_names => undef,
param_no => undef,
pollHandler => 1,
formHandler => 0,
+ method_ref => get_method_ref(qw/ PollProvider foo /),
},
],
expected_after => [
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ PollProvider foo before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::PollProvider',
+ after_ref => get_hook_ref(qw/ PollProvider foo after /),
+ package => 'RPC::ExtDirect::Test::Pkg::PollProvider',
method => 'foo',
- code => \&RPC::ExtDirect::Test::PollProvider::foo,
- arg => [ 'env' ],
+ code => \&RPC::ExtDirect::Test::Pkg::PollProvider::foo,
+ arg => [ ],
env => 'env',
result => undef,
exception => "Exception\n",
@@ -342,6 +394,7 @@ __DATA__
pollHandler => 1,
formHandler => 0,
method_called => undef,
+ method_ref => get_method_ref(qw/ PollProvider foo /),
},
],
},
@@ -356,29 +409,36 @@ __DATA__
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ PollProvider foo before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::PollProvider',
+ after_ref => get_hook_ref(qw/ PollProvider foo after /),
+ package => 'RPC::ExtDirect::Test::Pkg::PollProvider',
method => 'foo',
- code => \&RPC::ExtDirect::Test::PollProvider::foo,
- arg => [ 'env' ],
+ code => \&RPC::ExtDirect::Test::Pkg::PollProvider::foo,
+ arg => [ ],
env => 'env',
param_names => undef,
param_no => undef,
pollHandler => 1,
formHandler => 0,
+ method_ref => get_method_ref(qw/ PollProvider foo /),
},
],
expected_after => [
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ PollProvider foo before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::PollProvider',
+ after_ref => get_hook_ref(qw/ PollProvider foo after /),
+ package => 'RPC::ExtDirect::Test::Pkg::PollProvider',
method => 'foo',
- code => \&RPC::ExtDirect::Test::PollProvider::foo,
- arg => [ 'env' ],
+ code => \&RPC::ExtDirect::Test::Pkg::PollProvider::foo,
+ arg => [ ],
env => 'env',
result => 'Method canceled',
exception => undef,
@@ -387,6 +447,7 @@ __DATA__
pollHandler => 1,
formHandler => 0,
method_called => undef,
+ method_ref => get_method_ref(qw/ PollProvider foo /),
},
],
},
@@ -401,28 +462,35 @@ __DATA__
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ PollProvider foo before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::PollProvider',
+ after_ref => get_hook_ref(qw/ PollProvider foo after /),
+ package => 'RPC::ExtDirect::Test::Pkg::PollProvider',
method => 'foo',
- code => \&RPC::ExtDirect::Test::PollProvider::foo,
+ code => \&RPC::ExtDirect::Test::Pkg::PollProvider::foo,
arg => [ 'bar' ],
env => 'env',
param_names => undef,
param_no => undef,
pollHandler => 1,
formHandler => 0,
+ method_ref => get_method_ref(qw/ PollProvider foo /),
},
],
expected_after => [
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ PollProvider foo before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::PollProvider',
+ after_ref => get_hook_ref(qw/ PollProvider foo after /),
+ package => 'RPC::ExtDirect::Test::Pkg::PollProvider',
method => 'foo',
- code => \&RPC::ExtDirect::Test::PollProvider::foo,
+ code => \&RPC::ExtDirect::Test::Pkg::PollProvider::foo,
arg => [ 'bar' ],
env => 'env',
result => [q|foo_event:['foo']|, q|bar_event:{'foo' => 'bar'}|],
@@ -431,7 +499,8 @@ __DATA__
param_no => undef,
pollHandler => 1,
formHandler => 0,
- method_called => \&RPC::ExtDirect::Test::PollProvider::foo,
+ method_called => \&RPC::ExtDirect::Test::Pkg::PollProvider::foo,
+ method_ref => get_method_ref(qw/ PollProvider foo /),
},
],
},
@@ -445,29 +514,36 @@ __DATA__
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ PollProvider foo before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::PollProvider',
+ after_ref => get_hook_ref(qw/ PollProvider foo after /),
+ package => 'RPC::ExtDirect::Test::Pkg::PollProvider',
method => 'foo',
- code => \&RPC::ExtDirect::Test::PollProvider::foo,
- arg => [ 'env' ],
+ code => \&RPC::ExtDirect::Test::Pkg::PollProvider::foo,
+ arg => [ ],
env => 'env',
param_names => undef,
param_no => undef,
pollHandler => 1,
formHandler => 0,
+ method_ref => get_method_ref(qw/ PollProvider foo /),
},
],
expected_after => [
'main',
{
before => \&before_hook,
+ before_ref => get_hook_ref(qw/ PollProvider foo before /),
instead => undef,
+ instead_ref => undef,
after => \&after_hook,
- package => 'RPC::ExtDirect::Test::PollProvider',
+ after_ref => get_hook_ref(qw/ PollProvider foo after /),
+ package => 'RPC::ExtDirect::Test::Pkg::PollProvider',
method => 'foo',
- code => \&RPC::ExtDirect::Test::PollProvider::foo,
- arg => [ 'env' ],
+ code => \&RPC::ExtDirect::Test::Pkg::PollProvider::foo,
+ arg => [ ],
env => 'env',
result => [q|foo_event:['foo']|, q|bar_event:{'foo' => 'bar'}|],
exception => '',
@@ -475,7 +551,8 @@ __DATA__
param_no => undef,
pollHandler => 1,
formHandler => 0,
- method_called => \&RPC::ExtDirect::Test::PollProvider::foo,
+ method_called => \&RPC::ExtDirect::Test::Pkg::PollProvider::foo,
+ method_ref => get_method_ref(qw/ PollProvider foo /),
},
],
},
@@ -0,0 +1,37 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+if ( $ENV{REGRESSION_TESTS} ) {
+ plan tests => 8;
+}
+else {
+ plan skip_all => 'Regression tests are not enabled.';
+}
+
+# We will test deprecated API and don't want the warnings
+# cluttering STDERR
+$SIG{__WARN__} = sub {};
+
+use RPC::ExtDirect::Config;
+
+my @methods = qw(router_path poll_path remoting_var polling_var);
+
+my %expected_get_for = (
+ router_path => '/extdirectrouter',
+ poll_path => '/extdirectevents',
+ remoting_var => 'Ext.app.REMOTING_API',
+ polling_var => 'Ext.app.POLLING_API',
+);
+
+for my $method ( @methods ) {
+ my $get_sub = 'get_'.$method;
+
+ my $result = eval { RPC::ExtDirect::Config->$get_sub() };
+ my $expected = $expected_get_for{ $method };
+
+ is $@, '', "$method get eval $@";
+ is $result, $expected, "$method get result";
+};
+
@@ -0,0 +1,102 @@
+use strict;
+use warnings;
+
+use Test::More;
+use RPC::ExtDirect::Test::Util;
+
+if ( $ENV{REGRESSION_TESTS} ) {
+ plan tests => 24;
+}
+else {
+ plan skip_all => 'Regression tests are not enabled.';
+}
+
+# We will test deprecated API and don't want the warnings
+# cluttering STDERR
+$SIG{__WARN__} = sub {};
+
+use RPC::ExtDirect::Exception;
+
+package RPC::ExtDirect::Test;
+
+use RPC::ExtDirect::Exception;
+
+sub foo {
+ return RPC::ExtDirect::Exception->new({ debug => 0,
+ action => 'Test',
+ method => 'foo',
+ tid => 1,
+ message => 'new fail' });
+}
+
+sub bar {
+ return RPC::ExtDirect::Exception->new({ debug => 1,
+ action => 'Test',
+ method => 'bar',
+ tid => 2,
+ message => 'bar fail' });
+}
+
+sub qux {
+ return RPC::ExtDirect::Exception->new({ debug => 1,
+ action => 'Test',
+ method => 'qux',
+ tid => 3,
+ message => 'qux fail',
+ where => 'X->qux' });
+}
+
+package main;
+
+my $tests = [
+ { method => 'foo',
+ ex => { type => 'exception',
+ action => 'Test',
+ method => 'foo',
+ tid => 1,
+ where => 'ExtDirect',
+ message => 'An error has occured while processing request',
+ },
+ },
+ { method => 'bar',
+ ex => { type => 'exception',
+ action => 'Test',
+ method => 'bar',
+ tid => 2,
+ where => 'RPC::ExtDirect::Test->bar',
+ message => 'bar fail',
+ },
+ },
+ { method => 'qux',
+ ex => { type => 'exception',
+ action => 'Test',
+ method => 'qux',
+ tid => 3,
+ where => 'X->qux',
+ message => 'qux fail',
+ },
+ },
+];
+
+for my $test ( @$tests ) {
+ my $method = $test->{method};
+ my $expect = $test->{ex};
+
+ my $ex = eval { RPC::ExtDirect::Test->$method() };
+
+ is $@, '', "$method() new eval $@";
+ ok $ex, "$method() exception not null";
+ isa_ok $ex, 'RPC::ExtDirect::Exception';
+
+ my $run = eval { $ex->run() };
+
+ is $@, '', "$method() run eval $@";
+ ok !$run, "$method() run error returned";
+
+ my $result = eval { $ex->result() };
+
+ is $@, '', "$method() result eval $@";
+ ok $result, "$method() result not empty";
+ is_deep $result, $expect, "$method() exception deep";
+};
+
@@ -0,0 +1,80 @@
+use strict;
+use warnings;
+
+use Test::More;
+use RPC::ExtDirect::Test::Util;
+
+if ( $ENV{REGRESSION_TESTS} ) {
+ plan tests => 18;
+}
+else {
+ plan skip_all => 'Regression tests are not enabled.';
+}
+
+# We will test deprecated API and don't want the warnings
+# cluttering STDERR
+$SIG{__WARN__} = sub {};
+
+use RPC::ExtDirect::Event;
+use RPC::ExtDirect::NoEvents;
+
+# Test Event with data
+
+my $event = eval { RPC::ExtDirect::Event->new('foo', 'bar') };
+
+is $@, '', "Event new() eval $@";
+ok $event, "Event object created";
+isa_ok $event, 'RPC::ExtDirect::Event';
+
+my $expected_result = {
+ type => 'event',
+ name => 'foo',
+ data => 'bar',
+};
+
+my $real_result = eval { $event->result() };
+
+is $@, '', "Event result() eval $@";
+ok $real_result, "Event result() not empty";
+is_deep $real_result, $expected_result, "Event result() deep";
+
+# Test Event without data
+
+$event = eval { RPC::ExtDirect::Event->new('baz') };
+
+is $@, '', "Event new() eval $@";
+ok $event, "Event object created";
+isa_ok $event, 'RPC::ExtDirect::Event';
+
+$expected_result = {
+ type => 'event',
+ name => 'baz',
+ data => undef,
+};
+
+$real_result = eval { $event->result() };
+
+is $@, '', "Event result() eval $@";
+ok $real_result, "Event result() not empty";
+is_deep $real_result, $expected_result, "Event result() deep";
+
+# Test the stub
+
+my $no_events = eval { RPC::ExtDirect::NoEvents->new() };
+
+is $@, '', "NoEvents new() eval $@";
+ok $no_events, "NoEvents new() object created";
+isa_ok $no_events, 'RPC::ExtDirect::NoEvents';
+
+$expected_result = {
+ type => 'event',
+ name => '__NONE__',
+ data => '',
+};
+
+$real_result = eval { $no_events->result() };
+
+is $@, '', "NoEvents result() eval $@";
+ok $real_result, "NoEvents result() not empty";
+is_deep $real_result, $expected_result, "NoEvents result() deep";
+
@@ -0,0 +1,44 @@
+use strict;
+use warnings;
+no warnings 'once';
+
+use Test::More;
+
+if ( $ENV{REGRESSION_TESTS} ) {
+ plan tests => 3;
+}
+else {
+ plan skip_all => 'Regression tests are not enabled.';
+}
+
+# We will test deprecated API and don't want the warnings
+# cluttering STDERR
+$SIG{__WARN__} = sub {};
+
+use RPC::ExtDirect::Serialize;
+
+local $RPC::ExtDirect::Serialize::DEBUG = 1;
+
+my $data = { foo => 'foo', qux => 'qux', bar => 'bar' };
+my $expected = '{"bar":"bar","foo":"foo","qux":"qux"}';
+
+my $json = RPC::ExtDirect::Serialize->serialize(0, $data);
+
+is $json, $expected, "Canonical output";
+
+$data = bless { foo => 'foo', };
+$expected = q|{"action":null,"message":"encountered object 'main=HASH(blessed)'","method":null,"tid":null,"type":"exception","where":"RPC::ExtDirect::Serializer"}|;
+
+$json = RPC::ExtDirect::Serialize->serialize(0, $data);
+
+$json =~ s/HASH\([^\)]+\)[^"]+/HASH(blessed)'/;
+
+is $json, $expected, 'Invalid data, exceptions on';
+
+$expected = undef;
+
+$json = RPC::ExtDirect::Serialize->serialize(1, $data);
+
+is $json, $expected, 'Ivalid data, exceptions off';
+
+exit 0;
@@ -0,0 +1,365 @@
+use strict;
+use warnings;
+use Carp;
+
+use Test::More;
+use RPC::ExtDirect::Test::Util;
+
+if ( $ENV{REGRESSION_TESTS} ) {
+ plan tests => 69;
+}
+else {
+ plan skip_all => 'Regression tests are not enabled.';
+}
+
+# We will test deprecated API and don't want the warnings
+# cluttering STDERR
+$SIG{__WARN__} = sub {};
+
+sub global_before {
+}
+
+sub global_after {
+}
+
+use RPC::ExtDirect; # Checking case insensitiveness, too
+use RPC::ExtDirect::API Before => \&global_before,
+ aFtEr => \&global_after,
+ ;
+
+use lib 't/lib2';
+use RPC::ExtDirect::Test::Foo;
+use RPC::ExtDirect::Test::Bar;
+use RPC::ExtDirect::Test::Qux;
+use RPC::ExtDirect::Test::PollProvider;
+
+my %test_for = (
+ # foo is plain basic package with ExtDirect methods and hooks
+ 'Foo' => {
+ methods => [ sort qw( foo_foo foo_bar foo_baz foo_zero foo_blessed ) ],
+ list => {
+ foo_foo => { package => 'RPC::ExtDirect::Test::Foo',
+ method => 'foo_foo', param_no => 1,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef,
+ before => \&RPC::ExtDirect::Test::Foo::foo_before,
+ },
+ foo_bar => { package => 'RPC::ExtDirect::Test::Foo',
+ method => 'foo_bar', param_no => 2,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef,
+ instead => \&RPC::ExtDirect::Test::Foo::foo_instead,
+ },
+ foo_baz => { package => 'RPC::ExtDirect::Test::Foo',
+ method => 'foo_baz', param_no => undef,
+ formHandler => 0, pollHandler => 0,
+ param_names => [ qw( foo bar baz ) ],
+ before => \&RPC::ExtDirect::Test::Foo::foo_before,
+ after => \&RPC::ExtDirect::Test::Foo::foo_after,
+ },
+ foo_zero =>{ package => 'RPC::ExtDirect::Test::Foo',
+ method => 'foo_zero', param_no => 0,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+ foo_blessed => { package => 'RPC::ExtDirect::Test::Foo',
+ method => 'foo_blessed', param_no => undef,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+
+ },
+ },
+ # bar package has only its own methods as we don't support inheritance
+ 'Bar' => {
+ methods => [ sort qw( bar_foo bar_bar bar_baz ) ],
+ list => {
+ bar_foo => { package => 'RPC::ExtDirect::Test::Bar',
+ method => 'bar_foo', param_no => 4,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+ bar_bar => { package => 'RPC::ExtDirect::Test::Bar',
+ method => 'bar_bar', param_no => 5,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+ bar_baz => { package => 'RPC::ExtDirect::Test::Bar',
+ method => 'bar_baz', param_no => undef,
+ formHandler => 1, pollHandler => 0,
+ param_names => undef, },
+ },
+ },
+ # Now, qux package redefines all methods so we have 'em here
+ 'Qux' => {
+ methods => [sort qw(foo_foo foo_bar foo_baz bar_foo bar_bar bar_baz)],
+ list => {
+ foo_foo => { package => 'RPC::ExtDirect::Test::Qux',
+ method => 'foo_foo', param_no => 1,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+ foo_bar => { package => 'RPC::ExtDirect::Test::Qux',
+ method => 'foo_bar', param_no => 2,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+ foo_baz => { package => 'RPC::ExtDirect::Test::Qux',
+ method => 'foo_baz', param_no => undef,
+ formHandler => 0, pollHandler => 0,
+ param_names => [ qw( foo bar baz ) ], },
+ bar_foo => { package => 'RPC::ExtDirect::Test::Qux',
+ method => 'bar_foo', param_no => 4,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+ bar_bar => { package => 'RPC::ExtDirect::Test::Qux',
+ method => 'bar_bar', param_no => 5,
+ formHandler => 0, pollHandler => 0,
+ param_names => undef, },
+ bar_baz => { package => 'RPC::ExtDirect::Test::Qux',
+ method => 'bar_baz', param_no => undef,
+ formHandler => 1, pollHandler => 0,
+ param_names => undef, },
+ },
+ },
+ # PollProvider implements Event provider for polling mechanism
+ 'PollProvider' => {
+ methods => [ sort qw( foo ) ],
+ list => {
+ foo => { package => 'RPC::ExtDirect::Test::PollProvider',
+ method => 'foo', param_no => undef,
+ formHandler => 0, pollHandler => 1,
+ param_names => undef, },
+ },
+ },
+);
+
+my @expected_classes = sort qw( Foo Bar Qux PollProvider );
+
+my @full_classes = sort eval { RPC::ExtDirect->get_action_list() };
+
+is $@, '', "full get_action_list() eval $@";
+ok @full_classes, "full get_action_list() not empty";
+is_deep \@full_classes, \@expected_classes, "full get_action_list() deep";
+
+my @expected_methods = sort qw(
+ Qux::bar_bar Qux::bar_baz Qux::bar_foo
+ Qux::foo_bar Qux::foo_baz Qux::foo_foo
+ Foo::foo_foo Foo::foo_bar Foo::foo_baz
+ Foo::foo_zero Foo::foo_blessed
+ Bar::bar_foo Bar::bar_bar Bar::bar_baz
+ PollProvider::foo
+);
+
+my @full_methods = sort eval { RPC::ExtDirect->get_method_list() };
+
+is $@, '', "full get_method_list() eval $@";
+ok @full_methods, "full get_method_list() not empty";
+is_deep \@full_methods, \@expected_methods, "full get_method_list() deep";
+
+my @expected_poll_handlers = ( [ 'PollProvider', 'foo' ] );
+
+my @full_poll_handlers = eval { RPC::ExtDirect->get_poll_handlers() };
+
+is $@, '', "full get_poll_handlers() eval $@";
+ok @full_poll_handlers, "full get_poll_handlers() not empty";
+is_deep \@full_poll_handlers, \@expected_poll_handlers,
+ "full get_poll_handlers() deep";
+
+# We have RPC::ExtDirect already loaded so let's go
+for my $module ( sort keys %test_for ) {
+ my $test = $test_for{ $module };
+
+ my @method_list = sort eval { RPC::ExtDirect->get_method_list($module) };
+ is $@, '', "$module get_method_list eval $@";
+
+ my @expected_list = sort @{ $test->{methods} };
+
+ is_deep \@method_list, \@expected_list,
+ "$module get_method_list() deeply";
+
+ my %expected_parameter_for = %{ $test->{list } };
+
+ for my $method_name ( @method_list ) {
+ my %parameters = eval {
+ RPC::ExtDirect->get_method_parameters($module, $method_name)
+ };
+
+ is $@, '', "$module get_method_parameters() list eval $@";
+
+ my $expected_ref = $expected_parameter_for{ $method_name };
+
+ # No way to compare referents (and no sense in that, too);
+ delete $parameters{referent};
+
+ is_deep \%parameters, $expected_ref,
+ "$module get_method_parameters() deeply";
+ };
+};
+
+# Check if we have hooks properly defined
+my $hook_tests = [
+ {
+ name => 'foo_foo method scope before hook',
+ package => 'RPC::ExtDirect::Test::Foo',
+ method => 'foo_foo',
+ type => 'before',
+ code => \&RPC::ExtDirect::Test::Foo::foo_before,
+ },
+ {
+ name => 'foo_baz method scope instead hook',
+ package => 'RPC::ExtDirect::Test::Foo',
+ method => 'foo_bar',
+ type => 'instead',
+ code => \&RPC::ExtDirect::Test::Foo::foo_instead,
+ },
+ {
+ name => 'foo_baz method scope before hook',
+ package => 'RPC::ExtDirect::Test::Foo',
+ method => 'foo_baz',
+ type => 'before',
+ code => \&RPC::ExtDirect::Test::Foo::foo_before,
+ },
+ {
+ name => 'foo_baz method scope after hook',
+ package => 'RPC::ExtDirect::Test::Foo',
+ method => 'foo_baz',
+ type => 'after',
+ code => \&RPC::ExtDirect::Test::Foo::foo_after,
+ },
+ {
+ name => 'bar_foo package scope before hook',
+ package => 'RPC::ExtDirect::Test::Bar',
+ method => 'bar_foo',
+ type => 'before',
+ code => \&RPC::ExtDirect::Test::Bar::bar_before,
+ },
+ {
+ name => 'bar_foo package scope after hook',
+ package => 'RPC::ExtDirect::Test::Bar',
+ method => 'bar_foo',
+ type => 'after',
+ code => \&RPC::ExtDirect::Test::Bar::bar_after,
+ },
+ {
+ name => 'bar_bar package scope before hook',
+ package => 'RPC::ExtDirect::Test::Bar',
+ method => 'bar_bar',
+ type => 'before',
+ code => \&RPC::ExtDirect::Test::Bar::bar_before,
+ },
+ {
+ name => 'bar_bar package scope after hook',
+ package => 'RPC::ExtDirect::Test::Bar',
+ method => 'bar_bar',
+ type => 'after',
+ code => \&RPC::ExtDirect::Test::Bar::bar_after,
+ },
+ {
+ name => 'bar_baz package scope before hook',
+ package => 'RPC::ExtDirect::Test::Bar',
+ method => 'bar_baz',
+ type => 'before',
+ code => \&RPC::ExtDirect::Test::Bar::bar_before,
+ },
+ {
+ name => 'bar_baz package scope after hook',
+ package => 'RPC::ExtDirect::Test::Bar',
+ method => 'bar_baz',
+ type => 'after',
+ code => \&RPC::ExtDirect::Test::Bar::bar_after,
+ },
+ {
+ name => 'Global scope Qux foo_foo before hook',
+ package => 'RPC::ExtDirect::Test::Qux',
+ method => 'foo_foo',
+ type => 'before',
+ code => \&global_before,
+ },
+ {
+ name => 'Global scope Qux foo_foo after hook',
+ package => 'RPC::ExtDirect::Test::Qux',
+ method => 'foo_foo',
+ type => 'after',
+ code => \&global_after,
+ },
+ {
+ name => 'Global scope Qux foo_bar before hook',
+ package => 'RPC::ExtDirect::Test::Qux',
+ method => 'foo_bar',
+ type => 'before',
+ code => \&global_before,
+ },
+ {
+ name => 'Global scope Qux foo_bar after hook',
+ package => 'RPC::ExtDirect::Test::Qux',
+ method => 'foo_bar',
+ type => 'after',
+ code => \&global_after,
+ },
+ {
+ name => 'Global scope Qux foo_baz before hook',
+ package => 'RPC::ExtDirect::Test::Qux',
+ method => 'foo_baz',
+ type => 'before',
+ code => \&global_before,
+ },
+ {
+ name => 'Global scope Qux foo_baz after hook',
+ package => 'RPC::ExtDirect::Test::Qux',
+ method => 'foo_baz',
+ type => 'after',
+ code => \&global_after,
+ },
+ {
+ name => 'Global scope Qux bar_foo before hook',
+ package => 'RPC::ExtDirect::Test::Qux',
+ method => 'bar_foo',
+ type => 'before',
+ code => \&global_before,
+ },
+ {
+ name => 'Global scope Qux bar_foo after hook',
+ package => 'RPC::ExtDirect::Test::Qux',
+ method => 'bar_foo',
+ type => 'after',
+ code => \&global_after,
+ },
+ {
+ name => 'Global scope Qux bar_bar before hook',
+ package => 'RPC::ExtDirect::Test::Qux',
+ method => 'bar_bar',
+ type => 'before',
+ code => \&global_before,
+ },
+ {
+ name => 'Global scope Qux bar_bar after hook',
+ package => 'RPC::ExtDirect::Test::Qux',
+ method => 'bar_bar',
+ type => 'after',
+ code => \&global_after,
+ },
+ {
+ name => 'Global scope Qux bar_baz before hook',
+ package => 'RPC::ExtDirect::Test::Qux',
+ method => 'bar_baz',
+ type => 'before',
+ code => \&global_before,
+ },
+ {
+ name => 'Global scope Qux bar_baz after hook',
+ package => 'RPC::ExtDirect::Test::Qux',
+ method => 'bar_baz',
+ type => 'after',
+ code => \&global_after,
+ },
+];
+
+for my $test ( @$hook_tests ) {
+ my $name = $test->{name};
+
+ my $code = RPC::ExtDirect->get_hook(
+ package => $test->{package},
+ method => $test->{method},
+ type => $test->{type},
+ );
+
+ is $code, $test->{code}, "$name code matches";
+};
+
+exit 0;
+
@@ -0,0 +1,109 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use RPC::ExtDirect::Test::Util;
+
+if ( $ENV{REGRESSION_TESTS} ) {
+ plan tests => 4;
+}
+else {
+ plan skip_all => 'Regression tests are not enabled.';
+}
+
+# We will test deprecated API and don't want the warnings
+# cluttering STDERR
+$SIG{__WARN__} = sub {};
+
+# Test modules are so simple they can't be broken
+use lib 't/lib2';
+use RPC::ExtDirect::Test::Foo;
+use RPC::ExtDirect::Test::Bar;
+use RPC::ExtDirect::Test::Qux;
+
+use RPC::ExtDirect::API;
+
+# Set the debug flag
+local $RPC::ExtDirect::API::DEBUG = 1;
+
+my $expected = q~
+Ext.app.REMOTING_API = {
+ "actions":{
+ "Bar":[
+ { "len":5, "name":"bar_bar" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":4, "name":"bar_foo" }
+ ],
+ "Foo":[
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "name":"foo_blessed" },
+ { "len":1, "name":"foo_foo" },
+ { "len":0, "name":"foo_zero" }
+ ],
+ "Qux":[
+ { "len":5, "name":"bar_bar" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":4, "name":"bar_foo" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":1, "name":"foo_foo" }
+ ]
+ },
+ "type":"remoting",
+ "url":"/extdirectrouter"
+};
+~;
+
+my $remoting_api = eval { RPC::ExtDirect::API->get_remoting_api() };
+
+is $@, '', "remoting_api() 1 eval $@";
+cmp_api $remoting_api, $expected, "remoting_api() 1 result";
+
+# "Reimport" with parameters
+
+RPC::ExtDirect::API->import(
+ namespace => 'myApp.Server',
+ router_path => '/router.cgi',
+ poll_path => '/poll.cgi',
+ remoting_var => 'Ext.app.REMOTE_CALL_API',
+ polling_var => 'Ext.app.REMOTE_EVENT_API',
+ auto_connect => 'HELL YEAH!',
+);
+
+$expected = q~
+Ext.app.REMOTE_CALL_API = {
+ "actions":{
+ "Bar":[
+ { "len":5, "name":"bar_bar" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":4, "name":"bar_foo" }
+ ],
+ "Foo":[
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "name":"foo_blessed" },
+ { "len":1, "name":"foo_foo" },
+ { "len":0, "name":"foo_zero" }
+ ],
+ "Qux":[
+ { "len":5, "name":"bar_bar" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":4, "name":"bar_foo" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":1, "name":"foo_foo" }
+ ]
+ },
+ "namespace":"myApp.Server",
+ "type":"remoting",
+ "url":"/router.cgi"
+};
+Ext.direct.Manager.addProvider(Ext.app.REMOTE_CALL_API);
+~;
+
+$remoting_api = eval { RPC::ExtDirect::API->get_remoting_api() };
+
+is $@, '', "remoting_api() 2 eval $@";
+cmp_api $remoting_api, $expected, "remoting_api() 2 result";
@@ -0,0 +1,74 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use RPC::ExtDirect::Test::Util;
+
+if ( $ENV{REGRESSION_TESTS} ) {
+ plan tests => 2;
+}
+else {
+ plan skip_all => 'Regression tests are not enabled.';
+}
+
+# We will test deprecated API and don't want the warnings
+# cluttering STDERR
+$SIG{__WARN__} = sub {};
+
+# Test modules are so simple they can't be broken
+use lib 't/lib2';
+use RPC::ExtDirect::Test::Foo;
+use RPC::ExtDirect::Test::Bar;
+use RPC::ExtDirect::Test::Qux;
+use RPC::ExtDirect::Test::PollProvider;
+
+use RPC::ExtDirect::API namespace => 'myApp.Server',
+ router_path => '/router.cgi',
+ poll_path => '/poll.cgi',
+ remoting_var => 'Ext.app.REMOTE_CALL_API',
+ polling_var => 'Ext.app.REMOTE_EVENT_API',
+ auto_connect => 'HELL YEAH!';
+
+local $RPC::ExtDirect::API::DEBUG = 1;
+
+my $expected = q~
+Ext.app.REMOTE_CALL_API = {
+ "actions":{
+ "Bar":[
+ { "len":5, "name":"bar_bar" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":4, "name":"bar_foo" }
+ ],
+ "Foo":[
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "name":"foo_blessed" },
+ { "len":1, "name":"foo_foo" },
+ { "len":0, "name":"foo_zero" }
+ ],
+ "Qux":[
+ { "len":5, "name":"bar_bar" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":4, "name":"bar_foo" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":1, "name":"foo_foo" }
+ ]
+ },
+ "namespace":"myApp.Server",
+ "type":"remoting",
+ "url":"/router.cgi"
+};
+Ext.direct.Manager.addProvider(Ext.app.REMOTE_CALL_API);
+Ext.app.REMOTE_EVENT_API = {
+ "type":"polling",
+ "url":"/poll.cgi"
+};
+Ext.direct.Manager.addProvider(Ext.app.REMOTE_EVENT_API);
+~;
+
+my $remoting_api = eval { RPC::ExtDirect::API->get_remoting_api() };
+
+is $@, '', "remoting_api() 3 eval $@";
+cmp_api $remoting_api, $expected, "remoting_api() 3 result";
@@ -0,0 +1,74 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use RPC::ExtDirect::Test::Util;
+
+if ( $ENV{REGRESSION_TESTS} ) {
+ plan tests => 2;
+}
+else {
+ plan skip_all => 'Regression tests are not enabled.';
+}
+
+# We will test deprecated API and don't want the warnings
+# cluttering STDERR
+$SIG{__WARN__} = sub {};
+
+# Test modules are so simple they can't be broken
+use lib 't/lib2';
+use RPC::ExtDirect::Test::Foo;
+use RPC::ExtDirect::Test::Bar;
+use RPC::ExtDirect::Test::Qux;
+use RPC::ExtDirect::Test::PollProvider;
+
+use RPC::ExtDirect::API namespace => 'myApp.Server',
+ router_path => '/router.cgi',
+ poll_path => '/poll.cgi',
+ remoting_var => 'Ext.app.REMOTE_CALL_API',
+ polling_var => 'Ext.app.REMOTE_EVENT_API',
+ auto_connect => 'HELL YEAH!';
+
+local $RPC::ExtDirect::API::DEBUG = 1;
+
+my $expected = q~
+Ext.app.REMOTE_CALL_API = {
+ "actions":{
+ "Bar":[
+ { "len":5, "name":"bar_bar" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":4, "name":"bar_foo" }
+ ],
+ "Foo":[
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "name":"foo_blessed" },
+ { "len":1, "name":"foo_foo" },
+ { "len":0, "name":"foo_zero" }
+ ],
+ "Qux":[
+ { "len":5, "name":"bar_bar" },
+ { "formHandler":true, "len":0, "name":"bar_baz" },
+ { "len":4, "name":"bar_foo" },
+ { "len":2, "name":"foo_bar" },
+ { "name":"foo_baz", "params":["foo","bar","baz"] },
+ { "len":1, "name":"foo_foo" }
+ ]
+ },
+ "namespace":"myApp.Server",
+ "type":"remoting",
+ "url":"/router.cgi"
+};
+Ext.direct.Manager.addProvider(Ext.app.REMOTE_CALL_API);
+Ext.app.REMOTE_EVENT_API = {
+ "type":"polling",
+ "url":"/poll.cgi"
+};
+Ext.direct.Manager.addProvider(Ext.app.REMOTE_EVENT_API);
+~;
+
+my $remoting_api = eval { RPC::ExtDirect::API->get_remoting_api() };
+
+is $@, '', "remoting_api() 3 eval $@";
+cmp_api $remoting_api, $expected, "remoting_api() 3 result";
@@ -0,0 +1,187 @@
+use strict;
+use warnings;
+no warnings 'once';
+
+### Testing successful requests
+
+use Test::More;
+
+use RPC::ExtDirect::Test::Util;
+
+if ( $ENV{REGRESSION_TESTS} ) {
+ plan tests => 64;
+}
+else {
+ plan skip_all => 'Regression tests are not enabled.';
+}
+
+# We will test deprecated API and don't want the warnings
+# cluttering STDERR
+$SIG{__WARN__} = sub {};
+
+use RPC::ExtDirect::Request;
+
+# Test modules are so simple they can't fail
+use lib 't/lib2';
+use RPC::ExtDirect::Test::Foo;
+use RPC::ExtDirect::Test::Bar;
+use RPC::ExtDirect::Test::Qux;
+
+my $tests = eval do { local $/; <DATA>; } ## no critic
+ or die "Can't eval test data: $@";
+
+for my $test ( @$tests ) {
+ # Unpack variables
+ my ($name, $data, $expected_ran, $expected_result, $debug,
+ $run_twice, $isa)
+ = @$test{ qw(name data ran_ok result debug run_twice isa)
+ };
+
+ # Set debug flag according to test
+ local $RPC::ExtDirect::Request::DEBUG = $debug;
+
+ # Try to create object
+ my $request = eval { RPC::ExtDirect::Request->new($data) };
+
+ is $@, '', "$name new() eval $@";
+ ok $request, "$name new() object created";
+ isa_ok $request, $isa;
+
+ # Try to run method
+ my $ran_ok = eval { $request->run() };
+
+ is $@, '', "$name run() eval $@";
+ is $ran_ok, $expected_ran, "$name run() no error";
+
+ # Try to run method second time, no result checks this time
+ $ran_ok = eval { $request->run() } if $run_twice;
+
+ # Try to get results
+ my $result = eval { $request->result() };
+
+ is $@, '', "$name result() eval $@";
+ ok $result, "$name result() not empty";
+ is_deep $result, $expected_result, "$name result() deep";
+};
+
+__DATA__
+[
+ # Numbered one argument with scalar result
+ {
+ name => 'Foo->foo_foo, 1 arg', debug => 1, ran_ok => 1,
+ data => { action => 'Foo', method => 'foo_foo',
+ tid => 1, data => [ 1 ], type => 'rpc' },
+ isa => 'RPC::ExtDirect::Request',
+ result => { type => 'rpc', tid => 1, action => 'Foo',
+ method => 'foo_foo', result => "foo! '1'", },
+ },
+ # Numbered two arguments with arrayref result
+ {
+ name => 'Foo->foo_bar, 2 args', debug => 1, ran_ok => 1,
+ data => { action => 'Foo', method => 'foo_bar',
+ tid => 2, data => [ 1234, 4321 ], type => 'rpc', },
+ isa => 'RPC::ExtDirect::Request',
+ result => { type => 'rpc', tid => 2,
+ action => 'Foo', method => 'foo_bar',
+ result => [ 'foo! bar!', 1234, 4321 ], },
+ },
+ # Named arguments, hashref result
+ {
+ name => 'Foo->foo_baz, 3 args', debug => 1, ran_ok => 1,
+ data => { action => 'Foo', method => 'foo_baz',
+ tid => 3, type => 'rpc',
+ data => { foo => 111, bar => 222, baz => 333 }, },
+ isa => 'RPC::ExtDirect::Request',
+ result => { type => 'rpc', tid => 3,
+ action => 'Foo', method => 'foo_baz',
+ result => { msg => 'foo! bar! baz!',
+ foo => 111, bar => 222, baz => 333 }, },
+ },
+ # Check if we're actually passing no more than defined numbered args
+ {
+ name => 'Check number of args', ran_ok => 1, debug => 1,
+ data => { action => 'Qux', method => 'bar_bar', tid => 555,
+ type => 'rpc', data => [ 1, 2, 3, 4, 5, 6, 7 ], },
+ isa => 'RPC::ExtDirect::Request',
+ result => { type => 'rpc', tid => 555, action => 'Qux',
+ method => 'bar_bar', result => 5, # Number of args def-d
+ },
+ },
+ # Check that only defined named parameters are passed
+ {
+ name => 'Check named args', debug => 1, ran_ok => 1,
+ data => { action => 'Foo', method => 'foo_baz',
+ tid => 4, type => 'rpc',
+ data => { foo => 111, bar => [ '222?', '222!' ],
+ baz => 333,
+ qux => 'qux! qux!', blargh => 'phew',
+ splurge => 'choo-choo' }, },
+ isa => 'RPC::ExtDirect::Request',
+ result => { type => 'rpc', tid => 4,
+ action => 'Foo', method => 'foo_baz',
+ result => { msg => 'foo! bar! baz!', foo => 111,
+ bar => [ '222?', '222!' ], baz => 333 }, },
+ },
+ # Form handler call, no upload
+ {
+ name => 'Form call, no uploads', debug => 1, ran_ok => 1,
+ data => { action => '/something.cgi', method => 'POST',
+ extAction => 'Bar', extMethod => 'bar_baz',
+ extTID => 6, field1 => 'foo', field2 => 'bar', },
+ isa => 'RPC::ExtDirect::Request',
+ result => { type => 'rpc', tid => 6, action => 'Bar',
+ method => 'bar_baz',
+ result => { field1 => 'foo', field2 => 'bar', }, },
+ },
+ # Form handler call, one file "upload"
+ {
+ name => 'Form call, one upload', debug => 1, ran_ok => 1,
+ data => { action => '/router.cgi', method => 'POST',
+ extAction => 'Bar', extMethod => 'bar_baz',
+ extTID => 7, foo_field => 'foo', bar_field => 'bar',
+ extUpload => 'true',
+ _uploads => [{ basename => 'foo.txt',
+ type => 'text/plain', handle => {}, # dummy
+ filename => 'C:\Users\nohuhu\foo.txt',
+ path => '/tmp/cgi-upload/foo.txt', size => 123 }],
+ },
+ isa => 'RPC::ExtDirect::Request',
+ result => { type => 'rpc', tid => 7, action => 'Bar',
+ method => 'bar_baz',
+ result => { foo_field => 'foo', bar_field => 'bar',
+ upload_response =>
+ "The following files were processed:\n".
+ "foo.txt text/plain 123\n",
+ },
+ },
+ },
+ # Form handler call, multiple uploads
+ {
+ name => 'Form call, multi uploads', debug => 1, ran_ok => 1,
+ data => { action => '/router_action', method => 'POST',
+ extAction => 'Bar', extMethod => 'bar_baz',
+ extTID => 8, field => 'value', extUpload => 'true',
+ _uploads => [
+ { basename => 'bar.jpg', handle => {},
+ type => 'image/jpeg', filename => 'bar.jpg',
+ path => 'C:\Windows\tmp\bar.jpg', size => 123123, },
+ { basename => 'qux.png', handle => {},
+ type => 'image/png', filename => '/tmp/qux.png',
+ path => 'C:\Windows\tmp\qux.png', size => 54321, },
+ { basename => 'script.js', handle => undef,
+ type => 'application/javascript', size => 1000,
+ filename => '/Users/nohuhu/Documents/script.js',
+ path => 'C:\Windows\tmp\script.js', }, ],
+ },
+ isa => 'RPC::ExtDirect::Request',
+ result => {
+ type => 'rpc', tid => 8, action => 'Bar', method => 'bar_baz',
+ result => { field => 'value', upload_response =>
+ "The following files were processed:\n".
+ "bar.jpg image/jpeg 123123\n".
+ "qux.png image/png 54321\n".
+ "script.js application/javascript 1000\n",
+ },
+ },
+ },
+]
@@ -0,0 +1,278 @@
+use strict;
+use warnings;
+no warnings 'once';
+
+### Testing invalid inputs
+
+use Test::More;
+
+use RPC::ExtDirect::Test::Util;
+
+if ( $ENV{REGRESSION_TESTS} ) {
+ plan tests => 101;
+}
+else {
+ plan skip_all => 'Regression tests are not enabled.';
+}
+
+# We will test deprecated API and don't want the warnings
+# cluttering STDERR
+$SIG{__WARN__} = sub {};
+
+use RPC::ExtDirect::Request;
+
+# Test modules are so simple they can't fail
+use lib 't/lib2';
+use RPC::ExtDirect::Test::Foo;
+use RPC::ExtDirect::Test::Bar;
+use RPC::ExtDirect::Test::Qux;
+use RPC::ExtDirect::Test::Hooks;
+use RPC::ExtDirect::Test::PollProvider;
+
+my $tests = eval do { local $/; <DATA>; } ## no critic
+ or die "Can't eval test data: $@";
+
+for my $test ( @$tests ) {
+
+ # Unpack variables
+ my ($name, $data, $expected_ran, $expected_result, $debug,
+ $run_twice, $isa, $code, $exception)
+ = @$test{ qw(name data ran_ok result debug run_twice isa code xcpt)
+ };
+
+ # Set debug flag according to test
+ local $RPC::ExtDirect::Request::DEBUG = $debug;
+
+ # Try to create object
+ my $request = eval { RPC::ExtDirect::Request->new($data) };
+
+ is $@, '', "$name new() eval $@";
+ ok $request, "$name new() object created";
+ isa_ok $request, $isa;
+
+ # Try to run method
+ my $ran_ok = eval { $request->run() };
+
+ $exception ||= '';
+
+ is $ran_ok, $expected_ran, "$name run() no error";
+ is_deep $@, $exception, "$name run() eval";
+
+ # Try to run method second time, no result checks this time
+ $ran_ok = eval { $request->run() } if $run_twice;
+
+ # Try to get results
+ my $result = eval { $request->result() };
+
+ is $@, '', "$name result() eval $@";
+
+ if ( $expected_result ) {
+ is_deep $result, $expected_result, "$name result() deep";
+ };
+
+ ok $code->(), "$name custom check" if $code;
+};
+
+__DATA__
+[
+ # Null input, debug off
+ {
+ name => 'Failure 1, debug off', debug => 0, ran_ok => '',
+ data => { action => 'Nonexistent', method => 'nonexistent',
+ type => 'rpc', tid => 123,
+ data => [], },
+ isa => 'RPC::ExtDirect::Exception',
+ result => { type => 'exception',
+ action => 'Nonexistent',
+ method => 'nonexistent',
+ tid => 123,
+ where => 'ExtDirect',
+ message => 'An error has occured while processing '.
+ 'request', },
+ },
+ # Action not found, debug off
+ {
+ name => 'Failure 2, debug off', debug => 0, ran_ok => '',
+ data => { action => 'Nonexistent', method => 'nonexistent',
+ type => 'rpc', tid => 111,
+ data => [], },
+ isa => 'RPC::ExtDirect::Exception',
+ result => { type => 'exception',
+ action => 'Nonexistent',
+ method => 'nonexistent',
+ tid => 111,
+ where => 'ExtDirect',
+ message => 'An error has occured while processing '.
+ 'request', },
+ },
+ # Null input, debug on
+ {
+ name => 'Null input, debug on', debug => 1, ran_ok => '',
+ data => undef,
+ isa => 'RPC::ExtDirect::Exception',
+ result => { type => 'exception',
+ action => undef,
+ method => undef,
+ tid => undef,
+ where => 'RPC::ExtDirect::Request->new',
+ message => 'ExtDirect action (class name) required', },
+ },
+ # Invalid input 1, debug on
+ {
+ name => 'Invalid input 1, debug on', debug => 1, ran_ok => '',
+ data => { action => '', method => 'foo', type => 'rpc',
+ tid => 1, data => [], },
+ isa => 'RPC::ExtDirect::Exception',
+ result => { type => 'exception',
+ action => undef,
+ method => undef,
+ tid => undef,
+ where => 'RPC::ExtDirect::Request->new',
+ message => 'ExtDirect action (class name) required' },
+ },
+ # Invalid input 2, debug on
+ {
+ name => 'Invalid input 2, debug on', debug => 1, ran_ok => '',
+ data => { action => 'Some', method => '', type => 'rpc',
+ tid => 2, data => [], },
+ isa => 'RPC::ExtDirect::Exception',
+ result => { type => 'exception',
+ action => undef,
+ method => undef,
+ tid => undef,
+ where => 'RPC::ExtDirect::Request->new',
+ message => 'ExtDirect method name required' },
+ },
+ # Action not found, debug on
+ {
+ name => 'Action not found, debug on', debug => 1, ran_ok => '',
+ data => { action => 'None', method => 'nonexistent',
+ type => 'rpc', tid => 111,
+ data => [], },
+ isa => 'RPC::ExtDirect::Exception',
+ result => { type => 'exception',
+ action => 'None',
+ method => 'nonexistent',
+ tid => 111,
+ where => 'RPC::ExtDirect::Request->new',
+ message => 'ExtDirect action or method not found' },
+ },
+ # Not enough arguments
+ {
+ name => 'Not enough args, debug on', debug => 1, ran_ok => '',
+ data => { action => 'Qux', method => 'bar_foo', tid => 222,
+ type => 'rpc', data => [ 1, 2, 3 ], },
+ isa => 'RPC::ExtDirect::Exception',
+ result => { type => 'exception',
+ action => 'Qux',
+ method => 'bar_foo',
+ tid => 222,
+ where => 'RPC::ExtDirect::API::Method->'.
+ 'check_method_arguments',
+ message => 'ExtDirect Method Qux.bar_foo '.
+ 'requires 4 argument(s) but only 3 '.
+ 'are provided', },
+ },
+ # Tried to run method twice
+ {
+ name => 'Try to run twice, debug on', debug => 1, ran_ok => 1,
+ data => { action => 'Qux', method => 'foo_foo', tid => 333,
+ type => 'rpc', data => [ 123 ], },
+ isa => 'RPC::ExtDirect::Request',
+ run_twice => 1,
+ result => { type => 'exception',
+ action => 'Qux',
+ method => 'foo_foo',
+ tid => 333,
+ where => 'RPC::ExtDirect::Request->run',
+ message => "ExtDirect request can't run more than once per batch"
+ },
+ },
+ # Method call failed
+ {
+ name => 'Method failed, debug on', debug => 1, ran_ok => '',
+ data => { action => 'Qux', method => 'bar_foo', tid => 444,
+ type => 'rpc', data => [ 1, 2, 3, 4 ], },
+ isa => 'RPC::ExtDirect::Request',
+ result => { type => 'exception',
+ action => 'Qux',
+ method => 'bar_foo',
+ tid => 444,
+ where => 'RPC::ExtDirect::Test::Qux->bar_foo',
+ message => "bar foo!", },
+ },
+ # Form handler called directly
+ {
+ name => 'Form handler called directly', debug => 1, ran_ok => '',
+ data => { action => 'Bar', method => 'bar_baz', tid => 555,
+ type => 'rpc', data => {}, },
+ isa => 'RPC::ExtDirect::Exception',
+ result => { type => 'exception',
+ action => 'Bar',
+ method => 'bar_baz',
+ tid => 555,
+ where => 'RPC::ExtDirect::Request->check_arguments',
+ message => "ExtDirect formHandler method ".
+ "Bar.bar_baz should only be called ".
+ "with form submits", },
+ },
+ # Poll handler called directly
+ {
+ name => 'Poll handler called directly', debug => 1, ran_ok => '',
+ data => { action => 'PollProvider', method => 'foo', tid => 666,
+ type => 'rpc', data => [], },
+ isa => 'RPC::ExtDirect::Exception',
+ result => { type => 'exception',
+ action => 'PollProvider',
+ method => 'foo',
+ tid => 666,
+ where => 'RPC::ExtDirect::Request->check_arguments',
+ message => "ExtDirect pollHandler method ".
+ "PollProvider.foo should not ".
+ "be called directly", },
+ },
+
+ # Nonexistent before hook
+ {
+ name => 'Nonexistent before hook', debug => 1, ran_ok => '',
+ data => { action => 'Hooks', method => 'foo_foo', tid => 777,
+ type => 'rpc', data => [1], },
+ isa => 'RPC::ExtDirect::Request',
+ result => { type => 'exception',
+ action => 'Hooks',
+ method => 'foo_foo',
+ tid => 777,
+ where => 'RPC::ExtDirect::Test::Hooks->foo_foo',
+ message => 'Undefined subroutine '.
+ '&RPC::ExtDirect::Test::Hooks::'.
+ 'nonexistent_before_hook called',
+ },
+ code => sub { !$RPC::ExtDirect::Test::Hooks::foo_foo_called },
+ },
+
+ # Before hook unset (NONE)
+ {
+ name => 'Before hook unset (NONE)', debug => 1, ran_ok => 1,
+ data => { action => 'Hooks', method => 'foo_bar', tid => 888,
+ type => 'rpc', data => [ 1, 2, ], },
+ isa => 'RPC::ExtDirect::Request',
+ result => { type => 'rpc', action => 'Hooks', method => 'foo_bar',
+ tid => 888, result => 1 },
+ code => sub { $RPC::ExtDirect::Test::Hooks::foo_bar_called },
+ },
+
+ # After hook
+ {
+ name => 'After hook', debug => 1, ran_ok => 1,
+ data => { action => 'Hooks', method => 'foo_baz',
+ tid => 999, type => 'rpc',
+ data => { foo => 111, bar => 222, baz => 333 }, },
+ isa => 'RPC::ExtDirect::Request',
+ result => { type => 'rpc', tid => 999,
+ action => 'Hooks', method => 'foo_baz',
+ result => { msg => 'foo! bar! baz!',
+ foo => 111, bar => 222, baz => 333 }, },
+ code => sub { !!$RPC::ExtDirect::Test::Hooks::foo_baz_called },
+ },
+]
+
@@ -0,0 +1,206 @@
+use strict;
+use warnings;
+no warnings 'once';
+
+use Test::More;
+
+use RPC::ExtDirect::Test::Util;
+
+if ( $ENV{REGRESSION_TESTS} ) {
+ plan tests => 64;
+}
+else {
+ plan skip_all => 'Regression tests are not enabled.';
+}
+
+# We will test deprecated API and don't want the warnings
+# cluttering STDERR
+$SIG{__WARN__} = sub {};
+
+use RPC::ExtDirect::Deserialize;
+
+# Test modules are simple and effective
+use lib 't/lib2';
+use RPC::ExtDirect::Test::Qux;
+
+my $tests = eval do { local $/; <DATA>; } ## no critic
+ or die "Can't eval DATA: $@";
+
+for my $test ( @$tests ) {
+ my $name = $test->{name};
+ my $debug = $test->{debug};
+ my $method = $test->{method};
+ my $data = $test->{data};
+ my $expect = $test->{result};
+ my $run_exp = $test->{run};
+
+ # Set the debug flags
+ local $RPC::ExtDirect::Request::DEBUG = $debug;
+ local $RPC::ExtDirect::Deserialize::DEBUG = $debug;
+
+ my $requests = eval { RPC::ExtDirect::Deserialize->$method($data) };
+
+ is $@, '', "$name $method() requests eval $@";
+ ok ref $requests eq 'ARRAY', "$name $method requests is ARRAY";
+
+ if ( 'ARRAY' ne ref $requests ) {
+ print "requests not ARRAY\n";
+ exit 1;
+ };
+
+ my $runs = eval { [ map { $_->run() } @$requests ] };
+
+ is $@, '', "$name $method() runs eval $@";
+ ok ref $runs eq 'ARRAY', "$name $method() runs is ARRAY";
+ is_deep $runs, $run_exp, "$name $method() runs deep";
+
+ my $results = eval { [ map { $_->result() } @$requests ] };
+
+ is $@, '', "$name $method() results eval $@";
+ ok ref $results eq 'ARRAY', "$name $method() results is ARRAY";
+ is_deep $results, $expect, "$name $method() results deep";
+};
+
+__DATA__
+[
+ { name => 'Invalid post data, debug off', debug => 0,
+ method => 'decode_post',
+ data => '{"action":"foo" "method":"bar","tid":1}',
+ run => [ '' ],
+ result => [ { type => 'exception', action => undef,
+ tid => undef, method => undef,
+ where => 'ExtDirect',
+ message => 'An error has occured while processing request' }, ],
+ },
+ { name => 'Invalid post data, debug on', debug => 1,
+ method => 'decode_post',
+ data => '{"action":"foo" "method":"bar","tid":1}',
+ run => [ '' ],
+ result => [ { type => 'exception', action => undef,
+ tid => undef, method => undef,
+ where => 'RPC::ExtDirect::Serializer->decode_post',
+ message => q!ExtDirect error decoding POST data: '!.
+ q!, or } expected while parsing object/hash!.
+ q!, at character offset 16 (before !.
+ q!""method":"bar","tid"...")'! } ],
+ },
+ { name => 'Valid post data, single OK request', debug => 1,
+ method => 'decode_post',
+ data => '{"tid":1,"action":"Qux","method":"foo_foo",'.
+ '"data":["bar"],"type":"rpc"}',
+ run => [ 1 ],
+ result => [ { type => 'rpc', tid => 1, action => 'Qux',
+ method => 'foo_foo', result => "foo! 'bar'", },
+ ],
+ },
+ { name => 'Valid post data, multiple OK requests', debug => 1,
+ method => 'decode_post',
+ data => '[{"tid":1,"action":"Qux","method":"foo_foo",'.
+ ' "data":["foo"],"type":"rpc"},'.
+ ' {"tid":2,"action":"Qux","method":"foo_bar",'.
+ ' "data":["bar1","bar2"],"type":"rpc"},'.
+ ' {"tid":3,"action":"Qux","method":"foo_baz",'.
+ ' "data":{"foo":"baz1","bar":"baz2","baz":"baz3"},'.
+ ' "type":"rpc"}]',
+ run => [ 1, 1, 1 ],
+ result => [ { type => 'rpc', tid => 1, action => 'Qux',
+ method => 'foo_foo', result => "foo! 'foo'", },
+ { type => 'rpc', tid => 2, action => 'Qux',
+ method => 'foo_bar',
+ result => [ 'foo! bar!', 'bar1', 'bar2' ], },
+ { type => 'rpc', tid => 3, action => 'Qux',
+ method => 'foo_baz',
+ result => { msg => 'foo! bar! baz!',
+ foo => 'baz1', bar => 'baz2',
+ baz => 'baz3' }, },
+ ],
+ },
+ { name => 'Valid post data, OK/NOK requests', debug => 0,
+ method => 'decode_post',
+ data => '[{"tid":1,"action":"Qux","method":"foo_foo",'.
+ ' "data":["foo"],"type":"rpc"},'.
+ ' {"tid":2,"action":"Qux","method":"foo_barq",'.
+ ' "data":["bar1","bar2"],"type":"rpc"},'.
+ ' {"tid":3,"action":"Qux","method":"foo_baz",'.
+ ' "data":{"foo":"baz1","bar":"baz2","baz":"baz3"},'.
+ ' "type":"rpc"}]',
+ run => [ 1, '', 1 ],
+ result => [ { type => 'rpc', tid => 1, action => 'Qux',
+ method => 'foo_foo', result => "foo! 'foo'", },
+ { type => 'exception', where => 'ExtDirect', tid => 2,
+ action => 'Qux', method => 'foo_barq',
+ message => 'An error has occured while processing request',
+ },
+ { type => 'rpc', tid => 3, action => 'Qux',
+ method => 'foo_baz',
+ result => { msg => 'foo! bar! baz!',
+ foo => 'baz1', bar => 'baz2',
+ baz => 'baz3' }, },
+ ],
+ },
+ # Form handler call, no upload
+ {
+ name => 'Form call, no uploads', debug => 1,
+ method => 'decode_form',
+ data => { action => '/something.cgi', method => 'POST',
+ extAction => 'Bar', extMethod => 'bar_baz',
+ extTID => 6, field1 => 'foo', field2 => 'bar', },
+ run => [ 1 ],
+ result => [{ type => 'rpc', tid => 6, action => 'Bar',
+ method => 'bar_baz',
+ result => { field1 => 'foo', field2 => 'bar', }, }],
+ },
+ # Form handler call, one file "upload"
+ {
+ name => 'Form call, one upload', debug => 1,
+ method => 'decode_form',
+ data => { action => '/router.cgi', method => 'POST',
+ extAction => 'Bar', extMethod => 'bar_baz',
+ extTID => 7, foo_field => 'foo', bar_field => 'bar',
+ extUpload => 'true',
+ _uploads => [{ basename => 'foo.txt',
+ type => 'text/plain', handle => {}, # dummy
+ filename => 'C:\Users\nohuhu\foo.txt',
+ path => '/tmp/cgi-upload/foo.txt', size => 123 }],
+ },
+ run => [ 1 ],
+ result => [{ type => 'rpc', tid => 7, action => 'Bar',
+ method => 'bar_baz',
+ result => { foo_field => 'foo', bar_field => 'bar',
+ upload_response =>
+ "The following files were processed:\n".
+ "foo.txt text/plain 123\n",
+ },
+ }],
+ },
+ # Form handler call, multiple uploads
+ {
+ name => 'Form call, multi uploads', debug => 1,
+ method => 'decode_form',
+ data => { action => '/router_action', method => 'POST',
+ extAction => 'Bar', extMethod => 'bar_baz',
+ extTID => 8, field => 'value', extUpload => 'true',
+ _uploads => [
+ { basename => 'bar.jpg', handle => {},
+ type => 'image/jpeg', filename => 'bar.jpg',
+ path => 'C:\Windows\tmp\bar.jpg', size => 123123, },
+ { basename => 'qux.png', handle => {},
+ type => 'image/png', filename => '/tmp/qux.png',
+ path => 'C:\Windows\tmp\qux.png', size => 54321, },
+ { basename => 'script.js', handle => undef,
+ type => 'application/javascript', size => 1000,
+ filename => '/Users/nohuhu/Documents/script.js',
+ path => 'C:\Windows\tmp\script.js', }, ],
+ },
+ run => [ 1 ],
+ result => [{
+ type => 'rpc', tid => 8, action => 'Bar', method => 'bar_baz',
+ result => { field => 'value', upload_response =>
+ "The following files were processed:\n".
+ "bar.jpg image/jpeg 123123\n".
+ "qux.png image/png 54321\n".
+ "script.js application/javascript 1000\n",
+ },
+ }],
+ },
+]
@@ -0,0 +1,218 @@
+use strict;
+use warnings;
+no warnings 'once';
+
+use Test::More;
+
+use RPC::ExtDirect::Test::Util;
+
+if ( $ENV{REGRESSION_TESTS} ) {
+ plan tests => 24;
+}
+else {
+ plan skip_all => 'Regression tests are not enabled.';
+}
+
+# We will test deprecated API and don't want the warnings
+# cluttering STDERR
+$SIG{__WARN__} = sub {};
+
+use RPC::ExtDirect::Router;
+
+# Test modules are simple
+use lib 't/lib2';
+use RPC::ExtDirect::Test::Qux;
+
+my $tests = eval do { local $/; <DATA>; } ## no critic
+ or die "Can't eval DATA: $@";
+
+for my $test ( @$tests ) {
+ my $name = $test->{name};
+ my $debug = $test->{debug};
+ my $input = $test->{input};
+ my $expect = $test->{output};
+
+ local $RPC::ExtDirect::Router::DEBUG = $debug;
+
+ my $result = eval { RPC::ExtDirect::Router->route($input) };
+
+ # Remove whitespace
+ s/\s//g for ( $expect->[2]->[0], $result->[2]->[0] );
+
+ # Remove reference addresses. On different platforms
+ # stringified reference has different length so we're
+ # trying to compensate for it here
+ # Additionally, JSON error output may change (again) and
+ # that will break this test (again), so we cheat instead.
+ if ( $result->[2]->[0] =~ /HASH\(/ ) {
+ s/HASH\([^\)]+\)[^"]+/HASH(blessed)'/g
+ for ( $expect->[2]->[0], $result->[2]->[0] );
+
+ $result->[1]->[3] = $expect->[1]->[3] = length $expect->[2]->[0];
+ };
+
+ is $@, '', "$name eval $@";
+ is ref $result, 'ARRAY', "$name result ARRAY";
+ is_deep $result, $expect, "$name result deep";
+};
+
+
+__DATA__
+[
+ { name => 'Invalid result', debug => 1,
+ input => '{"type":"rpc","tid":1,"action":"Foo","method":"foo_blessed",'.
+ ' "data":[]}',
+ output => [
+ 200,
+ [
+ 'Content-Type', 'application/json',
+ 'Content-Length', 222,
+ ],
+ [
+ q|{"action":"Foo","message":"encountered object |.
+ q|'foo=HASH(0x10088fca0)', but neither allow_blessed|.
+ q| nor convert_blessed settings are enabled","method"|.
+ q|:"foo_blessed","tid":1,"type":"exception","where":|.
+ q|"RPC::ExtDirect::Serializer"}|,
+ ],
+ ],
+ },
+ { name => 'Invalid POST', debug => 1,
+ input => '{"something":"invalid":"here"}',
+ output => [ 200,
+ [ 'Content-Type', 'application/json',
+ 'Content-Length', 249,
+ ],
+ [ q|{"action":null,|.
+ q|"message":"ExtDirect error decoding POST data: |.
+ q|', or } expected while parsing object/hash, at |.
+ q|character offset 22 (before \":\"here\"}\")'",|.
+ q|"method":null,"tid":null,|.
+ q|"type":"exception",|.
+ q|"where":"RPC::ExtDirect::Serializer->decode_post"}|
+ ],
+ ],
+ },
+ { name => 'Valid POST, single request', debug => 1,
+ input => '{"type":"rpc","tid":1,"action":"Qux","method":"foo_foo",'.
+ ' "data":["bar"]}',
+ output => [ 200,
+ [ 'Content-Type', 'application/json',
+ 'Content-Length', 78,
+ ],
+ [ q|{"action":"Qux","method":"foo_foo",|.
+ q|"result":"foo! 'bar'","tid":1,"type":"rpc"}| ],
+ ],
+ },
+ { name => 'Valid POST, multiple requests', debug => 1,
+ input => q|[{"tid":1,"action":"Qux","method":"foo_foo",|.
+ q| "data":["foo"],"type":"rpc"},|.
+ q| {"tid":2,"action":"Qux","method":"foo_bar",|.
+ q| "data":["bar1","bar2"],"type":"rpc"},|.
+ q| {"tid":3,"action":"Qux","method":"foo_baz",|.
+ q| "data":{"foo":"baz1","bar":"baz2","baz":"baz3"},|.
+ q| "type":"rpc"}]|,
+ output => [ 200,
+ [ 'Content-Type', 'application/json',
+ 'Content-Length', 304,
+ ],
+ [
+ q|[{"action":"Qux","method":"foo_foo",|.
+ q|"result":"foo! 'foo'","tid":1,"type":"rpc"},|.
+ q|{"action":"Qux","method":"foo_bar",|.
+ q|"result":["foo! bar!","bar1","bar2"],"tid":2,|.
+ q|"type":"rpc"},|.
+ q|{"action":"Qux","method":"foo_baz",|.
+ q|"result":{"bar":"baz2","baz":"baz3","foo":"baz1",|.
+ q|"msg":"foo! bar! baz!"},"tid":3,"type":"rpc"}]|
+ ],
+ ],
+ },
+ { name => 'Invalid form request', debug => 1,
+ input => { extTID => 100, action => 'Bar', method => 'bar_baz',
+ type => 'rpc', data => undef, },
+ output => [ 200, [ 'Content-Type', 'application/json',
+ 'Content-Length', 208, ],
+ [
+ q|{"action":"Bar",|.
+ q|"message":"ExtDirect formHandler method |.
+ q|Bar.bar_baz should only be called with form submits",|.
+ q|"method":"bar_baz","tid":100,|.
+ q|"type":"exception",|.
+ q|"where":"RPC::ExtDirect::Request->check_arguments"}|,
+ ],
+ ],
+ },
+ { name => 'Form request, no upload', debug => 1,
+ input => { action => '/router_action', method => 'POST',
+ extAction => 'Bar', extMethod => 'bar_baz',
+ extTID => 123, field1 => 'foo', field2 => 'bar', },
+ output => [ 200, [ 'Content-Type', 'application/json',
+ 'Content-Length', 99 ],
+ [
+ q|{"action":"Bar","method":"bar_baz",|.
+ q|"result":{"field1":"foo","field2":"bar"},|.
+ q|"tid":123,"type":"rpc"}|,
+ ],
+ ],
+ },
+ { name => 'Form request, upload one file', debug => 1,
+ input => { action => '/router.cgi', method => 'POST',
+ extAction => 'Bar', extMethod => 'bar_baz',
+ extTID => 7, foo_field => 'foo', bar_field => 'bar',
+ extUpload => 'true',
+ _uploads => [{ basename => 'foo.txt',
+ type => 'text/plain', handle => {}, # dummy
+ filename => 'C:\Users\nohuhu\foo.txt',
+ path => '/tmp/cgi-upload/foo.txt', size => 123 }],
+ },
+ output => [ 200, [ 'Content-Type', 'text/html',
+ 'Content-Length', 232, ],
+ [
+ q|<html><body><textarea>|.
+ q|{"action":"Bar","method":"bar_baz",|.
+ q|"result":{"bar_field":"bar",|.
+ q|"foo_field":"foo",|.
+ q|"upload_response":"The following files were |.
+ q|processed:\n|.
+ q|foo.txt text/plain 123\n"|.
+ q|},"tid":7,|.
+ q|"type":"rpc"}|.
+ q|</textarea></body></html>|,
+ ],
+ ],
+ },
+ { name => 'Form request, multiple uploads', debug => 1,
+ input => { action => '/router_action', method => 'POST',
+ extAction => 'Bar', extMethod => 'bar_baz',
+ extTID => 8, field => 'value', extUpload => 'true',
+ _uploads => [
+ { basename => 'bar.jpg', handle => {},
+ type => 'image/jpeg', filename => 'bar.jpg',
+ path => 'C:\Windows\tmp\bar.jpg', size => 123123, },
+ { basename => 'qux.png', handle => {},
+ type => 'image/png', filename => '/tmp/qux.png',
+ path => 'C:\Windows\tmp\qux.png', size => 54321, },
+ { basename => 'script.js', handle => undef,
+ type => 'application/javascript', size => 1000,
+ filename => '/Users/nohuhu/Documents/script.js',
+ path => 'C:\Windows\tmp\script.js', }, ],
+ },
+ output => [ 200, [ 'Content-Type', 'text/html',
+ 'Content-Length', 279, ],
+ [
+ q|<html><body><textarea>|.
+ q|{"action":"Bar","method":"bar_baz",|.
+ q|"result":{|.
+ q|"field":"value",|.
+ q|"upload_response":"The following files were |.
+ q|processed:\n|.
+ q|bar.jpg image/jpeg 123123\n|.
+ q|qux.png image/png 54321\n|.
+ q|script.js application/javascript 1000\n"|.
+ q|},"tid":8,"type":"rpc"}|.
+ q|</textarea></body></html>|,
+ ],
+ ],
+ },
+]
@@ -0,0 +1,72 @@
+use strict;
+use warnings;
+no warnings 'once';
+
+use JSON;
+use Test::More;
+
+use RPC::ExtDirect::Test::Util;
+
+if ( $ENV{REGRESSION_TESTS} ) {
+ plan tests => 10;
+}
+else {
+ plan skip_all => 'Regression tests are not enabled.';
+}
+
+# We will test deprecated API and don't want the warnings
+# cluttering STDERR
+$SIG{__WARN__} = sub {};
+
+use lib 't/lib2';
+use RPC::ExtDirect::Test::PollProvider;
+
+use RPC::ExtDirect::EventProvider;
+
+local $RPC::ExtDirect::EventProvider::DEBUG = 1;
+
+my $tests = eval do { local $/; <DATA>; } ## no critic
+ or die "Can't eval DATA: '$@'";
+
+for my $test ( @$tests ) {
+ my $name = $test->{name};
+ my $password = $test->{password};
+ my $expect = from_json $test->{result};
+
+ local $RPC::ExtDirect::Test::PollProvider::WHAT_YOURE_HAVING
+ = $password;
+
+ my $result = from_json eval { RPC::ExtDirect::EventProvider->poll() };
+
+ is $@, '', "$name eval $@";
+ is_deep $result, $expect, "$name result";
+};
+
+
+__DATA__
+[
+ { name => 'Two events', password => 'Usual, please',
+ result => q|[{"data":["foo"],|.
+ q| "name":"foo_event",|.
+ q| "type":"event"},|.
+ q| {"data":{"foo":"bar"},|.
+ q| "name":"bar_event",|.
+ q| "type":"event"}]|,
+ },
+ { name => 'One event', password => 'Ein kaffe bitte',
+ result => q|{"data":"Uno cappuccino, presto!",|.
+ q| "name":"coffee",|.
+ q| "type":"event"}|,
+ },
+ { name => 'Failed method', password => 'Whiskey, straight away!',
+ result => q|{"data":"","name":"__NONE__","type":"event"}|,
+ },
+ { name => 'No events at all',
+ password => "But that's not on the menu!",
+ result => q|{"data":"","name":"__NONE__","type":"event"}|,
+ },
+ { name => 'Invalid Event provider output',
+ password => "Hey man! There's a roach in my soup!",
+ result => q|{"data":"","name":"__NONE__","type":"event"}|,
+ },
+]
@@ -0,0 +1,499 @@
+use strict;
+use warnings;
+no warnings 'once';
+
+use Test::More;
+
+use RPC::ExtDirect::Test::Util;
+
+if ( $ENV{REGRESSION_TESTS} ) {
+ plan tests => 16;
+}
+else {
+ plan skip_all => 'Regression tests are not enabled.';
+}
+
+# We will test deprecated API and don't want the warnings
+# cluttering STDERR
+$SIG{__WARN__} = sub {};
+
+use lib 't/lib2';
+use RPC::ExtDirect::Test::Hooks;
+use RPC::ExtDirect::Test::PollProvider;
+
+use RPC::ExtDirect::Router;
+use RPC::ExtDirect::EventProvider;
+use RPC::ExtDirect::Event;
+
+use RPC::ExtDirect::API before => \&before_hook, after => \&after_hook;
+
+{
+ package RPC::ExtDirect::Event;
+
+ use Data::Dumper;
+
+ use overload '""' => \&stringify,
+ 'eq' => \=
+
+ sub stringify {
+ my ($self) = @_;
+
+ local $Data::Dumper::Indent = 0;
+ local $Data::Dumper::Terse = 1;
+
+ my $str = $self->name . ':' . Dumper( $self->data );
+ $str =~ s/^'//;
+ $str =~ s/'$//;
+
+ return $str;
+ }
+
+ sub equals {
+ my ($self, $comparison) = @_;
+
+ return $self->stringify eq "$comparison";
+ }
+
+ # This cheating is to avoid rewriting test modules
+
+ package RPC::ExtDirect::Test::Hooks;
+
+ RPC::ExtDirect->import( Action => 'Hooks',
+ before => \&main::before_hook,
+ after => \&main::after_hook );
+}
+
+# These variables get set when hooks are called
+my ($before, $after, $modify, $throw_up, $cancel);
+
+sub before_hook {
+ my ($class, %params) = @_;
+
+ $before = [ $class, { %params } ];
+
+ $params{arg}->[0] = 'bar' if $modify;
+
+ die "Exception\n" if $throw_up;
+
+ return "Method canceled" if $cancel;
+
+ return 1;
+}
+
+sub after_hook {
+ $after = [ shift @_, { @_ } ];
+}
+
+my $tests = eval do { local $/; <DATA> };
+die "Can't read DATA: $@\n" if $@;
+
+for my $test ( @$tests ) {
+ my $name = $test->{name};
+ my $input = $test->{input};
+ my $type = $test->{type};
+ my $env = $test->{env};
+ my $exp_before = $test->{expected_before};
+ my $exp_after = $test->{expected_after};
+
+ $before = $after = $modify = $throw_up = $cancel = undef;
+
+ $modify = $test->{modify};
+ $throw_up = $test->{throw_up};
+ $cancel = $test->{cancel};
+
+ if ( $type eq 'router' ) {
+ RPC::ExtDirect::Router->route($input, $env);
+ }
+ else {
+ RPC::ExtDirect::EventProvider->poll($env);
+ };
+
+ # Orig is a closure in RPC::ExtDirect::Hook, impossible to take ref of
+ {
+ local $@;
+ eval { delete $before->[1]->{orig}; delete $after->[1]->{orig}; };
+ }
+
+ # (before|instead|after|method)_ref hook args were introduced in 3.0
+ # 2.x tests will blow up if we don't clean these up; however being
+ # additions they can't harm the existing code that is not aware of them
+ {
+ local $@;
+ eval {
+ delete $before->[1]->{$_}, delete $after->[1]->{$_}
+ for map { $_.'_ref' } qw/ before instead after method /;
+ };
+ }
+
+ is_deep $before, $exp_before, "$name: before data";
+ is_deep $after, $exp_after, "$name: after data";
+};
+
+__DATA__
+[
+ # Cancel Method call by throwing error
+ {
+ name => 'Router throw error',
+ input => q|{"type":"rpc","tid":1,"action":"Hooks",|.
+ q|"method":"foo_hook","data":["foo"]}|,
+ env => 'env',
+ throw_up => 1,
+ type => 'router',
+ expected_before => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::Hooks',
+ method => 'foo_hook',
+ code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
+ arg => [ 'foo' ],
+ env => 'env',
+ param_names => undef,
+ param_no => 1,
+ pollHandler => 0,
+ formHandler => 0,
+ },
+ ],
+ expected_after => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::Hooks',
+ method => 'foo_hook',
+ code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
+ arg => [ 'foo' ],
+ env => 'env',
+ result => undef,
+ exception => "Exception\n",
+ param_names => undef,
+ param_no => 1,
+ pollHandler => 0,
+ formHandler => 0,
+ method_called => undef,
+ },
+ ],
+ },
+
+ # Cancel Method call by returning non-1 from before hook
+ {
+ name => 'Router cancel Method',
+ input => q|{"type":"rpc","tid":1,"action":"Hooks",|.
+ q|"method":"foo_hook","data":["foo"]}|,
+ env => 'env',
+ cancel => 1,
+ type => 'router',
+ expected_before => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::Hooks',
+ method => 'foo_hook',
+ code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
+ arg => [ 'foo' ],
+ env => 'env',
+ param_names => undef,
+ param_no => 1,
+ pollHandler => 0,
+ formHandler => 0,
+ },
+ ],
+ expected_after => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::Hooks',
+ method => 'foo_hook',
+ code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
+ arg => [ 'foo' ],
+ env => 'env',
+ result => 'Method canceled',
+ exception => undef,
+ param_names => undef,
+ param_no => 1,
+ pollHandler => 0,
+ formHandler => 0,
+ method_called => undef,
+ },
+ ],
+ },
+
+ # Simple Router request
+ {
+ name => 'Router method call',
+ input => q|{"type":"rpc","tid":1,"action":"Hooks",|.
+ q|"method":"foo_hook","data":["foo"]}|,
+ env => 'env',
+ type => 'router',
+ expected_before => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::Hooks',
+ method => 'foo_hook',
+ code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
+ arg => [ 'foo' ],
+ env => 'env',
+ param_names => undef,
+ param_no => 1,
+ pollHandler => 0,
+ formHandler => 0,
+ },
+ ],
+ expected_after => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::Hooks',
+ method => 'foo_hook',
+ code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
+ arg => [ 'foo' ],
+ env => 'env',
+ result => [ 'RPC::ExtDirect::Test::Hooks', 'foo' ],
+ exception => '',
+ param_names => undef,
+ param_no => 1,
+ pollHandler => 0,
+ formHandler => 0,
+ method_called => \&RPC::ExtDirect::Test::Hooks::foo_hook,
+ },
+ ],
+ },
+
+ # Argument modification in "before" hook
+ {
+ name => 'Router arg modification',
+ input => q|{"type":"rpc","tid":1,"action":"Hooks",|.
+ q|"method":"foo_hook","data":["foo"]}|,
+ env => 'env',
+ modify => 1,
+ type => 'router',
+ expected_before => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::Hooks',
+ method => 'foo_hook',
+ code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
+ arg => [ 'bar' ],
+ env => 'env',
+ param_names => undef,
+ param_no => 1,
+ pollHandler => 0,
+ formHandler => 0,
+ },
+ ],
+ expected_after => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::Hooks',
+ method => 'foo_hook',
+ code => \&RPC::ExtDirect::Test::Hooks::foo_hook,
+ arg => [ 'bar' ],
+ env => 'env',
+ result => [ 'RPC::ExtDirect::Test::Hooks', 'bar' ],
+ exception => '',
+ param_names => undef,
+ param_no => 1,
+ pollHandler => 0,
+ formHandler => 0,
+ method_called => \&RPC::ExtDirect::Test::Hooks::foo_hook,
+ },
+ ],
+ },
+
+ # Cancel EventProvider call by throwing error
+ {
+ name => 'Poll throw error',
+ env => 'env',
+ throw_up => 1,
+ type => 'poll',
+ expected_before => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::PollProvider',
+ method => 'foo',
+ code => \&RPC::ExtDirect::Test::PollProvider::foo,
+ arg => [ ],
+ env => 'env',
+ param_names => undef,
+ param_no => undef,
+ pollHandler => 1,
+ formHandler => 0,
+ },
+ ],
+ expected_after => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::PollProvider',
+ method => 'foo',
+ code => \&RPC::ExtDirect::Test::PollProvider::foo,
+ arg => [ ],
+ env => 'env',
+ result => undef,
+ exception => "Exception\n",
+ param_names => undef,
+ param_no => undef,
+ pollHandler => 1,
+ formHandler => 0,
+ method_called => undef,
+ },
+ ],
+ },
+
+ # Cancel Method call by returning non-1 from before hook
+ {
+ name => 'Poll cancel Method',
+ env => 'env',
+ cancel => 1,
+ type => 'poll',
+ expected_before => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::PollProvider',
+ method => 'foo',
+ code => \&RPC::ExtDirect::Test::PollProvider::foo,
+ arg => [ ],
+ env => 'env',
+ param_names => undef,
+ param_no => undef,
+ pollHandler => 1,
+ formHandler => 0,
+ },
+ ],
+ expected_after => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::PollProvider',
+ method => 'foo',
+ code => \&RPC::ExtDirect::Test::PollProvider::foo,
+ arg => [ ],
+ env => 'env',
+ result => 'Method canceled',
+ exception => undef,
+ param_names => undef,
+ param_no => undef,
+ pollHandler => 1,
+ formHandler => 0,
+ method_called => undef,
+ },
+ ],
+ },
+
+ # Argument modification in "before" hook
+ {
+ name => 'Poll arg modification',
+ env => 'env',
+ modify => 1,
+ type => 'poll',
+ expected_before => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::PollProvider',
+ method => 'foo',
+ code => \&RPC::ExtDirect::Test::PollProvider::foo,
+ arg => [ 'bar' ],
+ env => 'env',
+ param_names => undef,
+ param_no => undef,
+ pollHandler => 1,
+ formHandler => 0,
+ },
+ ],
+ expected_after => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::PollProvider',
+ method => 'foo',
+ code => \&RPC::ExtDirect::Test::PollProvider::foo,
+ arg => [ 'bar' ],
+ env => 'env',
+ result => [q|foo_event:['foo']|, q|bar_event:{'foo' => 'bar'}|],
+ exception => '',
+ param_names => undef,
+ param_no => undef,
+ pollHandler => 1,
+ formHandler => 0,
+ method_called => \&RPC::ExtDirect::Test::PollProvider::foo,
+ },
+ ],
+ },
+
+ # Event polling
+ {
+ name => 'Poll method call',
+ env => 'env',
+ type => 'poll',
+ expected_before => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::PollProvider',
+ method => 'foo',
+ code => \&RPC::ExtDirect::Test::PollProvider::foo,
+ arg => [ ],
+ env => 'env',
+ param_names => undef,
+ param_no => undef,
+ pollHandler => 1,
+ formHandler => 0,
+ },
+ ],
+ expected_after => [
+ 'main',
+ {
+ before => \&before_hook,
+ instead => undef,
+ after => \&after_hook,
+ package => 'RPC::ExtDirect::Test::PollProvider',
+ method => 'foo',
+ code => \&RPC::ExtDirect::Test::PollProvider::foo,
+ arg => [ ],
+ env => 'env',
+ result => [q|foo_event:['foo']|, q|bar_event:{'foo' => 'bar'}|],
+ exception => '',
+ param_names => undef,
+ param_no => undef,
+ pollHandler => 1,
+ formHandler => 0,
+ method_called => \&RPC::ExtDirect::Test::PollProvider::foo,
+ },
+ ],
+ },
+]
@@ -1,19 +0,0 @@
-package RPC::ExtDirect::Demo::PollProvider;
-
-use strict;
-use warnings;
-no warnings 'uninitialized';
-
-use POSIX 'strftime';
-
-use RPC::ExtDirect;
-use RPC::ExtDirect::Event;
-
-sub poll : ExtDirect(pollHandler) {
- my $time = strftime "Successfully polled at: %a %b %e %H:%M:%S %Y",
- localtime;
-
- return RPC::ExtDirect::Event->new('message', $time);
-}
-
-1;
@@ -1,68 +0,0 @@
-package RPC::ExtDirect::Demo::Profile;
-
-use strict;
-use warnings;
-no warnings 'uninitialized';
-
-use RPC::ExtDirect Action => 'Profile';
-
-sub updateBasicInfo : ExtDirect(formHandler) {
- my ($class, %fields) = @_;
-
- if ( $fields{email} eq 'aaron@sencha.com' ) {
- return {
- success => \0,
- errors => { email => 'already taken' },
- debug_formPacket => \%fields,
- };
- }
- else {
- return {
- success => \1,
- debug_formPacket => \%fields
- };
- };
-}
-
-sub getBasicInfo : ExtDirect(2) {
- my ($class, $userId, $foo) = @_;
-
- return {
- success => \1,
- data => {
- foo => $foo,
- name => 'Aaron Conran',
- company => 'Sencha Inc.',
- email => 'aaron@sencha.com',
- },
- };
-}
-
-sub getPhoneInfo : ExtDirect(1) {
- my ($class, $userId) = @_;
-
- return {
- success => \1,
- data => {
- cell => '443-555-1234',
- office => '1-800-CALLEXT',
- home => '',
- },
- };
-}
-
-sub getLocationInfo : ExtDirect(1) {
- my ($class, $userId) = @_;
-
- return {
- success => \1,
- data => {
- street => '1234 Red Dog Rd.',
- city => 'Seminole',
- state => 'FL',
- zip => 33776,
- },
- };
-}
-
-1;
@@ -1,78 +0,0 @@
-package RPC::ExtDirect::Demo::TestAction;
-
-use strict;
-use warnings;
-no warnings 'uninitialized';
-
-use Carp;
-
-use RPC::ExtDirect Action => 'TestAction';
-
-sub doEcho : ExtDirect(1) {
- my ($class, $data) = @_;
-
- return $data;
-}
-
-sub multiply : ExtDirect(1) {
- my ($class, $num) = @_;
-
- croak "Call to multiply with a value that is not a number"
- unless $num =~ / \A \d+ \z /xms;
-
- return $num * 8;
-}
-
-sub getTree : ExtDirect(1) {
- my ($class, $id) = @_;
-
- return if length $id == 3;
-
- return [ map { { id => "n$_", text => "Node $_", leaf => \0 } } 1..5 ]
- if $id eq 'root';
-
- my ($parent) = $id =~ /n(\d)/;
-
- return [
- map { { id => "$id$_", text => "Node $parent.$_", leaf => \1 } } 1..5
- ];
-}
-
-sub getGrid : ExtDirect( params => [ 'sort' ] ) {
- my ($class, %params) = @_;
-
- my $field = $params{sort}->[0]->{property};
- my $direction = $params{sort}->[0]->{direction};
-
- my $sort_sub = sub {
- my ($foo, $bar) = $direction eq 'ASC' ? ($a, $b)
- : ($b, $a)
- ;
- return $field eq 'name' ? $foo->{name} cmp $bar->{name}
- : $foo->{turnover} <=> $bar->{turnover}
- ;
- };
-
- my @data = sort $sort_sub (
- { name => 'ABC Accounting', turnover => 50000 },
- { name => 'Ezy Video Rental', turnover => 106300 },
- { name => 'Greens Fruit Grocery', turnover => 120000 },
- { name => 'Icecream Express', turnover => 73000 },
- { name => 'Ripped Gym', turnover => 88400 },
- { name => 'Smith Auto Mechanic', turnover => 222980 },
- );
-
- return [ @data ];
-}
-
-sub showDetails : ExtDirect(params => [qw(firstName lastName age)]) {
- my ($class, %params) = @_;
-
- my $first = $params{firstName};
- my $last = $params{lastName};
- my $age = $params{age};
-
- return "Hi $first $last, you are $age years old.";
-}
-
-1;
@@ -1,53 +0,0 @@
-package RPC::ExtDirect::Test::Bar;
-
-use strict;
-use warnings;
-no warnings 'uninitialized';
-
-use base 'RPC::ExtDirect::Test::Foo';
-
-# Define package scope hooks
-use RPC::ExtDirect BEFORE => \&bar_before, after => \&bar_after;
-
-use Carp;
-
-# This one croaks merrily
-sub bar_foo : ExtDirect(4) { croak 'bar foo!' }
-
-# Return number of passed arguments
-sub bar_bar : ExtDirect(5) { shift; pop; return scalar @_; }
-
-# This is a form handler
-sub bar_baz : ExtDirect( formHandler ) {
- my ($class, %param) = @_;
-
- delete $param{_env};
-
- # Simulate uploaded file handling
- my $uploads = $param{file_uploads};
- return \%param unless $uploads;
-
- # Return 'uploads' data
- my $response = "The following files were processed:\n";
- for my $upload ( @$uploads ) {
- my $name = $upload->{basename};
- my $type = $upload->{type};
- my $size = $upload->{size};
-
- $response .= "$name $type $size\n";
- };
-
- delete $param{file_uploads};
- $param{upload_response} = $response;
-
- return \%param;
-}
-
-sub bar_before {
- return 1;
-}
-
-sub bar_after {
-}
-
-1;
@@ -1,64 +0,0 @@
-package RPC::ExtDirect::Test::Foo;
-
-use strict;
-use warnings;
-no warnings 'uninitialized';
-
-use RPC::ExtDirect;
-
-# Return scalar result
-sub foo_foo : ExtDirect(1, before => \&foo_before) {
- return "foo! '${_[1]}'"
-}
-
-# Return arrayref result
-sub foo_bar
- : ExtDirect(2, instead => \&foo_instead)
-{
- return [ 'foo! bar!', @_[1, 2], ];
-}
-
-# Return hashref result
-sub foo_baz : ExtDirect( params => [foo, bar, baz], before => \&foo_before, after => \&foo_after) {
- my $class = shift;
- my %param = @_;
-
- my $ret = { msg => 'foo! bar! baz!', foo => $param{foo},
- bar => $param{bar}, baz => $param{baz},
- };
-
- delete @param{ qw(foo bar baz _env) };
- @$ret{ keys %param } = values %param;
-
- return $ret;
-}
-
-# Testing zero parameters
-sub foo_zero : ExtDirect(0) {
- my ($class) = @_;
-
- my $ret = [ @_ ];
-
- return $ret;
-}
-
-# Testing blessed object return
-sub foo_blessed : ExtDirect {
- return bless {}, 'foo';
-}
-
-# Testing hooks
-sub foo_before {
- return 1;
-}
-
-sub foo_instead {
- my ($class, %params) = @_;
-
- return $params{orig}->();
-}
-
-sub foo_after {
-}
-
-1;
@@ -1,52 +0,0 @@
-package RPC::ExtDirect::Test::Hooks;
-
-use strict;
-use warnings;
-no warnings 'uninitialized';
-
-use RPC::ExtDirect before => \&nonexistent_before_hook;
-
-our ($foo_foo_called, $foo_bar_called, $foo_baz_called);
-
-sub foo_foo : ExtDirect(1) {
- $foo_foo_called = 1;
-}
-
-sub foo_bar : ExtDirect(2, before => 'NONE') {
- $foo_bar_called = 1;
-}
-
-# This hook will simply raise a flag and die
-sub foo_baz_after {
- $foo_baz_called = 1;
-
- die;
-}
-
-# Return hashref result
-sub foo_baz : ExtDirect( params => [foo, bar, baz], before => 'NONE', after => \&foo_baz_after)
-{
- my $class = shift;
- my %param = @_;
-
- my $ret = { msg => 'foo! bar! baz!', foo => $param{foo},
- bar => $param{bar}, baz => $param{baz},
- };
-
- delete @param{ qw(foo bar baz _env) };
- @$ret{ keys %param } = values %param;
-
- return $ret;
-}
-
-# Testing hook changing parameters
-sub foo_hook : ExtDirect(1) {
- my ($class, $foo) = @_;
-
- my $ret = [ @_ ];
-
- return $ret;
-}
-
-1;
-
@@ -1,58 +0,0 @@
-package RPC::ExtDirect::Test::JuiceBar;
-
-use strict;
-use warnings;
-no warnings 'uninitialized';
-
-use base 'RPC::ExtDirect::Test::Foo';
-
-use RPC::ExtDirect;
-
-use Carp;
-use Data::Dumper;
-
-our $CHEAT = 0;
-
-# This one croaks merrily
-sub bar_foo : ExtDirect(4) { croak 'bar foo!' }
-
-# Return number of passed arguments
-sub bar_bar : ExtDirect(5) { shift; return scalar @_; }
-
-# This is a form handler
-sub bar_baz : ExtDirect( formHandler ) {
- my ($class, %param) = @_;
-
- # Simulate uploaded file handling
- my $uploads = $param{file_uploads};
- return \%param unless $uploads;
-
- # Return 'uploads' data
- my $response = "The following files were processed:\n";
- for my $upload ( @$uploads ) {
- my $name = $upload->{basename};
- my $type = $upload->{type};
- my $size = $upload->{size};
-
- # CTI::Test somehow uploads files so that
- # they are 2 bytes shorter than actual size
- # This allows for the same test results to be
- # applied across all gateways and test frameworks
- #
- # Well, in all truthiness this should be the opposite
- # but CGI::Test was there first...
- $size -= 2 if $CHEAT;
-
- my $ok = (defined $upload->{handle} &&
- $upload->{handle}->opened) ? "ok" : "not ok";
-
- $response .= "$name $type $size $ok\n";
- };
-
- delete $param{file_uploads};
- $param{upload_response} = $response;
-
- return \%param;
-}
-
-1;
@@ -1,53 +0,0 @@
-package TheBug;
-
-sub new { bless { message => $_[1] }, $_[0] }
-sub result { $_[0] }
-
-package RPC::ExtDirect::Test::PollProvider;
-
-use strict;
-use warnings;
-no warnings 'uninitialized';
-
-use Carp;
-
-use RPC::ExtDirect;
-use RPC::ExtDirect::Event;
-
-# This is to control what gets returned
-our $WHAT_YOURE_HAVING = 'Usual, please';
-
-sub foo : ExtDirect( pollHandler ) {
- my ($class) = @_;
-
- # There ought to be something more substantive, but...
- if ( $WHAT_YOURE_HAVING eq 'Usual, please' ) {
- return (
- RPC::ExtDirect::Event->new('foo_event', [ 'foo' ]),
- RPC::ExtDirect::Event->new('bar_event', { foo => 'bar' }),
- );
- }
-
- elsif ( $WHAT_YOURE_HAVING eq 'Ein kaffe bitte' ) {
- return (
- RPC::ExtDirect::Event->new('coffee',
- 'Uno cappuccino, presto!'),
- );
- }
-
- elsif ( $WHAT_YOURE_HAVING eq 'Whiskey, straight away!' ) {
- croak "Burp!";
- }
-
- elsif ( $WHAT_YOURE_HAVING eq "Hey man! There's a roach in my soup!" ) {
- my $bug = new TheBug 'TIGER ROACH!! WHOA!';
- return $bug;
- }
-
- else {
- # Nothing special to report in our Special News Report!
- return ();
- };
-}
-
-1;
@@ -1,23 +0,0 @@
-package RPC::ExtDirect::Test::Qux;
-
-use strict;
-use warnings;
-no warnings 'uninitialized';
-
-use base 'RPC::ExtDirect::Test::Bar';
-
-use RPC::ExtDirect Action => 'Qux';
-
-# Redefine subs into Qux package without actually changing them
-sub foo_foo : ExtDirect( 1 ) { shift; __PACKAGE__->SUPER::foo_foo(@_); }
-sub foo_bar : ExtDirect( 2 ) { shift; __PACKAGE__->SUPER::foo_bar(@_); }
-sub foo_baz : ExtDirect( params => [ qw( foo bar baz ) ] )
- { shift; __PACKAGE__->SUPER::foo_baz(@_); }
-sub bar_foo : ExtDirect( 4 ) { shift; __PACKAGE__->SUPER::bar_foo(@_); }
-sub bar_bar : ExtDirect( 5 ) { shift; __PACKAGE__->SUPER::bar_bar(@_); }
-sub bar_baz : ExtDirect( formHandler ) {
- shift;
- __PACKAGE__->SUPER::bar_baz(@_);
-}
-
-1;
@@ -0,0 +1,13 @@
+package test::hooks;
+
+use strict;
+use warnings;
+
+our $WAS_THERE;
+
+sub global_before {
+ $WAS_THERE = 1;
+}
+
+1;
+
@@ -0,0 +1,19 @@
+package RPC::ExtDirect::Demo::PollProvider;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use POSIX 'strftime';
+
+use RPC::ExtDirect;
+use RPC::ExtDirect::Event;
+
+sub poll : ExtDirect(pollHandler) {
+ my $time = strftime "Successfully polled at: %a %b %e %H:%M:%S %Y",
+ localtime;
+
+ return RPC::ExtDirect::Event->new('message', $time);
+}
+
+1;
@@ -0,0 +1,68 @@
+package RPC::ExtDirect::Demo::Profile;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use RPC::ExtDirect Action => 'Profile';
+
+sub updateBasicInfo : ExtDirect(formHandler) {
+ my ($class, %fields) = @_;
+
+ if ( $fields{email} eq 'aaron@sencha.com' ) {
+ return {
+ success => \0,
+ errors => { email => 'already taken' },
+ debug_formPacket => \%fields,
+ };
+ }
+ else {
+ return {
+ success => \1,
+ debug_formPacket => \%fields
+ };
+ };
+}
+
+sub getBasicInfo : ExtDirect(2) {
+ my ($class, $userId, $foo) = @_;
+
+ return {
+ success => \1,
+ data => {
+ foo => $foo,
+ name => 'Aaron Conran',
+ company => 'Sencha Inc.',
+ email => 'aaron@sencha.com',
+ },
+ };
+}
+
+sub getPhoneInfo : ExtDirect(1) {
+ my ($class, $userId) = @_;
+
+ return {
+ success => \1,
+ data => {
+ cell => '443-555-1234',
+ office => '1-800-CALLEXT',
+ home => '',
+ },
+ };
+}
+
+sub getLocationInfo : ExtDirect(1) {
+ my ($class, $userId) = @_;
+
+ return {
+ success => \1,
+ data => {
+ street => '1234 Red Dog Rd.',
+ city => 'Seminole',
+ state => 'FL',
+ zip => 33776,
+ },
+ };
+}
+
+1;
@@ -0,0 +1,78 @@
+package RPC::ExtDirect::Demo::TestAction;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use Carp;
+
+use RPC::ExtDirect Action => 'TestAction';
+
+sub doEcho : ExtDirect(1) {
+ my ($class, $data) = @_;
+
+ return $data;
+}
+
+sub multiply : ExtDirect(1) {
+ my ($class, $num) = @_;
+
+ croak "Call to multiply with a value that is not a number"
+ unless $num =~ / \A \d+ \z /xms;
+
+ return $num * 8;
+}
+
+sub getTree : ExtDirect(1) {
+ my ($class, $id) = @_;
+
+ return if length $id == 3;
+
+ return [ map { { id => "n$_", text => "Node $_", leaf => \0 } } 1..5 ]
+ if $id eq 'root';
+
+ my ($parent) = $id =~ /n(\d)/;
+
+ return [
+ map { { id => "$id$_", text => "Node $parent.$_", leaf => \1 } } 1..5
+ ];
+}
+
+sub getGrid : ExtDirect( params => [ 'sort' ] ) {
+ my ($class, %params) = @_;
+
+ my $field = $params{sort}->[0]->{property};
+ my $direction = $params{sort}->[0]->{direction};
+
+ my $sort_sub = sub {
+ my ($foo, $bar) = $direction eq 'ASC' ? ($a, $b)
+ : ($b, $a)
+ ;
+ return $field eq 'name' ? $foo->{name} cmp $bar->{name}
+ : $foo->{turnover} <=> $bar->{turnover}
+ ;
+ };
+
+ my @data = sort $sort_sub (
+ { name => 'ABC Accounting', turnover => 50000 },
+ { name => 'Ezy Video Rental', turnover => 106300 },
+ { name => 'Greens Fruit Grocery', turnover => 120000 },
+ { name => 'Icecream Express', turnover => 73000 },
+ { name => 'Ripped Gym', turnover => 88400 },
+ { name => 'Smith Auto Mechanic', turnover => 222980 },
+ );
+
+ return [ @data ];
+}
+
+sub showDetails : ExtDirect(params => [qw(firstName lastName age)]) {
+ my ($class, %params) = @_;
+
+ my $first = $params{firstName};
+ my $last = $params{lastName};
+ my $age = $params{age};
+
+ return "Hi $first $last, you are $age years old.";
+}
+
+1;
@@ -0,0 +1,53 @@
+package RPC::ExtDirect::Test::Bar;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use base 'RPC::ExtDirect::Test::Foo';
+
+# Define package scope hooks
+use RPC::ExtDirect BEFORE => \&bar_before, after => \&bar_after;
+
+use Carp;
+
+# This one croaks merrily
+sub bar_foo : ExtDirect(4) { croak 'bar foo!' }
+
+# Return number of passed arguments
+sub bar_bar : ExtDirect(5) { shift; return scalar @_; }
+
+# This is a form handler
+sub bar_baz : ExtDirect( formHandler ) {
+ my ($class, %param) = @_;
+
+ delete $param{_env};
+
+ # Simulate uploaded file handling
+ my $uploads = $param{file_uploads};
+ return \%param unless $uploads;
+
+ # Return 'uploads' data
+ my $response = "The following files were processed:\n";
+ for my $upload ( @$uploads ) {
+ my $name = $upload->{basename};
+ my $type = $upload->{type};
+ my $size = $upload->{size};
+
+ $response .= "$name $type $size\n";
+ };
+
+ delete $param{file_uploads};
+ $param{upload_response} = $response;
+
+ return \%param;
+}
+
+sub bar_before {
+ return 1;
+}
+
+sub bar_after {
+}
+
+1;
@@ -0,0 +1,64 @@
+package RPC::ExtDirect::Test::Foo;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use RPC::ExtDirect;
+
+# Return scalar result
+sub foo_foo : ExtDirect(1, before => \&foo_before) {
+ return "foo! '${_[1]}'"
+}
+
+# Return arrayref result
+sub foo_bar
+ : ExtDirect(2, instead => \&foo_instead)
+{
+ return [ 'foo! bar!', @_[1, 2], ];
+}
+
+# Return hashref result
+sub foo_baz : ExtDirect( params => [foo, bar, baz], before => \&foo_before, after => \&foo_after) {
+ my $class = shift;
+ my %param = @_;
+
+ my $ret = { msg => 'foo! bar! baz!', foo => $param{foo},
+ bar => $param{bar}, baz => $param{baz},
+ };
+
+ delete @param{ qw(foo bar baz _env) };
+ @$ret{ keys %param } = values %param;
+
+ return $ret;
+}
+
+# Testing zero parameters
+sub foo_zero : ExtDirect(0) {
+ my ($class) = @_;
+
+ my $ret = [ @_ ];
+
+ return $ret;
+}
+
+# Testing blessed object return
+sub foo_blessed : ExtDirect {
+ return bless {}, 'foo';
+}
+
+# Testing hooks
+sub foo_before {
+ return 1;
+}
+
+sub foo_instead {
+ my ($class, %params) = @_;
+
+ return $params{orig}->();
+}
+
+sub foo_after {
+}
+
+1;
@@ -0,0 +1,52 @@
+package RPC::ExtDirect::Test::Hooks;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use RPC::ExtDirect before => \&nonexistent_before_hook;
+
+our ($foo_foo_called, $foo_bar_called, $foo_baz_called);
+
+sub foo_foo : ExtDirect(1) {
+ $foo_foo_called = 1;
+}
+
+sub foo_bar : ExtDirect(2, before => 'NONE') {
+ $foo_bar_called = 1;
+}
+
+# This hook will simply raise a flag and die
+sub foo_baz_after {
+ $foo_baz_called = 1;
+
+ die;
+}
+
+# Return hashref result
+sub foo_baz : ExtDirect( params => [foo, bar, baz], before => 'NONE', after => \&foo_baz_after)
+{
+ my $class = shift;
+ my %param = @_;
+
+ my $ret = { msg => 'foo! bar! baz!', foo => $param{foo},
+ bar => $param{bar}, baz => $param{baz},
+ };
+
+ delete @param{ qw(foo bar baz _env) };
+ @$ret{ keys %param } = values %param;
+
+ return $ret;
+}
+
+# Testing hook changing parameters
+sub foo_hook : ExtDirect(1) {
+ my ($class, $foo) = @_;
+
+ my $ret = [ @_ ];
+
+ return $ret;
+}
+
+1;
+
@@ -0,0 +1,58 @@
+package RPC::ExtDirect::Test::JuiceBar;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use base 'RPC::ExtDirect::Test::Foo';
+
+use RPC::ExtDirect;
+
+use Carp;
+use Data::Dumper;
+
+our $CHEAT = 0;
+
+# This one croaks merrily
+sub bar_foo : ExtDirect(4) { croak 'bar foo!' }
+
+# Return number of passed arguments
+sub bar_bar : ExtDirect(5) { shift; return scalar @_; }
+
+# This is a form handler
+sub bar_baz : ExtDirect( formHandler ) {
+ my ($class, %param) = @_;
+
+ # Simulate uploaded file handling
+ my $uploads = $param{file_uploads};
+ return \%param unless $uploads;
+
+ # Return 'uploads' data
+ my $response = "The following files were processed:\n";
+ for my $upload ( @$uploads ) {
+ my $name = $upload->{basename};
+ my $type = $upload->{type};
+ my $size = $upload->{size};
+
+ # CTI::Test somehow uploads files so that
+ # they are 2 bytes shorter than actual size
+ # This allows for the same test results to be
+ # applied across all gateways and test frameworks
+ #
+ # Well, in all truthiness this should be the opposite
+ # but CGI::Test was there first...
+ $size -= 2 if $CHEAT;
+
+ my $ok = (defined $upload->{handle} &&
+ $upload->{handle}->opened) ? "ok" : "not ok";
+
+ $response .= "$name $type $size $ok\n";
+ };
+
+ delete $param{file_uploads};
+ $param{upload_response} = $response;
+
+ return \%param;
+}
+
+1;
@@ -0,0 +1,53 @@
+package TheBug;
+
+sub new { bless { message => $_[1] }, $_[0] }
+sub result { $_[0] }
+
+package RPC::ExtDirect::Test::PollProvider;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use Carp;
+
+use RPC::ExtDirect;
+use RPC::ExtDirect::Event;
+
+# This is to control what gets returned
+our $WHAT_YOURE_HAVING = 'Usual, please';
+
+sub foo : ExtDirect( pollHandler ) {
+ my ($class) = @_;
+
+ # There ought to be something more substantive, but...
+ if ( $WHAT_YOURE_HAVING eq 'Usual, please' ) {
+ return (
+ RPC::ExtDirect::Event->new('foo_event', [ 'foo' ]),
+ RPC::ExtDirect::Event->new('bar_event', { foo => 'bar' }),
+ );
+ }
+
+ elsif ( $WHAT_YOURE_HAVING eq 'Ein kaffe bitte' ) {
+ return (
+ RPC::ExtDirect::Event->new('coffee',
+ 'Uno cappuccino, presto!'),
+ );
+ }
+
+ elsif ( $WHAT_YOURE_HAVING eq 'Whiskey, straight away!' ) {
+ croak "Burp!";
+ }
+
+ elsif ( $WHAT_YOURE_HAVING eq "Hey man! There's a roach in my soup!" ) {
+ my $bug = new TheBug 'TIGER ROACH!! WHOA!';
+ return $bug;
+ }
+
+ else {
+ # Nothing special to report in our Special News Report!
+ return ();
+ };
+}
+
+1;
@@ -0,0 +1,23 @@
+package RPC::ExtDirect::Test::Qux;
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use base 'RPC::ExtDirect::Test::Bar';
+
+use RPC::ExtDirect Action => 'Qux';
+
+# Redefine subs into Qux package without actually changing them
+sub foo_foo : ExtDirect( 1 ) { shift; __PACKAGE__->SUPER::foo_foo(@_); }
+sub foo_bar : ExtDirect( 2 ) { shift; __PACKAGE__->SUPER::foo_bar(@_); }
+sub foo_baz : ExtDirect( params => [ qw( foo bar baz ) ] )
+ { shift; __PACKAGE__->SUPER::foo_baz(@_); }
+sub bar_foo : ExtDirect( 4 ) { shift; __PACKAGE__->SUPER::bar_foo(@_); }
+sub bar_bar : ExtDirect( 5 ) { shift; __PACKAGE__->SUPER::bar_bar(@_); }
+sub bar_baz : ExtDirect( formHandler ) {
+ shift;
+ __PACKAGE__->SUPER::bar_baz(@_);
+}
+
+1;
@@ -1,6 +1,12 @@
use Test::More;
-eval "use Test::Pod 1.00";
-plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+if ( $ENV{POD_TESTS} ) {
+ eval "use Test::Pod 1.00";
+ plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+
+ all_pod_files_ok();
+}
+else {
+ plan skip_all => 'POD tests are not enabled.';
+}
-all_pod_files_ok();