4 use Test::More tests => 74;
12 ok($Maypole::VERSION, 'defines $VERSION');
13 ok($INC{'Maypole/Config.pm'}, 'loads Maypole::Config');
14 ok($INC{'UNIVERSAL/require.pm'}, 'loads UNIVERSAL::require');
15 ok($INC{'Maypole/Constants.pm'}, 'loads Maypole::Constants');
16 ok($INC{'Maypole/Headers.pm'}, 'loads Maypole::Headers');
17 ok($INC{'Class/Accessor/Fast.pm'}, 'loads Class::Accessor::Fast');
18 ok($INC{'Class/Data/Inheritable.pm'}, 'loads Class::Data::Inheritable');
21 my $OK = Maypole::Constants::OK();
22 my $DECLINED = Maypole::Constants::DECLINED();
23 my $ERROR = Maypole::Constants::ERROR();
26 my @API = qw/ config init_done view_object params query objects model_class
27 template_args output path args action template error document_encoding
28 content_type table headers_in headers_out
29 is_model_applicable setup init handler handler_guts
30 call_authenticate call_exception additional_data
31 authenticate exception parse_path make_path
32 make_uri get_template_root get_request
33 parse_location send_output
36 can_ok(Maypole => @API);
38 ok( ! UNIVERSAL::can(Maypole => 'is_applicable'), 'no is_applicable() method' );
40 ok(Maypole->config->isa('Maypole::Config'), 'config is a Maypole::Config object');
41 ok(! Maypole->init_done, '... which is false by default');
42 is(Maypole->view_object, undef, '... which is undefined');
44 # simple test class that inherits from Maypole
47 @MyDriver::ISA = 'Maypole';
48 @MyDriver::VERSION = 1;
51 # back to package main;
52 my $driver_class = 'MyDriver';
54 # subclass inherits API
55 can_ok($driver_class => @API);
57 # Mock the model class
58 my (%required, @db_args, @adopted);
59 my $model_class = 'Maypole::Model::CDBI';
60 my $table_class = $driver_class . '::One';
62 my $mock_model = Test::MockModule->new($model_class);
64 require => sub {$required{+shift} = 1},
65 setup_database => sub {
67 $_[1]->{classes} = ["$model_class\::One", "$model_class\::Two"];
68 $_[1]->{tables} = [qw(one two)];
70 adopt => sub {push @adopted, \@_},
76 # 2.11 - removed tests to check the installed handler was a different ref after setup().
77 # The handler tests were testing Maypole's old (pre 2.11) method of importing handler()
78 # into the subclass - it works via standard inheritance now, by setting the 'method'
79 # attribute on Maypole::handler(). The reason the handlers were different
80 # was because setup() would create a new anonymous ref to Maypole::handler(), and install
81 # that - i.e. it installed the same code, but in a different ref, so they tested unequal
82 # although they referred to the same code
84 $driver_class->setup('dbi:foo');
86 ok($required{$model_class}, '... requires model class');
87 is($driver_class->config->model(),
88 'Maypole::Model::CDBI', '... default model is CDBI');
89 is(@db_args, 1, '... calls model->setup_database');
90 like(join (' ', @{$db_args[0]}),
91 qr/$model_class Maypole::Config=\S* $driver_class dbi:foo/,
92 '... setup_database passed setup() args');
93 is(@adopted, 2, '... calls model->adopt foreach class in the model');
94 ok($adopted[0][0]->isa($model_class),
95 '... sets up model subclasses to inherit from model');
96 $driver_class->config->model('NonExistant::Model');
97 eval {$driver_class->setup};
98 like($@, qr/Couldn't load the model class/,
99 '... dies if unable to load model class');
103 $driver_class->config->model($model_class);
106 # Mock the view class
107 my $view_class = 'Maypole::View::TT';
108 my $mock_view = Test::MockModule->new($view_class);
110 new => sub {bless{}, shift},
111 require => sub {$required{+shift} = 1},
116 $driver_class->init();
117 ok($required{$view_class}, '... requires the view class');
118 is($driver_class->config->view, $view_class, '... the default view class is TT');
119 is(join(' ', @{$driver_class->config->display_tables}), 'one two',
120 '... config->display_tables defaults to all tables');
121 ok($driver_class->view_object->isa($view_class),
122 '... creates an instance of the view object');
123 ok($driver_class->init_done, '... sets init_done');
124 $driver_class->config->view('NonExistant::View');
125 eval {$driver_class->init};
126 like($@, qr/Couldn't load the view class/,
127 '... dies if unable to load view class');
131 $driver_class->config->view($view_class);
134 my ($r, $req); # request objects
142 my $mock_driver = Test::MockModule->new($driver_class, no_auto => 1);
144 init => sub {$init++; shift->init_done(1)},
145 get_request => sub {($r, $req) = @_; $called{get_request}++},
146 parse_location => sub {$called{parse_location}++},
147 handler_guts => sub {$called{handler_guts}++; $status},
148 send_output => sub {$called{send_output}++},
151 my $rv = $driver_class->handler();
153 ok($r && $r->isa($driver_class), '... created $r');
154 ok($called{get_request}, '... calls get_request()');
155 ok($called{parse_location}, '... calls parse_location');
156 ok($called{handler_guts}, '... calls handler_guts()');
157 ok($called{send_output}, '... call send_output');
158 is($rv, 0, '... return status (should be ok?)');
159 ok(!$init, "... doesn't call init() if init_done()");
161 ok($r->headers_out && $r->headers_out->isa('Maypole::Headers'),
162 '... populates headers_out() with a Maypole::Headers object');
164 # call again, testing other branches
165 $driver_class->init_done(0);
167 $rv = $driver_class->handler();
168 ok($called{handler_guts} == 2 && $called{send_output} == 1,
169 '... returns early if handler_guts failed');
170 is($rv, -1, '... returning the error code from handler_guts');
172 $driver_class->handler();
173 ok($init && $driver_class->init_done, "... init() called if !init_done()");
180 @{$table_class . "::ISA"} = $model_class;
183 my ($applicable, %called);
185 my $mock_driver = new Test::MockModule($driver_class, no_auto => 1);
186 my $mock_table = new Test::MockModule($table_class, no_auto => 1);
189 #is_applicable => sub {push @{$called{applicable}},\@_; $applicable},
190 is_model_applicable =>
191 sub {push @{$called{applicable}},\@_; $applicable},
192 get_request => sub {($r, $req) = @_},
193 additional_data => sub {$called{additional_data}++},
197 table_process => sub {push @{$called{process}},\@_},
201 class_of => sub {push @{$called{class_of}},\@_; $table_class},
202 process => sub {push @{$called{model_process}}, \@_},
206 process => sub {push @{$called{view_process}}, \@_; $OK}
212 $r->{path} = '/table/action';
215 my $status = $r->handler_guts();
217 is($r->model_class, $table_class, '... sets model_class from table()');
218 ok($called{additional_data}, '... call additional_data()');
219 is($status, $OK, '... return status = OK');
220 ok($called{model_process},
221 '... if_applicable, call model_class->process');
228 $r->{path} = '/table/action';
231 $status = $r->handler_guts();
233 is($r->template, $r->path,
234 '... if ! is_applicable set template() to path()');
235 ok(!$called{model_process},
236 '... !if_applicable, call model_class->process');
237 is_deeply($called{view_process}[0][1], $r,
238 ' ... view_object->process called');
239 is($status, $OK, '... return status = OK');
241 # pre-load some output
245 $r->{output} = 'test';
247 $status = $r->handler_guts();
249 ok(!$called{view_process},
250 '... unless output, call view_object->process to get output');
252 # fail authentication
253 $mock_driver->mock(call_authenticate => sub {$DECLINED});
254 $status = $r->handler_guts();
255 is($status, $DECLINED,
256 '... return DECLINED unless call_authenticate == OK');
258 # ... TODO authentication error handling
259 # ... TODO model error handling
260 # ... TODO view processing error handling
263 # is_model_applicable()
265 $r->config->display_tables([qw(one two)]);
266 $r->config->ok_tables(undef);
267 $r->model_class($table_class);
269 $r->action('unittest');
271 $mock_model->mock('is_public', sub {0});
272 my $true_false = $r->is_model_applicable;
274 '... returns 0 unless model_class->is_public(action)');
275 $mock_model->mock('is_public', sub {$is_public = \@_; 1});
276 $true_false = $r->is_model_applicable;
277 is($true_false, 1, '... returns 1 if table is in ok_tables');
278 is_deeply($is_public, [$r->model_class, 'unittest'],
279 '... calls model_class->is_public with request action');
280 is_deeply($r->config->ok_tables, {one => 1, two => 1},
281 '... config->ok_tables defaults to config->display_tables');
282 delete $r->config->ok_tables->{one};
283 $true_false = $r->is_model_applicable;
284 is($true_false, 0, '... returns 0 unless $r->table is in ok_tables');
287 my $mock_driver = new Test::MockModule($driver_class, no_auto => 1);
288 my $mock_table = new Test::MockModule($table_class, no_auto => 1);
290 # call_authenticate()
294 authenticate => sub {$auth_calls{model_auth} = \@_; $OK}
296 my $status = $r->call_authenticate;
297 is_deeply($auth_calls{model_auth}, [$table_class, $r],
298 '... calls model_class->authenticate if it exists');
299 is($status, $OK, '... and returns its status (OK)');
300 $mock_table->mock(authenticate => sub {$DECLINED});
301 $status = $r->call_authenticate;
302 is($status, $DECLINED, '... or DECLINED, as appropriate');
304 $mock_table->unmock('authenticate');
305 $mock_driver->mock(authenticate => sub {return $DECLINED});
306 $status = $r->call_authenticate;
307 is($status, $DECLINED, '... otherwise it calls authenticte()');
308 $mock_driver->unmock('authenticate');
309 $status = $r->call_authenticate;
310 is($status, $OK, '... the default authenticate is OK');
317 exception => sub {$ex_calls{model_exception} = \@_; $OK}
320 exception => sub {$ex_calls{driver_exception} = \@_; 'X'}
322 my $status = $r->call_exception('ERR');
323 is_deeply($ex_calls{model_exception}, [$table_class, $r, 'ERR'],
324 '... calls model_class->exception if it exists');
325 is($status, $OK, '... and returns its status (OK)');
326 $mock_table->mock(exception => sub {$DECLINED});
327 $status = $r->call_exception('ERR');
328 is_deeply($ex_calls{driver_exception}, [$r, 'ERR'],
329 '... or calls driver->exception if model returns !OK');
330 is($status, 'X', '... and returns the drivers status');
332 $mock_table->unmock('exception');
333 $mock_driver->unmock('exception');
334 $status = $r->call_exception('ERR');
335 is($status, $ERROR, '... the default exception is ERROR');
340 is(Maypole->authenticate(), $OK, '... returns OK');
345 is(Maypole->exception(), $ERROR, '... returns ERROR');
352 is($r->path, 'frontpage', '... path() defaults to "frontpage"');
356 is($r->table, 'table', '... parses "table" from the first part of path');
357 ok(@{$r->args} == 0, '... "args" default to empty list');
359 $r->path('/table/action');
361 ok($r->table eq 'table' && $r->action eq 'action',
362 '... action is parsed from second part of path');
364 $r->path('/table/action/arg1/arg2');
366 is_deeply($r->args, [qw(arg1 arg2)],
367 '... "args" are populated from remaning components');
369 # ... action defaults to index
372 is($r->action, 'index', '... action defaults to index');
375 # make_uri() and make_path() - see pathtools.t
378 # get_template_root()
380 is(Maypole->get_template_root(), '.', '... returns "."');
385 eval {Maypole->parse_location()};
386 like($@, qr/Do not use Maypole directly/, '... croaks - must be overriden');
391 eval {Maypole->send_output};
392 like($@, qr/Do not use Maypole directly/, '... croaks - must be overriden');