File Coverage

blib/lib/CGI/Dispatcher/Simple.pm

Criterion	Covered	Total	%
statement	12	31	38.7
branch	0	10	0.0
condition	0	5	0.0
subroutine	4	6	66.6
pod	2	2	100.0
total	18	54	33.3

package CGI::Dispatcher::Simple;
use strict;
use base qw/Class::Accessor::Fast/;
use CGI;
use Carp;

our $VERSION = '0.01';

__PACKAGE__->mk_accessors(qw/args cgi/);

=head1 NAME

CGI::Dispatcher::Simple - Simple CGI Dispacher by PATH_INFO

=head1 SYNOPSIS

  # In your App

  package MyApp;
  use base qw/CGI::Dispacher::Simple/;

  sub run {
      my $self = shift;

      $self->dispatch({
          '/' => 'default',
	  '/list' => 'list',
	  '/add' => 'add',
      });
  }

  sub default {
      :
  }

   :

  # And in your CGI script

  my $app = MyApp->new;
  $app->run;


=head1 DESCRIPTION

This module provide you to simple dispatcher by using PATH_INFO.

You can set some methods as hashref, PATH_INFO are keys, METHODS are values.
like:

  '/' => 'default',
  '/list/add' => 'add',

And, rest of PATH_INFO is saved in $self->args as arrayref.
When PATH_INFO is '/list/add/foo/bar' in above example, $self->args is:

  [ 'foo', 'bar' ]


If you define $self->begin or $self->end methods, these are called automatically
 before/after PATH_INFO method.

And when PATH_INFO is not defined, dispatch to '/' method.

=head1 METHODS

=over 4

=item new

=cut

sub new {
    my $self = bless {}, shift;
    $self->cgi(CGI->new);
    $self->cgi->charset('utf-8');

    $self;
}

=item dispatch

=cut

sub dispatch {
    my ( $self, $methods ) = @_;

    my ($method, @path, @args);
    my $path_info = $self->cgi->path_info || '';
    my $keys = keys %$methods;

    @path = split '/', $path_info;
    shift @path;

    do {
        @path = () if ($method = $methods->{ '/' . join '/', @path});
    } while (unshift @args, pop @path and @path);

    shift @args if @args > 1;
    $self->args(@args);

    if ($self->can($method)) {
        $self->begin if $self->can('begin');
        $self->$method;
        $self->end if $self->can('end');
    } else {
        croak(qq!Method "$method" does not exitst.!);
    }
}

=back

=head1 AUTHOR

Daisuke Murase [e-mail]

=head1 COPYRIGHT

This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=cut

1;