The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Test::More tests => 143;
use lib qw( ../lib ./lib );
use Egg::Helper;

$ENV{VTEST_DISPATCH_CLASS}= 'Egg::Dispatch::Standard';

my $e= Egg::Helper->run('Vtest');

can_ok $e, 'refhash';
  ok my $rhash= $e->can('refhash'), q{my $rhash= $e->can('refhash')};
  ok my $rh= $rhash->(), q{my $rh= $rhash->()};
  isa_ok $rh, 'HASH';
  isa_ok tied(%$rh), 'Tie::RefHash';

can_ok $e, 'dispatch';
can_ok $e, 'dispatch_map';
{
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	isa_ok $d, 'Egg::Dispatch::Standard::handler';
	my($begin, $default);
	ok $e->dispatch_map(
	  _default=> sub {},
	  _begin=> sub { $begin.= 1 },
	  test=> {
	    _begin=> sub { $begin.= 2 },
	    test=> {
	      _begin  => sub { $begin.= 3 },
	      _default=> sub { $default= 1 },
	      },
	    },
	  ), q{$e->dispatch_map( .......... };
	ok $e->dispatch_map, q{$e->dispatch_map};
can_ok $d, '_start';
	ok $d->_start, q{$d->_start};
	is $begin,   1, q{$begin, 1};
	$e->{Dispatch}= undef;
  };

{
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
can_ok $d, 'parts';
	ok $d->parts([qw/ test test /]), q{$d->parts([qw/ test test /])};
	my($begin, $default);
	ok $e->dispatch_map(
	  _default=> sub {},
	  _begin=> sub { $begin.= 1 },
	  test=> {
	    _begin=> sub { $begin.= 2 },
	    test=> {
	      _begin  => sub { $begin.= 3 },
	      _default=> sub { $default= 1 },
	      },
	    },
	  ), q{$e->dispatch_map( .......... };
	ok $d->_start, q{$d->_start};
	is $begin, '123', q{$begin, '123'};
can_ok $d, '_action';
	ok $d->_action, q{$d->_action};
	is $default, 1, q{$default, 1};
	$e->{Dispatch}= undef;
  };

{
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	my $end;
	ok $e->dispatch_map(
	  _default=> sub {},
	  _end=> sub { $end.= 1 },
	  test=> {
	    _end=> sub { $end.= 2 },
	    test=> {
	      _end  => sub { $end.= 3 },
	      _default=> sub { $default= 1 },
	      },
	    },
	  ), q{$e->dispatch_map( .......... };
	ok $d->_start, q{$d->_start};
can_ok $d, '_finish';
	ok $d->_finish, q{$d->_finish};
	is $end, 1, q{$end, 1};
	$e->{Dispatch}= undef;
  };


{
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ test test /]), q{$d->parts([qw/ test test /])};
	my $end;
	ok $e->dispatch_map(
	  _default=> sub {},
	  _end=> sub { $end.= 1 },
	  test=> {
	    _end=> sub { $end.= 2 },
	    test=> {
	      _end  => sub { $end.= 3 },
	      _default=> sub { $default= 1 },
	      },
	    },
	  ), q{$e->dispatch_map( .......... };
	ok $d->_start,  q{$d->_start};
	ok $d->_finish, q{$d->_finish};
	is $end, '321', q{$end, 321};
	$e->{Dispatch}= undef;
  };

{
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ test test /]), q{$d->parts([qw/ test test /])};
	ok $e->dispatch_map(
	  _default=> sub {},
	  test=> {
	    test=> {
	      _default=> sub { $default= 1 },
	      },
	    },
	  ), q{$e->dispatch_map( .......... };
	ok $d->_start,  q{$d->_start};
	ok $d->_action, q{$d->_action};
	is join('/', @{$e->action}), 'test/test/index', q{join('/', @{$e->action}), 'test/test/index'};
	$e->{Dispatch}= undef;
  };

{
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ test test /]), q{$d->parts([qw/ test test /])};
	ok $e->dispatch_map(
	  _default=> sub {},
	  test=> {
        _default=> sub { $default= 1 },
	    },
	  ), q{$e->dispatch_map( .......... };
	ok $d->_start,  q{$d->_start};
	ok $d->_action, q{$d->_action};
	is join('/', @{$e->action}), 'test/index', q{join('/', @{$e->action}), 'test/index'};
	$e->{Dispatch}= undef;
  };

{
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ test test /]), q{$d->parts([qw/ test test /])};
	ok $e->dispatch_map(
        _default=> sub { $default= 1 },
	  ), q{$e->dispatch_map( .......... };
	ok $d->_start,  q{$d->_start};
	ok $d->_action, q{$d->_action};
	is join('/', @{$e->action}), 'index', q{join('/', @{$e->action}), 'index'};
	$e->{Dispatch}= undef;
  };

