package MasonX::MiniMVC::Dispatcher; use strict; use warnings; use base qw(Class::Accessor); __PACKAGE__->mk_accessors(qw(controllers)); =head1 NAME MasonX::MiniMVC::Dispatcher -- Dispatcher class for MasonX::MiniMVC =head1 VERSION Version 0.01 =cut our $VERSION = '0.01'; =head1 DESCRIPTION For detailed documentation on how to use MasonX::MiniMVC, see the docs for that module. =head2 new(\%controllers) Takes a hashref of urls/controllers. =cut sub new { my ($class, $controllers) = @_; my $self = { controllers => $controllers, }; bless $self, $class; return $self; } =head2 dispatch($m) Dispatches to the appropriate controller. =cut sub dispatch { my ($self, $m) = @_; my $dhandler_args = $m->dhandler_arg(); $dhandler_args =~ s/\/$//; # strip trailing slash my ($class, $method, @args) = $self->_find_controller($dhandler_args); if ($class) { eval "require $class"; if ($method) { if ($class->can($method)) { $class->$method($m, @args); } else { $class->not_found($m, $method, @args); } } else { $class->default($m, @args); } } else { # we want a 404 if we can't find a controller. # however, this isn't working for me under CGIHandler. $m->clear_and_abort(404); } } sub _find_controller { my ($self, $desired_component, @extra_args) = @_; # this probably means we've exhausted the arg stack return undef unless $desired_component; foreach my $controller (sort keys %{$self->controllers()}) { if ($controller =~ /^$desired_component/) { return $self->controllers->{$controller}, @extra_args; } } # nothing found yet, so shift the rightmost part of the desired # component into the extra args. ie. "foo/bar/baz", "quux" becomes # "foo/bar", "baz", "quux". my @parts = split "/", $desired_component; unshift @extra_args, pop @parts; $desired_component = join "/", @parts; $self->_find_controller($desired_component, @extra_args); } =head1 AUTHOR Kirrily "Skud" Robert, C<< >> =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc MasonX::MiniMVC You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =back =head1 COPYRIGHT & LICENSE Copyright 2007 Kirrily "Skud" Robert, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1;