File: 07connect_info.t

package info (click to toggle)
libcatalyst-model-dbic-schema-perl 0.66-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 368 kB
  • sloc: perl: 2,984; makefile: 2
file content (114 lines) | stat: -rw-r--r-- 3,113 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
use strict;
use warnings;

use FindBin '$Bin';
use lib "$Bin/lib";

use Test::More;
use Test::Exception;
use Catalyst::Model::DBIC::Schema;
use ASchemaClass;

# execise the connect_info coercion

my $coderef = sub {};

my @tests = (
    ['dbi:SQLite:foo.db', '', ''],
    { dsn => 'dbi:SQLite:foo.db', user => '', password => '' },

    ['dbi:SQLite:foo.db', ''],
    { dsn => 'dbi:SQLite:foo.db', user => '', password => '' },

    ['dbi:SQLite:foo.db'],
    { dsn => 'dbi:SQLite:foo.db', user => '', password => '' },

    'dbi:SQLite:foo.db',
    { dsn => 'dbi:SQLite:foo.db', user => '', password => '' },

    ['dbi:Pg:dbname=foo', 'user', 'pass',
        { pg_enable_utf8 => 1, auto_savepoint => 1 }],
    { dsn => 'dbi:Pg:dbname=foo', user => 'user', password => 'pass',
        pg_enable_utf8 => 1, auto_savepoint => 1 },

    ['dbi:Pg:dbname=foo', 'user', 'pass',
        { pg_enable_utf8 => 1 }, { auto_savepoint => 1 }],
    { dsn => 'dbi:Pg:dbname=foo', user => 'user', password => 'pass',
        pg_enable_utf8 => 1, auto_savepoint => 1 },

    [ { dsn => 'dbi:Pg:dbname=foo', user => 'user', password => 'pass',
        pg_enable_utf8 => 1, auto_savepoint => 1 } ],
    { dsn => 'dbi:Pg:dbname=foo', user => 'user', password => 'pass',
        pg_enable_utf8 => 1, auto_savepoint => 1 },

    [$coderef, { pg_enable_utf8 => 1, auto_savepoint => 1 }],
    { dbh_maker => $coderef, pg_enable_utf8 => 1, auto_savepoint => 1 },
);

my @invalid = (
    { foo => 'bar' },
    [ { foo => 'bar' } ],
    ['dbi:Pg:dbname=foo', 'user', 'pass',
        { pg_enable_utf8 => 1 }, { AutoCommit => 1 }, { auto_savepoint => 1 }],
);

# ignore redefined warnings, and uninitialized warnings from old
# ::Storage::DBI::Replicated
local $SIG{__WARN__} = sub {
    $_[0] !~ /(?:redefined|uninitialized)/i && warn @_
};

for (my $i = 0; $i < @tests; $i += 2) {
    my $m = instance(
        connect_info => $tests[$i]
    );

    is_deeply $m->connect_info, $tests[$i+1],
        'connect_info coerced correctly';
}

throws_ok { instance(connect_info => $_) } qr/valid connect_info/i,
    'invalid connect_info throws exception'
    for @invalid;

# try as ConnectInfos (e.g.: replicants)
my @replicants = map $tests[$_], grep $_ % 2 == 0, 0..$#tests;

{
    package TryConnectInfos;

    use Moose;
    use Catalyst::Model::DBIC::Schema::Types 'ConnectInfos';

    has replicants => (is => 'ro', isa => ConnectInfos, coerce => 1);
}

my $m = TryConnectInfos->new(
    replicants   => \@replicants
);

lives_and {
    is_deeply(TryConnectInfos->new(replicants => $tests[1])->replicants,
        [ $tests[1] ])
} 'single replicant hashref coerces correctly';

is_deeply $m->replicants, [
    map $tests[$_], grep $_ % 2, 0 .. $#tests
], 'replicant connect_infos coerced correctly';

{
    ASchemaClass->connection( @{$tests[0]} );
    my $m = instance();

    is_deeply $m->connect_info, $tests[1],
        'connect_info coerced correctly when defining connection in the schema class';
}

done_testing;

sub instance {
    Catalyst::Model::DBIC::Schema->new({
        schema_class => 'ASchemaClass',
        @_
    })
}