MySQL-Workbench-DBIC

 view release on metacpan or  search on metacpan

lib/MySQL/Workbench/DBIC.pm  view on Meta::CPAN

    );

    return '' if !-f $path;

    return $self->_custom_code( $path );
}

sub _custom_code {
    my ($self, $path) = @_;

    my $content = do { local (@ARGV, $/) = $path; <> };

    my ($code) = $content =~ m{
        ^[#] \s+ --- \s*
        ^[#] \s+ Put \s+ your \s+ own \s+ code \s+ below \s+ this \s+ comment \s*
        ^[#] \s+ --- \s*
        (.*?) \s+
        ^[#] \s+ --- \s*
    }xms;

    return $code;

t/02_create_scheme.t  view on Meta::CPAN

(my $path = $namespace) =~ s!::!/!;

my $subpath = $output_path . '/' . $path;
ok( -e $subpath , 'Path created' );
ok( -e $subpath . '/DBIC_Schema.pm', 'Schema' );
ok( -e $subpath . '/DBIC_Schema/Result/Gefa_User.pm', 'Gefa_User' );
ok( -e $subpath . '/DBIC_Schema/Result/UserRole.pm', 'UserRole' );
ok( -e $subpath . '/DBIC_Schema/Result/Role.pm', 'Role' );

my $module  = $subpath . '/DBIC_Schema/Result/Role.pm';
my $content = do { local ( @ARGV, $/ ) = $module; <> };
like $content, qr{use base qw\(DBIx::Class\)}, 'Check correct inheritance';
like $content, qr{->load_components\( qw/PK::Auto Core/ \)}, 'Check correct component loading';

my $schema_content = do {
    local ( @ARGV, $/ ) = $subpath . '/DBIC_Schema.pm';
    <>;
};

like $schema_content, qr/->load_namespaces;/;
like $schema_content, qr/Put your own code/;

eval{
    rmtree( $output_path );
    rmdir $output_path;
};

t/08_columns_detailed.t  view on Meta::CPAN

        retrieve_on_insert => 1,
    },
    Rolename => {
        data_type          => 'VARCHAR',
        is_nullable        => 1,
        size               => 45,
    },

);~;

my $content = do{ local (@ARGV, $/) = $role_class; <> };
like $content, qr/\Q$check\E/;

#---

my $user_role_class = $subpath . '/DBIC_Schema/Result/UserRole.pm';

ok -e $user_role_class;

my $user_role_check = q~__PACKAGE__->add_columns(
    UserID => {

t/14_indexes.t  view on Meta::CPAN

(my $path = $namespace) =~ s!::!/!;

my $subpath = $output_path . '/' . $path;
ok( -e $subpath , 'Path ' . $subpath . ' created' );
ok( -e $subpath . '/DBIC_Schema.pm', 'Schema' );
ok( -e $subpath . '/DBIC_Schema/Result/Gefa_User.pm', 'Gefa_User' );
ok( -e $subpath . '/DBIC_Schema/Result/UserRole.pm', 'UserRole' );
ok( -e $subpath . '/DBIC_Schema/Result/Role.pm', 'Role' );

my $content = do{ local (@ARGV, $/) = $subpath . '/DBIC_Schema/Result/UserRole.pm'; <> };
like_string $content, qr/sub sqlt_deploy_hook/;

like_string $content,
    qr/add_index\( \s* 
        type \s*   => \s* "normal", \s*
        name \s*   => \s* "fk_Gefa_User_has_Role_Role1_idx", \s*
        fields \s* => \s* \['RoleID'\]
    /xms;

like_string $content, qr/

t/15_no_indexes.t  view on Meta::CPAN

(my $path = $namespace) =~ s!::!/!;

my $subpath = $output_path . '/' . $path;
ok( -e $subpath , 'Path ' . $subpath . ' created' );
ok( -e $subpath . '/DBIC_Schema.pm', 'Schema' );
ok( -e $subpath . '/DBIC_Schema/Result/Gefa_User.pm', 'Gefa_User' );
ok( -e $subpath . '/DBIC_Schema/Result/UserRole.pm', 'UserRole' );
ok( -e $subpath . '/DBIC_Schema/Result/Role.pm', 'Role' );

my $content = do{ local (@ARGV, $/) = $subpath . '/DBIC_Schema/Result/UserRole.pm'; <> };
unlike_string $content, qr/sqlt_deploy_hook/;

unlike_string $content,
    qr/add_index\( \s* 
        type \s*   => \s* "normal", \s*
        name \s*   => \s* "fk_Gefa_User_has_Role_Role1_idx", \s*
        fields \s* => \s* \['RoleID'\]
    /xms;

done_testing();

t/17_custom_code.t  view on Meta::CPAN

copy $bin . '/DBIC_Schema.pm', $subpath . '/DBIC_Schema.pm' or die $!;

$foo->create_schema;

my $role_class = $result_path . '/Role.pm';

ok -e $role_class;

my $check = qq~print "This is some custom code!";\n# ---~;

my $content = do{ local (@ARGV, $/) = $role_class; <> };
like $content, qr/\Q$check\E/;

my $schema_check = qq~print "This is some custom code!";\n}\n# ---~;
my $schema_content = do { local (@ARGV, $/) = $subpath . '/DBIC_Schema.pm'; <> };
like $schema_content, qr/VERSION = 0.02/;
like $schema_content, qr/\Q$schema_check\E/;

eval{
    rmtree( $output_path );
    rmdir $output_path;
};

done_testing();

t/18_table_comments.t  view on Meta::CPAN

        'passphrase_class' => 'SaltedDigest'
    \\},
    another_phrase => \\{ # A comment in JSON
        data_type          => 'VARCHAR',
        is_nullable        => 1,
        size               => 45,
    \\},

\\);~;

my $content = do{ local (@ARGV, $/) = $role_class; <> };
like $content, qr/$check/;
like $content, qr/__PACKAGE__->load_components\([^\)]+PassphraseColumn/;
like $content, qr/another_phrase => \{ # A comment in JSON/;
like $content, qr/=head1 \s+ DESCRIPTION \s+ A \s+ table \s+ comment \s+ in \s+ JSON/x;

my $comment_table = do { local (@ARGV, $/) = $subpath . '/DBIC_Schema/Result/another_comment.pm'; <> };
like $comment_table, qr/=head1 \s+ DESCRIPTION \s+ In \s+ this \s+ table/x;
like $comment_table, qr/comment_id => \{ # A column comment/;
like $comment_table, qr/comment_text => \{ # A multiline\n\s{22}# comment/;

eval{
    rmtree( $output_path );
    rmdir $output_path;
};

done_testing();

t/19_more_comments.t  view on Meta::CPAN

        'passphrase_class' => 'SaltedDigest'
    \\},
    another_phrase => \\{
        data_type          => 'VARCHAR',
        is_nullable        => 1,
        size               => 45,
    \\},

\\);~;

my $content = do{ local (@ARGV, $/) = $role_class; <> };
like( $content, qr/$check/ );

like $content, qr/__PACKAGE__->load_components\([^\)]+PassphraseColumn/;

eval{
#    rmtree( $output_path );
#    rmdir $output_path;
};

done_testing();

t/20_result_namespaces.t  view on Meta::CPAN

(my $path = $namespace) =~ s!::!/!;

my $subpath = $output_path . '/' . $path;
ok( -e $subpath , 'Path ' . $subpath . ' created' );
ok( -e $subpath . '/DBIC_Schema.pm', 'Schema' );
ok( -e $subpath . '/DBIC_Schema/Core/Result/Gefa_User.pm', 'Gefa_User' );
ok( -e $subpath . '/DBIC_Schema/Core/Result/UserRole.pm', 'UserRole' );
ok( -e $subpath . '/DBIC_Schema/Core/Result/Role.pm', 'Role' );

my $content = do{ local (@ARGV, $/) = $subpath . '/DBIC_Schema/Core/Result/UserRole.pm'; <> };
like_string $content, qr/sqlt_deploy_hook/;

like_string $content,
    qr/add_index\( \s*
        type \s*   => \s* "normal", \s*
        name \s*   => \s* "fk_Gefa_User_has_Role_Role1_idx", \s*
        fields \s* => \s* \['RoleID'\]
    /xms;

my $schema_content = do{ local (@ARGV, $/) = $subpath . '/DBIC_Schema.pm'; <> };
like_string $schema_content, qr/result_namespace => 'Core::Result',/, 'load_namespace set';

done_testing();

sub rmtree{
    my ($path) = @_;
    opendir my $dir, $path or die $!;
    while( my $entry = readdir $dir ){
        next if $entry =~ /^\.?\.$/;
        my $file = File::Spec->catfile( $path, $entry );

t/21_inherit_from_core.t  view on Meta::CPAN

        'passphrase_class' => 'SaltedDigest'
    \\},
    another_phrase => \\{ # A comment in JSON
        data_type          => 'VARCHAR',
        is_nullable        => 1,
        size               => 45,
    \\},

\\);~;

my $content = do{ local (@ARGV, $/) = $role_class; <> };
like( $content, qr/$check/ );

like $content, qr/use base qw\(DBIx::Class::Core\);/, 'inherit from DBIx::Class::Core';
like $content, qr/__PACKAGE__->load_components\([^\)]+PassphraseColumn/;

eval{
    rmtree( $output_path );
    rmdir $output_path;
};

t/22_custom_code_lc_uppercase.t  view on Meta::CPAN

(my $path = $namespace) =~ s!::!/!;

my $subpath = $output_path . '/' . $path;
my $role_class = $subpath . '/DBIC_Schema/Result/Role.pm';

ok -e $role_class;

my $check = q~print "This is some custom code!";~;

my $content = do{ local (@ARGV, $/) = $role_class; <> };
like $content, qr/\Q$check\E/;

eval{
    rmtree( $output_path );
    rmdir $output_path;
};

done_testing();

sub rmtree{

t/25_multi_result_namespaces.t  view on Meta::CPAN

(my $path = $namespace) =~ s!::!/!;

my $subpath = $output_path . '/' . $path;
ok( -e $subpath , 'Path ' . $subpath . ' created' );
ok( -e $subpath . '/DBIC_Schema.pm', 'Schema' );
ok( -e $subpath . '/DBIC_Schema/Core/Result/Gefa_User.pm', 'Gefa_User' );
ok( -e $subpath . '/DBIC_Schema/Core/Result/UserRole.pm', 'UserRole' );
ok( -e $subpath . '/DBIC_Schema/Core/Result/Role.pm', 'Role' );

my $content = do{ local (@ARGV, $/) = $subpath . '/DBIC_Schema/Core/Result/UserRole.pm'; <> };
like_string $content, qr/sqlt_deploy_hook/;

like_string $content,
    qr/add_index\( \s*
        type \s*   => \s* "normal", \s*
        name \s*   => \s* "fk_Gefa_User_has_Role_Role1_idx", \s*
        fields \s* => \s* \['RoleID'\]
    /xms;

my $schema_content = do{ local (@ARGV, $/) = $subpath . '/DBIC_Schema.pm'; <> };
like_string $schema_content, qr/result_namespace => \['Core::Result', 'Test', 'Virtual'\],/, 'load_namespace set';
like_string $schema_content, qr/resultset_namespace => \['Test', 'Virtual'\],/, 'load_namespace set';

done_testing();

sub rmtree{
    my ($path) = @_;
    opendir my $dir, $path or die $!;
    while( my $entry = readdir $dir ){
        next if $entry =~ /^\.?\.$/;

t/26_single_load_namespace.t  view on Meta::CPAN

(my $path = $namespace) =~ s!::!/!;

my $subpath = $output_path . '/' . $path;
ok( -e $subpath , 'Path ' . $subpath . ' created' );
ok( -e $subpath . '/DBIC_Schema.pm', 'Schema' );
ok( -e $subpath . '/DBIC_Schema/Core/Result/Gefa_User.pm', 'Gefa_User' );
ok( -e $subpath . '/DBIC_Schema/Core/Result/UserRole.pm', 'UserRole' );
ok( -e $subpath . '/DBIC_Schema/Core/Result/Role.pm', 'Role' );

my $content = do{ local (@ARGV, $/) = $subpath . '/DBIC_Schema/Core/Result/UserRole.pm'; <> };
like_string $content, qr/sqlt_deploy_hook/;

like_string $content,
    qr/add_index\( \s*
        type \s*   => \s* "normal", \s*
        name \s*   => \s* "fk_Gefa_User_has_Role_Role1_idx", \s*
        fields \s* => \s* \['RoleID'\]
    /xms;

my $schema_content = do{ local (@ARGV, $/) = $subpath . '/DBIC_Schema.pm'; <> };
like_string $schema_content, qr/result_namespace => \['Core::Result', 'Virtual'\],/, 'load_namespace set';
like_string $schema_content, qr/resultset_namespace => 'Virtual',/, 'load_namespace set';

done_testing();

sub rmtree{
    my ($path) = @_;
    opendir my $dir, $path or die $!;
    while( my $entry = readdir $dir ){
        next if $entry =~ /^\.?\.$/;

t/27_detect_double_namespaces.t  view on Meta::CPAN

(my $path = $namespace) =~ s!::!/!;

my $subpath = $output_path . '/' . $path;
ok( -e $subpath , 'Path ' . $subpath . ' created' );
ok( -e $subpath . '/DBIC_Schema.pm', 'Schema' );
ok( -e $subpath . '/DBIC_Schema/Core/Result/Gefa_User.pm', 'Gefa_User' );
ok( -e $subpath . '/DBIC_Schema/Core/Result/UserRole.pm', 'UserRole' );
ok( -e $subpath . '/DBIC_Schema/Core/Result/Role.pm', 'Role' );

my $content = do{ local (@ARGV, $/) = $subpath . '/DBIC_Schema/Core/Result/UserRole.pm'; <> };
like_string $content, qr/sqlt_deploy_hook/;

like_string $content,
    qr/add_index\( \s*
        type \s*   => \s* "normal", \s*
        name \s*   => \s* "fk_Gefa_User_has_Role_Role1_idx", \s*
        fields \s* => \s* \['RoleID'\]
    /xms;

my $schema_content = do{ local (@ARGV, $/) = $subpath . '/DBIC_Schema.pm'; <> };
#diag $schema_content;
like_string $schema_content, qr/result_namespace => \['Test', 'Virtual', 'Core::Result'\],/, 'load_namespace set';
like_string $schema_content, qr/resultset_namespace => \['Test', 'Virtual', 'Core::Result'\],/, 'load_namespace set';

done_testing();

sub rmtree{
    my ($path) = @_;
    opendir my $dir, $path or die $!;
    while( my $entry = readdir $dir ){

t/28_flags_and_constraints.t  view on Meta::CPAN

$foo->create_schema;

(my $path = $namespace) =~ s!::!/!;

my $subpath = $output_path . '/' . $path;
ok( -e $subpath , 'Path ' . $subpath . ' created' );
ok( -e $subpath . '/DBIC_Schema.pm', 'Schema' );
ok( -e $subpath . '/DBIC_Schema/Result/role.pm', 'Role' );

my $content = do{ local (@ARGV, $/) = $subpath . '/DBIC_Schema/Result/role.pm'; <> };

like_string $content, qr{>add_unique_constraint\(\s*
    Rolename_UNIQUE \s+ => \s+ \[qw/Rolename/\]
}xms;

like_string $content, qr{
    RoleID \s+ => .*?
        extra \s+ => \s+ \{ \s*
            unsigned \s+ => \s+ 1, \s*
            zerofill \s+ => \s+ 1 \s*

t/40_views.t  view on Meta::CPAN

my $subpath = $output_path . '/' . $path;
ok( -e $subpath , 'Path created' );
ok( -e $subpath . '/DBIC_Schema.pm', 'Schema' );
ok( -e $subpath . '/DBIC_Schema/Result/table1.pm', 'table1' );
ok( -e $subpath . '/DBIC_Schema/Result/table2.pm', 'table2' );
ok( -e $subpath . '/DBIC_Schema/Result/view1.pm', 'view1' );
ok( -e $subpath . '/DBIC_Schema/Result/view2.pm', 'view2' );

my $module  = $subpath . '/DBIC_Schema/Result/view2.pm';
my $content = do { local ( @ARGV, $/ ) = $module; <> };

like $content, qr{__PACKAGE__->table_class\('DBIx::Class::ResultSource::View'\);}, 'view result source';
like $content, qr{__PACKAGE__->result_source_instance->view_definition\(}, 'definition';
like $content, qr{
 CREATE \s+ VIEW \s+ `view2` \s+ AS \s+
    SELECT \s+ table1.cidr, \s+ col2, \s+ col3 \s+
    FROM \s+ table1 \s+
        INNER \s+ JOIN \s+ table2 \s+
            ON \s+ table1.cidr \s+ = \s+ table2.cidr;
}x, "SQL definition";

 view all matches for this distribution
 view release on metacpan -  search on metacpan