view release on metacpan or  search on metacpan

lib/Apache2/Controller/Funk.pm  view on Meta::CPAN

package Apache2::Controller::Funk;

=head1 NAME

Apache2::Controller::Funk

=head1 VERSION

Version 1.001.001

=cut

use version;
our $VERSION = version->new('1.001.001');

=head1 SYNOPSIS

 $bool = controller_allows_method($class, $method); 

 check_allowed_method($class, $method);     # throws NOT_FOUND exception

=head1 DESCRPTION

Useful routines for both Apache2::Controller and Apache2::Controller::Dispatch
objects to run.  Results and whether to 'require' are cached in this package's
namespace across requests, optimizing efficiency per mod_perl2 child, and are
queried futher using 'exists', which is very fast.

=cut

use strict;
use warnings FATAL => 'all';
use English '-no_match_vars';

use base 'Exporter';

use Log::Log4perl qw( :easy );
use Readonly;
use YAML::Syck;

use Apache2::Controller::X;
use Apache2::Const -compile => qw( NOT_FOUND );

our @EXPORT_OK = qw(
    controller_allows_method
    check_allowed_method
    log_bad_request_reason
    default_consumer_secret
);

# this was dumb... this should really be a directive.
# or it should let whatever pipe downstream do whatever it needs to.
Readonly my $ACCESS_LOG_REASON_LENGTH => 512;

=head1 IMPORTABLE FUNCTIONS

=head2 controller_allows_method

 $bool = controller_allows_method($class, $method); # controller_allows_method()

Ask if method name is returned by C<< allowed_methods() >>
in the given controller package.

Only two 'exists' calls are required for each query after caching the 
first result for this child.

=cut

my %allowed_methods = ( );
sub controller_allows_method {
    my ($class, $method) = @_;

    a2cx "class undefined"  if !defined $class;
    a2cx "method undefined" if !defined $method;
    DEBUG(sub{
        "checking class '$class', method '$method', allowed is:\n"
        .Dump(\%allowed_methods)
    });

    # check that the method is allowed.