[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_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_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

=item * show_indexes

if set to a true value, each record will also show the indexes
set on each table. it describes the index types along with
which columns are included in the index. this option requires
that show_fields is a true value as well

=item * friendly_ints

if set to a true value, each integer type field will be displayed
as a tinyint, smallint, integer or bigint depending on the field's
associated size parameter. this only applies for the 'integer'
type (and not the lowercase 'int' type, which is assumed to be a
32-bit integer).

=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_indexes     = $args->{'show_indexes'};
    my $friendly_ints    = $args->{'friendly_ints'};
    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; length $_ ? ($_, 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 $label = '{' . $table_name;
        if ($show_fields) {
          my $field_str = '';
          foreach my $field (@fields) {
            $field_str .= '-\ ' . $field->name;
            if ($show_datatypes) {
              my $dt = lc($field->data_type);

              # For the integer type, transform into different types based on
              # requested size, if a size is given.
              if ($friendly_ints && $dt eq 'integer' && $field->size) {
                # Automatically translate to int2, int4, int8
                # Type (Bits)     Max. Signed           Length
                # tinyint (8)     128                   3
                # smallint (16)   32767                 5
                # int (32)        2147483647            10
                # bigint (64)     9223372036854775807   19
                if ($field->size > 10) {
                  $dt = 'bigint';
                }
                elsif ($field->size > 5) {
                  $dt = 'integer';
                }
                elsif ($field->size > 3) {
                  $dt = 'smallint';
                }
                else { # 8 bits
                  $dt = 'tinyint';
                }
              }

              $field_str .= '\ ' . $dt;
              if ($show_sizes && $field->size && ($dt =~ /^(var)?char2?$/ || $dt eq 'numeric' || $dt eq 'decimal')) {
                $field_str .= '(' . $field->size . ')';
              }
            }

            if ($show_constraints) {
              my @constraints;
              push(@constraints, 'PK') if $field->is_primary_key;
              push(@constraints, 'FK') if $field->is_foreign_key;
              push(@constraints, 'U')  if $field->is_unique;
              if (scalar(@constraints)) {
                $field_str .= '\ [' . join(',\ ', @constraints) . ']';
              }
            }
            $field_str .= '\l';
          }
          $label .= '|' . $field_str;
        }

        if ($show_indexes) {
          my $index_str = '';
          foreach my $index ($table->get_indices) {
            next unless $index->is_valid;

            $index_str .= '*\ ' . $index->name . ': ';
            $index_str .= join(', ', $index->fields);
            if ($index->type eq 'UNIQUE') {
              $index_str .= '\ [U]';
            }
            $index_str .= '\l';
          }
          $label .= '|' . $index_str;
        }
        $label .= '}';
#        $gv->add_node( $table_name, label => $label );
#        $gv->add_node( $table_name, label => $label, ($node_shape eq 'record' ? ( shape => $node_shape ) : ()) );
        $gv->add_node( $table_name, label => $label, 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 ) {
                next if $i == $j;
                my $table2 = $tables[ $j ];
                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,
9d93edab	41	show_sizes => 1
d491c962	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
9d93edab	96	=item * fontname
027cebc7	97
	98	custom font name (or full path to font file) for node, edge, and graph
	99	labels
	100
9d93edab	101	=item * nodeattrs
027cebc7	102
	103	reference to a hash of node attribute names and their values; these
	104	may override general fontname or fontsize parameter
	105
9d93edab	106	=item * edgeattrs
027cebc7	107
	108	reference to a hash of edge attribute names and their values; these
	109	may override general fontname or fontsize parameter
	110
9d93edab	111	=item * graphattrs
027cebc7	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
9d93edab	132	=item * show_sizes
d491c962	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
b7478526	174	=item * show_indexes
	175
	176	if set to a true value, each record will also show the indexes
	177	set on each table. it describes the index types along with
	178	which columns are included in the index. this option requires
	179	that show_fields is a true value as well
	180
	181	=item * friendly_ints
	182
	183	if set to a true value, each integer type field will be displayed
	184	as a tinyint, smallint, integer or bigint depending on the field's
	185	associated size parameter. this only applies for the 'integer'
	186	type (and not the lowercase 'int' type, which is assumed to be a
	187	32-bit integer).
	188
d491c962	189	=back
	190
	191	=cut
	192
14d7eb56	193	use strict;
	194	use GraphViz;
	195	use Data::Dumper;
997f14b2	196	use SQL::Translator::Schema::Constants;
14d7eb56	197	use SQL::Translator::Utils qw(debug);
	198
	199	use vars qw[ $VERSION $DEBUG ];
f51d8e46	200	$VERSION = sprintf "%d.%02d", q$Revision: 1.14 $ =~ /(\d+)\.(\d+)/;
14d7eb56	201	$DEBUG = 0 unless defined $DEBUG;
	202
	203	use constant VALID_LAYOUT => {
	204	dot => 1,
	205	neato => 1,
	206	twopi => 1,
	207	};
	208
	209	use constant VALID_NODE_SHAPE => {
	210	record => 1,
	211	plaintext => 1,
	212	ellipse => 1,
	213	circle => 1,
	214	egg => 1,
	215	triangle => 1,
	216	box => 1,
	217	diamond => 1,
	218	trapezium => 1,
	219	parallelogram => 1,
	220	house => 1,
	221	hexagon => 1,
	222	octagon => 1,
	223	};
	224
	225	use constant VALID_OUTPUT => {
	226	canon => 1,
	227	text => 1,
	228	ps => 1,
	229	hpgl => 1,
	230	pcl => 1,
	231	mif => 1,
	232	pic => 1,
	233	gd => 1,
	234	gd2 => 1,
	235	gif => 1,
	236	jpeg => 1,
	237	png => 1,
	238	wbmp => 1,
	239	cmap => 1,
	240	ismap => 1,
	241	imap => 1,
	242	vrml => 1,
	243	vtx => 1,
	244	mp => 1,
	245	fig => 1,
	246	svg => 1,
	247	plain => 1,
	248	};
	249
	250	sub produce {
997f14b2	251	my $t = shift;
997f14b2	252	my $schema = $t->schema;
14d7eb56	253	my $args = $t->producer_args;
14d7eb56	254	local $DEBUG = $t->debug;
14d7eb56	255
59cbb03f	256	my $out_file = $args->{'out_file'} \|\| '';
	257	my $layout = $args->{'layout'} \|\| 'dot';
	258	my $node_shape = $args->{'node_shape'} \|\| 'record';
	259	my $output_type = $args->{'output_type'} \|\| 'png';
	260	my $width = defined $args->{'width'}
	261	? $args->{'width'} : 8.5;
	262	my $height = defined $args->{'height'}
	263	? $args->{'height'} : 11;
027cebc7	264	my $fontsize = $args->{'fontsize'};
	265	my $fontname = $args->{'fontname'};
	266	my $edgeattrs = $args->{'edgeattrs'} \|\| {};
	267	my $graphattrs = $args->{'graphattrs'} \|\| {};
	268	my $nodeattrs = $args->{'nodeattrs'} \|\| {};
59cbb03f	269	my $show_fields = defined $args->{'show_fields'}
	270	? $args->{'show_fields'} : 1;
	271	my $add_color = $args->{'add_color'};
	272	my $natural_join = $args->{'natural_join'};
	273	my $show_fk_only = $args->{'show_fk_only'};
	274	my $show_datatypes = $args->{'show_datatypes'};
	275	my $show_sizes = $args->{'show_sizes'};
b7478526	276	my $show_indexes = $args->{'show_indexes'};
b7478526	277	my $friendly_ints = $args->{'friendly_ints'};
37ce746e	278	my $show_constraints = $args->{'show_constraints'};
59cbb03f	279	my $join_pk_only = $args->{'join_pk_only'};
9d93edab	280	my $skip_fields = $args->{'skip_fields'} \|\| '';
9d93edab	281	my %skip = map { s/^\s+\|\s+$//g; length $_ ? ($_, 1) : () }
59cbb03f	282	split ( /,/, $skip_fields );
59cbb03f	283	$natural_join \|\|= $join_pk_only;
14d7eb56	284
997f14b2	285	$schema->make_natural_joins(
	286	join_pk_only => $join_pk_only,
	287	skip_fields => $args->{'skip_fields'},
	288	) if $natural_join;
	289
14d7eb56	290	die "Invalid layout '$layout'" unless VALID_LAYOUT->{ $layout };
	291	die "Invalid output type: '$output_type'"
	292	unless VALID_OUTPUT->{ $output_type };
	293	die "Invalid node shape'$node_shape'"
	294	unless VALID_NODE_SHAPE->{ $node_shape };
	295
e36752ea	296	for ( $height, $width ) {
	297	$_ = 0 unless $_ =~ /^\d+(.\d)?$/;
	298	$_ = 0 if $_ < 0;
	299	}
	300
14d7eb56	301	#
	302	# Create GraphViz and see if we can produce the output type.
	303	#
e36752ea	304	my %args = (
14d7eb56	305	directed => $natural_join ? 0 : 1,
	306	layout => $layout,
	307	no_overlap => 1,
	308	bgcolor => $add_color ? 'lightgoldenrodyellow' : 'white',
	309	node => {
	310	shape => $node_shape,
	311	style => 'filled',
027cebc7	312	fillcolor => 'white',
027cebc7	313	},
e36752ea	314	);
	315	$args{'width'} = $width if $width;
	316	$args{'height'} = $height if $height;
027cebc7	317	# set fontsize for edge and node labels if specified
	318	if ($fontsize) {
	319	$args{'node'}->{'fontsize'} = $fontsize;
	320	$args{'edge'} = {} unless $args{'edge'};
	321	$args{'edge'}->{'fontsize'} = $fontsize;
	322	}
	323	# set the font name globally for node, edge, and graph labels if
	324	# specified (use node, edge, or graph attributes for individual
	325	# font specification)
	326	if ($fontname) {
	327	$args{'node'}->{'fontname'} = $fontname;
	328	$args{'edge'} = {} unless $args{'edge'};
	329	$args{'edge'}->{'fontname'} = $fontname;
	330	$args{'graph'} = {} unless $args{'graph'};
	331	$args{'graph'}->{'fontname'} = $fontname;
	332	}
	333	# set additional node, edge, and graph attributes; these may
	334	# possibly override ones set before
	335	while (my ($key,$val) = each %$nodeattrs) {
	336	$args{'node'}->{$key} = $val;
	337	}
	338	$args{'edge'} = {} if %$edgeattrs && !$args{'edge'};
	339	while (my ($key,$val) = each %$edgeattrs) {
	340	$args{'edge'}->{$key} = $val;
	341	}
	342	$args{'graph'} = {} if %$edgeattrs && !$args{'graph'};
	343	while (my ($key,$val) = each %$graphattrs) {
	344	$args{'graph'}->{$key} = $val;
	345	}
e36752ea	346
e36752ea	347	my $gv = GraphViz->new( %args ) or die "Can't create GraphViz object\n";
14d7eb56	348
	349	my %nj_registry; # for locations of fields for natural joins
	350	my @fk_registry; # for locations of fields for foreign keys
	351
997f14b2	352	for my $table ( $schema->get_tables ) {
	353	my $table_name = $table->name;
	354	my @fields = $table->get_fields;
	355	if ( $show_fk_only ) {
	356	@fields = grep { $_->is_foreign_key } @fields;
14d7eb56	357	}
14d7eb56	358
b7478526	359	my $label = '{' . $table_name;
	360	if ($show_fields) {
	361	my $field_str = '';
	362	foreach my $field (@fields) {
	363	$field_str .= '-\ ' . $field->name;
	364	if ($show_datatypes) {
	365	my $dt = lc($field->data_type);
	366
	367	# For the integer type, transform into different types based on
	368	# requested size, if a size is given.
	369	if ($friendly_ints && $dt eq 'integer' && $field->size) {
	370	# Automatically translate to int2, int4, int8
	371	# Type (Bits) Max. Signed Length
	372	# tinyint (8) 128 3
	373	# smallint (16) 32767 5
	374	# int (32) 2147483647 10
	375	# bigint (64) 9223372036854775807 19
	376	if ($field->size > 10) {
	377	$dt = 'bigint';
	378	}
	379	elsif ($field->size > 5) {
	380	$dt = 'integer';
	381	}
	382	elsif ($field->size > 3) {
	383	$dt = 'smallint';
	384	}
	385	else { # 8 bits
	386	$dt = 'tinyint';
	387	}
	388	}
	389
	390	$field_str .= '\ ' . $dt;
	391	if ($show_sizes && $field->size && ($dt =~ /^(var)?char2?$/ \|\| $dt eq 'numeric' \|\| $dt eq 'decimal')) {
	392	$field_str .= '(' . $field->size . ')';
	393	}
	394	}
	395
	396	if ($show_constraints) {
	397	my @constraints;
	398	push(@constraints, 'PK') if $field->is_primary_key;
	399	push(@constraints, 'FK') if $field->is_foreign_key;
	400	push(@constraints, 'U') if $field->is_unique;
	401	if (scalar(@constraints)) {
	402	$field_str .= '\ [' . join(',\ ', @constraints) . ']';
	403	}
	404	}
	405	$field_str .= '\l';
	406	}
	407	$label .= '\|' . $field_str;
	408	}
	409
	410	if ($show_indexes) {
	411	my $index_str = '';
	412	foreach my $index ($table->get_indices) {
	413	next unless $index->is_valid;
	414
	415	$index_str .= '*\ ' . $index->name . ': ';
	416	$index_str .= join(', ', $index->fields);
	417	if ($index->type eq 'UNIQUE') {
	418	$index_str .= '\ [U]';
	419	}
	420	$index_str .= '\l';
	421	}
	422	$label .= '\|' . $index_str;
423	}
424	$label .= '}';
f51d8e46	425	# $gv->add_node( $table_name, label => $label );
b7478526	426	# $gv->add_node( $table_name, label => $label, ($node_shape eq 'record' ? ( shape => $node_shape ) : ()) );
b7478526	427	$gv->add_node( $table_name, label => $label, shape => $node_shape );
e36752ea	428	debug("Processing table '$table_name'");
e36752ea	429
997f14b2	430	debug("Fields = ", join(', ', map { $_->name } @fields));
14d7eb56	431
14d7eb56	432	for my $f ( @fields ) {
997f14b2	433	my $name = $f->name or next;
	434	my $is_pk = $f->is_primary_key;
	435	my $is_unique = $f->is_unique;
14d7eb56	436
	437	#
	438	# Decide if we should skip this field.
	439	#
	440	if ( $natural_join ) {
997f14b2	441	next unless $is_pk \|\| $f->is_foreign_key;
14d7eb56	442	}
	443
	444	my $constraints = $f->{'constraints'};
	445
	446	if ( $natural_join && !$skip{ $name } ) {
	447	push @{ $nj_registry{ $name } }, $table_name;
	448	}
997f14b2	449	}
	450
	451	unless ( $natural_join ) {
	452	for my $c ( $table->get_constraints ) {
	453	next unless $c->type eq FOREIGN_KEY;
	454	my $fk_table = $c->reference_table or next;
	455
	456	for my $field_name ( $c->fields ) {
	457	for my $fk_field ( $c->reference_fields ) {
	458	next unless defined $schema->get_table( $fk_table );
14d7eb56	459	push @fk_registry, [ $table_name, $fk_table ];
	460	}
	461	}
	462	}
	463	}
	464	}
	465
	466	#
	467	# Make the connections.
	468	#
	469	my @table_bunches;
	470	if ( $natural_join ) {
	471	for my $field_name ( keys %nj_registry ) {
	472	my @table_names = @{ $nj_registry{ $field_name } \|\| [] } or next;
	473	next if scalar @table_names == 1;
	474	push @table_bunches, [ @table_names ];
	475	}
	476	}
	477	else {
	478	@table_bunches = @fk_registry;
	479	}
	480
	481	my %done;
	482	for my $bunch ( @table_bunches ) {
	483	my @tables = @$bunch;
	484
	485	for my $i ( 0 .. $#tables ) {
	486	my $table1 = $tables[ $i ];
	487	for my $j ( 0 .. $#tables ) {
d51a158e	488	next if $i == $j;
14d7eb56	489	my $table2 = $tables[ $j ];
14d7eb56	490	next if $done{ $table1 }{ $table2 };
13811af0	491	$gv->add_edge( $table2, $table1 );
14d7eb56	492	$done{ $table1 }{ $table2 } = 1;
	493	$done{ $table2 }{ $table1 } = 1;
	494	}
	495	}
	496	}
	497
	498	#
	499	# Print the image.
	500	#
	501	my $output_method = "as_$output_type";
	502	if ( $out_file ) {
	503	open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
28c31cbf	504	binmode $fh;
14d7eb56	505	print $fh $gv->$output_method;
	506	close $fh;
	507	}
	508	else {
	509	return $gv->$output_method;
	510	}
	511	}
	512
	513	1;
	514
977651a5	515	# -------------------------------------------------------------------
977651a5	516
14d7eb56	517	=pod
14d7eb56	518
14d7eb56	519	=head1 AUTHOR
	520
	521	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
	522
d491c962	523	=head1 SEE ALSO
	524
	525	SQL::Translator, GraphViz
	526
14d7eb56	527	=cut