view release on metacpan or  search on metacpan

lib/CGI/Snapp/Dispatch.pm  view on Meta::CPAN

package CGI::Snapp::Dispatch;

use strict;
use warnings;

use Carp;

use CGI::PSGI;

use Class::Load ':all';

use HTTP::Exception;

use Log::Handler;

use Moo;

use Try::Tiny;

has logger =>
(
	is       => 'rw',
	default  => sub{return ''},
	required => 0,
);

has return_type =>
(
	is       => 'rw',
	default  => sub{return 0},
	required => 0,
);

our $VERSION = '2.00';

# --------------------------------------------------

sub as_psgi
{
	my($self, @args)   = @_;

	$self -> log(debug => 'as_psgi(...)');

	croak "Parameter \@args to dispatch() must be a hashref or a hash\n" if ( ($#args > 0) && ($#args % 2 != 1) );

	my($options) = ref $args[0] eq 'HASH' ? $args[0] : {@args};
	my($args)    = $self -> _merge_args($options);

	croak "Missing dispatch table, or it's not an arrayref\n" if (! $$args{table} || ref $$args{table} ne 'ARRAY');

	my($output);

	return
		sub
		{
			my($env)         = shift @_;
			my($http_method) = $$env{REQUEST_METHOD};
			my($named_args)  = $self -> _parse_path($http_method, $self -> _clean_path($$env{PATH_INFO}, $args), $$args{table});

			HTTP::Exception -> throw(404, status_message => 'Not Found') if (! $$named_args{app});
			HTTP::Exception -> throw(400, status_message => "Invalid characters in run mode name '$$named_args{rm}'") if ($$named_args{rm} && ($$named_args{rm} !~ m/^([a-zA-Z_][\w\']+)$/) );

			# If _prepare() croaks, error number is 404.
			# If run() croaks, error number is 500,
			# because the error message will not match /^\d+$/.

			try
			{
				my($module, $rm, $args_to_new) = $self -> _prepare($http_method, $args, $named_args);
				$$args_to_new{_psgi}           = 1; # Required.
				$$args_to_new{QUERY}           = CGI::PSGI -> new($env) if (! $$args_to_new{QUERY});
				my($app)                       = $module -> new(%$args_to_new);

				$app -> mode_param(sub {return $rm}) if ($rm);

				$output = $app -> run;
			}
			catch

lib/CGI/Snapp/Dispatch.pm  view on Meta::CPAN

the new code behave in an identical fashion to the corresponding code in L<CGI::Application::Dispatch>.

Also, the re-write allowed me to support a version of L</dispatch(@args)> which accepts a hashref, not just a hash.
The same flexibility has been added to L</as_psgi(@args)>.

=head3 No special code for Apache, mod_perl or plugins

I suggest that sort of stuff is best put in sub-classes.

=head3 Unsupported features

=over 4

=item o dispatch_path()

Method dispatch_path() is not provided. For L<CGI> scripts, the code in dispatch() accesses $ENV{PATH_INFO} directly,
whereas for L<PSGI|http://plackperl.org/> scripts, as_psgi() accesses the L<PSGI|http://plackperl.org/> environment
hashref $$env{PATH_INFO}.

=back

=head3 Enhanced features

L</new()> can take extra parameters:

=over 4

=item o return_type

Note: I<return_type> is ignored by L</as_psgi(@args)>.

=back

=head3 This module uses Class::Load to try loading your application's module

L<CGI::Application::Dispatch> uses:

	eval "require $module";

whereas CGI::Snapp::Dispatch uses 2 methods from L<Class::Load>:

	try_load_class $module;
	croak 404 if (! is_class_loaded $module);

For L<CGI> scripts, the 404 (and all other error numbers) is handled by sub _http_error(), whereas for
L<PSGI|http://plackperl.org/> scripts, the code throws errors of type L<HTTP::Exception>.

=head3 Reading an error document from a file

L<CGI::Application::Dispatch> always prepends $ENV{DOCUMENT_ROOT} to the file name.
Unfortunately, this means that when $ENV{DOCUMENT_ROOT} is not set, File::Spec prepends a '/' to the file name.
So, an I<error_document> of '<x.html' becomes '/x.html'.

This module only prepends $ENV{DOCUMENT_ROOT} if it is not empty. Hence, with an empty $ENV{DOCUMENT_ROOT},
an I<error_document> of '<x.html' becomes 'x.html'.

See sub _parse_error_document() and t/args.t test_26().

=head3 Handling of exceptions

L<CGI::Application::Dispatch> uses a combination of eval and L<Try::Tiny>, together with L<Exception::Class>.
Likewise, L<CGI::Application::Dispatch::PSGI> uses the same combination, although without L<Exception::Class>.

CGI::Snapp::Dispatch just uses L<Try::Tiny>. This applies both to CGI scripts and PSGI scripts.
For L<CGI> scripts, errors are handled by sub _http_errror(). For L<PSGI|http://plackperl.org/> scripts, the code
throws errors of type L<HTTP::Exception>.

=head2 How does CGI::Snapp parse the path info?

Firstly, the path info is split on '/' chars. Hence /module_name/mode1 gives us ('', 'module_name', 'mode1').

The value 'module_name' is passed to L</translate_module_name($name)>. In this case, the result is 'Module::Name'.

You are free to override L</translate_module_name($name)> to customize it.

After that, the I<prefix> option's value, if any, is added to the front of 'Module::Name'. See L</dispatch_args($args)> for
more about I<prefix>.

FInally, 'mode1' becomes the name of the run mode.

Remember from the docs for L<CGI::Snapp>, that this is the I<name> of the run mode, but is not necessarily the name
of the method which will be run. The code in your sub-class of L<CGI::Snapp> can map run mode names to method
names.

For instance, a statement like:

	$self -> run_modes({rm_name_1 => 'rm_method_1', rm_name_2 => 'rm_method_2'});

in (probably) sub setup(), shows how to separate run mode names from method names.

=head2 What is the structure of the dispatch table?

Sometimes it's easiest to explain with an example, so here you go:

	CGI::Snapp::Dispatch -> new -> dispatch # Note the new()!
	(
		args_to_new =>
		{
			PARAMS => {big => 'small'},
		},
		default => '/app',
		prefix  => 'MyApp',
		table   =>
		[
			''                         => {app => 'Blog', rm => 'recent'},
			'posts/:category'          => {app => 'Blog', rm => 'posts'},
			':app/:rm/:id'             => {app => 'Blog'},
			'date/:year/:month?/:day?' =>
			{
				app         => 'Blog',
				rm          => 'by_date',
				args_to_new => {PARAMS => {small => 'big'} },
			},
		]
	);

Firstly note, that besides passing this structure into L</dispatch(@args)>, you could sub-class L<CGI::Snapp::Dispatch>
and design L</dispatch_args($args)> to return exactly the same structure.

OK. The components, all of which are optional, are:

=over 4

=item o args_to_new => $hashref