4 use Test::More tests => 103;
9 my $OK = Maypole::Constants::OK();
10 my $DECLINED = Maypole::Constants::DECLINED();
11 my $ERROR = Maypole::Constants::ERROR();
13 ok($Maypole::VERSION, 'defines $VERSION');
14 ok($INC{'Maypole/Config.pm'}, 'loads Maypole::Config');
15 ok($INC{'UNIVERSAL/require.pm'}, 'loads UNIVERSAL::require');
16 ok($INC{'Maypole/Constants.pm'}, 'loads Maypole::Constants');
17 ok($INC{'Class/Accessor/Fast.pm'}, 'loads Class::Accessor::Fast');
18 ok($INC{'Class/Data/Inheritable.pm'}, 'loads Class::Data::Inheritable');
19 ok(Maypole->can('config'), 'defines a config attribute');
20 ok(Maypole->config->isa('Maypole::Config'), 'config is a Maypole::Config object');
21 ok(Maypole->can('init_done'), 'defines an init_done attribute');
22 ok(! Maypole->init_done, '... which is false by default');
23 ok(Maypole->can('view_object'), 'defines a view_object attribute');
24 is(Maypole->view_object, undef, '... which is undefined');
25 ok(Maypole->can('ar'), 'defines an "ar" accessor');
26 ok(Maypole->can('params'), 'defines a "params" accessor');
27 ok(Maypole->can('query'), 'defines a "query" accessor');
28 ok(Maypole->can('objects'), 'defines an "objects" accessor');
29 ok(Maypole->can('model_class'), 'defines a "model_class" accessor');
30 ok(Maypole->can('template_args'), 'defines a "template_args" accessor');
31 ok(Maypole->can('output'), 'defines an "output" accessor');
32 ok(Maypole->can('path'), 'defines a "path" accessor');
33 ok(Maypole->can('args'), 'defines an "args" accessor');
34 ok(Maypole->can('action'), 'defines an "action" accessor');
35 ok(Maypole->can('template'), 'defines a "template" accessor');
36 ok(Maypole->can('error'), 'defines an "error" accessor');
37 ok(Maypole->can('document_encoding'), 'defines a "document_encoding" accessor');
38 ok(Maypole->can('content_type'), 'defines a "content_type" accessor');
39 ok(Maypole->can('table'), 'defines a "table" accessor');
41 # simple test class that inherits from Maypole
43 @MyDriver::ISA = 'Maypole';
44 @MyDriver::VERSION = 1;
46 my $driver_class = 'MyDriver';
48 # Mock the model class
49 my (%required, @db_args, @adopted);
50 my $model_class = 'Maypole::Model::CDBI';
51 my $table_class = $driver_class . '::One';
52 my $mock_model = Test::MockModule->new($model_class);
54 require => sub {$required{+shift} = 1},
55 setup_database => sub {
57 $_[1]->{classes} = ["$model_class\::One", "$model_class\::Two"];
58 $_[1]->{tables} = [qw(one two)];
60 adopt => sub {push @adopted, \@_},
64 can_ok($driver_class => 'setup');
65 my $handler = $driver_class->can('handler');
66 is($handler, Maypole->can('handler'), 'calling package inherits handler()');
67 $driver_class->setup('dbi:foo'); # call setup()
68 isnt($handler, $driver_class->can('handler'), 'setup() installs new handler()');
69 ok($required{$model_class}, '... requires model class');
70 is($driver_class->config->model(),
71 'Maypole::Model::CDBI', '... default model is CDBI');
72 is(@db_args, 1, '... calls model->setup_database');
73 like(join (' ', @{$db_args[0]}),
74 qr/$model_class Maypole::Config=\S* $driver_class dbi:foo/,
75 '... setup_database passed setup() args');
76 is(@adopted, 2, '... calls model->adopt foreach class in the model');
77 ok($adopted[0][0]->isa($model_class),
78 '... sets up model subclasses to inherit from model');
79 $driver_class->config->model('NonExistant::Model');
80 eval {$driver_class->setup};
81 like($@, qr/Couldn't load the model class/,
82 '... dies if unable to load model class');
83 $@ = undef; $driver_class->config->model($model_class);
86 my $view_class = 'Maypole::View::TT';
87 my $mock_view = Test::MockModule->new($view_class);
89 new => sub {bless{}, shift},
90 require => sub {$required{+shift} = 1},
94 can_ok($driver_class => 'init');
95 $driver_class->init();
96 ok($required{$view_class}, '... requires the view class');
97 is($driver_class->config->view, $view_class, '... the default view class is TT');
98 is(join(' ', @{$driver_class->config->display_tables}), 'one two',
99 '... config->display_tables defaults to all tables');
100 ok($driver_class->view_object->isa($view_class),
101 '... creates an instance of the view object');
102 ok($driver_class->init_done, '... sets init_done');
103 $driver_class->config->view('NonExistant::View');
104 eval {$driver_class->init};
105 like($@, qr/Couldn't load the view class/,
106 '... dies if unable to load view class');
107 $@ = undef; $driver_class->config->view($view_class);
110 my ($r, $req); # request objects
116 my $mock_driver = Test::MockModule->new($driver_class, no_auto => 1);
118 init => sub {$init++; shift->init_done(1)},
119 get_request => sub {($r, $req) = @_; $called{get_request}++},
120 parse_location => sub {$called{parse_location}++},
121 handler_guts => sub {$called{handler_guts}++; $status},
122 send_output => sub {$called{send_output}++},
126 can_ok($driver_class => 'handler');
127 my $rv = $driver_class->handler();
128 ok($r && $r->isa($driver_class), '... created $r');
129 ok($called{get_request}, '... calls get_request()');
130 ok($called{get_request}, '... calls parse_location');
131 ok($called{get_request}, '... calls handler_guts()');
132 ok($called{get_request}, '... call send_output');
133 is($rv, 0, '... return status (should be ok?)');
134 ok(!$init, "... doesn't call init() if init_done()");
135 # call again, testing other branches
136 $driver_class->init_done(0);
138 $rv = $driver_class->handler();
139 ok($called{handler_guts} == 2 && $called{send_output} == 1,
140 '... returns early if handler_guts failed');
141 is($rv, -1, '... returning the error code from handler_guts');
142 $driver_class->handler();
143 ok($init && $driver_class->init_done, "... init() called if !init_done()");
150 @{$table_class . "::ISA"} = $model_class;
153 my ($applicable, %called, $status);
154 my $mock_driver = new Test::MockModule($driver_class, no_auto => 1);
155 my $mock_table = new Test::MockModule($table_class, no_auto => 1);
157 is_applicable => sub {push @{$called{applicable}},\@_; $applicable},
158 get_request => sub {($r, $req) = @_},
159 additional_data => sub {$called{additional_data}++},
162 table_process => sub {push @{$called{process}},\@_},
165 class_of => sub {push @{$called{class_of}},\@_; $table_class},
166 process => sub {push @{$called{model_process}}, \@_},
169 process => sub {push @{$called{view_process}}, \@_; $OK}
171 can_ok(Maypole => 'handler_guts');
174 $r->{path} = '/table/action'; $r->parse_path;
175 $status = $r->handler_guts();
177 is($r->model_class, $table_class, '... sets model_class from table()');
178 ok($called{additional_data}, '... call additional_data()');
179 is($status, $OK, '... return status = OK');
180 ok($called{model_process},
181 '... if_applicable, call model_class->process');
184 $applicable = $DECLINED;
185 $r->{path} = '/table/action';
187 $status = $r->handler_guts();
188 is($r->template, $r->path,
189 '... if ! is_applicable set template() to path()');
190 ok(!$called{model_process},
191 '... !if_applicable, call model_class->process');
192 is_deeply($called{view_process}[0][1], $r,
193 ' ... view_object->process called');
194 is($status, $OK, '... return status = OK');
198 $r->{output} = 'test';
199 $status = $r->handler_guts();
200 ok(!$called{view_process},
201 '... unless output, call view_object->process to get output');
203 $mock_driver->mock(call_authenticate => sub {$DECLINED});
204 $status = $r->handler_guts();
205 is($status, $DECLINED,
206 '... return DECLINED unless call_authenticate == OK');
208 # ... TODO authentication error handling
209 # ... TODO model error handling
210 # ... TODO view processing error handling
214 can_ok(Maypole => 'is_applicable');
215 $r->config->display_tables([qw(one two)]);
216 $r->config->ok_tables(undef);
217 $r->model_class($table_class);
219 $r->action('unittest');
221 $mock_model->mock('is_public', sub {0});
222 my $status = $r->is_applicable;
223 is($status, $DECLINED,
224 '... return DECLINED unless model_class->is_public(action)');
225 $mock_model->mock('is_public', sub {$is_public = \@_; 1});
226 $status = $r->is_applicable;
227 is($status, $OK, '... returns OK if table is in ok_tables');
228 is_deeply($is_public, [$r->model_class, 'unittest'],
229 '... calls model_class->is_public with request action');
230 is_deeply($r->config->ok_tables, {one => 1, two => 1},
231 '... config->ok_tables defaults to config->display_tables');
232 delete $r->config->ok_tables->{one};
233 $status = $r->is_applicable;
234 is($status, $DECLINED, '... return DECLINED unless $r->table is in ok_tables');
236 # call_authenticate()
237 can_ok(Maypole => 'call_authenticate');
238 my $mock_driver = new Test::MockModule($driver_class, no_auto => 1);
239 my $mock_table = new Test::MockModule($table_class, no_auto => 1);
242 authenticate => sub {$auth_calls{model_auth} = \@_; $OK}
244 $status = $r->call_authenticate;
245 is_deeply($auth_calls{model_auth}, [$table_class, $r],
246 '... calls model_class->authenticate if it exists');
247 is($status, $OK, '... and returns its status (OK)');
248 $mock_table->mock(authenticate => sub {$DECLINED});
249 $status = $r->call_authenticate;
250 is($status, $DECLINED, '... or DECLINED, as appropriate');
252 $mock_table->unmock('authenticate');
253 $mock_driver->mock(authenticate => sub {return $DECLINED});
254 $status = $r->call_authenticate;
255 is($status, $DECLINED, '... otherwise it calls authenticte()');
256 $mock_driver->unmock('authenticate');
257 $status = $r->call_authenticate;
258 is($status, $OK, '... the default authenticate is OK');
261 can_ok(Maypole => 'call_exception');
264 exception => sub {$ex_calls{model_exception} = \@_; $OK}
267 exception => sub {$ex_calls{driver_exception} = \@_; 'X'}
269 $status = $r->call_exception('ERR');
270 is_deeply($ex_calls{model_exception}, [$table_class, $r, 'ERR'],
271 '... calls model_class->exception if it exists');
272 is($status, $OK, '... and returns its status (OK)');
273 $mock_table->mock(exception => sub {$DECLINED});
274 $status = $r->call_exception('ERR');
275 is_deeply($ex_calls{driver_exception}, [$r, 'ERR'],
276 '... or calls driver->exception if model returns !OK');
277 is($status, 'X', '... and returns the drivers status');
279 $mock_table->unmock('exception');
280 $mock_driver->unmock('exception');
281 $status = $r->call_exception('ERR');
282 is($status, $ERROR, '... the default exception is ERROR');
285 can_ok(Maypole => 'additional_data');
288 can_ok(Maypole => 'authenticate');
289 is(Maypole->authenticate(), $OK, '... returns OK');
292 can_ok(Maypole => 'exception');
293 is(Maypole->exception(), $ERROR, '... returns ERROR');
296 can_ok(Maypole => 'parse_path');
299 is($r->path, 'frontpage', '... path() defaults to "frontpage"');
303 is($r->table, 'table', '... parses "table" from the first part of path');
304 ok(!defined $r->action && @{$r->args} == 0,
305 '... leaving "action" undefined, and "args" as empty list, if not present');
307 $r->path('/table/action');
309 ok($r->table eq 'table' && $r->action eq 'action',
310 '... action is parsed from second part of path');
312 $r->path('/table/action/arg1/arg2');
314 is_deeply($r->args, [qw(arg1 arg2)],
315 '... "args" are populated from remaning components');
317 # get_template_root()
318 can_ok(Maypole => 'get_template_root');
319 is(Maypole->get_template_root(), '.', '... returns "."');
322 can_ok(Maypole => 'get_request');
325 can_ok(Maypole => 'parse_location');
326 eval {Maypole->parse_location()};
327 like($@, qr/Do not use Maypole directly/, '... croaks - must be overriden');
330 can_ok(Maypole=> 'send_output');
331 eval {Maypole->send_output};
332 like($@, qr/Do not use Maypole directly/, '... croaks - must be overriden');