SQL::Translator::Producer::DBIx::Class::File::Simple - DBIx::Class file producer


SQL-Translator-Producer-DBIx-Class-File-Simple documentation Contained in the SQL-Translator-Producer-DBIx-Class-File-Simple distribution.

Index


Code Index:

NAME

Top

SQL::Translator::Producer::DBIx::Class::File::Simple - DBIx::Class file producer

SYNOPSIS

Top

  use SQL::Translator;

  my $t = SQL::Translator->new( parser => '...', 
                                producer => 'DBIx::Class::File::Simple',
                                no_comments         => 0 );
  print $translator->translate( $file );

Or use it as command:

  sqlt -f DBI --dsn $dsn --db-user $user --db-password $pass -t DBIx::Class::File::Simple --no-comments --prefix=$prefix > $tofile

DESCRIPTION

Top

Creates a DBIx::Class::Schema for use with DBIx::Class

IF no_comments == 0,it won't print detail for columns,whereas if no_comments == 1 ,it will. For most cases,we need not those detail information.


SQL-Translator-Producer-DBIx-Class-File-Simple documentation Contained in the SQL-Translator-Producer-DBIx-Class-File-Simple distribution.

package SQL::Translator::Producer::DBIx::Class::File::Simple;

use strict;
use vars qw[ $VERSION $DEBUG $WARN ];
$VERSION = '0.1';
$DEBUG   = 0 unless defined $DEBUG;

use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(header_comment);

## Skip all column type translation, as we want to use whatever the parser got.

sub produce
{
    my ($translator) = @_;
    $DEBUG             = $translator->debug;
    $WARN              = $translator->show_warnings;
    my $no_comments    = $translator->no_comments;
    my $add_drop_table = $translator->add_drop_table;
    my $schema         = $translator->schema;
    my $output         = '';

    # Steal the XML producers "prefix" arg for our namespace?
    my $dbixschema     = $translator->producer_args()->{prefix} || 
        $schema->name || 'My::Schema';

    my %tt_vars = ();
    $tt_vars{dbixschema} = $dbixschema;

    my $schemaoutput .= << "DATA";

package ${dbixschema};
use base 'DBIx::Class::Schema';
use strict;
use warnings;
DATA

    my %tableoutput = ();
    my %tableextras = ();
    foreach my $table ($schema->get_tables)
    {
        my $tname = $table->name;
        my $uc_tname = my_uc($tname);
        my $output .= qq{

package ${dbixschema}::${uc_tname};
use base 'DBIx::Class';
use strict;
use warnings;

__PACKAGE__->load_components(qw/PK::Auto Core/);
__PACKAGE__->table('${tname}');

};

        my @fields = map 
        { { $_->name  => {
            name              => $_->name,
            is_auto_increment => $_->is_auto_increment,
            is_foreign_key    => $_->is_foreign_key,
            is_nullable       => $_->is_nullable,
            default_value     => $_->default_value,
            data_type         => $_->data_type,
            size              => $_->size,
        } }
         } ($table->get_fields);
        
        if($no_comments){
            $output .= "\n__PACKAGE__->add_columns(qw/";
            foreach my $f (@fields)
            {
                local $Data::Dumper::Terse = 1;
                $output .= (keys %$f)[0] . " ";
            }
            $output .= "/);\n";
        }else{
            $output .= "\n__PACKAGE__->add_columns(";
            foreach my $f (@fields)
            {
                local $Data::Dumper::Terse = 1;
                $output .= "\n    '" . (keys %$f)[0] . "' => " ;
                my $colinfo =
                    Data::Dumper->Dump([values %$f],
                                       [''] # keys   %$f]
                                       );
                chomp($colinfo);
                $output .= $colinfo . ",";
            }
            $output .= "\n);\n";
        }

        my $pk = $table->primary_key;
        if($pk)
        {
            my @pk = map { $_->name } ($pk->fields);
            $output .= "__PACKAGE__->set_primary_key(";
            $output .= "'" . join("', '", @pk) . "');\n";
        }

        foreach my $cont ($table->get_constraints)
        {
            if($cont->type =~ /foreign key/i)
            {
                $tableextras{$table->name} .= "\n__PACKAGE__->belongs_to('" . 
                    $cont->fields->[0]->name . "', '" .
                    "${dbixschema}::" . $cont->reference_table . "');\n";
                
                my $other = "\n__PACKAGE__->has_many('" .
                    "get_" . $table->name. "', '" .
                    "${dbixschema}::" . $table->name. "', '" .
                    $cont->fields->[0]->name . "');";
                $tableextras{$cont->reference_table} .= $other;
            }
        }

        $tableoutput{$table->name} .= $output;
    }

    foreach my $to (keys %tableoutput)
    {
        $output .= $tableoutput{$to};
        $schemaoutput .= "\n__PACKAGE__->register_class('${to}', '${dbixschema}::${to}');\n"; 
    }

    foreach my $te (keys %tableextras)
    {
        $output .= "\npackage ${dbixschema}::$te;\n";
        $output .= $tableextras{$te} . "\n";
    }

    return "${output}\n\n${schemaoutput}\n1;\n";
}

sub my_uc {
    my $table = shift;
    my @pieces = split '_', $table;
    @pieces = map { ucfirst($_) } @pieces;
    $table = join( '', @pieces );
}

1;