Commit | Line | Data |
c0e7b4e5 |
1 | package # hide from PAUSE |
2 | SQL::Translator::Parser::DBIx::Class; |
b02b20b5 |
3 | |
4 | # AUTHOR: Jess Robinson |
5 | |
1d996af5 |
6 | # Some mistakes the fault of Matt S Trout |
7 | |
b02b20b5 |
8 | use strict; |
9 | use warnings; |
10 | use vars qw($DEBUG $VERSION @EXPORT_OK); |
11 | $DEBUG = 0 unless defined $DEBUG; |
12 | $VERSION = sprintf "%d.%02d", q$Revision 1.0$ =~ /(\d+)\.(\d+)/; |
13 | |
14 | use Exporter; |
15 | use Data::Dumper; |
16 | use SQL::Translator::Utils qw(debug normalize_name); |
17 | |
18 | use base qw(Exporter); |
19 | |
20 | @EXPORT_OK = qw(parse); |
21 | |
22 | # ------------------------------------------------------------------- |
23 | # parse($tr, $data) |
24 | # |
25 | # Note that $data, in the case of this parser, is unuseful. |
26 | # We're working with DBIx::Class Schemas, not data streams. |
27 | # ------------------------------------------------------------------- |
28 | sub parse { |
29 | my ($tr, $data) = @_; |
30 | my $args = $tr->parser_args; |
31 | my $dbixschema = $args->{'DBIx::Schema'} || $data; |
bddbe61c |
32 | $dbixschema ||= $args->{'package'}; |
b02b20b5 |
33 | |
34 | die 'No DBIx::Schema' unless ($dbixschema); |
35 | if (!ref $dbixschema) { |
36 | eval "use $dbixschema;"; |
37 | die "Can't load $dbixschema ($@)" if($@); |
38 | } |
39 | |
40 | my $schema = $tr->schema; |
41 | my $table_no = 0; |
42 | |
43 | # print Dumper($dbixschema->registered_classes); |
44 | |
0009fa49 |
45 | #foreach my $tableclass ($dbixschema->registered_classes) |
46 | foreach my $moniker ($dbixschema->sources) |
b02b20b5 |
47 | { |
0009fa49 |
48 | #eval "use $tableclass"; |
49 | #print("Can't load $tableclass"), next if($@); |
50 | my $source = $dbixschema->source($moniker); |
b02b20b5 |
51 | |
52 | my $table = $schema->add_table( |
53 | name => $source->name, |
54 | type => 'TABLE', |
55 | ) || die $schema->error; |
56 | my $colcount = 0; |
57 | foreach my $col ($source->columns) |
58 | { |
59 | # assuming column_info in dbix is the same as DBI (?) |
60 | # data_type is a number, column_type is text? |
61 | my %colinfo = ( |
62 | name => $col, |
b02b20b5 |
63 | size => 0, |
64 | is_auto_increment => 0, |
65 | is_foreign_key => 0, |
66 | is_nullable => 0, |
67 | %{$source->column_info($col)} |
68 | ); |
0009fa49 |
69 | if ($colinfo{is_nullable}) { |
70 | $colinfo{default} = '' unless exists $colinfo{default}; |
71 | } |
b02b20b5 |
72 | my $f = $table->add_field(%colinfo) || die $table->error; |
73 | } |
74 | $table->primary_key($source->primary_columns); |
75 | |
b02b20b5 |
76 | my @rels = $source->relationships(); |
77 | foreach my $rel (@rels) |
78 | { |
79 | my $rel_info = $source->relationship_info($rel); |
b02b20b5 |
80 | next if(!exists $rel_info->{attrs}{accessor} || |
1d996af5 |
81 | $rel_info->{attrs}{accessor} eq 'multi'); |
82 | # Going by the accessor type isn't such a good idea (yes, I know |
83 | # I suggested it). I think the best way to tell if something's a |
84 | # foreign key constraint is to assume if it doesn't include our |
85 | # primaries then it is (dumb but it'll do). Ignore any rel cond |
86 | # that isn't a straight hash, but get both sets of keys in full |
87 | # so you don't barf on multi-primaries. Oh, and a dog-simple |
88 | # deploy method to chuck the results of this exercise at a db |
89 | # for testing is |
90 | # $schema->storage->dbh->do($_) for split(";\n", $sql); |
91 | # -- mst (03:42 local time, please excuse any mistakes) |
d22bc4e3 |
92 | my $rel_table = $source->related_source($rel)->name; |
b02b20b5 |
93 | my $cond = (keys (%{$rel_info->{cond}}))[0]; |
94 | my ($refkey) = $cond =~ /^\w+\.(\w+)$/; |
2478970c |
95 | my ($key) = $rel_info->{cond}->{$cond} =~ /^\w+\.(\w+)$/; |
b02b20b5 |
96 | if($rel_table && $refkey) |
1d996af5 |
97 | { |
b02b20b5 |
98 | $table->add_constraint( |
99 | type => 'foreign_key', |
2478970c |
100 | name => "fk_${key}", |
101 | fields => $key, |
b02b20b5 |
102 | reference_fields => $refkey, |
103 | reference_table => $rel_table, |
2478970c |
104 | ); |
b02b20b5 |
105 | } |
106 | } |
107 | } |
108 | |
109 | } |
110 | |
111 | 1; |