4 use Test::More tests => 304;
10 # simple test class that inherits from Maypole
13 @MyDriver::ISA = 'Maypole';
14 @MyDriver::VERSION = 1;
17 # back to package main;
18 my $driver_class = 'MyDriver';
20 my $r = $driver_class->new;
24 my @bases = ( '/', '/foo', '/foo/', '', 'http://www.example.com',
25 'http://www.example.com/', 'http://www.example.com/foo',
26 'http://www.example.com/foo/', );
28 my $query = { string => 'baz',
30 list => [ qw/ fee fi fo / ],
33 my $query_string = '?number=4&string=baz&list=fee&list=fi&list=fo';
44 send => [ qw( table ) ],
46 { expect => '/table/action',
47 send => [ qw( table action ) ],
49 { expect => '/table/action/id',
50 send => [ qw( table action id ) ],
55 send => [ '', $query ],
61 send => [ qw( table ), $query ],
63 { expect => '/table/action',
64 send => [ qw( table action ), $query ],
66 { expect => '/table/action/id',
67 send => [ qw( table action id ), $query ],
72 foreach my $base (@bases)
74 $driver_class->config->uri_base($base);
76 (my $base_no_slash = $base) =~ s|/$||;
77 my $base_or_slash = $base_no_slash || '/';
81 foreach my $test (@uris)
83 #diag "BASE: $base - URI #$i"; $i++;
85 my @s = @{ $test->{send} };
86 my $expect = $test->{expect};
88 my $uri = $r->make_uri(@s);
90 like("$uri", qr/^\Q$base_or_slash\E/,
91 "'$uri' starts with '$base_or_slash'");
93 my $q = ref $s[-1] ? $query_string : '';
96 sprintf "'%s' is '%s%s%s': base - '%s' segments - '%s'",
97 $uri, $base_no_slash, $expect, $q, $base,
98 @s ? join(', ', @s) : '()';
100 my $reconstructed = $expect =~ m|^/| ? "$base_no_slash$expect$q" :
101 "$base_or_slash$expect$q";
103 cmp_ok("$uri", 'eq', "$reconstructed" || '/', $msg);
110 my @bases = ( '/', '/foo', '/foo/', '', 'http://www.example.com',
111 'http://www.example.com/', 'http://www.example.com/foo',
112 'http://www.example.com/foo/', );
114 my $query = { string => 'baz',
116 list => [ qw/ fee fi fo / ],
119 my $query_string = '?number=4&string=baz&list=fee&list=fi&list=fo';
123 { expect => '/table/action',
124 send => [ qw( table action ) ],
126 { expect => '/table/action/id',
127 send => [ qw( table action id ) ],
131 { expect => '/table/action',
132 send => [ qw( table action ), $query ],
136 foreach my $base (@bases)
138 $driver_class->config->uri_base($base);
140 (my $base_no_slash = $base) =~ s|/$||;
141 my $base_or_slash = $base_no_slash || '/';
145 foreach my $test (@uris)
147 #diag "BASE: $base - URI #$i"; $i++;
149 my @args = @{ $test->{send} };
151 my %args = ( table => $args[0],
153 additional => $args[2],
156 my %arg_sets = ( array => \@args,
161 my $expect = $test->{expect};
162 my @s = @{ $test->{send} };
164 foreach my $set (keys %arg_sets)
168 $path = $r->make_path(@{ $arg_sets{$set} }) if $set eq 'array';
169 $path = $r->make_path(%{ $arg_sets{$set} }) if $set eq 'hash';
170 $path = $r->make_path($arg_sets{$set}) if $set eq 'hashref';
172 like($path, qr/^\Q$base_or_slash\E/,
173 "'$path' starts with '$base_or_slash'");
175 my $q = ref $s[-1] ? $query_string : '';
178 sprintf "'%s' is '%s%s%s': base - '%s' segments - '%s'",
179 $path, $base_no_slash, $expect, $q, $base,
180 @s ? join(', ', @s) : '()';
182 my $reconstructed = $expect =~ m|^/|
183 ? "$base_no_slash$expect$q" :
184 "$base_or_slash$expect$q";
186 cmp_ok($path, 'eq', "$reconstructed" || '/', $msg);