view release on metacpan or  search on metacpan

t/backcompat/0.04006/lib/dbixcsl_common_tests.pm  view on Meta::CPAN

        my $rsobj18   = $conn->resultset($moniker18);

        my $moniker19 = $monikers->{loader_test19};
        my $class19   = $classes->{loader_test19};
        my $rsobj19   = $conn->resultset($moniker19);

        my $moniker20 = $monikers->{loader_test20};
        my $class20   = $classes->{loader_test20};
        my $rsobj20   = $conn->resultset($moniker20);

        my $moniker21 = $monikers->{loader_test21};
        my $class21   = $classes->{loader_test21};
        my $rsobj21   = $conn->resultset($moniker21);

        my $moniker22 = $monikers->{loader_test22};
        my $class22   = $classes->{loader_test22};
        my $rsobj22   = $conn->resultset($moniker22);

        my $moniker25 = $monikers->{loader_test25};
        my $class25   = $classes->{loader_test25};
        my $rsobj25   = $conn->resultset($moniker25);

        my $moniker26 = $monikers->{loader_test26};
        my $class26   = $classes->{loader_test26};
        my $rsobj26   = $conn->resultset($moniker26);

        isa_ok( $rsobj3, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj4, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj5, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj6, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj7, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj8, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj9, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj16, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj17, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj18, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj19, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj20, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj21, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj22, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj25, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj26, "DBIx::Class::ResultSet" );

        # basic rel test
        my $obj4 = $rsobj4->find(123);
        isa_ok( $obj4->fkid_singular, $class3);

        my $obj3 = $rsobj3->find(1);
        my $rs_rel4 = $obj3->search_related('loader_test4zes');
        isa_ok( $rs_rel4->first, $class4);

        # test that _id is not stripped and prepositions in rel names are
        # ignored
        ok ($rsobj4->result_source->has_relationship('loader_test5_to_ids'),
            "rel with preposition 'to' and _id pluralized backward-compatibly");

        ok ($rsobj4->result_source->has_relationship('loader_test5_from_ids'),
            "rel with preposition 'from' and _id pluralized backward-compatibly");

        # check that default relationship attributes are not applied in 0.04006 mode
        is $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{cascade_delete}, 1,
            'cascade_delete => 1 on has_many by default';

        is $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{cascade_copy}, 1,
            'cascade_copy => 1 on has_many by default';

        ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{on_delete}),
            'has_many does not have on_delete');

        ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{on_update}),
            'has_many does not have on_update');

        ok ((not exists $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{is_deferrable}),
            'has_many does not have is_deferrable');

        isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_delete}, 'CASCADE',
            "on_delete => 'CASCADE' not on belongs_to by default";

        isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_update}, 'CASCADE',
            "on_update => 'CASCADE' not on belongs_to by default";

        isnt $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{is_deferrable}, 1,
            "is_deferrable => 1 not on belongs_to by default";

        ok ((not exists $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{cascade_delete}),
            'belongs_to does not have cascade_delete');

        ok ((not exists $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{cascade_copy}),
            'belongs_to does not have cascade_copy');

        # find on multi-col pk
        my $obj5 = $rsobj5->find({id1 => 1, id2 => 1});
        is( $obj5->id2, 1 );

        # mulit-col fk def
        my $obj6 = $rsobj6->find(1);
        isa_ok( $obj6->loader_test2, $class2);
        isa_ok( $obj6->loader_test5, $class5);

        # fk that references a non-pk key (UNIQUE)
        my $obj8 = $rsobj8->find(1);
        isa_ok( $obj8->loader_test7, $class7);

        # test double-fk 17 ->-> 16
        my $obj17 = $rsobj17->find(33);

        my $rs_rel16_one = $obj17->loader16_one;
        isa_ok($rs_rel16_one, $class16);
        is($rs_rel16_one->dat, 'y16');

        my $rs_rel16_two = $obj17->loader16_two;
        isa_ok($rs_rel16_two, $class16);
        is($rs_rel16_two->dat, 'z16');

        my $obj16 = $rsobj16->find(2);
        my $rs_rel17 = $obj16->search_related('loader_test17_loader16_ones');
        isa_ok($rs_rel17->first, $class17);
        is($rs_rel17->first->id, 3);

        # XXX test m:m 18 <- 20 -> 19

        # XXX test double-fk m:m 21 <- 22 -> 21

        # test double multi-col fk 26 -> 25
        my $obj26 = $rsobj26->find(33);

        my $rs_rel25_one = $obj26->loader_test25_id_rel1;
        isa_ok($rs_rel25_one, $class25);
        is($rs_rel25_one->dat, 'x25');

        my $rs_rel25_two = $obj26->loader_test25_id_rel2;
        isa_ok($rs_rel25_two, $class25);
        is($rs_rel25_two->dat, 'y25');

        my $obj25 = $rsobj25->find(3,42);
        my $rs_rel26 = $obj25->search_related('loader_test26_id_rel1s');
        isa_ok($rs_rel26->first, $class26);
        is($rs_rel26->first->id, 3);

        # from Chisel's tests...
        SKIP: {
            if($self->{vendor} =~ /sqlite/i) {
                skip 'SQLite cannot do the advanced tests', 8;
            }

            my $moniker10 = $monikers->{loader_test10};
            my $class10   = $classes->{loader_test10};
            my $rsobj10   = $conn->resultset($moniker10);