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