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';
43 send => [ qw( table ) ],
45 { expect => '/table/action',
46 send => [ qw( table action ) ],
48 { expect => '/table/action/id',
49 send => [ qw( table action id ) ],
54 send => [ '', $query ],
60 send => [ qw( table ), $query ],
62 { expect => '/table/action',
63 send => [ qw( table action ), $query ],
65 { expect => '/table/action/id',
66 send => [ qw( table action id ), $query ],
71 foreach my $base (@bases)
73 $driver_class->config->uri_base($base);
75 (my $base_no_slash = $base) =~ s|/$||;
76 my $base_or_slash = $base_no_slash || '/';
80 foreach my $test (@uris)
82 #diag "BASE: $base - URI #$i"; $i++;
84 my @s = @{ $test->{send} };
85 my $expect = $test->{expect};
87 my $uri = $r->make_uri(@s);
89 like("$uri", qr/^\Q$base_or_slash\E/,
90 "'$uri' starts with '$base_or_slash'");
92 my $q = ref $s[-1] ? $query_string : '';
95 sprintf "'%s' is '%s%s%s': base - '%s' segments - '%s'",
96 $uri, $base_no_slash, $expect, $q, $base,
97 @s ? join(', ', @s) : '()';
99 my $reconstructed = $expect =~ m|^/| ? "$base_no_slash$expect$q" :
100 "$base_or_slash$expect$q";
102 cmp_ok("$uri", 'eq', "$reconstructed" || '/', $msg);
109 my @bases = ( '/', '/foo', '/foo/', '', 'http://www.example.com',
110 'http://www.example.com/', 'http://www.example.com/foo',
111 'http://www.example.com/foo/', );
113 my $query = { string => 'baz',
115 list => [ qw/ fee fi fo / ],
118 my $query_string = '?number=4&string=baz&list=fee&list=fi&list=fo';
122 { expect => '/table/action',
123 send => [ qw( table action ) ],
125 { expect => '/table/action/id',
126 send => [ qw( table action id ) ],
130 { expect => '/table/action',
131 send => [ qw( table action ), $query ],
135 foreach my $base (@bases)
137 $driver_class->config->uri_base($base);
139 (my $base_no_slash = $base) =~ s|/$||;
140 my $base_or_slash = $base_no_slash || '/';
144 foreach my $test (@uris)
146 #diag "BASE: $base - URI #$i"; $i++;
148 my @args = @{ $test->{send} };
150 my %args = ( table => $args[0],
152 additional => $args[2],
155 my %arg_sets = ( array => \@args,
160 my $expect = $test->{expect};
161 my @s = @{ $test->{send} };
163 foreach my $set (keys %arg_sets)
167 $path = $r->make_path(@{ $arg_sets{$set} }) if $set eq 'array';
168 $path = $r->make_path(%{ $arg_sets{$set} }) if $set eq 'hash';
169 $path = $r->make_path($arg_sets{$set}) if $set eq 'hashref';
171 like($path, qr/^\Q$base_or_slash\E/,
172 "'$path' starts with '$base_or_slash'");
174 my $q = ref $s[-1] ? $query_string : '';
177 sprintf "'%s' is '%s%s%s': base - '%s' segments - '%s'",
178 $path, $base_no_slash, $expect, $q, $base,
179 @s ? join(', ', @s) : '()';
181 my $reconstructed = $expect =~ m|^/|
182 ? "$base_no_slash$expect$q" :
183 "$base_or_slash$expect$q";
185 cmp_ok($path, 'eq', "$reconstructed" || '/', $msg);