Merge pull request #22 from waterkip/act-psgi-act-config-test

Add test DB for testing on docker

Makefile.PL

@@ -167,7 +167,9 @@ my %WriteMakefileArgs = (
     "Plack::Test" => 0,
     "Test" => 0,
     "Test::Builder" => 0,
+    "Test::Deep" => 0,
     "Test::Deep::NoTest" => 0,
+    "Test::Exception" => 0,
     "Test::Fatal" => 0,
     "Test::Lib" => 0,
     "Test::MockModule" => 0,
@@ -275,7 +277,9 @@ my %FallbackPrereqs = (
   "Term::ReadKey" => 0,
   "Test" => 0,
   "Test::Builder" => 0,
+  "Test::Deep" => 0,
   "Test::Deep::NoTest" => 0,
+  "Test::Exception" => 0,
   "Test::Fatal" => 0,
   "Test::Lib" => 0,
   "Test::MockModule" => 0,

conferences/demo/actdocs/conf/act.ini

@@ -39,27 +39,34 @@ level4_name_en = Advanced
 
 [rooms]
 rooms = r1 r2 r3
+r1 = "Silence"
+r2 = "Test"
+r3 = "Suite"
 r1_name_en = Room 1
 r2_name_en = Room 2
 r3_name_en = Room 3
 
 [payment]
-type        = CC
+type        = NONE
 currency    = EUR
 open        = 0
 invoices    = 0
 products    = registration
 
+
 [product_registration]
 name_en     = Registration
+name_nl     = Registratie
 prices      = 2
 
 [product_registration_price1]
 name_en     = Regular price
+name_nl     = Reguliere prijs
 amount      = 1
 
 [product_registration_price2]
 name_en     = Reduced price
+name_nl     = Gereduceerde prijs
 amount      = 2
 
 # optional Flickr support

cpanfile

@@ -123,7 +123,9 @@ on 'test' => sub {
   requires "Plack::Test" => "0";
   requires "Test" => "0";
   requires "Test::Builder" => "0";
+  requires "Test::Deep" => "0";
   requires "Test::Deep::NoTest" => "0";
+  requires "Test::Exception" => "0";
   requires "Test::Fatal" => "0";
   requires "Test::Lib" => "0";
   requires "Test::MockModule" => "0";

db/act/initial/20-act-version.sql

@@ -0,0 +1,4 @@
+
+\c act
+
+INSERT INTO schema (current_version) VALUES (12);

db/act/initial/99-test-db.sql

@@ -0,0 +1,3 @@
+
+CREATE database act_test WITH TEMPLATE act;
+

db/act/template.sql

@@ -120,6 +120,13 @@ CREATE TABLE talks (
     level        integer DEFAULT 1,
     lang         text,
 
+    teaser       text,
+    url_video1   text,
+    url_video2   text,
+    url_video3   text,
+    hide_details boolean DEFAULT false NOT NULL,
+    allow_record boolean DEFAULT true  NOT NULL,
+
     FOREIGN KEY( user_id  ) REFERENCES users( user_id )
 );
 CREATE INDEX talks_idx ON talks ( talk_id, conf_id );

etc/act.ini.dist

@@ -18,6 +18,12 @@ dsn         = dbi:Pg:dbname=$(database_name)
 host        = act-db
 user        = act
 passwd      = act123
+
+test_dsn         = dbi:Pg:dbname=act_test
+test_host        = act-db
+test_user        = act
+test_passwd      = act123
+
 # Disable version checking, defaults to true
 version_check = 0
 

lib/Act/Config.pm

@@ -185,10 +185,12 @@ my @Optional = qw(
 # salutations
 our $Nb_salutations = 4;
 
-sub load_configs {
-    my $self = shift;
+# load configurations
+load_configs() unless $^C;
 
-    my $home = shift // $ENV{ACTHOME} // $ENV{ACT_HOME};
+sub load_configs
+{
+    my $home = $ENV{ACTHOME} // $ENV{ACT_HOME};
     die "ACT_HOME environment variable isn't set\n" unless $home;
     $GlobalConfig = _init_config($home);
     %ConfConfigs = ();
@@ -414,8 +416,12 @@ sub _get
 sub _load_config
 {
     my ($cfg, $dir) = @_;
+
     for my $file (qw< act local >) {
         my $path = catfile($dir, 'conf', "$file.ini");
+        if (-d $path) {
+            die "$path is a directory, please refer to the documentation\n";
+        }
         if (-e $path) {
             open my $fh, '<:encoding(UTF-8)', $path
                 or die "can't open $path: $!\n";

lib/Act/Database.pm

@@ -1,6 +1,7 @@
 use strict;
 package Act::Database;
-
+use Try::Tiny;
+
 my @SCHEMA_UPDATES = (
 #1
   "create table schema (
@@ -94,19 +95,20 @@ my @SCHEMA_UPDATES = (
 );
 
 # returns ( current database schema version, required version )
-sub get_versions
-{
+sub get_versions {
     my $dbh = shift;
+
     my $version;
-    eval {
+    try {
         $version = $dbh->selectrow_array('SELECT current_version FROM schema');
-    };
-    if ($@) {
+    }
+    catch {
         $dbh->rollback;
         die "Failed to retrieve the schema version:\n",
             "DB error:   '", $dbh->errstr, "'\n",
-            "eval error: '$@'";
-    }
+            "eval error: '$_'\n";
+    };
+
     defined $version
         or  warn "No database schema version found.\n";
     $version ||= 0;

lib/Act/Dispatcher.pm

@@ -78,7 +78,7 @@ my %private_handlers = (
 );
 
 sub to_app {
-    Act::Config->load_configs();
+    Act::Config::reload_configs();
     my $conference_app = conference_app();
     my $app            = builder {
         enable 'Debug', panels => [split(/\s+/, $ENV{ACT_DEBUG})]

lib/Act/I18N.pm

@@ -7,22 +7,20 @@ use Locale::Maketext::Lexicon;
 
 use Act::Config;
 
+unless ($^C) {
+    Locale::Maketext::Lexicon->import({
+        '*' => [ Gettext => catfile($Config->home, 'po', '*.[pm]o'),
+                 Gettext => catfile($Config->home, 'po', '*', '*.[pm]o'),
+               ],
+        _auto   => 0,
+        _decode => 1,
+        _style  => 'gettext',
+    });
+}
+
 sub init
 {
     my $self = shift;
-
-    Act::Config->load_configs();
-
-    unless ($^C) {
-        Locale::Maketext::Lexicon->import({
-            '*' => [ Gettext => catfile($Config->home, 'po', '*.[pm]o'),
-                     Gettext => catfile($Config->home, 'po', '*', '*.[pm]o'),
-                   ],
-            _auto   => 0,
-            _decode => 1,
-            _style  => 'gettext',
-        });
-    }
     $self->SUPER::init();
     $self->fail_with('failure_handler');
 }

lib/Act/Object.pm

@@ -6,7 +6,7 @@ use Act::Util qw(format_datetime_string);
 use Carp;
 use DBI qw(:sql_types);
 
-use constant DEBUG => $ENV{ACT_DEBUG};
+use constant DEBUG => !$^C && $Config->database_debug;
 use vars qw(@ISA @EXPORT );
 @ISA    = qw(Exporter);
 @EXPORT = qw(sql sql_prepare sql_exec);

lib/Act/Store/Database.pm

@@ -39,7 +39,6 @@ has schema => (
 
 # -------- Attribute helpers -------------------------------------------
 sub _build_connector ($self) {
-    Act::Config::load_configs;
     my $Config = $Act::Config::Config;
     my $dsn = $Config->database_dsn;
     if ($Config->database_host) {
@@ -95,7 +94,6 @@ sub BUILD ($self,@) {
 # _check_db_version
 #   Purpose: Make sure that the code understands the database schema.
 sub _check_db_version ($self) {
-    return;
     my $current_version = $self->get_schema_version();
     my $required_version = Act::Database::required_version;
     if ($current_version > $required_version) {

t/02config.t

@@ -37,7 +37,6 @@ my @conf_simple = qw(
 BEGIN { use_ok('Act::Language') }
 BEGIN { use_ok('Act::Config') }
 
-Act::Config->load_configs(catfile(qw(t act.ini)));
 ok($Config, "configuration loaded");
 
 ## Act::Config globals
@@ -49,11 +48,6 @@ for my $lang (sort keys %Languages) {
 ## global config
 _test_config($Config, 'global');
 
-# optional compiled templates
-if ($Config->general_dir_ttc) {
-    ok(-d $Config->general_dir_ttc, "compiled templates directory exists");
-}
-
 # test each conference configuration
 isa_ok($Config->conferences, 'HASH', "general_conferences");
 isa_ok($Config->uris, 'HASH', "uris");

t/03database.t

@@ -1,59 +1,46 @@
+use warnings;
 use strict;
-use Act::Config;
-use DBI;
-use Test::More tests => 16;
-
-my @databases = (
-    [ 'main',
-      $Config->database_dsn,
-      $Config->database_user,
-      $Config->database_passwd,
-    ],
-    [ 'test',
-      $Config->database_test_dsn,
-      $Config->database_test_user,
-      $Config->database_test_passwd,
-    ],
-    [ 'wiki',
-      'dbi:Pg:dbname=' . $Config->wiki_dbname,
-      $Config->wiki_dbuser,
-      $Config->wiki_dbpass,
-    ],
-);
+use Test::More;
+use Test::Deep;
+use Test::Exception;
+
+use Test::MockObject;
 
 require_ok('Act::Database');
-for my $d (@databases) {
-    my ($name, @c) = @$d;
-    my $is_pg = $c[0] =~ /Pg:/ ? 1 : 0;
-
-    my $dbh = DBI->connect(@c,
-                            { AutoCommit => 0,
-                              PrintError => 0,
-                              pg_enable_utf8 => 1,
-                            }
-                          );
-
-    if (not ok $dbh, "$name connect") {
-        SKIP: {
-            skip "connect failed; following tests can't be run", 4
-        }
-        next
-    }
-
-    SKIP: {
-        skip "tests specific to PostgreSQL", 2 unless $is_pg;
-        cmp_ok($dbh->{pg_server_version}, '>=', 80000, "$name server version");
-        cmp_ok($dbh->{pg_lib_version}, '>=', 80000, "$name library version");
-    }
-
-    SKIP: {
-        skip "irrelevent", 1 if $name eq 'wiki';
-        my ($version, $required) = Act::Database::get_versions($dbh);
-        is ($version, $required, "$name schema is up to date");
-    }
-
-    eval { $dbh->disconnect };
-    is $@, "", "$name disconnect";
+
+my $required_version = Act::Database::required_version();
+is($required_version, 12, "12 db upgrades found");
+
+{
+    my $warn;
+    local $SIG{__WARN__} = sub { $warn = shift };
+    my $dbh = Test::MockObject->new();
+    $dbh->mock('selectrow_array' => sub { return undef });
+    my @found = Act::Database::get_versions($dbh);
+    cmp_deeply(\@found, [0, $required_version], "undef returns 0 as a version");
+    is($warn, "No database schema version found.\n", ".. and correct warning found");
+}
+
+{
+    my $dbh = Test::MockObject->new();
+    $dbh->mock('selectrow_array' => sub { return 12 });
+    my @found = Act::Database::get_versions($dbh);
+    cmp_deeply(\@found, [12, $required_version], "12 returns 12");
 }
 
+{
+    my $dbh = Test::MockObject->new();
+    $dbh->mock('selectrow_array' => sub { die "Failure" });
+    $dbh->mock('rollback' => sub { 1 });
+    $dbh->mock('errstr' => sub { return "we dead" });
+    throws_ok(
+        sub {
+            Act::Database::get_versions($dbh);
+        },
+        qr/Failed to retrieve the schema version/
+    );
+}
+
+done_testing;
+
 __END__

t/04i18n.t

@@ -1,9 +1,11 @@
 #!perl -w
-
 use strict;
-use Act::Config;
+use warnings;
 
 use Test::More;
+use Test::Lib;
+
+use Act::Config;
 
 # set up some test lexicons
 package Act::I18N::en;

t/08track.t

@@ -1,11 +1,10 @@
 #!/usr/bin/env perl
-
-use Test::More tests => 7;
-use Act::Track;
 use strict;
-use lib $ENV{ACTHOME};
+use warnings;
+use Act::Track;
 use Test::Lib;
 use Test::Act::Util;
+use Test::More;
 
 # manually insert a track
 my $sth = $Request{dbh}->prepare_cached("INSERT INTO tracks (conf_id,title,description) VALUES(?,?,?)");
@@ -45,3 +44,5 @@ is_deeply( $track, $track2, "field modified by update" );
 $track->delete;
 
 is( Act::Track->new( track_id => $id ), undef, "Track removed" );
+
+done_testing();

t/09dbbool.t

@@ -1,5 +1,5 @@
 #!perl -w
-use Test::More tests => 2;
+use Test::More tests => 3;
 use strict;
 use Test::Lib;
 use Test::Act::Util;   # load the test database