[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / GraphViz.pm

package SQL::Translator::Producer::GraphViz;

# -------------------------------------------------------------------
# $Id: GraphViz.pm,v 1.12 2004-02-20 02:41:47 dlc Exp $
# -------------------------------------------------------------------
# Copyright (C) 2002-4 SQLFairy Authors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307  USA
# -------------------------------------------------------------------

=pod

=head1 NAME

SQL::Translator::Producer::GraphViz - GraphViz producer for SQL::Translator

=head1 SYNOPSIS

  use SQL::Translator;

  my $trans = new SQL::Translator(
      from => 'MySQL',            # or your db of choice
      to => 'GraphViz',
      producer_args => {
          out_file => 'schema.png',
          add_color => 1,
          show_constraints => 1,
          show_datatypes => 1,
          show_col_sizes => 1
      }
  ) or die SQL::Translator->error;

  $trans->translate or die $trans->error;

=head1 DESCRIPTION

Creates a graph of a schema using the amazing graphviz
(see http://www.graphviz.org/) application (via
the GraphViz module).  It's nifty--you should try it!

=head1 PRODUCER ARGS

=over 4

=item * out_file

the name of the file where the graphviz graphic is to be written

=item * layout (DEFAULT: 'dot')

determines which layout algorithm GraphViz will use; possible
values are 'dot' (the default GraphViz layout for directed graph
layouts), 'neato' (for undirected graph layouts - spring model)
or 'twopi' (for undirected graph layouts - circular)

=item * node_shape (DEFAULT: 'record')

sets the node shape of each table in the graph; this can be
one of 'record', 'plaintext', 'ellipse', 'circle', 'egg',
'triangle', 'box', 'diamond', 'trapezium', 'parallelogram',
'house', 'hexagon', or 'octagon'

=item * output_type (DEFAULT: 'png')

sets the file type of the output graphic; possible values are
'ps', 'hpgl', 'pcl', 'mif', 'pic', 'gd', 'gd2', 'gif', 'jpeg',
'png', 'wbmp', 'cmap', 'ismap', 'imap', 'vrml', 'vtx', 'mp',
'fig', 'svg', 'canon', 'plain' or 'text' (see GraphViz for
details on each of these)

=item * width (DEFAULT: 8.5)

width (in inches) of the output graphic

=item * height (DEFAULT: 11)

height (in inches) of the output grahic

=item * show_fields (DEFAULT: true)

if set to a true value, the names of the colums in a table will
be displayed in each table's node

=item * show_fk_only

if set to a true value, only columns which are foreign keys
will be displayed in each table's node

=item * show_datatypes

if set to a true value, the datatype of each column will be
displayed next to each column's name; this option will have no
effect if the value of show_fields is set to false

=item * show_col_sizes

if set to a true value, the size (in bytes) of each CHAR and
VARCHAR column will be displayed in parentheses next to the
column's name; this option will have no effect if the value of
show_fields is set to false

=item * show_constraints

if set to a true value, a field's constraints (i.e., its
primary-key-ness, its foreign-key-ness and/or its uniqueness)
will appear as a comma-separated list in brackets next to the
field's name; this option will have no effect if the value of
show_fields is set to false

=item * add_color

if set to a true value, the graphic will have a background
color of 'lightgoldenrodyellow'; otherwise the background
color will be white

=item * natural_join

if set to a true value, the make_natural_join method of
SQL::Translator::Schema will be called before generating the
graph; a true value for join_pk_only (see below) implies a
true value for this option

=item * join_pk_only

the value of this option will be passed as the value of the
like-named argument in the make_natural_join method (see
natural_join above) of SQL::Translator::Schema, if either the
value of this option or the natural_join option is set to true

=item * skip_fields

the value of this option will be passed as the value of the
like-named argument in the make_natural_join method (see
natural_join above) of SQL::Translator::Schema, if either
the natural_join or join_pk_only options has a true value

=back

=cut

use strict;
use GraphViz;
use Data::Dumper;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(debug);

use vars qw[ $VERSION $DEBUG ];
$VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/;
$DEBUG   = 0 unless defined $DEBUG;

use constant VALID_LAYOUT => {
    dot   => 1, 
    neato => 1, 
    twopi => 1,
};

use constant VALID_NODE_SHAPE => {
    record        => 1, 
    plaintext     => 1, 
    ellipse       => 1, 
    circle        => 1, 
    egg           => 1, 
    triangle      => 1, 
    box           => 1, 
    diamond       => 1, 
    trapezium     => 1, 
    parallelogram => 1, 
    house         => 1, 
    hexagon       => 1, 
    octagon       => 1, 
};

