Commit | Line | Data |
0caaf4c3 |
1 | package SQL::Translator::Schema::Graph; |
2 | |
3 | use strict; |
4 | |
4b5c50b9 |
5 | use base 'Class::Base'; |
6 | |
ba506e52 |
7 | use vars qw[ $VERSION ]; |
8 | $VERSION = '1.60'; |
0caaf4c3 |
9 | |
ba506e52 |
10 | use Data::Dumper; |
0caaf4c3 |
11 | use SQL::Translator::Schema::Graph::Node; |
12 | use SQL::Translator::Schema::Graph::Edge; |
13 | use SQL::Translator::Schema::Graph::Port; |
14 | use SQL::Translator::Schema::Graph::CompoundEdge; |
15 | use SQL::Translator::Schema::Graph::HyperEdge; |
ba506e52 |
16 | use Readonly; |
0caaf4c3 |
17 | |
ba506e52 |
18 | local $Data::Dumper::Maxdepth = 3; |
19 | |
20 | Readonly my $Node => 'SQL::Translator::Schema::Graph::Node'; |
21 | Readonly my $Edge => 'SQL::Translator::Schema::Graph::Edge'; |
22 | Readonly my $Port => 'SQL::Translator::Schema::Graph::Port'; |
23 | Readonly my $CompoundEdge => 'SQL::Translator::Schema::Graph::CompoundEdge'; |
24 | Readonly my $HyperEdge => 'SQL::Translator::Schema::Graph::HyperEdge'; |
0caaf4c3 |
25 | |
26 | use Class::MakeMethods::Template::Hash ( |
ba506e52 |
27 | 'new --and_then_init' => 'new', |
28 | object => [ 'translator' => { class => 'SQL::Translator' }, ], |
29 | 'hash' => [qw( node )], |
30 | 'number --counter' => [qw( order )], |
0caaf4c3 |
31 | ); |
32 | |
4b5c50b9 |
33 | use vars qw/$DEBUG/; |
34 | $DEBUG = 0 unless defined $DEBUG; |
35 | |
0caaf4c3 |
36 | sub init { |
ba506e52 |
37 | my $self = shift; |
38 | |
39 | # |
40 | # build package objects |
41 | # |
42 | for my $table ( $self->translator->schema->get_tables ) { |
43 | die __PACKAGE__ |
44 | . " table " |
45 | . $table->name |
46 | . " doesn't have a primary key!" |
47 | unless $table->primary_key; |
48 | die __PACKAGE__ |
49 | . " table " |
50 | . $table->name |
51 | . " can't have a composite primary key!" |
52 | if ( $table->primary_key->fields )[1]; |
53 | |
54 | my $node = $Node->new(); |
55 | |
56 | $self->node_push( $table->name => $node ); |
57 | |
58 | if ( $table->is_trivial_link ) { $node->is_trivial_link(1); } |
59 | else { $node->is_trivial_link(0); } |
60 | |
61 | $node->order( $self->order_incr() ); |
62 | $node->name( $self->translator->format_package_name( $table->name ) ); |
63 | $node->table($table); |
64 | $node->primary_key( ( $table->primary_key->fields )[0] ); |
65 | |
66 | # Primary key may have a differenct accessor method name |
67 | $node->primary_key_accessor( |
68 | defined( $self->translator->format_pk_name ) |
69 | ? $self->translator->format_pk_name->( |
70 | $node->name, $node->primary_key |
71 | ) |
72 | : undef |
73 | ); |
74 | } |
75 | |
76 | for my $node ( $self->node_values ) { |
77 | for my $field ( $node->table->get_fields ) { |
78 | if ( !$field->is_foreign_key && !$field->is_primary_key ) { |
79 | $node->data_fields->{ $field->name } = 1; |
80 | } |
81 | elsif ( $field->is_foreign_key ) { |
82 | my $that = |
83 | $self->node( $field->foreign_key_reference->reference_table ); |
84 | |
85 | #this means we have an incomplete schema |
86 | next unless $that; |
87 | |
88 | my $edge = $Edge->new( |
89 | type => 'import', |
90 | thisnode => $node, |
91 | thisfield => $field, |
92 | thatnode => $that, |
93 | |
94 | #can you believe this sh*t just to get a field obj? |
95 | thatfield => $self->translator->schema->get_table( |
96 | $field->foreign_key_reference->reference_table |
97 | )->get_field( |
98 | ( $field->foreign_key_reference->reference_fields )[0] |
99 | ) |
100 | ); |
101 | |
102 | $node->edgecount( $that->name, |
103 | $node->edgecount( $that->name ) + 1 ); |
104 | |
105 | $node->has( $that->name, $node->has( $that->name ) + 1 ); |
106 | $that->many( $node->name, $that->many( $node->name ) + 1 ); |
107 | |
108 | $that->edgecount( $node->name, |
109 | $that->edgecount( $node->name ) + 1 ); |
110 | |
111 | #warn "\t" . $node->name . "\t" . $node->edgecount($that->name); |
112 | $node->push_edges($edge); |
113 | $that->push_edges( $edge->flip ); |
114 | } |
115 | } |
116 | } |
117 | |
118 | # |
119 | # type MM relationships |
120 | # |
121 | #for linknode |
122 | for my $lnode ( sort $self->node_values ) { |
123 | next if $lnode->table->is_data; |
124 | for my $inode1 ( sort $self->node_values ) { |
125 | |
126 | #linknode can't link to itself |
127 | next if $inode1 eq $lnode; |
128 | |
129 | my @inode1_imports = |
130 | grep { $_->type eq 'import' and $_->thatnode eq $inode1 } |
131 | $lnode->edges; |
132 | next unless @inode1_imports; |
133 | |
134 | for my $inode2 ( sort $self->node_values ) { |
135 | |
136 | #linknode can't link to itself |
137 | next if $inode2 eq $lnode; |
138 | |
139 | #identify tables that import keys to linknode |
140 | my %i = |
141 | map { $_->thatnode->name => 1 } |
142 | grep { $_->type eq 'import' } $lnode->edges; |
143 | |
144 | if ( scalar( keys %i ) == 1 ) { |
145 | } |
146 | else { |
147 | last if $inode1 eq $inode2; |
148 | } |
149 | |
150 | my @inode2_imports = |
151 | grep { $_->type eq 'import' and $_->thatnode eq $inode2 } |
152 | $lnode->edges; |
153 | next unless @inode2_imports; |
154 | |
155 | my $cedge = $CompoundEdge->new(); |
156 | $cedge->via($lnode); |
157 | |
158 | $cedge->push_edges( |
159 | map { $_->flip } |
160 | grep { |
161 | $_->type eq 'import' |
162 | and |
163 | ( $_->thatnode eq $inode1 or $_->thatnode eq $inode2 ) |
164 | } $lnode->edges |
165 | ); |
166 | |
167 | if ( scalar(@inode1_imports) == 1 |
168 | and scalar(@inode2_imports) == 1 ) |
169 | { |
170 | $cedge->type('one2one'); |
171 | |
172 | $inode1->via( $inode2->name, |
173 | $inode1->via( $inode2->name ) + 1 ); |
174 | $inode2->via( $inode1->name, |
175 | $inode2->via( $inode1->name ) + 1 ); |
176 | } |
177 | elsif ( scalar(@inode1_imports) > 1 |
178 | and scalar(@inode2_imports) == 1 ) |
179 | { |
180 | $cedge->type('many2one'); |
181 | |
182 | $inode1->via( $inode2->name, |
183 | $inode1->via( $inode2->name ) + 1 ); |
184 | $inode2->via( $inode1->name, |
185 | $inode2->via( $inode1->name ) + 1 ); |
186 | } |
187 | elsif ( scalar(@inode1_imports) == 1 |
188 | and scalar(@inode2_imports) > 1 ) |
189 | { |
190 | |
191 | #handled above |
192 | } |
193 | elsif ( scalar(@inode1_imports) > 1 |
194 | and scalar(@inode2_imports) > 1 ) |
195 | { |
196 | $cedge->type('many2many'); |
197 | |
198 | $inode1->via( $inode2->name, |
199 | $inode1->via( $inode2->name ) + 1 ); |
200 | $inode2->via( $inode1->name, |
201 | $inode2->via( $inode1->name ) + 1 ); |
202 | } |
203 | |
204 | $inode1->push_compoundedges($cedge); |
205 | $inode2->push_compoundedges($cedge) unless $inode1 eq $inode2; |
206 | } |
b046b0b9 |
207 | } |
ba506e52 |
208 | } |
209 | |
210 | my $graph = $self; #hack |
211 | |
212 | # |
213 | # create methods |
214 | # |
215 | # this code needs to move to Graph.pm |
216 | for my $node_from ( $graph->node_values ) { |
217 | |
218 | next |
219 | unless $node_from->table->is_data |
220 | or !$node_from->table->is_trivial_link; |
221 | |
222 | for my $cedge ( $node_from->compoundedges ) { |
223 | |
224 | my $hyperedge = SQL::Translator::Schema::Graph::HyperEdge->new(); |
225 | |
226 | my $node_to; |
227 | for my $edge ( $cedge->edges ) { |
228 | if ( $edge->thisnode->name eq $node_from->name ) { |
229 | $hyperedge->vianode( $edge->thatnode ); |
230 | |
231 | if ( $edge->thatnode->name ne $cedge->via->name ) { |
232 | $node_to ||= |
233 | $graph->node( $edge->thatnode->table->name ); |
234 | } |
235 | |
236 | $hyperedge->push_thisnode( $edge->thisnode ); |
237 | $hyperedge->push_thisfield( $edge->thisfield ); |
238 | $hyperedge->push_thisviafield( $edge->thatfield ); |
239 | |
240 | } |
241 | else { |
242 | if ( $edge->thisnode->name ne $cedge->via->name ) { |
243 | $node_to ||= |
244 | $graph->node( $edge->thisnode->table->name ); |
245 | } |
246 | $hyperedge->push_thatnode( $edge->thisnode ); |
247 | $hyperedge->push_thatfield( $edge->thisfield ); |
248 | $hyperedge->push_thatviafield( $edge->thatfield ); |
249 | } |
250 | $self->debug( $edge->thisfield->name ); |
251 | $self->debug( $edge->thatfield->name ); |
252 | } |
253 | |
254 | if ( $hyperedge->count_thisnode == 1 |
255 | and $hyperedge->count_thatnode == 1 ) |
256 | { |
257 | $hyperedge->type('one2one'); |
258 | } |
259 | elsif ( $hyperedge->count_thisnode > 1 |
260 | and $hyperedge->count_thatnode == 1 ) |
261 | { |
262 | $hyperedge->type('many2one'); |
263 | } |
264 | elsif ( $hyperedge->count_thisnode == 1 |
265 | and $hyperedge->count_thatnode > 1 ) |
266 | { |
267 | $hyperedge->type('one2many'); |
268 | } |
269 | elsif ( $hyperedge->count_thisnode > 1 |
270 | and $hyperedge->count_thatnode > 1 ) |
271 | { |
272 | $hyperedge->type('many2many'); |
273 | } |
274 | |
275 | $self->debug($_) |
276 | for sort keys %::SQL::Translator::Schema::Graph::HyperEdge::; |
277 | |
278 | # node_to won't always be defined b/c of multiple edges to a |
279 | # single other node |
280 | if ( defined($node_to) ) { |
281 | $self->debug( $node_from->name ); |
282 | $self->debug( $node_to->name ); |
283 | |
284 | if ( scalar( $hyperedge->thisnode ) > 1 ) { |
285 | $self->debug( $hyperedge->type . " via " |
286 | . $hyperedge->vianode->name ); |
287 | my $i = 0; |
288 | for my $thisnode ( $hyperedge->thisnode ) { |
289 | $self->debug( $thisnode->name . ' ' |
290 | . $hyperedge->thisfield_index(0)->name . ' -> ' |
291 | . $hyperedge->thisviafield_index($i)->name . ' ' |
292 | . $hyperedge->vianode->name . ' ' |
293 | . $hyperedge->thatviafield_index(0)->name . ' <- ' |
294 | . $hyperedge->thatfield_index(0)->name . ' ' |
295 | . $hyperedge->thatnode_index(0)->name |
296 | . "\n" ); |
297 | $i++; |
298 | } |
299 | } |
300 | |
301 | #warn Dumper($hyperedge) if $hyperedge->type eq 'many2many'; |
302 | $node_from->push_hyperedges($hyperedge); |
303 | } |
b046b0b9 |
304 | } |
b046b0b9 |
305 | } |
b046b0b9 |
306 | |
0caaf4c3 |
307 | } |
308 | |
309 | 1; |