Commit | Line | Data |
b02b20b5 |
1 | package SQL::Translator::Parser::DBIx::Class; |
2 | |
3 | # AUTHOR: Jess Robinson |
4 | |
5 | use strict; |
6 | use warnings; |
7 | use vars qw($DEBUG $VERSION @EXPORT_OK); |
8 | $DEBUG = 0 unless defined $DEBUG; |
9 | $VERSION = sprintf "%d.%02d", q$Revision 1.0$ =~ /(\d+)\.(\d+)/; |
10 | |
11 | use Exporter; |
12 | use Data::Dumper; |
13 | use SQL::Translator::Utils qw(debug normalize_name); |
14 | |
15 | use base qw(Exporter); |
16 | |
17 | @EXPORT_OK = qw(parse); |
18 | |
19 | # ------------------------------------------------------------------- |
20 | # parse($tr, $data) |
21 | # |
22 | # Note that $data, in the case of this parser, is unuseful. |
23 | # We're working with DBIx::Class Schemas, not data streams. |
24 | # ------------------------------------------------------------------- |
25 | sub parse { |
26 | my ($tr, $data) = @_; |
27 | my $args = $tr->parser_args; |
28 | my $dbixschema = $args->{'DBIx::Schema'} || $data; |
29 | |
30 | die 'No DBIx::Schema' unless ($dbixschema); |
31 | if (!ref $dbixschema) { |
32 | eval "use $dbixschema;"; |
33 | die "Can't load $dbixschema ($@)" if($@); |
34 | } |
35 | |
36 | my $schema = $tr->schema; |
37 | my $table_no = 0; |
38 | |
39 | # print Dumper($dbixschema->registered_classes); |
40 | |
41 | foreach my $tableclass ($dbixschema->registered_classes) |
42 | { |
43 | eval "use $tableclass"; |
44 | print("Can't load $tableclass"), next if($@); |
45 | my $source = $tableclass->result_source_instance; |
46 | |
47 | my $table = $schema->add_table( |
48 | name => $source->name, |
49 | type => 'TABLE', |
50 | ) || die $schema->error; |
51 | my $colcount = 0; |
52 | foreach my $col ($source->columns) |
53 | { |
54 | # assuming column_info in dbix is the same as DBI (?) |
55 | # data_type is a number, column_type is text? |
56 | my %colinfo = ( |
57 | name => $col, |
58 | default_value => '', |
59 | size => 0, |
60 | is_auto_increment => 0, |
61 | is_foreign_key => 0, |
62 | is_nullable => 0, |
63 | %{$source->column_info($col)} |
64 | ); |
65 | my $f = $table->add_field(%colinfo) || die $table->error; |
66 | } |
67 | $table->primary_key($source->primary_columns); |
68 | |
69 | |
70 | my @rels = $source->relationships(); |
71 | foreach my $rel (@rels) |
72 | { |
73 | my $rel_info = $source->relationship_info($rel); |
74 | print "Accessor: $rel_info->{attrs}{accessor}\n"; |
75 | next if(!exists $rel_info->{attrs}{accessor} || |
76 | $rel_info->{attrs}{accessor} ne 'filter'); |
77 | my $rel_table = $source->related_source($rel)->name; # rel_info->{class}->table(); |
78 | my $cond = (keys (%{$rel_info->{cond}}))[0]; |
79 | my ($refkey) = $cond =~ /^\w+\.(\w+)$/; |
80 | if($rel_table && $refkey) |
81 | { |
82 | $table->add_constraint( |
83 | type => 'foreign_key', |
84 | name => "fk_${rel}_id", |
85 | fields => $rel, |
86 | reference_fields => $refkey, |
87 | reference_table => $rel_table, |
88 | ); |
89 | } |
90 | } |
91 | } |
92 | |
93 | } |
94 | |
95 | 1; |