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

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

# -------------------------------------------------------------------
# $Id: GraphViz.pm,v 1.14 2007-09-26 13:20:09 schiffbruechige 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 * fontsize

custom font size for node and edge labels (note that arbitrarily large
sizes may be ignored due to page size or graph size constraints)

==item * fontname

custom font name (or full path to font file) for node, edge, and graph
labels

==item * nodeattrs

reference to a hash of node attribute names and their values; these
may override general fontname or fontsize parameter

==item * edgeattrs

reference to a hash of edge attribute names and their values; these
may override general fontname or fontsize parameter

==item * graphattrs

reference to a hash of graph attribute names and their values; these
may override the general fontname parameter

=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.14 $ =~ /(\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 $fontsize         = $args->{'fontsize'};
    my $fontname         = $args->{'fontname'};
    my $edgeattrs        = $args->{'edgeattrs'} || {};
    my $graphattrs       = $args->{'graphattrs'} || {};
    my $nodeattrs        = $args->{'nodeattrs'} || {};
    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;
    # set fontsize for edge and node labels if specified
    if ($fontsize) {
        $args{'node'}->{'fontsize'} = $fontsize;
        $args{'edge'} = {} unless $args{'edge'};
        $args{'edge'}->{'fontsize'} = $fontsize;        
    }
    # set the font name globally for node, edge, and graph labels if
    # specified (use node, edge, or graph attributes for individual
    # font specification)
    if ($fontname) {
        $args{'node'}->{'fontname'} = $fontname;
        $args{'edge'} = {} unless $args{'edge'};
        $args{'edge'}->{'fontname'} = $fontname;        
        $args{'graph'} = {} unless $args{'graph'};
        $args{'graph'}->{'fontname'} = $fontname;        
    }
    # set additional node, edge, and graph attributes; these may
    # possibly override ones set before
    while (my ($key,$val) = each %$nodeattrs) {
        $args{'node'}->{$key} = $val;
    }
    $args{'edge'} = {} if %$edgeattrs && !$args{'edge'};
    while (my ($key,$val) = each %$edgeattrs) {
        $args{'edge'}->{$key} = $val;
    }
    $args{'graph'} = {} if %$edgeattrs && !$args{'graph'};
    while (my ($key,$val) = each %$graphattrs) {
        $args{'graph'}->{$key} = $val;
    }

    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 );
        $gv->add_node( $table_name, label => $label, ($node_shape eq 'record' ? ( shape => $node_shape ) : ()) );
        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	# -------------------------------------------------------------------
f51d8e46	4	# $Id: GraphViz.pm,v 1.14 2007-09-26 13:20:09 schiffbruechige 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
027cebc7	91	=item * fontsize
	92
	93	custom font size for node and edge labels (note that arbitrarily large
	94	sizes may be ignored due to page size or graph size constraints)
	95
	96	==item * fontname
	97
	98	custom font name (or full path to font file) for node, edge, and graph
	99	labels
	100
	101	==item * nodeattrs
	102
	103	reference to a hash of node attribute names and their values; these
	104	may override general fontname or fontsize parameter
	105
	106	==item * edgeattrs
	107
	108	reference to a hash of edge attribute names and their values; these
	109	may override general fontname or fontsize parameter
	110
	111	==item * graphattrs
	112
	113	reference to a hash of graph attribute names and their values; these
	114	may override the general fontname parameter
	115