{
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ test test /]), q{$d->parts([qw/ test test /])};
	ok $e->dispatch_map( $rhash->(
      [qw/ _default /]=> sub { $default= 1 },
	  ) ), q{$e->dispatch_map( .......... };
	ok $d->_start,  q{$d->_start};
	ok $d->_action, q{$d->_action};
	is join('/', @{$e->action}), 'index', q{join('/', @{$e->action}), 'index'};
	$e->{Dispatch}= undef;
  };

{
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ test test /]), q{$d->parts([qw/ test test /])};
	ok $e->dispatch_map( $rhash->(
	  _default=> sub {},
      test=> $rhash->(
        [qw/ _default /]=> sub { $default= 1 },
        ),
	  ) ), q{$e->dispatch_map( .......... };
	ok $d->_start,  q{$d->_start};
	ok $d->_action, q{$d->_action};
	is join('/', @{$e->action}), 'test/index', q{join('/', @{$e->action}), 'test/index'};
	$e->{Dispatch}= undef;
  };

{
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ test test /]), q{$d->parts([qw/ test test /])};
	ok $e->dispatch_map( $rhash->(
	  _default=> sub {},
      test=> $rhash->(
        test=> $rhash->(
          [qw/ _default /]=> sub { $default= 1 },
          ),
        ),
	  ) ), q{$e->dispatch_map( .......... };
	ok $d->_start,  q{$d->_start};
	ok $d->_action, q{$d->_action};
	is join('/', @{$e->action}), 'test/test/index', q{join('/', @{$e->action}), 'test/test/index'};
	$e->{Dispatch}= undef;
  };

{
	$ENV{REQUEST_METHOD}= 'GET';
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ test test /]), q{$d->parts([qw/ test test /])};
	ok $e->dispatch_map( $rhash->(
	  _default=> sub {},
      test=> $rhash->(
        [qw/ _default 1 /]=> sub { $default= 1 },
        test=> $rhash->(
          [qw/ _default 1 /]=> sub { $default= 1 },
          ),
        ),
	  ) ), q{$e->dispatch_map( .......... };
	ok $d->_start,  q{$d->_start};
	ok $d->_action, q{$d->_action};
	is join('/', @{$e->action}), 'test/test/index', q{join('/', @{$e->action}), 'test/test/index'};
	$e->{Dispatch}= undef;
	$ENV{REQUEST_METHOD}= "";
  };

{
	$ENV{REQUEST_METHOD}= 'GET';
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ test test /]), q{$d->parts([qw/ test test /])};
	ok $e->dispatch_map( $rhash->(
	  _default=> sub {},
      test=> $rhash->(
        [qw/ _default 1 /]=> sub { $default= 1 },
        test=> $rhash->(
          [qw/ _default 2 /]=> sub { $default= 1 },
          ),
        ),
	  ) ), q{$e->dispatch_map( .......... };
	ok ! $d->_start,  q{! $d->_start};
	ok $e->finished, q{$e->finished};
	is $e->response->status, 405, q{$e->response->status, 405};
	$e->{Dispatch}= undef;
	$ENV{REQUEST_METHOD}= "";
	$e->finished(0);
  };

{
	$ENV{REQUEST_METHOD}= 'POST';
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ test test /]), q{$d->parts([qw/ test test /])};
	ok $e->dispatch_map( $rhash->(
	  _default=> sub {},
      test=> $rhash->(
        [qw/ _default 1 /]=> sub { $default= 1 },
        test=> $rhash->(
          [qw/ _default 1 /]=> sub { $default= 1 },
          ),
        ),
	  ) ), q{$e->dispatch_map( .......... };
	ok ! $d->_start, q{! $d->_start};
	ok $e->finished, q{$e->finished};
	is $e->response->status, 405, q{$e->response->status, 405};
	$e->{Dispatch}= undef;
	$ENV{REQUEST_METHOD}= "";
	$e->finished(0);
  };

{
	$ENV{REQUEST_METHOD}= 'POST';
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ test test /]), q{$d->parts([qw/ test test /])};
	ok $e->dispatch_map( $rhash->(
	  _default=> sub {},
      test=> $rhash->(
        [qw/ _default 2 /]=> sub { $default= 1 },
        test=> $rhash->(
          [qw/ _default 2 /]=> sub { $default= 1 },
          ),
        ),
	  ) ), q{$e->dispatch_map( .......... };
	ok $d->_start,  q{$d->_start};
	ok $d->_action, q{$d->_action};
	is join('/', @{$e->action}), 'test/test/index', q{join('/', @{$e->action}), 'test/test/index'};
	$e->{Dispatch}= undef;
	$ENV{REQUEST_METHOD}= "";
	$e->finished(0);
  };

