1 package SQL::Translator::Schema::Graph;
5 use base 'Class::Base';
7 use vars qw[ $VERSION ];
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;
18 local $Data::Dumper::Maxdepth = 3;
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';
26 use Class::MakeMethods::Template::Hash (
27 'new --and_then_init' => 'new',
28 object => [ 'translator' => { class => 'SQL::Translator' }, ],
29 'hash' => [qw( node )],
30 'number --counter' => [qw( order )],
34 $DEBUG = 0 unless defined $DEBUG;
40 # build package objects
42 for my $table ( $self->translator->schema->get_tables ) {
46 . " doesn't have a primary key!"
47 unless $table->primary_key;
51 . " can't have a composite primary key!"
52 if ( $table->primary_key->fields )[1];
54 my $node = $Node->new();
56 $self->node_push( $table->name => $node );
58 if ( $table->is_trivial_link ) { $node->is_trivial_link(1); }
59 else { $node->is_trivial_link(0); }
61 $node->order( $self->order_incr() );
62 $node->name( $self->translator->format_package_name( $table->name ) );
64 $node->primary_key( ( $table->primary_key->fields )[0] );
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
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;
81 elsif ( $field->is_foreign_key ) {
83 $self->node( $field->foreign_key_reference->reference_table );
85 #this means we have an incomplete schema
88 my $edge = $Edge->new(
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
98 ( $field->foreign_key_reference->reference_fields )[0]
102 $node->edgecount( $that->name,
103 $node->edgecount( $that->name ) + 1 );
105 $node->has( $that->name, $node->has( $that->name ) + 1 );
106 $that->many( $node->name, $that->many( $node->name ) + 1 );
108 $that->edgecount( $node->name,
109 $that->edgecount( $node->name ) + 1 );
111 #warn "\t" . $node->name . "\t" . $node->edgecount($that->name);
112 $node->push_edges($edge);
113 $that->push_edges( $edge->flip );
119 # type MM relationships
122 for my $lnode ( sort $self->node_values ) {
123 next if $lnode->table->is_data;
124 for my $inode1 ( sort $self->node_values ) {
126 #linknode can't link to itself
127 next if $inode1 eq $lnode;
130 grep { $_->type eq 'import' and $_->thatnode eq $inode1 }
132 next unless @inode1_imports;
134 for my $inode2 ( sort $self->node_values ) {
136 #linknode can't link to itself
137 next if $inode2 eq $lnode;
139 #identify tables that import keys to linknode
141 map { $_->thatnode->name => 1 }
142 grep { $_->type eq 'import' } $lnode->edges;
144 if ( scalar( keys %i ) == 1 ) {
147 last if $inode1 eq $inode2;
151 grep { $_->type eq 'import' and $_->thatnode eq $inode2 }
153 next unless @inode2_imports;
155 my $cedge = $CompoundEdge->new();
163 ( $_->thatnode eq $inode1 or $_->thatnode eq $inode2 )
167 if ( scalar(@inode1_imports) == 1
168 and scalar(@inode2_imports) == 1 )
170 $cedge->type('one2one');
172 $inode1->via( $inode2->name,
173 $inode1->via( $inode2->name ) + 1 );
174 $inode2->via( $inode1->name,
175 $inode2->via( $inode1->name ) + 1 );
177 elsif ( scalar(@inode1_imports) > 1
178 and scalar(@inode2_imports) == 1 )
180 $cedge->type('many2one');
182 $inode1->via( $inode2->name,
183 $inode1->via( $inode2->name ) + 1 );
184 $inode2->via( $inode1->name,
185 $inode2->via( $inode1->name ) + 1 );
187 elsif ( scalar(@inode1_imports) == 1
188 and scalar(@inode2_imports) > 1 )
193 elsif ( scalar(@inode1_imports) > 1
194 and scalar(@inode2_imports) > 1 )
196 $cedge->type('many2many');
198 $inode1->via( $inode2->name,
199 $inode1->via( $inode2->name ) + 1 );
200 $inode2->via( $inode1->name,
201 $inode2->via( $inode1->name ) + 1 );
204 $inode1->push_compoundedges($cedge);
205 $inode2->push_compoundedges($cedge) unless $inode1 eq $inode2;
210 my $graph = $self; #hack
215 # this code needs to move to Graph.pm
216 for my $node_from ( $graph->node_values ) {
219 unless $node_from->table->is_data
220 or !$node_from->table->is_trivial_link;
222 for my $cedge ( $node_from->compoundedges ) {
224 my $hyperedge = SQL::Translator::Schema::Graph::HyperEdge->new();
227 for my $edge ( $cedge->edges ) {
228 if ( $edge->thisnode->name eq $node_from->name ) {
229 $hyperedge->vianode( $edge->thatnode );
231 if ( $edge->thatnode->name ne $cedge->via->name ) {
233 $graph->node( $edge->thatnode->table->name );
236 $hyperedge->push_thisnode( $edge->thisnode );
237 $hyperedge->push_thisfield( $edge->thisfield );
238 $hyperedge->push_thisviafield( $edge->thatfield );
242 if ( $edge->thisnode->name ne $cedge->via->name ) {
244 $graph->node( $edge->thisnode->table->name );
246 $hyperedge->push_thatnode( $edge->thisnode );
247 $hyperedge->push_thatfield( $edge->thisfield );
248 $hyperedge->push_thatviafield( $edge->thatfield );
250 $self->debug( $edge->thisfield->name );
251 $self->debug( $edge->thatfield->name );
254 if ( $hyperedge->count_thisnode == 1
255 and $hyperedge->count_thatnode == 1 )
257 $hyperedge->type('one2one');
259 elsif ( $hyperedge->count_thisnode > 1
260 and $hyperedge->count_thatnode == 1 )
262 $hyperedge->type('many2one');
264 elsif ( $hyperedge->count_thisnode == 1
265 and $hyperedge->count_thatnode > 1 )
267 $hyperedge->type('one2many');
269 elsif ( $hyperedge->count_thisnode > 1
270 and $hyperedge->count_thatnode > 1 )
272 $hyperedge->type('many2many');
276 for sort keys %::SQL::Translator::Schema::Graph::HyperEdge::;
278 # node_to won't always be defined b/c of multiple edges to a
280 if ( defined($node_to) ) {
281 $self->debug( $node_from->name );
282 $self->debug( $node_to->name );
284 if ( scalar( $hyperedge->thisnode ) > 1 ) {
285 $self->debug( $hyperedge->type . " via "
286 . $hyperedge->vianode->name );
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
301 #warn Dumper($hyperedge) if $hyperedge->type eq 'many2many';
302 $node_from->push_hyperedges($hyperedge);