use constant VALID_OUTPUT => {
    canon => 1, 
    text  => 1, 
    ps    => 1, 
    hpgl  => 1,
    pcl   => 1, 
    mif   => 1, 
    pic   => 1, 
    gd    => 1, 
    gd2   => 1, 
    gif   => 1, 
    jpeg  => 1,
    png   => 1, 
    wbmp  => 1, 
    cmap  => 1, 
    ismap => 1, 
    imap  => 1, 
    vrml  => 1,
    vtx   => 1, 
    mp    => 1, 
    fig   => 1, 
    svg   => 1, 
    plain => 1,
};

sub produce {
    my $t          = shift;
    my $schema     = $t->schema;
    my $args       = $t->producer_args;
    local $DEBUG   = $t->debug;

    my $out_file         = $args->{'out_file'}    || '';
    my $layout           = $args->{'layout'}      || 'dot';
    my $node_shape       = $args->{'node_shape'}  || 'record';
    my $output_type      = $args->{'output_type'} || 'png';
    my $width            = defined $args->{'width'} 
                           ? $args->{'width'} : 8.5;
    my $height           = defined $args->{'height'}
                           ? $args->{'height'} : 11;
    my $show_fields      = defined $args->{'show_fields'} 
                           ? $args->{'show_fields'} : 1;
    my $add_color        = $args->{'add_color'};
    my $natural_join     = $args->{'natural_join'};
    my $show_fk_only     = $args->{'show_fk_only'};
    my $show_datatypes   = $args->{'show_datatypes'};
    my $show_sizes       = $args->{'show_sizes'};
    my $show_constraints = $args->{'show_constraints'};
    my $join_pk_only     = $args->{'join_pk_only'};
    my $skip_fields      = $args->{'skip_fields'};
    my %skip             = map { s/^\s+|\s+$//g; $_, 1 }
                           split ( /,/, $skip_fields );
    $natural_join      ||= $join_pk_only;

    $schema->make_natural_joins(
        join_pk_only => $join_pk_only,
        skip_fields  => $args->{'skip_fields'},
    ) if $natural_join;

    die "Invalid layout '$layout'" unless VALID_LAYOUT->{ $layout };
    die "Invalid output type: '$output_type'"
        unless VALID_OUTPUT->{ $output_type };
    die "Invalid node shape'$node_shape'" 
        unless VALID_NODE_SHAPE->{ $node_shape };

    for ( $height, $width ) {
        $_ = 0 unless $_ =~ /^\d+(.\d)?$/;
        $_ = 0 if $_ < 0;
    }

    #
    # Create GraphViz and see if we can produce the output type.
    #
    my %args = (
        directed      => $natural_join ? 0 : 1,
        layout        => $layout,
        no_overlap    => 1,
        bgcolor       => $add_color ? 'lightgoldenrodyellow' : 'white',
        node          => { 
            shape     => $node_shape, 
            style     => 'filled', 
            fillcolor => 'white' 
        }
    );
    $args{'width'}  = $width  if $width;
    $args{'height'} = $height if $height;

    my $gv =  GraphViz->new( %args ) or die "Can't create GraphViz object\n";

    my %nj_registry; # for locations of fields for natural joins
    my @fk_registry; # for locations of fields for foreign keys

    for my $table ( $schema->get_tables ) {
        my $table_name = $table->name;
        my @fields     = $table->get_fields;
        if ( $show_fk_only ) {
            @fields = grep { $_->is_foreign_key } @fields;
        }

        my $field_str = join(
            '\l',
            map {
                '-\ '
                . $_->name
                . ( $show_datatypes ? '\ ' . $_->data_type : '')
                . ( $show_sizes && ! $show_datatypes ? '\ ' : '')
                . ( $show_sizes && $_->data_type =~ /^(VAR)?CHAR2?$/i ? '(' . $_->size . ')' : '')
                . ( $show_constraints ?
                    ( $_->is_primary_key || $_->is_foreign_key || $_->is_unique ? '\ [' : '' )
                    . ( $_->is_primary_key ? 'PK' : '' )
                    . ( $_->is_primary_key && ($_->is_foreign_key || $_->is_unique) ? ',' : '' )
                    . ( $_->is_foreign_key ? 'FK' : '' )
                    . ( $_->is_unique && ($_->is_primary_key || $_->is_foreign_key) ? ',' : '' )
                    . ( $_->is_unique ? 'U' : '' )
                    . ( $_->is_primary_key || $_->is_foreign_key || $_->is_unique ? ']' : '' )
                : '' )
                . '\ '
            } @fields
        ) . '\l';
        my $label = $show_fields ? "{$table_name|$field_str}" : $table_name;
        $gv->add_node( $table_name, label => $label );

        debug("Processing table '$table_name'");

        debug("Fields = ", join(', ', map { $_->name } @fields));

        for my $f ( @fields ) {
            my $name      = $f->name or next;
            my $is_pk     = $f->is_primary_key;
            my $is_unique = $f->is_unique;

            #
            # Decide if we should skip this field.
            #
            if ( $natural_join ) {
                next unless $is_pk || $f->is_foreign_key;
            }

            my $constraints = $f->{'constraints'};

            if ( $natural_join && !$skip{ $name } ) {
                push @{ $nj_registry{ $name } }, $table_name;
            }
        }

        unless ( $natural_join ) {
            for my $c ( $table->get_constraints ) {
                next unless $c->type eq FOREIGN_KEY;
                my $fk_table = $c->reference_table or next;

                for my $field_name ( $c->fields ) {
                    for my $fk_field ( $c->reference_fields ) {
                        next unless defined $schema->get_table( $fk_table );
                        push @fk_registry, [ $table_name, $fk_table ];
                    }
                }
            }
        }
    }

    #
    # Make the connections.
    #
    my @table_bunches;
    if ( $natural_join ) {
        for my $field_name ( keys %nj_registry ) {
            my @table_names = @{ $nj_registry{ $field_name } || [] } or next;
            next if scalar @table_names == 1;
            push @table_bunches, [ @table_names ];
        }
    }
    else {
        @table_bunches = @fk_registry;
    }

    my %done;
    for my $bunch ( @table_bunches ) {
        my @tables = @$bunch;

        for my $i ( 0 .. $#tables ) {
            my $table1 = $tables[ $i ];
            for my $j ( 0 .. $#tables ) {
                my $table2 = $tables[ $j ];
                next if $table1 eq $table2;
                next if $done{ $table1 }{ $table2 };
                $gv->add_edge( $table2, $table1 );
                $done{ $table1 }{ $table2 } = 1;
                $done{ $table2 }{ $table1 } = 1;
            }
        }
    }

    #
    # Print the image.
    #
    my $output_method = "as_$output_type";
    if ( $out_file ) {
        open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
        binmode $fh;
        print $fh $gv->$output_method;
        close $fh;
    }
    else {
        return $gv->$output_method;
    }
}

1;

# -------------------------------------------------------------------

=pod

=head1 AUTHOR

Ken Y. Clark E<lt>kclark@cpan.orgE<gt>

=head1 SEE ALSO

SQL::Translator, GraphViz

=cut
Commit	Line	Data
14d7eb56	1	package SQL::Translator::Producer::GraphViz;
	2
	3	# -------------------------------------------------------------------
d491c962	4	# $Id: GraphViz.pm,v 1.12 2004-02-20 02:41:47 dlc Exp $
14d7eb56	5	# -------------------------------------------------------------------
977651a5	6	# Copyright (C) 2002-4 SQLFairy Authors
14d7eb56	7	#
	8	# This program is free software; you can redistribute it and/or
	9	# modify it under the terms of the GNU General Public License as
	10	# published by the Free Software Foundation; version 2.
	11	#
	12	# This program is distributed in the hope that it will be useful, but
	13	# WITHOUT ANY WARRANTY; without even the implied warranty of
	14	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	15	# General Public License for more details.
	16	#
	17	# You should have received a copy of the GNU General Public License
	18	# along with this program; if not, write to the Free Software
	19	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
	20	# 02111-1307 USA
	21	# -------------------------------------------------------------------
	22
d491c962	23	=pod
	24
	25	=head1 NAME
	26
	27	SQL::Translator::Producer::GraphViz - GraphViz producer for SQL::Translator
	28
	29	=head1 SYNOPSIS
	30
	31	use SQL::Translator;
	32
	33	my $trans = new SQL::Translator(
	34	from => 'MySQL', # or your db of choice
	35	to => 'GraphViz',
	36	producer_args => {
	37	out_file => 'schema.png',
	38	add_color => 1,
	39	show_constraints => 1,
	40	show_datatypes => 1,
	41	show_col_sizes => 1
	42	}
	43	) or die SQL::Translator->error;
	44
	45	$trans->translate or die $trans->error;
	46
	47	=head1 DESCRIPTION
	48
	49	Creates a graph of a schema using the amazing graphviz
	50	(see http://www.graphviz.org/) application (via
	51	the GraphViz module). It's nifty--you should try it!
	52
	53	=head1 PRODUCER ARGS
	54
	55	=over 4
	56
	57	=item * out_file
	58
	59	the name of the file where the graphviz graphic is to be written
	60
	61	=item * layout (DEFAULT: 'dot')
	62
	63	determines which layout algorithm GraphViz will use; possible
	64	values are 'dot' (the default GraphViz layout for directed graph
	65	layouts), 'neato' (for undirected graph layouts - spring model)
	66	or 'twopi' (for undirected graph layouts - circular)
	67
	68	=item * node_shape (DEFAULT: 'record')
	69
	70	sets the node shape of each table in the graph; this can be
	71	one of 'record', 'plaintext', 'ellipse', 'circle', 'egg',
	72	'triangle', 'box', 'diamond', 'trapezium', 'parallelogram',
	73	'house', 'hexagon', or 'octagon'
	74
	75	=item * output_type (DEFAULT: 'png')
	76
	77	sets the file type of the output graphic; possible values are
	78	'ps', 'hpgl', 'pcl', 'mif', 'pic', 'gd', 'gd2', 'gif', 'jpeg',
	79	'png', 'wbmp', 'cmap', 'ismap', 'imap', 'vrml', 'vtx', 'mp',
	80	'fig', 'svg', 'canon', 'plain' or 'text' (see GraphViz for
	81	details on each of these)
	82
	83	=item * width (DEFAULT: 8.5)
	84
	85	width (in inches) of the output graphic
	86
87	=item * height (DEFAULT: 11)
88
89	height (in inches) of the output grahic
90
91	=item * show_fields (DEFAULT: true)
92
93	if set to a true value, the names of the colums in a table will
94	be displayed in each table's node
95
96	=item * show_fk_only
97
98	if set to a true value, only columns which are foreign keys
99	will be displayed in each table's node
100
101	=item * show_datatypes
102
103	if set to a true value, the datatype of each column will be
104	displayed next to each column's name; this option will have no
105	effect if the value of show_fields is set to false
106
107	=item * show_col_sizes
108
109	if set to a true value, the size (in bytes) of each CHAR and
110	VARCHAR column will be displayed in parentheses next to the
111	column's name; this option will have no effect if the value of
112	show_fields is set to false
113
114	=item * show_constraints
115
116	if set to a true value, a field's constraints (i.e., its
117	primary-key-ness, its foreign-key-ness and/or its uniqueness)
118	will appear as a comma-separated list in brackets next to the
119	field's name; this option will have no effect if the value of
120	show_fields is set to false
121
122	=item * add_color
123
124	if set to a true value, the graphic will have a background
125	color of 'lightgoldenrodyellow'; otherwise the background
126	color will be white
127
128	=item * natural_join
129
130	if set to a true value, the make_natural_join method of
131	SQL::Translator::Schema will be called before generating the
132	graph; a true value for join_pk_only (see below) implies a
133	true value for this option
134
135	=item * join_pk_only
136
137	the value of this option will be passed as the value of the
138	like-named argument in the make_natural_join method (see
139	natural_join above) of SQL::Translator::Schema, if either the
140	value of this option or the natural_join option is set to true
141
142	=item * skip_fields
143
144	the value of this option will be passed as the value of the
145	like-named argument in the make_natural_join method (see
146	natural_join above) of SQL::Translator::Schema, if either
147	the natural_join or join_pk_only options has a true value
148
149	=back
150
151	=cut
152
14d7eb56	153	use strict;
	154	use GraphViz;
	155	use Data::Dumper;
