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