view release on metacpan or  search on metacpan

lib/Bigtop/Backend/Model/GantryCDBI.pm  view on Meta::CPAN

        TT                  => $template_text,
        POST_CHOMP          => 1,
        TRIM_LEADING_SPACE  => 0,
        TRIM_TRAILING_SPACE => 0,
    );

    $template_is_setup = 1;
}

sub gen_Model {
    my $class       = shift;
    my $build_dir   = shift;
    my $bigtop_tree = shift;

    # make sure the directories are ready for us
    my $model_name    = $bigtop_tree->get_appname() . '::Model';

    my ( $module_dir, @sub_dirs )
                      = Bigtop::make_module_path( $build_dir, $model_name );

    my $gen_dir       = File::Spec->catdir( $module_dir, 'GEN' );

    mkdir $gen_dir;

    # see if there is an alternate default base module
    my $config_block  = $bigtop_tree->get_config()->{ Model };

    # build the individual model packages
    $bigtop_tree->walk_postorder(
        'output_model',
        {
            module_dir       => $module_dir,
            model_name       => $model_name,
            lookup           => $bigtop_tree->{application}{lookup},
            model_base_class => $config_block->{model_base_class}
                                    || 'Gantry::Utils::CDBI',
        },
    );

}

#-----------------------------------------------------------------
#   Packages named in the grammar
#-----------------------------------------------------------------

# table_block
package # table_block
    table_block;
use strict; use warnings;

sub output_model {
    my $self         = shift;
    my $child_output = shift;
    my $data         = shift;

    # Skip sequences, etc.
    return unless ( $self->{__TYPE__} eq 'tables' );

    my $table_lookup = $data->{lookup}{tables}{ $self->{__NAME__} };

    if ( $table_lookup->{not_for} ) {
        foreach my $skipped_type ( @{ $table_lookup->{not_for}{__ARGS__} } ) {
            return if ( $skipped_type eq 'Model' );
        }
    }

    # get columns sets
    my $lookup       = $table_lookup->{fields};

    my $all        = $self->walk_postorder(
            'output_all_fields_cdbi', $lookup
    );
    my $essentials = $self->walk_postorder(
            'output_essential_fields_cdbi', $lookup
    );

    # deal with foreign keys
    my $foreign_tables = $self->walk_postorder(
            'output_foreign_tables_cdbi',       $lookup
    );

    my @foreign_table_names;
    my @has_a_list;

    foreach my $entry ( @{ $foreign_tables } ) {
        my $entry_hash    = { @{ $entry } };

        my $foreign_table = $entry_hash->{ table };
        $foreign_table    =~ s/\./_/;

        push @foreign_table_names, $foreign_table;

        push @has_a_list, {
            table  => $foreign_table,
            column => $entry_hash->{ column },
        };
    }

    # Gone Fishing.
    my $table           = $self->{__NAME__};
    $table              =~ s/\./_/;
    my $module_name     = $data->{model_name} . '::' . $table;
    my $gen_pack_name   = $data->{model_name} . '::GEN::' . $table;
    my $alias           = uc $table;
    my $sequence        = $table_lookup->{sequence};
    my $foreign_display = $table_lookup->{foreign_display};

    my $sequence_name;

    if ( $sequence ) {
        $sequence_name = $sequence->{__ARGS__}[0];
    }

    my $primary_key = $self->find_primary_key(
            $self->{__NAME__},
            $data->{ lookup },
    );

    my $foreign_display_columns;
    my $foreign_display_body;

    if ( $foreign_display ) {

lib/Bigtop/Backend/Model/GantryCDBI.pm  view on Meta::CPAN

            base_class              => $base_class,
            base_class_default      => $data->{model_base_class},
            base_package_name       => $data->{model_name},
            gen_package_name        => $gen_pack_name,
            package_name            => $module_name,
            package_alias           => $alias,
            table_name              => $table,
        }
    );

    my $gen_content = Bigtop::Backend::Model::GantryCDBI::gen_table_module(
        {
            base_package_name       => $data->{model_name},
            package_name            => $module_name,
            gen_package_name        => $gen_pack_name,
            package_alias           => $alias,
            table_name              => $table,
            real_table_name         => $self->{__NAME__},
            sequence_name           => $sequence_name,
            primary_key             => $primary_key,
            foreign_display_columns => $foreign_display_columns,
            foreign_display_body    => $foreign_display_body,
            all_columns             => $all,
            essential_columns       => $essentials,
            has_a_list              => \@has_a_list,
            foreign_tables          => \@foreign_table_names,
        }
    );

    # store it
    my $module_file = File::Spec->catfile( $data->{module_dir}, "$table.pm" );
    my $gen_dir     = File::Spec->catdir ( $data->{module_dir}, 'GEN' );
    my $gen_file    = File::Spec->catfile( $gen_dir, "$table.pm" );

    eval {
        no warnings qw( Bigtop );
        Bigtop::write_file( $module_file, $stub_content, 'no overwrite' );
    };
    warn $@ if $@;

    eval {
        Bigtop::write_file( $gen_file, $gen_content );
    };
    warn $@ if $@;
}

# table_element_block
package # table_element_block
    table_element_block;
use strict; use warnings;

sub output_all_fields_cdbi {
    my $self         = shift;
    shift;
    my $data         = shift;

    return unless ( ref( $self->{__BODY__} ) );

    my $field  = $data->{ $self->{__NAME__} };

    return if ( _not_for_model( $field ) );

    return [ $self->{__NAME__} ];
}

sub output_essential_fields_cdbi {
    my $self         = shift;
    shift;
    my $data         = shift;

    return unless ( ref( $self->{__BODY__} ) );

    my $field  = $data->{ $self->{__NAME__} };

    if ( $field->{non_essential} ) {
        my $non_essential_value = $field->{non_essential}{args}[0];

        return if ( $non_essential_value );
    }

    return if ( _not_for_model( $field ) );

    return [ $self->{__NAME__} ];
}

sub output_foreign_tables_cdbi {
    my $self         = shift;
    shift;
    my $data         = shift;

    return unless ( ref( $self->{__BODY__} ) );

    my $field  = $data->{ $self->{__NAME__} };

    if ( $field->{refers_to} ) {
        my $foreign_table_name = $field->{refers_to}{args}[0];

        if ( ref( $foreign_table_name ) eq 'HASH' ) {
            ( $foreign_table_name ) = %{ $foreign_table_name };
        }

        return [
            [ column => $self->{__NAME__}, table => $foreign_table_name ]
        ];
    }
    return;
}

1;

__END__

=head1 NAME

Bigtop::Backend::Model::GantryCDBI - Bigtop backend generating Class::DBI::Sweet models

=head1 SYNOPSIS

If your bigtop file looks like this:

    config {
        base_dir `/home/user`;
        ...
        Model GantryCDBI {}
    }
    app Name {...}

and there are tables in the app block, when you type:

    bigtop your.bigtop Model

or
    bigtop your.bigtop all

this module will make model modules which are subclasses of
Gantry::Utils::CDBI (which inherits from Class::DBI::Sweet in a
mod_perl safe way).

All modules will live in the lib subdirectory of the app's build directory.
See Bigtop::Init::Std for an explanation of how base_dir and the
build directory are related.