File Coverage

blib/lib/CGI/Application/Plugin/Routes.pm

Criterion	Covered	Total	%
statement	27	70	38.5
branch	1	16	6.2
condition			n/a
subroutine	5	10	50.0
pod	5	5	100.0
total	38	101	37.6

package CGI::Application::Plugin::Routes;
use strict;
use Carp;

use vars qw($VERSION @ISA @EXPORT);

our $VERSION = '1.02';

sub import {
    my $pkg     = shift;
    my $callpkg = caller;

    # Do our own exporting.
    {
        no strict qw(refs);
        *{ $callpkg . '::routes' } = \&CGI::Application::Plugin::Routes::routes;
        *{ $callpkg . '::routes_parse' } = \&CGI::Application::Plugin::Routes::routes_parse;
        *{ $callpkg . '::routes_dbg' } = \&CGI::Application::Plugin::Routes::routes_dbg;
        *{ $callpkg . '::routes_root' } = \&CGI::Application::Plugin::Routes::routes_root;
        *{ $callpkg . '::routes_params' } = \&CGI::Application::Plugin::Routes::routes_params;

    }

    if ( ! UNIVERSAL::isa($callpkg, 'CGI::Application') ) {
        warn "Calling package is not a CGI::Application module so not setting up the prerun hook.  If you are using \@ISA instead of 'use base', make sure it is in a BEGIN { } block, and make sure these statements appear before the plugin is loaded";
    }
    elsif ( ! UNIVERSAL::can($callpkg, 'add_callback')) {
        warn "You are using an older version of CGI::Application that does not support callbacks, so the prerun method can not be registered automatically (Lookup the prerun_callback method in the docs for more info)";
    }
    else {
	    #Add the required callback to the CGI::Application app so it executes the routes_parse sub on the prerun stage
        $callpkg->add_callback( prerun => 'routes_parse' );
    }
}

sub routes {
	my ($self, $table) = @_;
	$self->{'Application::Plugin::Routes::__dispatch_table'} = $table;
    #register every runmode declared.
	for(my $i = 1 ; $i < scalar(@$table) ; $i += 2) {
        my $rm_name = $table->[$i];
        $self->run_modes([$rm_name]);
	}
}

sub routes_dbg {
	my $self = shift;
    require Data::Dumper;
	return Dumper($self->{'Application::Plugin::Routes::__r_params'});
}

sub routes_root{
	my ($self, $root) = @_;
	#make sure no trailing slash is present on the root.
	$root =~ s/\/$//;
	$self->{'Application::Plugin::Routes::__routes_root'} = $root;
}

sub routes_params{
   my ($self) = shift;
   if ( @_ ){
       $self->{'Application::Plugin::Routes::__routes_params'} = [ @_ ];
   }
   return $self->{'Application::Plugin::Routes::__routes_params'};
}

sub routes_parse {
	#all this routine, except a few own modifications was borrowed from the wonderful
	# Michael Peter's CGI::Application::Dispatch module that can be found here:
	# http://search.cpan.org/~wonko/CGI-Application-Dispatch/
	my ($self) = @_;
	my $path = $self->query->path_info;
	# get the module name from the table
	my $table = $self->{'Application::Plugin::Routes::__dispatch_table'};
	unless(ref($table) eq 'ARRAY') {
		carp "[__parse_path] Invalid or no dispatch table!\n";
		return;
	}
	# look at each rule and stop when we get a match
	for(my $i = 0 ; $i < scalar(@$table) ; $i += 2) {
		my $rule = $self->{'Application::Plugin::Routes::__routes_root'} . $table->[$i];
		my @names = ();
		# translate the rule into a regular expression, but remember where the named args are
		# '/:foo' will become '/([^\/]*)'
		# and
		# '/:bar?' will become '/?([^\/]*)?'
		# and then remember which position it matches
		$rule =~ s{
						(^|/)                 # beginning or a /
						(:([^/\?]+)(\?)?)     # stuff in between
				}{
						push(@names, $3);
						$1 . ($4 ? '?([^/]*)?' : '([^/]*)')
				}gxe;
		# '/*/' will become '/(.*)/$' the end / is added to the end of
		# both $rule and $path elsewhere
		if($rule =~ m{/\*/$}) {
			$rule =~ s{/\*/$}{/(.*)/\$};
			push(@names, 'dispatch_url_remainder');
		}
		# if we found a match, then run with it
		if(my @values = ($path =~ m#^$rule$#)) {
			$self->{'Application::Plugin::Routes::__match'} = $path;
			$self->routes_params( @names );
			my %named_args;
			$self->param('rm',$table->[++$i]);

            my $rm_name = $table->[$i];
			$self->prerun_mode($rm_name);

			@named_args{@names} = @values if @names;
			#force params into $self->query. NOTE that it will overwrite any existing param with the same name
			foreach my $k (keys %named_args){
				$self->query->param("$k", $named_args{$k});
			}
			$self->{'Application::Plugin::Routes::__r_params'} = {"parsed_params: " => \%named_args, "path_received: " => $path, "rule_matched: " => $rule, "runmode: " => $rm_name};
		}
	}
}

1;
__END__