first pass at unit tests

[maypole.git] / t / cgi_maypole.t

diff --git a/t/cgi_maypole.t b/t/cgi_maypole.t
new file mode 100644 (file)
index 0000000..f4d4e82
--- /dev/null
+++ b/t/cgi_maypole.t
@@ -0,0 +1,93 @@
+#!/usr/bin/perl -w
+use strict;
+use Test::More tests => 26;
+use Test::MockModule;
+
+require_ok('CGI::Maypole');
+ok($CGI::Maypole::VERSION, 'defines $VERSION');
+ok($INC{'CGI/Simple.pm'}, 'requires CGI::Simple');
+ok(CGI::Maypole->isa('Maypole'), '@ISA = Maypole');
+
+my %calls;
+my $mock_maypole = new Test::MockModule('CGI::Maypole');
+my $mock_cgi = new Test::MockModule('CGI::Simple');
+$mock_cgi->mock(path_info => sub {
+    delete $_[0]->{'.path_info'};
+    goto $mock_cgi->original('path_info')
+});
+
+# run()
+can_ok('CGI::Maypole' => 'run');
+$mock_maypole->mock(handler => sub {$calls{handler} = \@_; 'X'});
+my $status = CGI::Maypole->run('TEST');
+ok($calls{handler}, '... calls handler()');
+is_deeply($calls{handler}, ['CGI::Maypole'],
+          '... as a method, passing 0 arguments');
+is($status, 'X', '... and returns its status');
+
+my $r = bless {}, 'CGI::Maypole';
+$ENV{HTTP_HOST}      = 'localhost';
+$ENV{SCRIPT_NAME}    = '/maypole/index.cgi';
+$ENV{PATH_INFO}      = '/';
+$ENV{REQUEST_METHOD} = 'GET';
+$ENV{QUERY_STRING}   = 'beer=1;beer=2;pub=red+lion;handpump';
+$ENV{DOCUMENT_ROOT}  = '/var/tmp/maypole';
+
+# get_request()
+can_ok($r => 'get_request');
+my $cgi = $r->get_request;
+isa_ok($cgi, 'CGI::Simple', '... returns a CGI::Simple object');
+is($cgi, $r->{cgi}, '... and stores it in the "cgi" slot');
+
+# parse_location()
+can_ok($r => 'parse_location');
+$r->parse_location;
+is($r->path, 'frontpage', '... sets "path" to frontpage if undefined');
+
+#delete $r->{cgi}{'.path_info'};
+$ENV{PATH_INFO} = '/brewery/view/1/2/3';
+$r->parse_location;
+is($r->path, 'brewery/view/1/2/3', '... path is PATH_INFO without leading /');
+is($r->table, 'brewery', '... sets "table" to first part of PATH_INFO');
+is($r->action, 'view', '... sets "action" to second part of PATH_INFO');
+is_deeply($r->args, [1,2,3],
+          '... sets "args" to a list of remaining path segments');
+
+$mock_maypole->mock(
+    parse_path => sub {$calls{parse_path} = \@_},
+    parse_args => sub {$calls{parse_args} = \@_},
+);
+$r->parse_location;
+is_deeply($calls{parse_path}, [$r], '... calls parse_path');
+is_deeply($calls{parse_args}, [$r], '... calls parse_args');
+
+
+# parse_args()
+$mock_maypole->unmock('parse_args');
+can_ok($r => 'parse_args');
+$cgi->parse_query_string;
+$r->parse_args;
+is_deeply($r->params, { beer => [1,2], pub => 'red lion', handpump => undef },
+          '... parsed params');
+is_deeply($r->params, $r->query, '... query and params are identical');
+
+# send_output()
+can_ok($r => 'send_output');
+SKIP: {
+    eval "require IO::CaptureOutput";
+    skip "IO::CaptureOutput not installed", 3 if $@;
+    $r->content_type('text/plain');
+    $r->document_encoding('iso8859-1');
+    $r->output('Hello World!');
+    my $stdout;
+    IO::CaptureOutput::capture(sub {$r->send_output}, \$stdout);
+
+    my $compare = join "\cM\cJ", 'Content-length: 12',
+        'Content-Type: text/plain; charset=iso8859-1', '', 'Hello World!';
+    is($stdout, $compare, '... prints output, including content-type header');
+}
+
+# get_template_root()
+can_ok($r => 'get_template_root');
+is($r->get_template_root(), '/var/tmp/maypole/index.cgi',
+   '... catdir(document_root, [relative_url])');