- my @bases = ( '/', '/foo', '/foo/', '', 'http://www.example.com',
- 'http://www.example.com/', 'http://www.example.com/foo',
- 'http://www.example.com/foo/', );
-
- my $query = { string => 'baz',
- number => 4,
- list => [ qw/ fee fi fo / ],
- };
-
- my $query_string = '?number=4&string=baz&list=fee&list=fi&list=fo';
-
- # expect # send
- my @uris = (
- { expect => '/table/action',
- send => [ qw( table action ) ],
- },
- { expect => '/table/action/id',
- send => [ qw( table action id ) ],
- },
-
-
- { expect => '/table/action',
- send => [ qw( table action ), $query ],
- },
- );
-
- foreach my $base (@bases)
- {
- $driver_class->config->uri_base($base);
-
- (my $base_no_slash = $base) =~ s|/$||;
- my $base_or_slash = $base_no_slash || '/';
-
- my $i = 1;
-
- foreach my $test (@uris)
- {
- #diag "BASE: $base - URI #$i"; $i++;
-
- my @args = @{ $test->{send} };
-
- my %args = ( table => $args[0],
- action => $args[1],
- additional => $args[2],
- );
-
- my %arg_sets = ( array => \@args,
- hash => \%args,
- hashref => \%args,
- );
-
- my $expect = $test->{expect};
- my @s = @{ $test->{send} };
-
- foreach my $set (keys %arg_sets)
- {
-
- my $path;
- $path = $r->make_path(@{ $arg_sets{$set} }) if $set eq 'array';
- $path = $r->make_path(%{ $arg_sets{$set} }) if $set eq 'hash';
- $path = $r->make_path($arg_sets{$set}) if $set eq 'hashref';
-
- like($path, qr/^\Q$base_or_slash\E/,
- "'$path' starts with '$base_or_slash'");
-
- my $q = ref $s[-1] ? $query_string : '';
-
- my $msg =
- sprintf "'%s' is '%s%s%s': base - '%s' segments - '%s'",
- $path, $base_no_slash, $expect, $q, $base,
- @s ? join(', ', @s) : '()';
-
- my $reconstructed = $expect =~ m|^/|
- ? "$base_no_slash$expect$q" :
- "$base_or_slash$expect$q";
-
- cmp_ok($path, 'eq', "$reconstructed" || '/', $msg);
- }
- }
- }
-}
+ # expect # send
+ my @uris = (
+ { expect => '/table/action',
+ send => [ qw( table action ) ],
+ },
+ { expect => '/table/action/id',
+ send => [ qw( table action id ) ],
+ },
+ { expect => '/table/action',
+ send => [ qw( table action ), $query ],
+ },
+ );
+
+ foreach my $base (@bases) {
+ $driver_class->config->uri_base($base);
+
+ (my $base_no_slash = $base) =~ s|/$||;
+ my $base_or_slash = $base_no_slash || '/';
+
+ my $i = 1;
+ foreach my $test (@uris) {
+ #diag "BASE: $base - URI #$i"; $i++;
+
+ my @args = @{ $test->{send} };
+
+ my %args = ( table => $args[0],
+ action => $args[1],
+ additional => $args[2],
+ );