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