view release on metacpan or  search on metacpan

lib/CGI/Application/Muto.pm  view on Meta::CPAN

package CGI::Application::Muto;

use base 'CGI::Application';

use strict;
use warnings;

use vars '$VERSION';
$VERSION = '0.02';

# Load our recommended plugins
use CGI::Application::Plugin::DBH qw/dbh_config dbh/;
use CGI::Application::Plugin::ConfigAuto qw/cfg_file cfg/;
use CGI::Application::Plugin::Redirect;
use CGI::Application::Plugin::LogDispatch;
use CGI::Application::Plugin::Session;


# Load our magic maker plugins
use Class::Inspector;
use CGI::Application::Muto::MethodAttributes;
use Data::Dumper;
use Module::Load;


# We overload the CGI::App run method to provide some extra functionality
# of our own
sub run {

    my $self = shift;

    $self->_init_controllers();
    $self->_init_controller_methods();

    #Some callbacks
    $self->add_callback('prerun', \&_fetch_controller_method);
    $self->add_callback('prerun', \&_check_protected_methods);

    return $self->SUPER::run(); #call CGI::App run method

}


sub _init_controllers{

    my $self = shift;

    # @controller_paths define the search path where we want to search for
    # plugins
    our @controller_paths = ('Muto::App::Controller');
    push @controller_paths, $self->param('controller_path') if $self->param('controller_path');

    # Using Module::Pluggable we fetch the list of all available plugins
    # and have them available by the '_contr' method in our namespace
    use Module::Pluggable search_path => \@controller_paths,
                          sub_name => '_contr';

    # We iterate through the plugin list and using Module::Load we
    # attempt to load them
    for my $Controller( $self->_contr ){
        load $Controller;
    }

    return;
}


# We are gonna provide a really cool way of making our methods work similar to
# the ones on Catalyst
# This code has been taken almost entirely from the module
# CGI::Application::Plugin::ActionDispatch by Jason Yates, E<lt>jaywhy@gmail.comE<gt>
# so all credit goes to him on this aspect of the code
our %_attr_cache;
my %methods;
my $init_attr_handlers = 1;

sub CGI::Application::Muto::Path :ATTR {
  my ($class, $referent, $attr, $data) = @_;

  $data ||='';
  $data =~ s/\/$//;
  unless( $data =~ /^\// ) {
    $data = "/" . $data;
  }

  my $regex = qr/^$data\/?(\/.*)?$/;
  push(@{ $_attr_cache{$class}{$attr} }, [ $referent, $regex ]);
}

sub CGI::Application::Muto::Regex :ATTR {
  my ($package, $referent, $attr, $data) = @_;
  my $regex = qr/$data/;
  push(@{ $_attr_cache{$package}{$attr} }, [$referent, $regex ]);
}