997f14b2	156	use SQL::Translator::Schema::Constants;
14d7eb56	157	use SQL::Translator::Utils qw(debug);
	158
	159	use vars qw[ $VERSION $DEBUG ];
d491c962	160	$VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/;
14d7eb56	161	$DEBUG = 0 unless defined $DEBUG;
	162
	163	use constant VALID_LAYOUT => {
	164	dot => 1,
	165	neato => 1,
	166	twopi => 1,
	167	};
	168
	169	use constant VALID_NODE_SHAPE => {
	170	record => 1,
	171	plaintext => 1,
	172	ellipse => 1,
	173	circle => 1,
	174	egg => 1,
	175	triangle => 1,
	176	box => 1,
	177	diamond => 1,
	178	trapezium => 1,
	179	parallelogram => 1,
	180	house => 1,
	181	hexagon => 1,
	182	octagon => 1,
	183	};
	184
	185	use constant VALID_OUTPUT => {
	186	canon => 1,
	187	text => 1,
	188	ps => 1,
	189	hpgl => 1,
	190	pcl => 1,
	191	mif => 1,
	192	pic => 1,
	193	gd => 1,
	194	gd2 => 1,
	195	gif => 1,
	196	jpeg => 1,
	197	png => 1,
	198	wbmp => 1,
	199	cmap => 1,
	200	ismap => 1,
	201	imap => 1,
	202	vrml => 1,
	203	vtx => 1,
	204	mp => 1,
	205	fig => 1,
	206	svg => 1,
	207	plain => 1,
	208	};
	209
	210	sub produce {
997f14b2	211	my $t = shift;
997f14b2	212	my $schema = $t->schema;
14d7eb56	213	my $args = $t->producer_args;
14d7eb56	214	local $DEBUG = $t->debug;
14d7eb56	215
59cbb03f	216	my $out_file = $args->{'out_file'} \|\| '';
	217	my $layout = $args->{'layout'} \|\| 'dot';
	218	my $node_shape = $args->{'node_shape'} \|\| 'record';
	219	my $output_type = $args->{'output_type'} \|\| 'png';
	220	my $width = defined $args->{'width'}
	221	? $args->{'width'} : 8.5;
	222	my $height = defined $args->{'height'}
	223	? $args->{'height'} : 11;
	224	my $show_fields = defined $args->{'show_fields'}
	225	? $args->{'show_fields'} : 1;
	226	my $add_color = $args->{'add_color'};
	227	my $natural_join = $args->{'natural_join'};
	228	my $show_fk_only = $args->{'show_fk_only'};
	229	my $show_datatypes = $args->{'show_datatypes'};
	230	my $show_sizes = $args->{'show_sizes'};
37ce746e	231	my $show_constraints = $args->{'show_constraints'};
59cbb03f	232	my $join_pk_only = $args->{'join_pk_only'};
	233	my $skip_fields = $args->{'skip_fields'};
	234	my %skip = map { s/^\s+\|\s+$//g; $_, 1 }
	235	split ( /,/, $skip_fields );
	236	$natural_join \|\|= $join_pk_only;
14d7eb56	237
997f14b2	238	$schema->make_natural_joins(
	239	join_pk_only => $join_pk_only,
	240	skip_fields => $args->{'skip_fields'},
	241	) if $natural_join;
	242
14d7eb56	243	die "Invalid layout '$layout'" unless VALID_LAYOUT->{ $layout };
	244	die "Invalid output type: '$output_type'"
	245	unless VALID_OUTPUT->{ $output_type };
	246	die "Invalid node shape'$node_shape'"
	247	unless VALID_NODE_SHAPE->{ $node_shape };
	248
e36752ea	249	for ( $height, $width ) {
	250	$_ = 0 unless $_ =~ /^\d+(.\d)?$/;
	251	$_ = 0 if $_ < 0;
	252	}
	253
14d7eb56	254	#
	255	# Create GraphViz and see if we can produce the output type.
	256	#
e36752ea	257	my %args = (
14d7eb56	258	directed => $natural_join ? 0 : 1,
	259	layout => $layout,
	260	no_overlap => 1,
	261	bgcolor => $add_color ? 'lightgoldenrodyellow' : 'white',
	262	node => {
	263	shape => $node_shape,
	264	style => 'filled',
	265	fillcolor => 'white'
e36752ea	266	}
	267	);
	268	$args{'width'} = $width if $width;
	269	$args{'height'} = $height if $height;
	270
	271	my $gv = GraphViz->new( %args ) or die "Can't create GraphViz object\n";
14d7eb56	272
	273	my %nj_registry; # for locations of fields for natural joins
	274	my @fk_registry; # for locations of fields for foreign keys
	275
997f14b2	276	for my $table ( $schema->get_tables ) {
	277	my $table_name = $table->name;
	278	my @fields = $table->get_fields;
	279	if ( $show_fk_only ) {
	280	@fields = grep { $_->is_foreign_key } @fields;
14d7eb56	281	}
14d7eb56	282
37ce746e	283	my $field_str = join(
	284	'\l',
	285	map {
	286	'-\ '
	287	. $_->name
	288	. ( $show_datatypes ? '\ ' . $_->data_type : '')
	289	. ( $show_sizes && ! $show_datatypes ? '\ ' : '')
59cbb03f	290	. ( $show_sizes && $_->data_type =~ /^(VAR)?CHAR2?$/i ? '(' . $_->size . ')' : '')
37ce746e	291	. ( $show_constraints ?
	292	( $_->is_primary_key \|\| $_->is_foreign_key \|\| $_->is_unique ? '\ [' : '' )
	293	. ( $_->is_primary_key ? 'PK' : '' )
	294	. ( $_->is_primary_key && ($_->is_foreign_key \|\| $_->is_unique) ? ',' : '' )
	295	. ( $_->is_foreign_key ? 'FK' : '' )
	296	. ( $_->is_unique && ($_->is_primary_key \|\| $_->is_foreign_key) ? ',' : '' )
	297	. ( $_->is_unique ? 'U' : '' )
	298	. ( $_->is_primary_key \|\| $_->is_foreign_key \|\| $_->is_unique ? ']' : '' )
	299	: '' )
	300	. '\ '
	301	} @fields
	302	) . '\l';
e36752ea	303	my $label = $show_fields ? "{$table_name\|$field_str}" : $table_name;
	304	$gv->add_node( $table_name, label => $label );
	305
	306	debug("Processing table '$table_name'");
	307
997f14b2	308	debug("Fields = ", join(', ', map { $_->name } @fields));
14d7eb56	309
14d7eb56	310	for my $f ( @fields ) {
997f14b2	311	my $name = $f->name or next;
	312	my $is_pk = $f->is_primary_key;
	313	my $is_unique = $f->is_unique;
14d7eb56	314
	315	#
	316	# Decide if we should skip this field.
	317	#
	318	if ( $natural_join ) {
997f14b2	319	next unless $is_pk \|\| $f->is_foreign_key;
14d7eb56	320	}
	321
	322	my $constraints = $f->{'constraints'};
	323
	324	if ( $natural_join && !$skip{ $name } ) {
	325	push @{ $nj_registry{ $name } }, $table_name;
	326	}
997f14b2	327	}
	328
	329	unless ( $natural_join ) {
	330	for my $c ( $table->get_constraints ) {
	331	next unless $c->type eq FOREIGN_KEY;
	332	my $fk_table = $c->reference_table or next;
	333
	334	for my $field_name ( $c->fields ) {
	335	for my $fk_field ( $c->reference_fields ) {
	336	next unless defined $schema->get_table( $fk_table );
14d7eb56	337	push @fk_registry, [ $table_name, $fk_table ];
	338	}
	339	}
	340	}
	341	}
	342	}
	343
	344	#
	345	# Make the connections.
	346	#
	347	my @table_bunches;
	348	if ( $natural_join ) {
	349	for my $field_name ( keys %nj_registry ) {
	350	my @table_names = @{ $nj_registry{ $field_name } \|\| [] } or next;
	351	next if scalar @table_names == 1;
	352	push @table_bunches, [ @table_names ];
	353	}
	354	}
	355	else {
	356	@table_bunches = @fk_registry;
	357	}
	358
	359	my %done;
	360	for my $bunch ( @table_bunches ) {
	361	my @tables = @$bunch;
	362
	363	for my $i ( 0 .. $#tables ) {
	364	my $table1 = $tables[ $i ];
	365	for my $j ( 0 .. $#tables ) {
	366	my $table2 = $tables[ $j ];
	367	next if $table1 eq $table2;
	368	next if $done{ $table1 }{ $table2 };
13811af0	369	$gv->add_edge( $table2, $table1 );
14d7eb56	370	$done{ $table1 }{ $table2 } = 1;
	371	$done{ $table2 }{ $table1 } = 1;
	372	}
	373	}
	374	}
	375
	376	#
	377	# Print the image.
	378	#
	379	my $output_method = "as_$output_type";
	380	if ( $out_file ) {
	381	open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
28c31cbf	382	binmode $fh;
14d7eb56	383	print $fh $gv->$output_method;
	384	close $fh;
	385	}
	386	else {
	387	return $gv->$output_method;
	388	}
	389	}
	390
	391	1;
	392
977651a5	393	# -------------------------------------------------------------------
977651a5	394
14d7eb56	395	=pod
14d7eb56	396
14d7eb56	397	=head1 AUTHOR
	398
	399	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
	400
d491c962	401	=head1 SEE ALSO
	402
	403	SQL::Translator, GraphViz
	404
14d7eb56	405	=cut