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 warn "\nuri : '$uri'\nexpected : '$expected'\n";
83 warn "uri_basepath : $uri_basepath, uri_query : $uri_query\n";
85 my $q_got = new CGI($uri_query);
89 # list => [ qw/ fee fi fo / ], string => 'baz', number => 4
90 is($q_got->param('string'),'baz','string param correct');
91 is($q_got->param('number'),4,'number param correct');
92 is_deeply([$q_got->param('list')],[ qw/ fee fi fo / ],'list param correct');
94 ok(URI::eq($expected,$uri_basepath),'host and path match');
105 { expect => '/table/action',
106 send => [ qw( table action ) ],
108 { expect => '/table/action/id',
109 send => [ qw( table action id ) ],
111 { expect => '/table/action',
112 send => [ qw( table action ), $query ],
116 foreach my $base (@bases) {
117 $driver_class->config->uri_base($base);
119 (my $base_no_slash = $base) =~ s|/$||;
120 my $base_or_slash = $base_no_slash || '/';
123 foreach my $test (@uris) {
124 #diag "BASE: $base - URI #$i"; $i++;
126 my @args = @{ $test->{send} };
128 my %args = ( table => $args[0],
130 additional => $args[2],
133 my %arg_sets = ( array => \@args,
138 my $expect = $test->{expect};
140 foreach my $set (keys %arg_sets) {
143 $path = $r->make_path(@{ $arg_sets{$set} }) if $set eq 'array';
144 $path = $r->make_path(%{ $arg_sets{$set} }) if $set eq 'hash';
145 $path = $r->make_path($arg_sets{$set}) if $set eq 'hashref';
147 my ($uri_path,$uri_query) = split(/\?/,$path);
148 my $q_got = new CGI($uri_query);
150 my $expected = $expect =~ m|^/| ? "$base_no_slash$expect" : "$base_or_slash$expect";
153 # list => [ qw/ fee fi fo / ], string => 'baz', number => 4
154 is($q_got->param('string'),'baz','string param correct');
155 is($q_got->param('number'),4,'number param correct');
156 is_deeply([$q_got->param('list')],[ qw/ fee fi fo / ],'list param correct');
158 ok(URI::eq($expected,$uri_path),'host and path match');