Added make_path() and make_uri() methods,

[maypole.git] / t / pathtools.t

diff --git a/t/pathtools.t b/t/pathtools.t
new file mode 100644 (file)
index 0000000..c8e78d0
--- /dev/null
+++ b/t/pathtools.t
@@ -0,0 +1,191 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More tests => 304;
+use Test::MockModule;
+
+# module compilation
+use Maypole;
+
+# simple test class that inherits from Maypole
+{
+    package MyDriver;
+    @MyDriver::ISA = 'Maypole';
+    @MyDriver::VERSION = 1;
+}
+
+# back to package main;
+my $driver_class = 'MyDriver';
+
+my $r = $driver_class->new;
+
+# make_uri
+{
+    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   =>'',
+                   send     => [ '' ],
+                   },
+                 { expect   => '',
+                   send     => [ () ],
+                   },
+                 { expect   => '/table',
+                   send     => [ qw( table ) ],
+                   },
+                 { expect   => '/table/action',
+                   send     => [ qw( table action ) ],
+                   },
+                 { expect   => '/table/action/id',
+                   send     => [ qw( table action id ) ],
+                   },
+                 
+                 
+                 { expect   =>'',
+                   send     => [ '', $query ],
+                   },
+                 { expect   => '',
+                   send     => [ $query ],
+                   },
+                 { expect   => '/table',
+                   send     => [ qw( table ), $query ],
+                   },
+                 { expect   => '/table/action',
+                   send     => [ qw( table action ), $query ],
+                   },
+                 { expect   => '/table/action/id',
+                   send     => [ qw( table action id ), $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 @s      = @{ $test->{send} };
+            my $expect = $test->{expect};
+        
+            my $uri = $r->make_uri(@s);
+            
+            like("$uri", qr/^\Q$base_or_slash\E/, 
+                "'$uri' starts with '$base_or_slash'");
+            
+            my $q = ref $s[-1] ? $query_string : '';
+                        
+            my $msg = 
+                sprintf "'%s' is '%s%s%s': base - '%s' segments - '%s'", 
+                        $uri, $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("$uri", 'eq', "$reconstructed" || '/', $msg);
+        }
+    }
+}
+
+# make_path
+{
+    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);
+            }
+        }
+    }
+}
+