d491c962	116	=item * show_fields (DEFAULT: true)
	117
	118	if set to a true value, the names of the colums in a table will
	119	be displayed in each table's node
	120
	121	=item * show_fk_only
	122
	123	if set to a true value, only columns which are foreign keys
	124	will be displayed in each table's node
	125
	126	=item * show_datatypes
	127
	128	if set to a true value, the datatype of each column will be
	129	displayed next to each column's name; this option will have no
	130	effect if the value of show_fields is set to false
	131
	132	=item * show_col_sizes
	133
	134	if set to a true value, the size (in bytes) of each CHAR and
	135	VARCHAR column will be displayed in parentheses next to the
	136	column's name; this option will have no effect if the value of
	137	show_fields is set to false
	138
	139	=item * show_constraints
	140
	141	if set to a true value, a field's constraints (i.e., its
	142	primary-key-ness, its foreign-key-ness and/or its uniqueness)
	143	will appear as a comma-separated list in brackets next to the
	144	field's name; this option will have no effect if the value of
	145	show_fields is set to false
	146
	147	=item * add_color
	148
	149	if set to a true value, the graphic will have a background
	150	color of 'lightgoldenrodyellow'; otherwise the background
	151	color will be white
	152
	153	=item * natural_join
	154
	155	if set to a true value, the make_natural_join method of
	156	SQL::Translator::Schema will be called before generating the
	157	graph; a true value for join_pk_only (see below) implies a
	158	true value for this option
	159
	160	=item * join_pk_only
	161
	162	the value of this option will be passed as the value of the
	163	like-named argument in the make_natural_join method (see
	164	natural_join above) of SQL::Translator::Schema, if either the
	165	value of this option or the natural_join option is set to true
	166
	167	=item * skip_fields
	168
	169	the value of this option will be passed as the value of the
	170	like-named argument in the make_natural_join method (see
	171	natural_join above) of SQL::Translator::Schema, if either
	172	the natural_join or join_pk_only options has a true value
	173
	174	=back
	175
	176	=cut
	177
14d7eb56	178	use strict;
	179	use GraphViz;
	180	use Data::Dumper;
997f14b2	181	use SQL::Translator::Schema::Constants;
14d7eb56	182	use SQL::Translator::Utils qw(debug);
	183
	184	use vars qw[ $VERSION $DEBUG ];