{
	$ENV{REQUEST_METHOD}= 'POST';
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ test test /]), q{$d->parts([qw/ test test /])};
	ok $e->dispatch_map( $rhash->(
	  _default=> sub {},
      test=> $rhash->(
        [qw/ _default 1 /]=> sub { $default= 1 },
        test=> $rhash->(
          [qw/ _default 2 /]=> sub { $default= 1 },
          ),
        ),
	  ) ), q{$e->dispatch_map( .......... };
	ok ! $d->_start, q{! $d->_start};
	ok $e->finished, q{$e->finished};
	is $e->response->status, 405, q{$e->response->status, 405};
	$e->{Dispatch}= undef;
	$ENV{REQUEST_METHOD}= "";
	$e->finished(0);
  };

{
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ test test /]), q{$d->parts([qw/ test test /])};
	ok $e->dispatch_map( $rhash->(
	  _default=> sub {},
      test=> $rhash->(
        [qw/ _default 0 /, 'TEST 1']=> sub { $default= 1 },
        test=> $rhash->(
          [qw/ _default 0 /, 'TEST 2']=> sub { $default= 1 },
          ),
        ),
	  ) ), q{$e->dispatch_map( .......... };
	ok $d->_start,  q{$d->_start};
	is join('/', @{$e->action}), 'test/test/index', q{join('/', @{$e->action}), 'test/test/index'};
	is $d->page_title, 'TEST 2', q{$d->page_title, 'TEST 2'};
	$e->{Dispatch}= undef;
  };

{
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ test /]), q{$d->parts([qw/ test test /])};
	ok $e->dispatch_map( $rhash->(
	  _default=> sub {},
      test=> $rhash->(
        [qw/ _default 0 /, 'TEST 1']=> sub { $default= 1 },
        test=> $rhash->(
          [qw/ _default 0 /, 'TEST 2']=> sub { $default= 1 },
          ),
        ),
	  ) ), q{$e->dispatch_map( .......... };
	ok $d->_start,  q{$d->_start};
	is join('/', @{$e->action}), 'test/index', q{join('/', @{$e->action}), 'test/index'};
	is $d->page_title, 'TEST 1', q{$d->page_title, 'TEST 1'};
	$e->{Dispatch}= undef;
  };

{
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ Test1234 Test5678 /]), q{$d->_actions([qw/ test test /])};
	my $match;
	ok $e->dispatch_map(
	  _default=> sub {},
      qr{^[A-Z][a-z]+([0-9]+)}=> {
        qr{^[A-Z]([a-z]+)([0-9]+)}=> sub {
          (my $egg, my $dipatch, $match)= @_;
          },
        },
	  ), q{$e->dispatch_map( .......... };
	ok $d->_start,  q{$d->_start};
	ok $d->_action, q{$d->_action};
	is join('/', @{$e->action}), 'Test1234/Test5678', q{join('/', @{$e->action}), 'Test1234/Test5678'};
	isa_ok $match, 'ARRAY';
	is @$match, 2, q{@$match, 2};
	is $match->[0], 'est',  q{$match->[0], 'est'};
	is $match->[1], '5678', q{$match->[1], '5678'};
	ok my $obj= tied($d->parts->[0]), q{my $obj= tied($d->parts->[0])};
	isa_ok $obj->[2], 'ARRAY';
	is @{$obj->[2]}, 1, q{@{$obj->[2]}, 1};
	is $obj->[2][0], '1234', q{$obj->[2][0], '1234'};
	is $d->page_title, 'Test5678', q{$d->page_title, 'TEST 1'};
	$e->{Dispatch}= undef;
  };

{
	ok my $d= $e->dispatch, q{my $d= $e->dispatch};
	ok $d->parts([qw/ Test1234 Test5678 /]), q{$d->_actions([qw/ test test /])};
	my $match;
	ok $e->dispatch_map( $rhash->(
	  _default=> sub {},
      [ qr{^[A-Z][a-z]+([0-9]+)} ]=> $rhash->(
        [ qr{^[A-Z]([a-z]+)([0-9]+)} ]=> sub {
          (my $egg, my $dipatch, $match)= @_;
          },
        ),
	  ) ), q{$e->dispatch_map( .......... };
	ok $d->_start,  q{$d->_start};
	ok $d->_action, q{$d->_action};
	is join('/', @{$e->action}), 'Test1234/Test5678', q{join('/', @{$e->action}), 'Test1234/Test5678'};
	isa_ok $match, 'ARRAY';
	is @$match, 2, q{@$match, 2};
	is $match->[0], 'est',  q{$match->[0], 'est'};
	is $match->[1], '5678', q{$match->[1], '5678'};
	ok my $obj= tied($d->parts->[0]), q{my $obj= tied($d->parts->[0])};
	isa_ok $obj->[2], 'ARRAY';
	is @{$obj->[2]}, 1, q{@{$obj->[2]}, 1};
	is $obj->[2][0], '1234', q{$obj->[2][0], '1234'};
	is $d->page_title, 'Test5678', q{$d->page_title, 'TEST 1'};
	$e->{Dispatch}= undef;
  };