Magic

disp.pl

use strict;
use warnings;
use Path::Dispatcher;
use Test::More;

my @calls;

my $dispatcher = Path::Dispatcher->new(
    rules => [
                Path::Dispatcher::Rule::Under->new(
                        predicate => Path::Dispatcher::Rule::Tokens->new(
                                tokens => [],
                                prefix => 1,
                        ),
                        rules => [
                                Path::Dispatcher::Rule::Chain->new(
                                        block => sub { push @calls, 'base' },
                                ),
                                Path::Dispatcher::Rule::Under->new(
                                        predicate => Path::Dispatcher::Rule::Tokens->new(
                                                tokens => ['twitter'],
                                                prefix => 1,
                                        ),
                                        rules => [
                                                Path::Dispatcher::Rule::Chain->new(
                                                        block => sub { push @calls, 'twitter_base' },
                                                ),
                                                Path::Dispatcher::Rule::Tokens->new(
                                                        tokens => ['add'],
                                                        block  => sub { push @calls, 'twitter_add' },
                                                ),
                                                Path::Dispatcher::Rule::Under->new(
                                                        predicate => Path::Dispatcher::Rule::Tokens->new(
                                                                tokens => [qr/.+/],
                                                                prefix => 1,
                                                        ),
                                                        rules => [
                                                                Path::Dispatcher::Rule::Chain->new(
                                                                        block => sub { push @calls, 'twitter_account:'.$_[0]->parent->pos(1) },
                                                                ),
                                                                Path::Dispatcher::Rule::Tokens->new(
                                                                        tokens => ['update',qr/.+/],
                                                                        prefix => 1,
                                                                        block  => sub { push @calls, 'twitter_update:'.$_[0]->pos(2).( $_[0]->leftover ? ' '.(join(' ',$_[0]->leftover)) : '' )},
                                                                ),
                                                                Path::Dispatcher::Rule::Tokens->new(
                                                                        tokens => ['command'],
                                                                        block  => sub { push @calls, 'twitter_command' },
                                                                ),
                                                        ],
                                                ),
                                        ],
                                ),
                                Path::Dispatcher::Rule::Tokens->new(
                                        tokens => ['help'],
                                        block  => sub { push @calls, 'help' },
                                ),
                        ],
                ),
        ],
);

$dispatcher->run("help");
is_deeply([splice @calls], [ 'base', 'help' ]);

$dispatcher->run("help AAAAAAA");
is_deeply([splice @calls], []);

$dispatcher->run("twitter add");
is_deeply([splice @calls], [ 'base', 'twitter_base', 'twitter_add' ]);

$dispatcher->run("twitter add update");
is_deeply([splice @calls], []);

$dispatcher->run("twitter add raudssus update test tweet!");
is_deeply([splice @calls], []);

$dispatcher->run("twitter raudssus test tweet!");
is_deeply([splice @calls], []);

$dispatcher->run("twitter raudssus update onewordeasy");
is_deeply([splice @calls], [ 'base', 'twitter_base', 'twitter_account:raudssus', 'twitter_update:onewordeasy' ]);

$dispatcher->run("twitter raudssus update My Test Tweet!!!");
is_deeply([splice @calls], [ 'base', 'twitter_base', 'twitter_account:raudssus', 'twitter_update:My Test Tweet!!!' ]);

$dispatcher->run("twitter raudssus update");
is_deeply([splice @calls], []);

$dispatcher->run("twitter raudssus command");
is_deeply([splice @calls], [ 'base', 'twitter_base', 'twitter_account:raudssus', 'twitter_command' ]);

done_testing;