view release on metacpan or  search on metacpan

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

        my $moniker44 = $monikers->{loader_test44};
        my $class44   = $classes->{loader_test44};
        my $rsobj44   = $conn->resultset($moniker44);

        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" );
        isa_ok( $rsobj27, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj28, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj29, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj31, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj32, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj33, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj34, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj36, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj37, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj42, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj43, "DBIx::Class::ResultSet" );
        isa_ok( $rsobj44, "DBIx::Class::ResultSet" );

        # basic rel test
        my $obj4 = try { $rsobj4->find(123) } || $rsobj4->search({ id => 123 })->single;
        isa_ok( try { $obj4->fkid_singular }, $class3);

        # test renaming rel that conflicts with a class method
        ok ($obj4->has_relationship('belongs_to_rel'), 'relationship name that conflicts with a method renamed');

        isa_ok( try { $obj4->belongs_to_rel }, $class3);

        ok ($obj4->has_relationship('caught_rel_collision_set_primary_key'),
            'relationship name that conflicts with a method renamed based on rel_collision_map');
        isa_ok( try { $obj4->caught_rel_collision_set_primary_key }, $class3);

        ok($class4->column_info('fkid')->{is_foreign_key}, 'Foreign key detected');

        my $obj3 = try { $rsobj3->find(1) } || $rsobj3->search({ id => 1 })->single;
        my $rs_rel4 = try { $obj3->search_related('loader_test4zes') };
        isa_ok( try { $rs_rel4->single }, $class4);

        # check rel naming with prepositions
        ok ($rsobj4->result_source->has_relationship('loader_test5s_to'),
            "rel with preposition 'to' pluralized correctly");

        ok ($rsobj4->result_source->has_relationship('loader_test5s_from'),
            "rel with preposition 'from' pluralized correctly");

        # check default relationship attributes
        is try { $rsobj3->result_source->relationship_info('loader_test4zes')->{attrs}{cascade_delete} }, 0,
            'cascade_delete => 0 on has_many by default';

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

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

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

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

        my $default_on_clause = $self->{default_on_clause} || 'CASCADE';

        my $default_on_delete_clause = $self->{default_on_delete_clause} || $default_on_clause;

        is try { $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_delete} },
            $default_on_delete_clause,
            "on_delete is $default_on_delete_clause on belongs_to by default";

        my $default_on_update_clause = $self->{default_on_update_clause} || $default_on_clause;

        is try { $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{on_update} },
            $default_on_update_clause,
            "on_update is $default_on_update_clause on belongs_to by default";

        my $default_is_deferrable = $self->{default_is_deferrable};

        $default_is_deferrable = 1
            if not defined $default_is_deferrable;

        is try { $rsobj4->result_source->relationship_info('fkid_singular')->{attrs}{is_deferrable} },
            $default_is_deferrable,
            "is_deferrable => $default_is_deferrable on belongs_to by default";

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

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

        is try { $rsobj27->result_source->relationship_info('loader_test28')->{attrs}{cascade_delete} }, 0,
            'cascade_delete => 0 on might_have by default';

        is try { $rsobj27->result_source->relationship_info('loader_test28')->{attrs}{cascade_copy} }, 0,
            'cascade_copy => 0 on might_have by default';

        ok ((not try { exists $rsobj27->result_source->relationship_info('loader_test28')->{attrs}{on_delete} }),
            'might_have does not have on_delete');

        ok ((not try { exists $rsobj27->result_source->relationship_info('loader_test28')->{attrs}{on_update} }),
            'might_have does not have on_update');

        ok ((not try { exists $rsobj27->result_source->relationship_info('loader_test28')->{attrs}{is_deferrable} }),
            'might_have does not have is_deferrable');

        # find on multi-col pk
        if ($conn->loader->preserve_case) {
            my $obj5 = $rsobj5->find({id1 => 1, iD2 => 1});
            is $obj5->i_d2, 1, 'Find on multi-col PK';
        }
        else {
            my $obj5 = $rsobj5->find({id1 => 1, id2 => 1});
            is $obj5->id2, 1, 'Find on multi-col PK';
        }

        # mulit-col fk def
        my $obj6 = try { $rsobj6->find(1) } || $rsobj6->search({ id => 1 })->single;
        isa_ok( try { $obj6->loader_test2 }, $class2);
        isa_ok( try { $obj6->loader_test5 }, $class5);

        ok($class6->column_info('loader_test2_id')->{is_foreign_key}, 'Foreign key detected');
        ok($class6->column_info('id')->{is_foreign_key}, 'Foreign key detected');

        my $id2_info = try { $class6->column_info('id2') } ||
            $class6->column_info('Id2');
        ok($id2_info->{is_foreign_key}, 'Foreign key detected');

        unlike slurp_file $conn->_loader->get_dump_filename($class6),
            qr{
                \n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
                \s+ "(\w+?)"
                .*?
                \n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
                \s+ "\1"
            }xs,
            'did not create two relationships with the same name';

        unlike slurp_file $conn->_loader->get_dump_filename($class8),
            qr{
                \n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
                \s+ "(\w+?)"
                .*?
                \n__PACKAGE__->(?:belongs_to|has_many|might_have|has_one|many_to_many)\(
                \s+ "\1"
            }xs,
            'did not create two relationships with the same name';

        # check naming of ambiguous relationships
        my $rel_info = $class6->relationship_info('lovely_loader_test7') || {};

        ok (($class6->has_relationship('lovely_loader_test7')
            && $rel_info->{cond}{'foreign.lovely_loader_test6'} eq 'self.id'
            && $rel_info->{class} eq $class7
            && $rel_info->{attrs}{accessor} eq 'single'),
            'ambiguous relationship named correctly');