1use strict;
2use Test::More;
3use Test::Exception;
4use Try::Tiny;
5use lib qw(t/lib);
6use make_dbictest_db;
7
8use DBIx::Class::Schema::Loader;
9
10my $schema_counter = 0;
11
12# test skip_relationships
13my $regular = schema_with();
14is( ref($regular->source('Bar')->relationship_info('fooref')), 'HASH',
15    'regularly-made schema has fooref rel',
16  );
17my $skip_rel = schema_with( skip_relationships => 1 );
18is_deeply( $skip_rel->source('Bar')->relationship_info('fooref'), undef,
19    'skip_relationships blocks generation of fooref rel',
20  );
21
22# test hashref as rel_name_map
23my $hash_relationship = schema_with(
24    rel_name_map => {
25        fooref => "got_fooref",
26        bars   => "ignored",
27        Foo    => {
28            bars => "got_bars",
29            fooref => "ignored",
30        },
31    }
32);
33is( ref($hash_relationship->source('Foo')->relationship_info('got_bars')),
34    'HASH',
35    'single level hash in rel_name_map picked up correctly'
36  );
37is( ref($hash_relationship->source('Bar')->relationship_info('got_fooref')),
38    'HASH',
39    'double level hash in rel_name_map picked up correctly'
40  );
41
42# test coderef as rel_name_map
43my $code_relationship = schema_with(
44    rel_name_map => sub {
45        my ($args) = @_;
46
47        if ($args->{local_moniker} eq 'Foo') {
48            is_deeply(
49                $args,
50                {
51		    name           => 'bars',
52		    type           => 'has_many',
53                    local_class    =>
54                        "DBICTest::Schema::${schema_counter}::Result::Foo",
55		    local_moniker  => 'Foo',
56		    local_columns  => ['fooid'],
57                    remote_class   =>
58                        "DBICTest::Schema::${schema_counter}::Result::Bar",
59		    remote_moniker => 'Bar',
60		    remote_columns => ['fooref'],
61		},
62		'correct args for Foo passed'
63              );
64	    return 'bars_caught';
65        }
66	elsif ($args->{local_moniker} eq 'Bar') {
67            is_deeply(
68                $args,
69                {
70		    name           => 'fooref',
71		    type           => 'belongs_to',
72                    local_class    =>
73                        "DBICTest::Schema::${schema_counter}::Result::Bar",
74		    local_moniker  => 'Bar',
75		    local_columns  => ['fooref'],
76                    remote_class   =>
77                        "DBICTest::Schema::${schema_counter}::Result::Foo",
78		    remote_moniker => 'Foo',
79		    remote_columns => ['fooid'],
80		},
81		'correct args for Foo passed'
82              );
83	
84            return 'fooref_caught';
85	}
86    }
87  );
88is( ref($code_relationship->source('Foo')->relationship_info('bars_caught')),
89    'HASH',
90    'rel_name_map overrode local_info correctly'
91  );
92is( ref($code_relationship->source('Bar')->relationship_info('fooref_caught')),
93    'HASH',
94    'rel_name_map overrode remote_info correctly'
95  );
96
97
98
99# test relationship_attrs
100throws_ok {
101    schema_with( relationship_attrs => 'laughably invalid!!!' );
102} qr/relationship_attrs/, 'throws error for invalid (scalar) relationship_attrs';
103
104throws_ok {
105    schema_with( relationship_attrs => [qw/laughably invalid/] );
106} qr/relationship_attrs/, 'throws error for invalid (arrayref) relationship_attrs';
107
108{
109    my $nodelete = schema_with( relationship_attrs =>
110				{
111				 all        => { cascade_delete => 0 },
112				 belongs_to => { cascade_delete => 1 },
113				},
114			      );
115
116    my $bars_info   = $nodelete->source('Foo')->relationship_info('bars');
117    #use Data::Dumper;
118    #die Dumper([ $nodelete->source('Foo')->relationships() ]);
119    my $fooref_info = $nodelete->source('Bar')->relationship_info('fooref');
120    is( ref($fooref_info), 'HASH',
121	'fooref rel is present',
122      );
123    is( $bars_info->{attrs}->{cascade_delete}, 0,
124	'relationship_attrs settings seem to be getting through to the generated rels',
125      );
126    is( $fooref_info->{attrs}->{cascade_delete}, 1,
127	'belongs_to in relationship_attrs overrides all def',
128      );
129}
130
131# test relationship_attrs coderef
132{
133    my $relationship_attrs_coderef_invoked = 0;
134    my $schema;
135
136    lives_ok {
137        $schema = schema_with(relationship_attrs => sub {
138            my %p = @_;
139
140            $relationship_attrs_coderef_invoked++;
141
142            if ($p{rel_name} eq 'bars') {
143                is $p{local_table},  'foo', 'correct local_table';
144                is_deeply $p{local_cols}, [ 'fooid' ], 'correct local_cols';
145                is $p{remote_table}, 'bar', 'correct remote_table';
146                is_deeply $p{remote_cols}, [ 'fooref' ], 'correct remote_cols';
147                is_deeply $p{attrs}, {
148                    cascade_delete => 0,
149                    cascade_copy   => 0,
150                }, "got default rel attrs for $p{rel_name} in $p{local_table}";
151
152                like $p{local_source}->result_class,
153                    qr/^DBICTest::Schema::\d+::Result::Foo\z/,
154                    'correct local source';
155
156                like $p{remote_source}->result_class,
157                    qr/^DBICTest::Schema::\d+::Result::Bar\z/,
158                    'correct remote source';
159 
160                $p{attrs}{snoopy} = 1;
161
162                return $p{attrs};
163            }
164            elsif ($p{rel_name} eq 'fooref') {
165                is $p{local_table},  'bar', 'correct local_table';
166                is_deeply $p{local_cols}, [ 'fooref' ], 'correct local_cols';
167                is $p{remote_table}, 'foo', 'correct remote_table';
168                is_deeply $p{remote_cols}, [ 'fooid' ], 'correct remote_cols';
169                is_deeply $p{attrs}, {
170                    on_delete     => 'NO ACTION',
171                    on_update     => 'NO ACTION',
172                    is_deferrable => 0,
173                }, "got correct rel attrs for $p{rel_name} in $p{local_table}";
174
175                like $p{local_source}->result_class,
176                    qr/^DBICTest::Schema::\d+::Result::Bar\z/,
177                    'correct local source';
178
179                like $p{remote_source}->result_class,
180                    qr/^DBICTest::Schema::\d+::Result::Foo\z/,
181                    'correct remote source';
182 
183                $p{attrs}{scooby} = 1;
184
185                return $p{attrs};
186            }
187            else {
188                fail "unknown rel $p{rel_name} in $p{local_table}";
189            }
190        });
191    } 'dumping schema with coderef relationship_attrs survived';
192
193    is $relationship_attrs_coderef_invoked, 2,
194        'relationship_attrs coderef was invoked correct number of times';
195
196    is ((try { $schema->source('Foo')->relationship_info('bars')->{attrs}{snoopy} }) || undef, 1,
197        "correct relationship attributes for 'bars' in 'Foo'");
198
199    is ((try { $schema->source('Bar')->relationship_info('fooref')->{attrs}{scooby} }) || undef, 1,
200        "correct relationship attributes for 'fooref' in 'Bar'");
201}
202
203done_testing;
204
205#### generates a new schema with the given opts every time it's called
206sub schema_with {
207    $schema_counter++;
208    DBIx::Class::Schema::Loader::make_schema_at(
209            'DBICTest::Schema::'.$schema_counter,
210            { naming => 'current', @_ },
211            [ $make_dbictest_db::dsn ],
212    );
213    "DBICTest::Schema::$schema_counter"->clone;
214}
215