4 use Test::More tests => 172;
12 # simple test class that inherits from Maypole
15 @MyDriver::ISA = 'Maypole';
16 @MyDriver::VERSION = 1;
19 # back to package main;
20 my $driver_class = 'MyDriver';
21 my $r = $driver_class->new;
23 my $query = { list => [ qw/ fee fi fo / ], string => 'baz', number => 4 };
25 my $query_string = '?number=4&string=baz&list=fee&list=fi&list=fo';
27 my @bases = ( 'http://www.example.com',
28 'http://www.example.com/', 'http://www.example.com/foo',
29 'http://www.example.com/foo/', );
41 send => [ qw( table ) ],
43 { expect => '/table/action',
44 send => [ qw( table action ) ],
46 { expect => '/table/action/id',
47 send => [ qw( table action id ) ],
50 send => [ '', $query ],
56 send => [ qw( table ), $query ],
58 { expect => '/table/action',
59 send => [ qw( table action ), $query ],
61 { expect => '/table/action/id',
62 send => [ qw( table action id ), $query ],
66 foreach my $base (@bases) {
67 $driver_class->config->uri_base($base);
68 (my $base_no_slash = $base) =~ s|/$||;
69 my $base_or_slash = $base_no_slash || '/';
72 foreach my $test (@uris) {
73 #diag "BASE: $base - URI #$i"; $i++;
74 my @s = @{ $test->{send} };
75 my $expect = $test->{expect};
76 my $uri = $r->make_uri(@s);
78 my $expected = $base_or_slash.$test->{expect};
80 my ($uri_basepath,$uri_query) = split(/\?/,$uri);
82 my $q_got = new CGI($uri_query);
86 # list => [ qw/ fee fi fo / ], string => 'baz', number => 4
87 is($q_got->param('string'),'baz','string param correct');
88 is($q_got->param('number'),4,'number param correct');
89 is_deeply([$q_got->param('list')],[ qw/ fee fi fo / ],'list param correct');
91 ok(URI::eq($expected,$uri_basepath),'host and path match');
102 { expect => '/table/action',
103 send => [ qw( table action ) ],
105 { expect => '/table/action/id',
106 send => [ qw( table action id ) ],
108 { expect => '/table/action',
109 send => [ qw( table action ), $query ],
113 foreach my $base (@bases) {
114 $driver_class->config->uri_base($base);
116 (my $base_no_slash = $base) =~ s|/$||;
117 my $base_or_slash = $base_no_slash || '/';
120 foreach my $test (@uris) {
121 #diag "BASE: $base - URI #$i"; $i++;
123 my @args = @{ $test->{send} };
125 my %args = ( table => $args[0],
127 additional => $args[2],
130 my %arg_sets = ( array => \@args,
135 my $expect = $test->{expect};
137 foreach my $set (keys %arg_sets) {
140 $path = $r->make_path(@{ $arg_sets{$set} }) if $set eq 'array';
141 $path = $r->make_path(%{ $arg_sets{$set} }) if $set eq 'hash';
142 $path = $r->make_path($arg_sets{$set}) if $set eq 'hashref';
144 my ($uri_path,$uri_query) = split(/\?/,$path);
145 my $q_got = new CGI($uri_query);
147 my $expected = $expect =~ m|^/| ? "$base_no_slash$expect" : "$base_or_slash$expect";
150 # list => [ qw/ fee fi fo / ], string => 'baz', number => 4
151 is($q_got->param('string'),'baz','string param correct');
152 is($q_got->param('number'),4,'number param correct');
153 is_deeply([$q_got->param('list')],[ qw/ fee fi fo / ],'list param correct');
155 ok(URI::eq($expected,$uri_path),'host and path match');