t/pathtools.t

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use Test::More tests => 172;
   5 use Test::MockModule;
   6
   7 use CGI;
   8 use URI;
   9
  10 use Maypole;
  11
  12 # simple test class that inherits from Maypole
  13 {
  14   package MyDriver;
  15   @MyDriver::ISA = 'Maypole';
  16   @MyDriver::VERSION = 1;
  17 }
  18
  19 # back to package main;
  20 my $driver_class = 'MyDriver';
  21 my $r = $driver_class->new;
  22
  23 my $query = { list   => [ qw/ fee fi fo / ], string => 'baz', number => 4 };
  24
  25 my $query_string = '?number=4&string=baz&list=fee&list=fi&list=fo';
  26
  27 my @bases = ( 'http://www.example.com',
  28               'http://www.example.com/', 'http://www.example.com/foo',
  29               'http://www.example.com/foo/', );
  30
  31 # make_uri
  32 {
  33   my @uris = (
  34               { expect   =>'',
  35                 send     => [ '' ],
  36               },
  37               { expect   => '',
  38                 send     => [ () ],
  39               },
  40               { expect   => '/table',
  41                 send     => [ qw( table ) ],
  42               },
  43               { expect   => '/table/action',
  44                 send     => [ qw( table action ) ],
  45               },
  46               { expect   => '/table/action/id',
  47                 send     => [ qw( table action id ) ],
  48               },
  49               { expect   =>'',
  50                 send     => [ '', $query ],
  51               },
  52               { expect   => '',
  53                 send     => [ $query ],
  54               },
  55               { expect   => '/table',
  56                 send     => [ qw( table ), $query ],
  57               },
  58               { expect   => '/table/action',
  59                 send     => [ qw( table action ), $query ],
  60               },
  61               { expect   => '/table/action/id',
  62                 send     => [ qw( table action id ), $query ],
  63               },
  64              );
  65
  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 || '/';
  70     my $i = 1;
  71
  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);
  77
  78       my $expected = $base_or_slash.$test->{expect};
  79
  80       my ($uri_basepath,$uri_query) = split(/\?/,$uri);
  81
  82       warn "\nuri : '$uri'\nexpected : '$expected'\n";
  83       warn "uri_basepath : $uri_basepath, uri_query : $uri_query\n";
  84
  85       my $q_got = new CGI($uri_query);
  86
  87       if ($uri_query) {
  88         # check query params
  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');
  93       }
  94       ok(URI::eq($expected,$uri_basepath),'host and path match');
  95
  96     }
  97   }
  98 } ;
  99
 100
 101 # make_path
 102 {
 103   # expect       # send
 104   my @uris = (
 105               { expect   => '/table/action',
 106                 send     => [ qw( table action ) ],
 107               },
 108               { expect   => '/table/action/id',
 109                 send     => [ qw( table action id ) ],
 110               },
 111               { expect   => '/table/action',
 112                 send     => [ qw( table action ), $query ],
 113               },
 114              );
 115
 116   foreach my $base (@bases) {
 117     $driver_class->config->uri_base($base);
 118
 119     (my $base_no_slash = $base) =~ s|/$||;
 120     my $base_or_slash = $base_no_slash || '/';
 121
 122     my $i = 1;
 123     foreach my $test (@uris) {
 124       #diag "BASE: $base - URI #$i"; $i++;
 125
 126       my @args = @{ $test->{send} };
 127
 128       my %args = ( table  => $args[0],
 129                    action => $args[1],
 130                    additional => $args[2],
 131                  );
 132
 133       my %arg_sets = ( array => \@args,
 134                        hash  => \%args,
 135                        hashref => \%args,
 136                      );
 137
 138       my $expect = $test->{expect};
 139
 140       foreach my $set (keys %arg_sets) {
 141
 142         my $path;
 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';
 146
 147         my ($uri_path,$uri_query) = split(/\?/,$path);
 148         my $q_got = new CGI($uri_query);
 149
 150         my $expected = $expect =~ m|^/| ? "$base_no_slash$expect" : "$base_or_slash$expect";
 151         if ($uri_query) {
 152           # check query params
 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');
 157         }
 158         ok(URI::eq($expected,$uri_path),'host and path match');
 159
 160       }
 161     }
 162   }
 163 };