CGI-Snapp
view release on metacpan or search on metacpan
Changelog.ini
Changes
lib/CGI/Snapp.pm
LICENSE
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
README
t/basic.pl
t/callbacks.pl
t/defaults.pl
t/forward.t
t/headers.pl
t/hook.test.a.pl
t/hook.test.b.pl
t/hook.test.c.pl
t/hook.test.d.pl
t/hook.tests.pl
t/isa.pl
t/lib/CGI/Snapp/Callback.pm
lib/CGI/Snapp.pm view on Meta::CPAN
required => 0,
);
has logger =>
(
is => 'rw',
default => sub{return ''},
required => 0,
);
has _object_callbacks =>
(
is => 'rw',
default => sub{return {} },
required => 0,
);
has PARAMS =>
(
is => 'rw',
default => sub{return {} },
lib/CGI/Snapp.pm view on Meta::CPAN
required => 0,
);
has _start_mode =>
(
is => 'rw',
default => sub{return 'start'},
required => 0,
);
my(%class_callbacks) =
(
error => {},
forward_prerun => {},
init => {'CGI::Snapp' => ['cgiapp_init']},
prerun => {'CGI::Snapp' => ['cgiapp_prerun']},
postrun => {'CGI::Snapp' => ['cgiapp_postrun']},
teardown => {'CGI::Snapp' => ['teardown']},
);
my($myself);
lib/CGI/Snapp.pm view on Meta::CPAN
sub add_callback
{
my($self, $hook, $option) = @_;
croak "Error: Can't use undef as a hook name\n" if (! defined $hook);
$hook = lc $hook;
$self -> log(debug => "add_callback($hook, ...)");
croak "Error: Unknown hook name '$hook'\n" if (! $class_callbacks{$hook});
if (ref $self)
{
# it's an object-level callback.
my($object_callback) = $self -> _object_callbacks;
$$object_callback{$hook} = [] if (! $$object_callback{$hook});
push @{$$object_callback{$hook} }, $option;
$self -> _object_callbacks($object_callback);
}
else
{
# It's a class-level callback.
push @{$class_callbacks{$hook}{$self} }, $option;
}
} # End of add_callback.
# --------------------------------------------------
sub add_header
{
my($self, @headers) = @_;
lib/CGI/Snapp.pm view on Meta::CPAN
$hook = lc $hook;
$self -> log(debug => "call_hook($hook, ...)");
my($count) = {class => 0, object => 0};
my(%seen);
# Call object-level hooks.
for my $callback (@{${$self -> _object_callbacks}{$hook} })
{
next if ($seen{$callback});
try
{
$self -> $callback(@args);
}
catch
{
croak "Error executing object-level callback for hook '$hook': $@\n" if ($@);
lib/CGI/Snapp.pm view on Meta::CPAN
$$count{object}++;
$seen{$callback} = 1;
}
# Call class-level hooks.
for my $class (Class::ISA::self_and_super_path(ref $self || $self) )
{
next if (! exists $class_callbacks{$hook}{$class});
for my $callback (@{$class_callbacks{$hook}{$class} })
{
next if ($seen{$callback});
try
{
$self -> $callback(@args);
}
catch
{
croak "Error executing class-level callback for class '$class', hook '$hook': $@\n" if ($@);
lib/CGI/Snapp.pm view on Meta::CPAN
croak "Error executing run mode '$run_mode': $error\n";
}
};
return defined($output) ? $output : '';
} # End of _generate_output.
# --------------------------------------------------
sub get_callbacks
{
my($self, $type, $hook) = @_;
$type ||= '';
$hook ||= '';
$self -> log(debug => "get_callbacks($type, $hook)");
croak "Error: \$type parameter to get_callbacks() must be 'class' or 'object'\n" if ($type !~ /^(?:class|object)$/);
croak "Error: \$hook parameter to get_callbacks() must be a string\n" if (length($hook) == 0);
return $type eq 'class' ? $class_callbacks{$hook} : ${$self -> _object_callbacks}{$hook};
} # End of get_callbacks.
# --------------------------------------------------
sub get_current_runmode
{
my($self) = @_;
$self -> log(debug => 'get_current_runmode()');
return $self -> _current_run_mode;
lib/CGI/Snapp.pm view on Meta::CPAN
sub new_hook
{
my($self, $hook) = @_;
croak "Error: Can't use undef as a hook name\n" if (! defined $hook);
$hook = lc $hook;
$self -> log(debug => "new_hook($hook)");
$class_callbacks{$hook} ||= {};
return 1;
} # End of new_hook.
# --------------------------------------------------
sub param
{
my($self, @params) = @_;
lib/CGI/Snapp.pm view on Meta::CPAN
=item o Fallback
Finally, if L<error_mode([$method_name])> does not return a method name, or calling that method also fails, the code calls L<Carp>'s croak($message).
=back
Aren't you glad that was the I<simple> view?
=head2 A More Complex View
L<CGI::Snapp> and before it L<CGI::Application> are designed in such a way that some of those methods are actually I<callbacks> aka I<hooks>, and their names are looked up via hook names.
See the Wikipedia article L<Hooking|http://en.wikipedia.org/wiki/Hooking> for a long explanation of hooks.
It works like this: A hook name is a key in a hash, and the corresponding value is a package name, which in turn points to an arrayref of method names. So, for a given hook name and
package, we can execute a series of named methods, where those names are listed in that arrayref.
The hooked methods are not expected to return anything.
Here's the default set of hooks aka (default) dispatch table. It's just a hash with fancy values per key:
lib/CGI/Snapp.pm view on Meta::CPAN
init => {'CGI::Snapp' => ['cgiapp_init']},
prerun => {'CGI::Snapp' => ['cgiapp_prerun']},
postrun => {'CGI::Snapp' => ['cgiapp_postrun']},
teardown => {'CGI::Snapp' => ['teardown']},
);
An explanation:
=over 4
=item o Yes, there are class-level callbacks and object-level callbacks
See L</add_callback($hook, $option)> for details.
=item o The error hook
By default, there is no method attached to the 'error' hook. See L</error_mode([$method_name])> for details.
=item o The init hook
Instead of calling cgiapp_init() directly at the start of the run as alleged above, we call all those methods named as belonging to the 'init' hook, of which - here - there is just the
lib/CGI/Snapp.pm view on Meta::CPAN
Adds another method to the stack of methods associated with $hook.
$hook is the name of a hook. $hook is forced to be lower-case.
Returns nothing.
That name is either pre-defined (see L</new_hook($hook)>) or one of your own, which you've previously set up with L</new_hook($hook)>.
Sample code:
# Class-level callbacks.
$class_name -> add_callback('init', \&method_1);
KillerApp -> add_callback('init', 'method_2');
# Object-level callbacks.
$app = CGI::Snapp -> new;
$app -> add_callback('init', \&method_3);
Notes:
=over 4
=item o Callback lifetimes
Class-level callbacks outlive the life of the $app object (of type L<CGI::Snapp> or your sub-class), by surviving for the duration of the Perl process, which, in a persistent
environment like L<Starman>, L<Plack>, etc, can be long enough to serve many HTTP client requests.
Object-level callbacks, however, go out of scope at the same time the $app object itself does.
=item o The class hierarchy
Callbacks can be registered by an object, or any of its parent classes, all the way up the hierarchy to L<CGI::Snapp>.
=item o Callback name resolution
Callback names are checked, and only the first with a given name is called. The type of callback, class or object, is ignored in this test, as it is in L<CGI::Application>.
This also means, that if there are 2 callbacks with the same name, in different classes, then still only the first is called.
Consider:
In Class A: $self -> add_callback('teardown', 'teardown_sub');
In Class B: $self -> add_callback('teardown', 'teardown_sub');
Here, because the names are the same, only one (1) teardown_sub() will be called. Which one called depends on the order in which those calls to add_callback() take place.
In Class A: $self -> add_callback('teardown', \&teardown_sub);
In Class B: $self -> add_callback('teardown', \&teardown_sub);
This time, both teardown_sub()s are called, because what's passed to add_callback() are 2 subrefs, which are memory addresses, and can't be the same for 2 different subs.
=item o Pre-defined hooks
Only the pre-defined hooks are called by L<CGI::Snapp>. So, if you use your own name in calling new_hook($name), you are also responsible for triggering the calls to that hook.
The pre-defined hooks are called 'error', 'init', 'prerun', 'postrun' and 'teardown', and there is no need to call L</new_hook($hook)> for those.
=item o Class-level callbacks
These belong to the class of the object calling L</add_callback($hook, $option)>.
=item o Multiple callbacks for a given hook
If multiple I<class>-level callbacks are added for the same hook by different classes, they will be executed in reverse-class-hierarchy order.
That it, the callback for the most derived class is executed first. This is the way normal class-hierarchy overrides work - nothing unexpected here.
If multiple I<class>-level callbacks are added for the same hook by the same class, they will be executed in the order added, since they are pushed onto a stack (as are object-level
callbacks).
If multiple I<object>-level callbacks are added for the same hook, they are run in the order they are registered, i.e. in the order of calls to L</add_callback($hook, $option)>.
=item o The 'init' hook
Since the 'init' hook is triggered during the call to L</new()>, even before L</setup()> is called, there is no opportunity for normal end-user code (your sub-class of L<CGI::Snapp>) to attach
a callback to this hook.
The way around this is to write a class which is I<not> a sub-class of L<CGI::Snapp>, and whose import() method is triggered when you 'use' this class in your sub-class of L<CGI::Snapp>.
There is a group of examples on how to do this. Start with t/hook.test.a.pl, which 'use's t/lib/CGI/Snapp/HookTestA.pm, which in turn 'use's t/lib/CGI/Snapp/Plugin/HookTest1.pm.
Alternately, examine the source code of L<CGI::Snapp::Plugin::Forward> for another way to do things, although it uses 'forward_prerun' rather than 'init'.
=back
To summarize, you are I<strongly> advised to examine t/hook.test.pl and all the modules it uses to gain a deeper understanding of this complex issue. In particular, the order of 'use'
statements in your sub-class of L<CGI::Snapp> will determine the order in which class-level callbacks are triggered.
=head2 add_header(@headers)
Adds headers to the list which will be sent to the HTTP client.
Returns all headers as a hash.
See also L</delete_header(@keys)>, L</header_add(@headers)>, L</header_props([@headers])>, L</header_type([$option])> and L</How does add_header() differ from header_add()?>.
=head2 call_hook($hook, @args)
Call the named hook. $hook is forced to be lower-case.
Returns a hashref of the number of callbacks actually called, where the keys are 'class' and 'object', and the values are integer counts.
@args takes various values, depending on the name of the callback:
=over 4
=item o init
Here, @args is the hash of options passed in to L</new()>.
Defaults to calling CGI::Snapp::cgiapp_init(@args).
lib/CGI/Snapp.pm view on Meta::CPAN
Adds I<and sometimes deletes> headers from the list which will be sent to the HTTP client.
This strange behaviour is copied directly from L<CGI::Application>.
Returns the remaining headers as a hash.
Deprecated.
See also L</add_header(@headers)>, L</delete_header(@keys)>, L</header_props([@headers])>, L</header_type([$option])> and L</How does add_header() differ from header_add()?>.
=head2 get_callbacks($type, $hook)
Gets callback information associated with the given $type (class/object) and $hook.
$type is 'class' for class-level callbacks, and 'object' for object-level callbacks.
Values for $type:
=over 4
=item o 'class'
get_callbacks('class', $hook) returns a I<hashref>.
The keys of this hashref are the class names which have registered callbacks for $hook.
The values of this hashref are arrayrefs of method names or references.
=item o 'object'
get_callbacks('object', $hook) returns an I<arrayref>.
The values of this arrayref are arrayrefs of method names or references.
=back
See t/defaults.pl for sample code.
=head2 header_props([@headers])
Sets the headers to be sent to the HTTP client. These headers are expected to be a hash of L<CGI>-compatible HTTP header properties.
lib/CGI/Snapp.pm view on Meta::CPAN
These are the major differences:
=head3 Clean up 'run_mode' 'v' runmode
Except for method calls where 'runmode' is unfortunately used, e.g L</get_current_runmode()>, 'run_mode' and 'run mode' have been adopted as the norm.
=head3 Always call croak and not a combination of croak and die
Also, every message passed to croak matches /^Error/ and ends with "\n".
=head3 No global variables (except for the inescapable dispatch table of class-level callbacks)
This means things like $$self{__CURRENT_RUNMODE} and $$self{__PRERUN_MODE_LOCKED} etc are only be available via method calls.
Here is a list of the global variables in L<CGI::Application>, and the corresponding methods in L<CGI::Snapp>, in alphabetical order:
=over 4
=item o __CALLBACK_CLASSES => %callback_classes
=item o __CURRENT_RUNMODE => L</get_current_runmode()>
lib/CGI/Snapp.pm view on Meta::CPAN
=item o __CURRENT_TMPL_EXTENSION => Not implemented
=item o __ERROR_MODE => L</error_mode([$method_name])>
=item o __HEADER_PROPS => L</header_props([@headers])>
=item o __HEADER_TYPE => L</header_type([$option])>
=item o __HTML_TMPL_CLASS => Not implemented
=item o __INSTALLED_CALLBACKS => L</installed_callbacks()>
=item o __IS_PSGI => _psgi()
=item o __MODE_PARAM => L</mode_param([@new_options])>
=item o __PARAMS => L</param([@params])>
=item o __PRERUN_MODE => L</prerun_mode($string)>
=item o __PRERUN_MODE_LOCKED => _prerun_mode_lock([$Boolean])
lib/CGI/Snapp.pm view on Meta::CPAN
=back
The leading '_' on some CGI::Snapp method names means all such methods are for the exclusive use of the author of this module.
=head3 New methods
=over 4
=item o L</add_header(@headers)>
=item o L</get_callbacks($type, $hook)>
=item o L</log($level, $string)>
=item o L</logger($logger_object)>
=item o L</send_output([$Boolean])>
=back
=head3 Deprecated methods
t/callbacks.pl view on Meta::CPAN
my($modes) = {finish => 'finisher', start => 'starter'};
$app -> run_modes($modes);
cmp_deeply({$app -> run_modes}, $modes, 'Set/get run modes'); $count++;
ok(length($app -> run) > 0, "Output from $0 is not empty"); $count++;
isa_ok($app -> query, 'CGI::Simple'); $count++;
isa_ok($app -> cgiapp_get_query, 'CGI::Simple'); $count++;
my($callbacks) = $app -> get_callbacks('class', 'init');
ok(ref $callbacks eq 'HASH', 'get_callbacks() returned a hashref'); $count++;
ok(ref $$callbacks{'CGI::Snapp'} eq 'ARRAY', 'get_callbacks() returned an arrayref'); $count++;
ok($#{$$callbacks{'CGI::Snapp'} } == 0, 'get_callbacks() returned an arrayref of 1 element'); $count++;
ok($$callbacks{'CGI::Snapp'}[0] eq 'cgiapp_init', 'get_callbacks() returned the correct method'); $count++;
my($hook) = 'crook';
$app -> new_hook($hook);
$app -> add_callback($hook, 'sub_one');
$app -> add_callback($hook, sub{'two'} );
$app -> add_callback($hook, 'sub_three');
$callbacks = $app -> get_callbacks('object', $hook);
ok(ref $callbacks eq 'ARRAY', 'get_callbacks() returned an arrayref'); $count++;
ok($#$callbacks == 2, 'get_callbacks() returned an arrayref of 3 elements'); $count++;
ok($$callbacks[0] eq 'sub_one', 'get_callbacks() returned the correct method'); $count++;
ok($$callbacks[2] eq 'sub_three', 'get_callbacks() returned the correct method'); $count++;
done_testing($count);
t/lib/CGI/Snapp/Plugin/HookTest/HookTest3.pm view on Meta::CPAN
@EXPORT = (qw/init_sub_1_1 init_sub_2_2/);
our $VERSION = '2.01';
# --------------------------------------------------
sub import
{
my($caller) = caller;
# Class-level callbacks.
$caller -> add_callback('init', 'init_sub_1_1');
$caller -> add_callback('init', 'init_sub_2_2');
goto &Exporter::import;
} # End of import.
# --------------------------------------------------
t/lib/CGI/Snapp/Plugin/HookTest1.pm view on Meta::CPAN
@EXPORT = (qw/init_sub_1_1 init_sub_1_2/);
our $VERSION = '2.01';
# --------------------------------------------------
sub import
{
my($caller) = caller;
# Class-level callbacks.
$caller -> add_callback('init', 'init_sub_1_1');
$caller -> add_callback('init', 'init_sub_1_2');
$caller -> add_callback('teardown', \&teardown_sub);
goto &Exporter::import;
} # End of import.
# --------------------------------------------------
t/lib/CGI/Snapp/Plugin/HookTest2.pm view on Meta::CPAN
@EXPORT = (qw/init_sub_2_1 init_sub_2_2/);
our $VERSION = '2.01';
# --------------------------------------------------
sub import
{
my($caller) = caller;
# Class-level callbacks.
$caller -> add_callback('init', 'init_sub_2_1');
$caller -> add_callback('init', 'init_sub_2_2');
$caller -> add_callback('teardown', \&teardown_sub);
goto &Exporter::import;
} # End of import.
# --------------------------------------------------
} # End of process_output;
# -----------------------------------------------
my($runner) = CGI::Snapp::RunScript -> new;
my($count) = 0;
my(%test) =
(
'basic.pl' => 4,
'callbacks.pl' => 13,
'defaults.pl' => 6,
'headers.pl' => 17,
'hook.tests.pl' => 16,
'isa.pl' => 1,
'overrides.pl' => 2,
'params.pl' => 12,
'psgi.basic.pl' => 4,
'run.modes.pl' => 11,
'subclass.pl' => 3,
);
( run in 1.698 second using v1.01-cache-2.11-cpan-9b1e4054eb1 )