f51d8e46	185	$VERSION = sprintf "%d.%02d", q$Revision: 1.14 $ =~ /(\d+)\.(\d+)/;
14d7eb56	186	$DEBUG = 0 unless defined $DEBUG;
	187
	188	use constant VALID_LAYOUT => {
	189	dot => 1,
	190	neato => 1,
	191	twopi => 1,
	192	};
	193
	194	use constant VALID_NODE_SHAPE => {
	195	record => 1,
	196	plaintext => 1,
	197	ellipse => 1,
	198	circle => 1,
	199	egg => 1,
	200	triangle => 1,
	201	box => 1,
	202	diamond => 1,
	203	trapezium => 1,
	204	parallelogram => 1,
	205	house => 1,
	206	hexagon => 1,
	207	octagon => 1,
	208	};
	209
	210	use constant VALID_OUTPUT => {
	211	canon => 1,
	212	text => 1,
	213	ps => 1,
	214	hpgl => 1,
	215	pcl => 1,
	216	mif => 1,
	217	pic => 1,
	218	gd => 1,
	219	gd2 => 1,
	220	gif => 1,
	221	jpeg => 1,
	222	png => 1,
	223	wbmp => 1,
	224	cmap => 1,
	225	ismap => 1,
	226	imap => 1,
	227	vrml => 1,
	228	vtx => 1,
	229	mp => 1,
	230	fig => 1,
	231	svg => 1,
	232	plain => 1,
	233	};
	234
	235	sub produce {
997f14b2	236	my $t = shift;
997f14b2	237	my $schema = $t->schema;
14d7eb56	238	my $args = $t->producer_args;
14d7eb56	239	local $DEBUG = $t->debug;
14d7eb56	240
59cbb03f	241	my $out_file = $args->{'out_file'} \|\| '';
	242	my $layout = $args->{'layout'} \|\| 'dot';
	243	my $node_shape = $args->{'node_shape'} \|\| 'record';
	244	my $output_type = $args->{'output_type'} \|\| 'png';
	245	my $width = defined $args->{'width'}
	246	? $args->{'width'} : 8.5;
	247	my $height = defined $args->{'height'}
	248	? $args->{'height'} : 11;
027cebc7	249	my $fontsize = $args->{'fontsize'};
	250	my $fontname = $args->{'fontname'};
	251	my $edgeattrs = $args->{'edgeattrs'} \|\| {};
	252	my $graphattrs = $args->{'graphattrs'} \|\| {};
	253	my $nodeattrs = $args->{'nodeattrs'} \|\| {};
59cbb03f	254	my $show_fields = defined $args->{'show_fields'}
	255	? $args->{'show_fields'} : 1;
	256	my $add_color = $args->{'add_color'};
	257	my $natural_join = $args->{'natural_join'};
	258	my $show_fk_only = $args->{'show_fk_only'};
	259	my $show_datatypes = $args->{'show_datatypes'};
	260	my $show_sizes = $args->{'show_sizes'};
37ce746e	261	my $show_constraints = $args->{'show_constraints'};
59cbb03f	262	my $join_pk_only = $args->{'join_pk_only'};
	263	my $skip_fields = $args->{'skip_fields'};
	264	my %skip = map { s/^\s+\|\s+$//g; $_, 1 }
	265	split ( /,/, $skip_fields );
	266	$natural_join \|\|= $join_pk_only;
14d7eb56	267
997f14b2	268	$schema->make_natural_joins(
	269	join_pk_only => $join_pk_only,
	270	skip_fields => $args->{'skip_fields'},
	271	) if $natural_join;
	272
14d7eb56	273	die "Invalid layout '$layout'" unless VALID_LAYOUT->{ $layout };
	274	die "Invalid output type: '$output_type'"
	275	unless VALID_OUTPUT->{ $output_type };
	276	die "Invalid node shape'$node_shape'"
	277	unless VALID_NODE_SHAPE->{ $node_shape };
	278
e36752ea	279	for ( $height, $width ) {
	280	$_ = 0 unless $_ =~ /^\d+(.\d)?$/;
	281	$_ = 0 if $_ < 0;
	282	}
	283
14d7eb56	284	#
	285	# Create GraphViz and see if we can produce the output type.
	286	#
e36752ea	287	my %args = (
14d7eb56	288	directed => $natural_join ? 0 : 1,
	289	layout => $layout,
	290	no_overlap => 1,
	291	bgcolor => $add_color ? 'lightgoldenrodyellow' : 'white',
	292	node => {
	293	shape => $node_shape,
	294	style => 'filled',
027cebc7	295	fillcolor => 'white',
027cebc7	296	},
e36752ea	297	);
	298	$args{'width'} = $width if $width;
	299	$args{'height'} = $height if $height;
027cebc7	300	# set fontsize for edge and node labels if specified
	301	if ($fontsize) {
	302	$args{'node'}->{'fontsize'} = $fontsize;
	303	$args{'edge'} = {} unless $args{'edge'};
	304	$args{'edge'}->{'fontsize'} = $fontsize;
	305	}
	306	# set the font name globally for node, edge, and graph labels if
	307	# specified (use node, edge, or graph attributes for individual
	308	# font specification)
	309	if ($fontname) {
	310	$args{'node'}->{'fontname'} = $fontname;
	311	$args{'edge'} = {} unless $args{'edge'};
	312	$args{'edge'}->{'fontname'} = $fontname;
	313	$args{'graph'} = {} unless $args{'graph'};
	314	$args{'graph'}->{'fontname'} = $fontname;
	315	}
	316	# set additional node, edge, and graph attributes; these may
	317	# possibly override ones set before
	318	while (my ($key,$val) = each %$nodeattrs) {
	319	$args{'node'}->{$key} = $val;
	320	}
	321	$args{'edge'} = {} if %$edgeattrs && !$args{'edge'};
	322	while (my ($key,$val) = each %$edgeattrs) {
	323	$args{'edge'}->{$key} = $val;
	324	}
	325	$args{'graph'} = {} if %$edgeattrs && !$args{'graph'};
	326	while (my ($key,$val) = each %$graphattrs) {
	327	$args{'graph'}->{$key} = $val;
	328	}
e36752ea	329
e36752ea	330	my $gv = GraphViz->new( %args ) or die "Can't create GraphViz object\n";
14d7eb56	331
	332	my %nj_registry; # for locations of fields for natural joins
	333	my @fk_registry; # for locations of fields for foreign keys
	334
997f14b2	335	for my $table ( $schema->get_tables ) {
	336	my $table_name = $table->name;
	337	my @fields = $table->get_fields;
	338	if ( $show_fk_only ) {
	339	@fields = grep { $_->is_foreign_key } @fields;
14d7eb56	340	}
14d7eb56	341
37ce746e	342	my $field_str = join(
	343	'\l',
	344	map {
	345	'-\ '
	346	. $_->name
	347	. ( $show_datatypes ? '\ ' . $_->data_type : '')
	348	. ( $show_sizes && ! $show_datatypes ? '\ ' : '')
59cbb03f	349	. ( $show_sizes && $_->data_type =~ /^(VAR)?CHAR2?$/i ? '(' . $_->size . ')' : '')
37ce746e	350	. ( $show_constraints ?
	351	( $_->is_primary_key \|\| $_->is_foreign_key \|\| $_->is_unique ? '\ [' : '' )
	352	. ( $_->is_primary_key ? 'PK' : '' )
	353	. ( $_->is_primary_key && ($_->is_foreign_key \|\| $_->is_unique) ? ',' : '' )
	354	. ( $_->is_foreign_key ? 'FK' : '' )
	355	. ( $_->is_unique && ($_->is_primary_key \|\| $_->is_foreign_key) ? ',' : '' )
	356	. ( $_->is_unique ? 'U' : '' )
	357	. ( $_->is_primary_key \|\| $_->is_foreign_key \|\| $_->is_unique ? ']' : '' )
	358	: '' )
	359	. '\ '
	360	} @fields
	361	) . '\l';
e36752ea	362	my $label = $show_fields ? "{$table_name\|$field_str}" : $table_name;
f51d8e46	363	# $gv->add_node( $table_name, label => $label );
f51d8e46	364	$gv->add_node( $table_name, label => $label, ($node_shape eq 'record' ? ( shape => $node_shape ) : ()) );
e36752ea	365	debug("Processing table '$table_name'");
e36752ea	366
997f14b2	367	debug("Fields = ", join(', ', map { $_->name } @fields));
14d7eb56	368
14d7eb56	369	for my $f ( @fields ) {
997f14b2	370	my $name = $f->name or next;
	371	my $is_pk = $f->is_primary_key;
	372	my $is_unique = $f->is_unique;
14d7eb56	373
	374	#
	375	# Decide if we should skip this field.
	376	#
	377	if ( $natural_join ) {
997f14b2	378	next unless $is_pk \|\| $f->is_foreign_key;
14d7eb56	379	}
	380
	381	my $constraints = $f->{'constraints'};
	382
	383	if ( $natural_join && !$skip{ $name } ) {
	384	push @{ $nj_registry{ $name } }, $table_name;
	385	}
997f14b2	386	}
	387
	388	unless ( $natural_join ) {
	389	for my $c ( $table->get_constraints ) {
	390	next unless $c->type eq FOREIGN_KEY;
	391	my $fk_table = $c->reference_table or next;
	392
	393	for my $field_name ( $c->fields ) {
	394	for my $fk_field ( $c->reference_fields ) {
	395	next unless defined $schema->get_table( $fk_table );
14d7eb56	396	push @fk_registry, [ $table_name, $fk_table ];
	397	}
	398	}
	399	}
	400	}
	401	}
	402
	403	#
	404	# Make the connections.
	405	#
	406	my @table_bunches;
	407	if ( $natural_join ) {
	408	for my $field_name ( keys %nj_registry ) {
	409	my @table_names = @{ $nj_registry{ $field_name } \|\| [] } or next;
	410	next if scalar @table_names == 1;
	411	push @table_bunches, [ @table_names ];
	412	}
	413	}
	414	else {
	415	@table_bunches = @fk_registry;
	416	}
	417
	418	my %done;
	419	for my $bunch ( @table_bunches ) {
	420	my @tables = @$bunch;
	421
	422	for my $i ( 0 .. $#tables ) {
	423	my $table1 = $tables[ $i ];
	424	for my $j ( 0 .. $#tables ) {
	425	my $table2 = $tables[ $j ];
	426	next if $table1 eq $table2;
	427	next if $done{ $table1 }{ $table2 };
13811af0	428	$gv->add_edge( $table2, $table1 );
14d7eb56	429	$done{ $table1 }{ $table2 } = 1;
	430	$done{ $table2 }{ $table1 } = 1;
	431	}
	432	}
	433	}
	434
	435	#
	436	# Print the image.
	437	#
	438	my $output_method = "as_$output_type";
	439	if ( $out_file ) {
	440	open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
28c31cbf	441	binmode $fh;
14d7eb56	442	print $fh $gv->$output_method;
	443	close $fh;
	444	}
	445	else {
	446	return $gv->$output_method;
	447	}
	448	}
	449
	450	1;
	451
977651a5	452	# -------------------------------------------------------------------
977651a5	453
14d7eb56	454	=pod
14d7eb56	455
14d7eb56	456	=head1 AUTHOR
	457
	458	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
	459
d491c962	460	=head1 SEE ALSO
	461
	462	SQL::Translator, GraphViz
	463
14d7eb56	464	=cut