1package SQL::Translator::Producer::DBIx::Class::File; 2 3=head1 NAME 4 5SQL::Translator::Producer::DBIx::Class::File - DBIx::Class file producer 6 7=head1 SYNOPSIS 8 9 use SQL::Translator; 10 11 my $t = SQL::Translator->new( parser => '...', 12 producer => 'DBIx::Class::File' ); 13 print $translator->translate( $file ); 14 15=head1 DESCRIPTION 16 17Creates a DBIx::Class::Schema for use with DBIx::Class 18 19=cut 20 21use strict; 22use vars qw[ $VERSION $DEBUG $WARN ]; 23$VERSION = '0.1'; 24$DEBUG = 0 unless defined $DEBUG; 25 26use SQL::Translator::Schema::Constants; 27use SQL::Translator::Utils qw(header_comment); 28use Data::Dumper (); 29 30## Skip all column type translation, as we want to use whatever the parser got. 31 32## Translate parsers -> PK::Auto::Foo, however 33 34my %parser2PK = ( 35 MySQL => 'PK::Auto::MySQL', 36 PostgreSQL => 'PK::Auto::Pg', 37 DB2 => 'PK::Auto::DB2', 38 Oracle => 'PK::Auto::Oracle', 39 ); 40 41sub produce 42{ 43 my ($translator) = @_; 44 $DEBUG = $translator->debug; 45 $WARN = $translator->show_warnings; 46 my $no_comments = $translator->no_comments; 47 my $add_drop_table = $translator->add_drop_table; 48 my $schema = $translator->schema; 49 my $output = ''; 50 51 # Steal the XML producers "prefix" arg for our namespace? 52 my $dbixschema = $translator->producer_args()->{prefix} || 53 $schema->name || 'My::Schema'; 54 my $pkclass = $parser2PK{$translator->parser_type} || ''; 55 56 my %tt_vars = (); 57 $tt_vars{dbixschema} = $dbixschema; 58 $tt_vars{pkclass} = $pkclass; 59 60 my $schemaoutput .= << "DATA"; 61 62package ${dbixschema}; 63use base 'DBIx::Class::Schema'; 64use strict; 65use warnings; 66DATA 67 68 my %tableoutput = (); 69 my %tableextras = (); 70 foreach my $table ($schema->get_tables) 71 { 72 my $tname = $table->name; 73 my $output .= qq{ 74 75package ${dbixschema}::${tname}; 76use base 'DBIx::Class'; 77use strict; 78use warnings; 79 80__PACKAGE__->load_components(qw/${pkclass} Core/); 81__PACKAGE__->table('${tname}'); 82 83}; 84 85 my @fields = map 86 { { $_->name => { 87 name => $_->name, 88 is_auto_increment => $_->is_auto_increment, 89 is_foreign_key => $_->is_foreign_key, 90 is_nullable => $_->is_nullable, 91 default_value => $_->default_value, 92 data_type => $_->data_type, 93 size => $_->size, 94 } } 95 } ($table->get_fields); 96 97 $output .= "\n__PACKAGE__->add_columns("; 98 foreach my $f (@fields) 99 { 100 local $Data::Dumper::Terse = 1; 101 $output .= "\n '" . (keys %$f)[0] . "' => " ; 102 my $colinfo = 103 Data::Dumper->Dump([values %$f], 104 [''] # keys %$f] 105 ); 106 chomp($colinfo); 107 $output .= $colinfo . ","; 108 } 109 $output .= "\n);\n"; 110 111 my $pk = $table->primary_key; 112 if($pk) 113 { 114 my @pk = map { $_->name } ($pk->fields); 115 $output .= "__PACKAGE__->set_primary_key("; 116 $output .= "'" . join("', '", @pk) . "');\n"; 117 } 118 119 foreach my $cont ($table->get_constraints) 120 { 121# print Data::Dumper::Dumper($cont->type); 122 if($cont->type =~ /foreign key/i) 123 { 124# $output .= "\n__PACKAGE__->belongs_to('" . 125# $cont->fields->[0]->name . "', '" . 126# "${dbixschema}::" . $cont->reference_table . "');\n"; 127 128 $tableextras{$table->name} .= "\n__PACKAGE__->belongs_to('" . 129 $cont->fields->[0]->name . "', '" . 130 "${dbixschema}::" . $cont->reference_table . "');\n"; 131 132 my $other = "\n__PACKAGE__->has_many('" . 133 "get_" . $table->name. "', '" . 134 "${dbixschema}::" . $table->name. "', '" . 135 $cont->fields->[0]->name . "');"; 136 $tableextras{$cont->reference_table} .= $other; 137 } 138 } 139 140 $tableoutput{$table->name} .= $output; 141 } 142 143 foreach my $to (keys %tableoutput) 144 { 145 $output .= $tableoutput{$to}; 146 $schemaoutput .= "\n__PACKAGE__->register_class('${to}', '${dbixschema}::${to}');\n"; 147 } 148 149 foreach my $te (keys %tableextras) 150 { 151 $output .= "\npackage ${dbixschema}::$te;\n"; 152 $output .= $tableextras{$te} . "\n"; 153# $tableoutput{$te} .= $tableextras{$te} . "\n"; 154 } 155 156# print "$output\n"; 157 return "${output}\n\n${schemaoutput}\n1;\n"; 158} 159