3 use lib 'ex'; # Where BeerDB should live
5 eval { require BeerDB };
6 Test::More->import( skip_all =>
7 "SQLite not working or BeerDB module could not be loaded: $@"
12 use Maypole::CLI qw(BeerDB);
13 use Maypole::Constants;
14 $ENV{MAYPOLE_TEMPLATES} = "t/templates";
16 isa_ok( (bless {},"BeerDB") , "Maypole");
18 BeerDB->config->view_options({COMPILE_DIR => '/home/simon/dev/maypole/compiled'});
20 # Test the effect of trailing slash on config->uri_base and request URI
21 (my $uri_base = BeerDB->config->uri_base) =~ s:/$::;
22 BeerDB->config->uri_base($uri_base);
23 like(BeerDB->call_url("http://localhost/beerdb/"), qr/frontpage/,
24 "Got frontpage, trailing '/' on request but not uri_base");
25 like(BeerDB->call_url("http://localhost/beerdb"), qr/frontpage/,
26 "Got frontpage, no trailing '/' on request or uri_base");
27 BeerDB->config->uri_base($uri_base . '/');
28 like(BeerDB->call_url("http://localhost/beerdb/"), qr/frontpage/,
29 "Got frontpage, trailing '/' on uri_base and request");
30 like(BeerDB->call_url("http://localhost/beerdb"), qr/frontpage/,
31 "Got frontpage, trailing '/' on uri_base but not request");
33 like(BeerDB->call_url("http://localhost/beerdb/beer/list"), qr/Organic Best/, "Found a beer in the list");
34 my (%classdata)=split /\n/, BeerDB->call_url("http://localhost/beerdb/beer/classdata");
35 is ($classdata{plural},'beers','classdata.plural');
36 is ($classdata{moniker},'beer','classdata.moniker');
37 like ($classdata{cgi},qr/^HTML::Element/,'classdata.cgi');
38 is ($classdata{table},'beer','classdata.table');
39 is ($classdata{name},'BeerDB::Beer','classdata.name');
40 is ($classdata{colnames},'Abv','classdata.colnames');
41 is($classdata{columns}, 'abv brewery id name notes price score style url',
43 is($classdata{list_columns}, 'score name price style brewery url',
44 'classdata.list_columns');
45 is ($classdata{related_accessors},'pubs','classdata.related_accessors');