1use strict; 2use warnings; 3 4use Test::More; 5use Test::Exception; 6use Test::Warn; 7use lib qw(t/lib); 8use DBICTest; 9use DBIC::SqlMakerTest; 10 11my $schema = DBICTest->init_schema(); 12 13eval { require DateTime::Format::SQLite }; 14my $NO_DTFM = $@ ? 1 : 0; 15 16my @art = $schema->resultset("Artist")->search({ }, { order_by => 'name DESC'}); 17 18is(@art, 3, "Three artists returned"); 19 20my $art = $art[0]; 21 22is($art->name, 'We Are Goth', "Correct order too"); 23 24$art->name('We Are In Rehab'); 25 26is($art->name, 'We Are In Rehab', "Accessor update ok"); 27 28my %dirty = $art->get_dirty_columns(); 29is(scalar(keys(%dirty)), 1, '1 dirty column'); 30ok(grep($_ eq 'name', keys(%dirty)), 'name is dirty'); 31 32is($art->get_column("name"), 'We Are In Rehab', 'And via get_column'); 33 34ok($art->update, 'Update run'); 35 36my %not_dirty = $art->get_dirty_columns(); 37is(scalar(keys(%not_dirty)), 0, 'Nothing is dirty'); 38 39throws_ok ( sub { 40 my $ret = $art->make_column_dirty('name2'); 41}, qr/No such column 'name2'/, 'Failed to make non-existent column dirty'); 42 43$art->make_column_dirty('name'); 44my %fake_dirty = $art->get_dirty_columns(); 45is(scalar(keys(%fake_dirty)), 1, '1 fake dirty column'); 46ok(grep($_ eq 'name', keys(%fake_dirty)), 'name is fake dirty'); 47 48my $record_jp = $schema->resultset("Artist")->search(undef, { join => 'cds' })->search(undef, { prefetch => 'cds' })->next; 49 50ok($record_jp, "prefetch on same rel okay"); 51 52my $record_fn = $schema->resultset("Artist")->search(undef, { join => 'cds' })->search({'cds.cdid' => '1'}, {join => 'artist_undirected_maps'})->next; 53 54ok($record_fn, "funny join is okay"); 55 56@art = $schema->resultset("Artist")->search({ name => 'We Are In Rehab' }); 57 58is(@art, 1, "Changed artist returned by search"); 59 60is($art[0]->artistid, 3,'Correct artist too'); 61 62lives_ok (sub { $art->delete }, 'Cascading delete on Ordered has_many works' ); # real test in ordered.t 63 64@art = $schema->resultset("Artist")->search({ }); 65 66is(@art, 2, 'And then there were two'); 67 68is($art->in_storage, 0, "It knows it's dead"); 69 70dies_ok ( sub { $art->delete }, "Can't delete twice"); 71 72is($art->name, 'We Are In Rehab', 'But the object is still live'); 73 74$art->insert; 75 76ok($art->in_storage, "Re-created"); 77 78@art = $schema->resultset("Artist")->search({ }); 79 80is(@art, 3, 'And now there are three again'); 81 82my $new = $schema->resultset("Artist")->create({ artistid => 4 }); 83 84is($new->artistid, 4, 'Create produced record ok'); 85 86@art = $schema->resultset("Artist")->search({ }); 87 88is(@art, 4, "Oh my god! There's four of them!"); 89 90$new->set_column('name' => 'Man With A Fork'); 91 92is($new->name, 'Man With A Fork', 'set_column ok'); 93 94$new->discard_changes; 95 96ok(!defined $new->name, 'Discard ok'); 97 98$new->name('Man With A Spoon'); 99 100$new->update; 101 102my $new_again = $schema->resultset("Artist")->find(4); 103 104is($new_again->name, 'Man With A Spoon', 'Retrieved correctly'); 105 106is($new_again->ID, 'DBICTest::Artist|artist|artistid=4', 'unique object id generated correctly'); 107 108# test that store_column is called once for create() for non sequence columns 109{ 110 ok(my $artist = $schema->resultset('Artist')->create({name => 'store_column test'})); 111 is($artist->name, 'X store_column test'); # used to be 'X X store...' 112 113 # call store_column even though the column doesn't seem to be dirty 114 $artist->name($artist->name); 115 is($artist->name, 'X X store_column test'); 116 ok($artist->is_column_changed('name'), 'changed column marked as dirty'); 117 118 $artist->delete; 119} 120 121# Test backwards compatibility 122{ 123 my $warnings = ''; 124 local $SIG{__WARN__} = sub { $warnings .= $_[0] }; 125 126 my $artist_by_hash = $schema->resultset('Artist')->find(artistid => 4); 127 is($artist_by_hash->name, 'Man With A Spoon', 'Retrieved correctly'); 128 is($artist_by_hash->ID, 'DBICTest::Artist|artist|artistid=4', 'unique object id generated correctly'); 129 like($warnings, qr/deprecated/, 'warned about deprecated find usage'); 130} 131 132is($schema->resultset("Artist")->count, 4, 'count ok'); 133 134# test find_or_new 135{ 136 my $existing_obj = $schema->resultset('Artist')->find_or_new({ 137 artistid => 4, 138 }); 139 140 is($existing_obj->name, 'Man With A Spoon', 'find_or_new: found existing artist'); 141 ok($existing_obj->in_storage, 'existing artist is in storage'); 142 143 my $new_obj = $schema->resultset('Artist')->find_or_new({ 144 artistid => 5, 145 name => 'find_or_new', 146 }); 147 148 is($new_obj->name, 'find_or_new', 'find_or_new: instantiated a new artist'); 149 is($new_obj->in_storage, 0, 'new artist is not in storage'); 150} 151 152my $cd = $schema->resultset("CD")->find(1); 153my %cols = $cd->get_columns; 154 155is(keys %cols, 6, 'get_columns number of columns ok'); 156 157is($cols{title}, 'Spoonful of bees', 'get_columns values ok'); 158 159%cols = ( title => 'Forkful of bees', year => 2005); 160$cd->set_columns(\%cols); 161 162is($cd->title, 'Forkful of bees', 'set_columns ok'); 163 164is($cd->year, 2005, 'set_columns ok'); 165 166$cd->discard_changes; 167 168# check whether ResultSource->columns returns columns in order originally supplied 169my @cd = $schema->source("CD")->columns; 170 171is_deeply( \@cd, [qw/cdid artist title year genreid single_track/], 'column order'); 172 173$cd = $schema->resultset("CD")->search({ title => 'Spoonful of bees' }, { columns => ['title'] })->next; 174is($cd->title, 'Spoonful of bees', 'subset of columns returned correctly'); 175 176$cd = $schema->resultset("CD")->search(undef, { include_columns => [ 'artist.name' ], join => [ 'artist' ] })->find(1); 177 178is($cd->title, 'Spoonful of bees', 'Correct CD returned with include'); 179is($cd->get_column('name'), 'Caterwauler McCrae', 'Additional column returned'); 180 181# check if new syntax +columns also works for this 182$cd = $schema->resultset("CD")->search(undef, { '+columns' => [ 'artist.name' ], join => [ 'artist' ] })->find(1); 183 184is($cd->title, 'Spoonful of bees', 'Correct CD returned with include'); 185is($cd->get_column('name'), 'Caterwauler McCrae', 'Additional column returned'); 186 187# check if new syntax for +columns select specifiers works for this 188$cd = $schema->resultset("CD")->search(undef, { '+columns' => [ {artist_name => 'artist.name'} ], join => [ 'artist' ] })->find(1); 189 190is($cd->title, 'Spoonful of bees', 'Correct CD returned with include'); 191is($cd->get_column('artist_name'), 'Caterwauler McCrae', 'Additional column returned'); 192 193# update_or_insert 194$new = $schema->resultset("Track")->new( { 195 trackid => 100, 196 cd => 1, 197 title => 'Insert or Update', 198 last_updated_on => '1973-07-19 12:01:02' 199} ); 200$new->update_or_insert; 201ok($new->in_storage, 'update_or_insert insert ok'); 202 203# test in update mode 204$new->title('Insert or Update - updated'); 205$new->update_or_insert; 206is( $schema->resultset("Track")->find(100)->title, 'Insert or Update - updated', 'update_or_insert update ok'); 207 208# get_inflated_columns w/relation and accessor alias 209SKIP: { 210 skip "This test requires DateTime::Format::SQLite", 8 if $NO_DTFM; 211 212 isa_ok($new->updated_date, 'DateTime', 'have inflated object via accessor'); 213 my %tdata = $new->get_inflated_columns; 214 is($tdata{'trackid'}, 100, 'got id'); 215 isa_ok($tdata{'cd'}, 'DBICTest::CD', 'cd is CD object'); 216 is($tdata{'cd'}->id, 1, 'cd object is id 1'); 217 is( 218 $tdata{'position'}, 219 $schema->resultset ('Track')->search ({cd => 1})->count, 220 'Ordered assigned proper position', 221 ); 222 is($tdata{'title'}, 'Insert or Update - updated'); 223 is($tdata{'last_updated_on'}, '1973-07-19T12:01:02'); 224 isa_ok($tdata{'last_updated_on'}, 'DateTime', 'inflated accessored column'); 225} 226 227throws_ok (sub { 228 $schema->class("Track")->load_components('DoesNotExist'); 229}, qr!Can't locate DBIx/Class/DoesNotExist.pm!, 'exception on nonexisting component'); 230 231is($schema->class("Artist")->field_name_for->{name}, 'artist name', 'mk_classdata usage ok'); 232 233my $search = [ { 'tags.tag' => 'Cheesy' }, { 'tags.tag' => 'Blue' } ]; 234 235my( $or_rs ) = $schema->resultset("CD")->search_rs($search, { join => 'tags', 236 order_by => 'cdid' }); 237is($or_rs->all, 5, 'Joined search with OR returned correct number of rows'); 238is($or_rs->count, 5, 'Search count with OR ok'); 239 240my $collapsed_or_rs = $or_rs->search ({}, { distinct => 1 }); # induce collapse 241is ($collapsed_or_rs->all, 4, 'Collapsed joined search with OR returned correct number of rows'); 242is ($collapsed_or_rs->count, 4, 'Collapsed search count with OR ok'); 243 244# make sure sure distinct on a grouped rs is warned about 245my $cd_rs = $schema->resultset ('CD') 246 ->search ({}, { distinct => 1, group_by => 'title' }); 247warnings_exist (sub { 248 $cd_rs->next; 249}, qr/Useless use of distinct/, 'UUoD warning'); 250 251{ 252 my $tcount = $schema->resultset('Track')->search( 253 {}, 254 { 255 select => [ qw/position title/ ], 256 distinct => 1, 257 } 258 ); 259 is($tcount->count, 13, 'multiple column COUNT DISTINCT ok'); 260 261 $tcount = $schema->resultset('Track')->search( 262 {}, 263 { 264 columns => [ qw/position title/ ], 265 distinct => 1, 266 } 267 ); 268 is($tcount->count, 13, 'multiple column COUNT DISTINCT ok'); 269 270 $tcount = $schema->resultset('Track')->search( 271 {}, 272 { 273 group_by => [ qw/position title/ ] 274 } 275 ); 276 is($tcount->count, 13, 'multiple column COUNT DISTINCT using column syntax ok'); 277} 278 279my $tag_rs = $schema->resultset('Tag')->search( 280 [ { 'me.tag' => 'Cheesy' }, { 'me.tag' => 'Blue' } ]); 281 282my $rel_rs = $tag_rs->search_related('cd'); 283 284is($rel_rs->count, 5, 'Related search ok'); 285 286is($or_rs->next->cdid, $rel_rs->next->cdid, 'Related object ok'); 287$or_rs->reset; 288$rel_rs->reset; 289 290my $tag = $schema->resultset('Tag')->search( 291 [ { 'me.tag' => 'Blue' } ], { cols=>[qw/tagid/] } )->next; 292 293ok($tag->has_column_loaded('tagid'), 'Has tagid loaded'); 294ok(!$tag->has_column_loaded('tag'), 'Has not tag loaded'); 295 296ok($schema->storage(), 'Storage available'); 297 298{ 299 my $rs = $schema->resultset("Artist")->search({ 300 -and => [ 301 artistid => { '>=', 1 }, 302 artistid => { '<', 3 } 303 ] 304 }); 305 306 $rs->update({ name => 'Test _cond_for_update_delete' }); 307 308 my $art; 309 310 $art = $schema->resultset("Artist")->find(1); 311 is($art->name, 'Test _cond_for_update_delete', 'updated first artist name'); 312 313 $art = $schema->resultset("Artist")->find(2); 314 is($art->name, 'Test _cond_for_update_delete', 'updated second artist name'); 315} 316 317# test source_name 318{ 319 # source_name should be set for normal modules 320 is($schema->source('CD')->source_name, 'CD', 'source_name is set to moniker'); 321 322 # test the result source that sets source_name explictly 323 ok($schema->source('SourceNameArtists'), 'SourceNameArtists result source exists'); 324 325 my @artsn = $schema->resultset('SourceNameArtists')->search({}, { order_by => 'name DESC' }); 326 is(@artsn, 4, "Four artists returned"); 327 328 # make sure subclasses that don't set source_name are ok 329 ok($schema->source('ArtistSubclass'), 'ArtistSubclass exists'); 330} 331 332my $newbook = $schema->resultset( 'Bookmark' )->find(1); 333 334lives_ok (sub { my $newlink = $newbook->link}, "stringify to false value doesn't cause error"); 335 336# test cascade_delete through many_to_many relations 337{ 338 my $art_del = $schema->resultset("Artist")->find({ artistid => 1 }); 339 lives_ok (sub { $art_del->delete }, 'Cascading delete on Ordered has_many works' ); # real test in ordered.t 340 is( $schema->resultset("CD")->search({artist => 1}), 0, 'Cascading through has_many top level.'); 341 is( $schema->resultset("CD_to_Producer")->search({cd => 1}), 0, 'Cascading through has_many children.'); 342} 343 344# test column_info 345{ 346 $schema->source("Artist")->{_columns}{'artistid'} = {}; 347 $schema->source("Artist")->column_info_from_storage(1); 348 349 my $typeinfo = $schema->source("Artist")->column_info('artistid'); 350 is($typeinfo->{data_type}, 'INTEGER', 'column_info ok'); 351 $schema->source("Artist")->column_info('artistid'); 352 ok($schema->source("Artist")->{_columns_info_loaded} == 1, 'Columns info flag set'); 353} 354 355# test source_info 356{ 357 my $expected = { 358 "source_info_key_A" => "source_info_value_A", 359 "source_info_key_B" => "source_info_value_B", 360 "source_info_key_C" => "source_info_value_C", 361 }; 362 363 my $sinfo = $schema->source("Artist")->source_info; 364 365 is_deeply($sinfo, $expected, 'source_info data works'); 366} 367 368# test remove_columns 369{ 370 is_deeply( 371 [$schema->source('CD')->columns], 372 [qw/cdid artist title year genreid single_track/], 373 'initial columns', 374 ); 375 376 $schema->source('CD')->remove_columns('coolyear'); #should not delete year 377 is_deeply( 378 [$schema->source('CD')->columns], 379 [qw/cdid artist title year genreid single_track/], 380 'nothing removed when removing a non-existent column', 381 ); 382 383 $schema->source('CD')->remove_columns('genreid', 'year'); 384 is_deeply( 385 [$schema->source('CD')->columns], 386 [qw/cdid artist title single_track/], 387 'removed two columns', 388 ); 389 390 my $priv_columns = $schema->source('CD')->_columns; 391 ok(! exists $priv_columns->{'year'}, 'year purged from _columns'); 392 ok(! exists $priv_columns->{'genreid'}, 'genreid purged from _columns'); 393} 394 395# test get_inflated_columns with objects 396SKIP: { 397 skip "This test requires DateTime::Format::SQLite", 5 if $NO_DTFM; 398 my $event = $schema->resultset('Event')->search->first; 399 my %edata = $event->get_inflated_columns; 400 is($edata{'id'}, $event->id, 'got id'); 401 isa_ok($edata{'starts_at'}, 'DateTime', 'start_at is DateTime object'); 402 isa_ok($edata{'created_on'}, 'DateTime', 'create_on DateTime object'); 403 is($edata{'starts_at'}, $event->starts_at, 'got start date'); 404 is($edata{'created_on'}, $event->created_on, 'got created date'); 405} 406 407# test resultsource->table return value when setting 408{ 409 my $class = $schema->class('Event'); 410 my $table = $class->table($class->table); 411 is($table, $class->table, '->table($table) returns $table'); 412} 413 414#make sure insert doesn't use set_column 415{ 416 my $en_row = $schema->resultset('Encoded')->new_result({encoded => 'wilma'}); 417 is($en_row->encoded, 'amliw', 'new encodes'); 418 $en_row->insert; 419 is($en_row->encoded, 'amliw', 'insert does not encode again'); 420} 421 422# make sure we got rid of the compat shims 423SKIP: { 424 skip "Remove in 0.082", 3 if $DBIx::Class::VERSION < 0.082; 425 426 for (qw/compare_relationship_keys pk_depends_on resolve_condition/) { 427 ok (! DBIx::Class::ResultSource->can ($_), "$_ no longer provided by DBIx::Class::ResultSource"); 428 } 429} 430 431#------------------------------ 432# READ THIS BEFORE "FIXING" 433#------------------------------ 434# 435# make sure we got rid of discard_changes mess - this is a mess and a source 436# of great confusion. Here I simply die if the methods are available, which 437# is wrong on its own (we *have* to provide some sort of back-compat, even 438# if with warnings). Here is how I envision things should actually be. Also 439# note that a lot of the deprecation can be started today (i.e. the switch 440# from get_from_storage to copy_from_storage). So: 441# 442# $row->discard_changes => 443# warning, and delegation to reload_from_storage 444# 445# $row->reload_from_storage => 446# does what discard changes did in 0.08 - issues a query to the db 447# and repopulates all column slots, regardless of dirty states etc. 448# 449# $row->revert_changes => 450# does what discard_changes should have done initially (before it became 451# a dual-purpose call). In order to make this work we will have to 452# augment $row to carry its own initial-state, much like svn has a 453# copy of the current checkout in contrast to cvs. 454# 455# my $db_row = $row->get_from_storage => 456# warns and delegates to an improved name copy_from_storage, with the 457# same semantics 458# 459# my $db_row = $row->copy_from_storage => 460# a much better/descriptive name than get_from_storage 461# 462#------------------------------ 463# READ THIS BEFORE "FIXING" 464#------------------------------ 465# 466SKIP: { 467 skip "Something needs to be done before 0.09", 2 if $DBIx::Class::VERSION < 0.09; 468 469 my $row = $schema->resultset ('Artist')->next; 470 471 for (qw/discard_changes get_from_storage/) { 472 ok (! $row->can ($_), "$_ needs *some* sort of facelift before 0.09 ships - current state of affairs is unacceptable"); 473 } 474} 475 476throws_ok { $schema->resultset} qr/resultset\(\) expects a source name/, 'resultset with no argument throws exception'; 477 478done_testing; 479