lib/SQL/Translator/Schema/Graph.pm

   1 package SQL::Translator::Schema::Graph;
   2
   3 use strict;
   4
   5 use base 'Class::Base';
   6
   7 use vars qw[ $VERSION ];
   8 $VERSION = '1.60';
   9
  10 use Data::Dumper;
  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;
  16 use Readonly;
  17
  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';
  25
  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 )],
  31 );
  32
  33 use vars qw/$DEBUG/;
  34 $DEBUG = 0 unless defined $DEBUG;
  35
  36 sub init {
  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             }
 207         }
 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             }
 304         }
 305     }
 306
 307 }
 308
 309 1;