[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema / Graph.pm

package SQL::Translator::Schema::Graph;

use strict;

use base 'Class::Base';

use vars qw[ $VERSION ];
$VERSION = '1.60';

use Data::Dumper;
use SQL::Translator::Schema::Graph::Node;
use SQL::Translator::Schema::Graph::Edge;
use SQL::Translator::Schema::Graph::Port;
use SQL::Translator::Schema::Graph::CompoundEdge;
use SQL::Translator::Schema::Graph::HyperEdge;
use Readonly;

local $Data::Dumper::Maxdepth = 3;

Readonly my $Node         => 'SQL::Translator::Schema::Graph::Node';
Readonly my $Edge         => 'SQL::Translator::Schema::Graph::Edge';
Readonly my $Port         => 'SQL::Translator::Schema::Graph::Port';
Readonly my $CompoundEdge => 'SQL::Translator::Schema::Graph::CompoundEdge';
Readonly my $HyperEdge    => 'SQL::Translator::Schema::Graph::HyperEdge';

use Class::MakeMethods::Template::Hash (
    'new --and_then_init' => 'new',
    object             => [ 'translator' => { class => 'SQL::Translator' }, ],
    'hash'             => [qw( node )],
    'number --counter' => [qw( order )],
);

use vars qw/$DEBUG/;
$DEBUG = 0 unless defined $DEBUG;

sub init {
    my $self = shift;

    #
    # build package objects
    #
    for my $table ( $self->translator->schema->get_tables ) {
        die __PACKAGE__
          . " table "
          . $table->name
          . " doesn't have a primary key!"
          unless $table->primary_key;
        die __PACKAGE__
          . " table "
          . $table->name
          . " can't have a composite primary key!"
          if ( $table->primary_key->fields )[1];

        my $node = $Node->new();

        $self->node_push( $table->name => $node );

        if   ( $table->is_trivial_link ) { $node->is_trivial_link(1); }
        else                             { $node->is_trivial_link(0); }

        $node->order( $self->order_incr() );
        $node->name( $self->translator->format_package_name( $table->name ) );
        $node->table($table);
        $node->primary_key( ( $table->primary_key->fields )[0] );

        # Primary key may have a differenct accessor method name
        $node->primary_key_accessor(
            defined( $self->translator->format_pk_name )
            ? $self->translator->format_pk_name->(
                $node->name, $node->primary_key
              )
            : undef
        );
    }

    for my $node ( $self->node_values ) {
        for my $field ( $node->table->get_fields ) {
            if ( !$field->is_foreign_key && !$field->is_primary_key ) {
                $node->data_fields->{ $field->name } = 1;
            }
            elsif ( $field->is_foreign_key ) {
                my $that =
                  $self->node( $field->foreign_key_reference->reference_table );

                #this means we have an incomplete schema
                next unless $that;

                my $edge = $Edge->new(
                    type      => 'import',
                    thisnode  => $node,
                    thisfield => $field,
                    thatnode  => $that,

                    #can you believe this sh*t just to get a field obj?
                    thatfield => $self->translator->schema->get_table(
                        $field->foreign_key_reference->reference_table
                      )->get_field(
                        ( $field->foreign_key_reference->reference_fields )[0]
                      )
                );

                $node->edgecount( $that->name,
                    $node->edgecount( $that->name ) + 1 );

                $node->has( $that->name, $node->has( $that->name ) + 1 );
                $that->many( $node->name, $that->many( $node->name ) + 1 );

                $that->edgecount( $node->name,
                    $that->edgecount( $node->name ) + 1 );

                #warn "\t" . $node->name . "\t" . $node->edgecount($that->name);
                $node->push_edges($edge);
                $that->push_edges( $edge->flip );
            }
        }
    }

    #
    # type MM relationships
    #
    #for linknode
    for my $lnode ( sort $self->node_values ) {
        next if $lnode->table->is_data;
        for my $inode1 ( sort $self->node_values ) {

            #linknode can't link to itself
            next if $inode1 eq $lnode;

            my @inode1_imports =
              grep { $_->type eq 'import' and $_->thatnode eq $inode1 }
              $lnode->edges;
            next unless @inode1_imports;

            for my $inode2 ( sort $self->node_values ) {

                #linknode can't link to itself
                next if $inode2 eq $lnode;

                #identify tables that import keys to linknode
                my %i =
                  map { $_->thatnode->name => 1 }
                  grep { $_->type eq 'import' } $lnode->edges;

                if ( scalar( keys %i ) == 1 ) {
                }
                else {
                    last if $inode1 eq $inode2;
                }

                my @inode2_imports =
                  grep { $_->type eq 'import' and $_->thatnode eq $inode2 }
                  $lnode->edges;
                next unless @inode2_imports;

                my $cedge = $CompoundEdge->new();
                $cedge->via($lnode);

                $cedge->push_edges(
                    map { $_->flip }
                      grep {
                        $_->type eq 'import'
                          and
                          ( $_->thatnode eq $inode1 or $_->thatnode eq $inode2 )
                      } $lnode->edges
                );

                if (    scalar(@inode1_imports) == 1
                    and scalar(@inode2_imports) == 1 )
                {
                    $cedge->type('one2one');

                    $inode1->via( $inode2->name,
                        $inode1->via( $inode2->name ) + 1 );
                    $inode2->via( $inode1->name,
                        $inode2->via( $inode1->name ) + 1 );
                }
                elsif ( scalar(@inode1_imports) > 1
                    and scalar(@inode2_imports) == 1 )
                {
                    $cedge->type('many2one');

                    $inode1->via( $inode2->name,
                        $inode1->via( $inode2->name ) + 1 );
                    $inode2->via( $inode1->name,
                        $inode2->via( $inode1->name ) + 1 );
                }
                elsif ( scalar(@inode1_imports) == 1
                    and scalar(@inode2_imports) > 1 )
                {

                    #handled above
                }
                elsif ( scalar(@inode1_imports) > 1
                    and scalar(@inode2_imports) > 1 )
                {
                    $cedge->type('many2many');

                    $inode1->via( $inode2->name,
                        $inode1->via( $inode2->name ) + 1 );
                    $inode2->via( $inode1->name,
                        $inode2->via( $inode1->name ) + 1 );
                }

                $inode1->push_compoundedges($cedge);
                $inode2->push_compoundedges($cedge) unless $inode1 eq $inode2;
            }
        }
    }

    my $graph = $self;    #hack

    #
    # create methods
    #
    # this code needs to move to Graph.pm
    for my $node_from ( $graph->node_values ) {

        next
          unless $node_from->table->is_data
              or !$node_from->table->is_trivial_link;

        for my $cedge ( $node_from->compoundedges ) {

            my $hyperedge = SQL::Translator::Schema::Graph::HyperEdge->new();

            my $node_to;
            for my $edge ( $cedge->edges ) {
                if ( $edge->thisnode->name eq $node_from->name ) {
                    $hyperedge->vianode( $edge->thatnode );

                    if ( $edge->thatnode->name ne $cedge->via->name ) {
                        $node_to ||=
                          $graph->node( $edge->thatnode->table->name );
                    }

                    $hyperedge->push_thisnode( $edge->thisnode );
                    $hyperedge->push_thisfield( $edge->thisfield );
                    $hyperedge->push_thisviafield( $edge->thatfield );

                }
                else {
                    if ( $edge->thisnode->name ne $cedge->via->name ) {
                        $node_to ||=
                          $graph->node( $edge->thisnode->table->name );
                    }
                    $hyperedge->push_thatnode( $edge->thisnode );
                    $hyperedge->push_thatfield( $edge->thisfield );
                    $hyperedge->push_thatviafield( $edge->thatfield );
                }
                $self->debug( $edge->thisfield->name );
                $self->debug( $edge->thatfield->name );
            }

            if (    $hyperedge->count_thisnode == 1
                and $hyperedge->count_thatnode == 1 )
            {
                $hyperedge->type('one2one');
            }
            elsif ( $hyperedge->count_thisnode > 1
                and $hyperedge->count_thatnode == 1 )
            {
                $hyperedge->type('many2one');
            }
            elsif ( $hyperedge->count_thisnode == 1
                and $hyperedge->count_thatnode > 1 )
            {
                $hyperedge->type('one2many');
            }
            elsif ( $hyperedge->count_thisnode > 1
                and $hyperedge->count_thatnode > 1 )
            {
                $hyperedge->type('many2many');
            }

            $self->debug($_)
              for sort keys %::SQL::Translator::Schema::Graph::HyperEdge::;

            # node_to won't always be defined b/c of multiple edges to a 
            # single other node
            if ( defined($node_to) ) {
                $self->debug( $node_from->name );
                $self->debug( $node_to->name );

                if ( scalar( $hyperedge->thisnode ) > 1 ) {
                    $self->debug( $hyperedge->type . " via "
                          . $hyperedge->vianode->name );
                    my $i = 0;
                    for my $thisnode ( $hyperedge->thisnode ) {
                        $self->debug( $thisnode->name . ' '
                              . $hyperedge->thisfield_index(0)->name . ' -> '
                              . $hyperedge->thisviafield_index($i)->name . ' '
                              . $hyperedge->vianode->name . ' '
                              . $hyperedge->thatviafield_index(0)->name . ' <- '
                              . $hyperedge->thatfield_index(0)->name . ' '
                              . $hyperedge->thatnode_index(0)->name
                              . "\n" );
                        $i++;
                    }
                }

                #warn Dumper($hyperedge) if $hyperedge->type eq 'many2many';
                $node_from->push_hyperedges($hyperedge);
            }
        }
    }

}

1;
Commit	Line	Data
0caaf4c3	1	package SQL::Translator::Schema::Graph;
	2
	3	use strict;
	4
4b5c50b9	5	use base 'Class::Base';
4b5c50b9	6
ba506e52	7	use vars qw[ $VERSION ];
ba506e52	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
0caaf4c3	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	);
0caaf4c3	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;