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       my $q_got = new CGI($uri_query);
  83
  84       if ($uri_query) {
  85         # check query params
  86         # list   => [ qw/ fee fi fo / ], string => 'baz', number => 4
  87         is($q_got->param('string'),'baz','string param correct');
  88         is($q_got->param('number'),4,'number param correct');
  89         is_deeply([$q_got->param('list')],[ qw/ fee fi fo / ],'list param correct');
  90       }
  91       ok(URI::eq($expected,$uri_basepath),'host and path match');
  92
  93     }
  94   }
  95 } ;
  96
  97
  98 # make_path
  99 {
 100   # expect       # send
 101   my @uris = (
 102               { expect   => '/table/action',
 103                 send     => [ qw( table action ) ],
 104               },
 105               { expect   => '/table/action/id',
 106                 send     => [ qw( table action id ) ],
 107               },
 108               { expect   => '/table/action',
 109                 send     => [ qw( table action ), $query ],
 110               },
 111              );
 112
 113   foreach my $base (@bases) {
 114     $driver_class->config->uri_base($base);
 115
 116     (my $base_no_slash = $base) =~ s|/$||;
 117     my $base_or_slash = $base_no_slash || '/';
 118
 119     my $i = 1;
 120     foreach my $test (@uris) {
 121       #diag "BASE: $base - URI #$i"; $i++;
 122
 123       my @args = @{ $test->{send} };
 124
 125       my %args = ( table  => $args[0],
 126                    action => $args[1],
 127                    additional => $args[2],
 128                  );
 129
 130       my %arg_sets = ( array => \@args,
 131                        hash  => \%args,
 132                        hashref => \%args,
 133                      );
 134
 135       my $expect = $test->{expect};
 136
 137       foreach my $set (keys %arg_sets) {
 138
 139         my $path;
 140         $path = $r->make_path(@{ $arg_sets{$set} }) if $set eq 'array';
 141         $path = $r->make_path(%{ $arg_sets{$set} }) if $set eq 'hash';
 142         $path = $r->make_path($arg_sets{$set})   if $set eq 'hashref';
 143
 144         my ($uri_path,$uri_query) = split(/\?/,$path);
 145         my $q_got = new CGI($uri_query);
 146
 147         my $expected = $expect =~ m|^/| ? "$base_no_slash$expect" : "$base_or_slash$expect";
 148         if ($uri_query) {
 149           # check query params
 150           # list   => [ qw/ fee fi fo / ], string => 'baz', number => 4
 151           is($q_got->param('string'),'baz','string param correct');
 152           is($q_got->param('number'),4,'number param correct');
 153           is_deeply([$q_got->param('list')],[ qw/ fee fi fo / ],'list param correct');
 154         }
 155         ok(URI::eq($expected,$uri_path),'host and path match');
 156
 157       }
 158     }
 159   }
 160 };