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

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

# -------------------------------------------------------------------
# Copyright (C) 2002-2009 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 resulting GraphViz output will be
written. Alternatively an open filehandle can be supplied. If
undefined (the default) - the result is returned as a string.

=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 * skip_tables

A comma-separated list of table names that should be skipped.

=item * skip_tables_like

A comma-separated list of regular expressions describing table names
that should be skipped.

=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 * show_index_names

if show_indexes is set to a true value, then the value of this
parameter determines whether or not to print names of indexes.
if show_index_names is false, then a list of indexed columns
will appear below the field list. otherwise, it will be a list
prefixed with the name of each index. it defaults to true.

=item * friendly_ints

if set to a true value, each integer type field will be displayed
as a 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).

=item * friendly_ints_extended

if set to a true value, the friendly ints displayed will take into
account the non-standard types, 'tinyint' and 'mediumint' (which,
as far as I am aware, is only implemented in MySQL)

=back

=cut

use strict;
use GraphViz;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(debug);
use Scalar::Util qw/openhandle/;

use vars qw[ $VERSION $DEBUG ];
$VERSION = '1.59';
$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, 
};

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 $show_index_names = defined $args->{'show_index_names'} 
                         ? $args->{'show_index_names'} : 1;
    my $friendly_ints    = $args->{'friendly_ints'};
    my $friendly_ints_ex = $args->{'friendly_ints_extended'};
    my $show_constraints = $args->{'show_constraints'};
    my $join_pk_only     = $args->{'join_pk_only'};
    my $skip_fields      = $args->{'skip_fields'}      || '';
    my $skip_tables      = $args->{'skip_tables'}      || '';
    my $skip_tables_like = $args->{'skip_tables_like'} || '';
    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 node shape'$node_shape'" 
        unless VALID_NODE_SHAPE->{ $node_shape };

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

    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 %cluster;
    if ( defined $args->{'cluster'} ) {
        my @clusters;
        if ( ref $args->{'cluster'} eq 'ARRAY' ) {
            @clusters = @{ $args->{'cluster'} };
        }
        else {
            @clusters = split /\s*;\s*/, $args->{'cluster'};
        }

        for my $c ( @clusters ) {
            my ( $cluster_name, @cluster_tables );
            if ( ref $c eq 'HASH' ) {
                $cluster_name   = $c->{'name'} || $c->{'cluster_name'};
                @cluster_tables = @{ $c->{'tables'} || [] };
            }
            else {
                my ( $name, $tables ) = split /\s*=\s*/, $c;
                $cluster_name   = $name;
                @cluster_tables = split /\s*,\s*/, $tables;
            }

            for my $table ( @cluster_tables ) {
                $cluster{ $table } = $cluster_name;
            }
        }
    }

    #
    # Create a blank GraphViz object and see if we can produce the output type.
    #
    my $gv = GraphViz->new( %args ) or die "Can't create GraphViz object\n";
    my $output_method = "as_$output_type";

    # the generators are AUTOLOADed so can't use ->can ($output_method) 
    eval { $gv->$output_method };
    die "Invalid output type: '$output_type'" if $@;

    my %skip_table       = map { $_, 1 }  split /\s*,\s*/, $skip_tables;
    my @skip_tables_like = map { qr/$_/ } split /\s*,\s*/, $skip_tables_like;
    my %nj_registry; # for locations of fields for natural joins
    my @fk_registry; # for locations of fields for foreign keys

    TABLE:
    for my $table ( $schema->get_tables ) {
        my $tname = $table->name;

        if ( %skip_table ) {
            next TABLE if $skip_table{ $tname };

            for my $regex ( @skip_tables_like ) {
                next TABLE if $tname =~ $regex;
            }
        }

        my @fields = $table->get_fields;
        if ( $show_fk_only ) {
            @fields = grep { $_->is_foreign_key } @fields;
        }

        my $field_str = '';
        my $field_num = 0;
        if ( $show_fields ) {
            my @fmt_fields;
            for my $field ( @fields ) {
                my $field_type;
                if ($show_datatypes) {
                    $field_type = $field->data_type;

                    # For the integer type, transform into different
                    # types based on requested size, if a size is given.
                    if (    $field->size
                        and $friendly_ints
                        and ( lc $field_type ) eq 'integer' 
                    ) {
                        # Automatically translate to int2, int4, int8
                        # Type (Bits)     Max. Signed/Unsigned    Length
                        # tinyint* (8)    128                     3
                        #                 255                     3
                        # smallint (16)   32767                   5
                        #                 65535                   5
                        # mediumint* (24) 8388607                 7
                        #                 16777215                8
                        # int (32)        2147483647              10
                        #                 4294967295              11
                        # bigint (64)     9223372036854775807     19
                        #                 18446744073709551615    20
                        #
                        # * tinyint and mediumint are nonstandard extensions 
                        # which are only available under MySQL (to my knowledge)
                        my $size = $field->size;
                        if ( $size <= 3 and $friendly_ints_ex ) {
                            $field_type = 'tinyint',;
                        }
                        elsif ( $size <= 5 ) {
                            $field_type = 'smallint';
                        }
                        elsif ( $size <= 8 and $friendly_ints_ex ) {
                            $field_type = 'mediumint';
                        }
                        elsif ( $size <= 11 ) {
                            $field_type = 'integer';
                        }
                        else {
                            $field_type = 'bigint';
                        }
                    }

                    if (
                            $show_sizes
                        and $field->size
                        and (  $field_type =~ /^(var)?char2?$/
                            or $field_type eq 'numeric'
                            or $field_type eq 'decimal' )
                    ) {
                        $field_type .= '(' . $field->size . ')';
                    }
                }

                my $constraints;
                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;

                    $constraints = join( ',', @constraints );
                }

                # construct the field line from all info gathered so far
                push @fmt_fields, join( ' ',
                    '-', 
                    $field->name,
                    $field_type || (),
                    $constraints ? "[$constraints]" : (),
                );
            }

            # join field lines with graphviz formatting
            $field_str = join( '\l', @fmt_fields ) . '\l';
        }

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

                push @fmt_indexes, join( ' ',
                    '*',
                    $show_index_names ? $index->name . ':' : (),
                    join( ', ', $index->fields ),
                    ( $index->type eq 'UNIQUE' ) ? '[U]' : (),
                );
            }

            # join index lines with graphviz formatting (if any indexes at all)
            $index_str = join( '\l', @fmt_indexes ) . '\l' if @fmt_indexes;
        }

        my $table_name = $table->name;
        my $name_str = $table_name . '\n';

        # escape spaces
        for ($name_str, $field_str, $index_str) {
            $_ =~ s/ /\\ /g;
        }

        # only the 'record' type supports nice formatting
        if ( $node_shape eq 'record' ) {
            # the necessity to supply shape => 'record' is a graphviz bug
            my %node_args = (
                shape => 'record',
                label => sprintf( '{%s}',
                    join( '|', $name_str, $field_str || (), $index_str || (), ),
                ),
            );

            if ( my $cluster_name = $cluster{ $table->name } ) {
                $node_args{'cluster'} = $cluster_name;
            }

            $gv->add_node( $table_name, %node_args );
        }
        else {
            my $sep = sprintf ('%s\n',
                '-' x ( (length $table_name) + 2)
            );

            $gv->add_node( $table_name,
                label => join ($sep,
                    $name_str,
                    $field_str || (),
                    $index_str || (),
                ),
            );
        }

        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 ( 1 .. $#tables ) {
                next if $i == $j;
                my $table2 = $tables[ $j ];
                next if $done{ $table1 }{ $table2 };
                $gv->add_edge( $table2, $table1 );
                $done{ $table1 }{ $table2 } = 1;
            }
        }
    }

    #
    # Print the image.
    #
    if ( $out_file ) {
        if ( openhandle( $out_file ) ) {
            print $out_file $gv->$output_method;
        }
        else {
            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 Youens-Clark E<lt>kclark@cpan.orgE<gt>,
Jonathan Yu E<lt>frequency@cpan.orgE<gt>

=head1 SEE ALSO

SQL::Translator, GraphViz.

=cut
Commit	Line	Data
14d7eb56	1	package SQL::Translator::Producer::GraphViz;
	2
	3	# -------------------------------------------------------------------
6264cdc8	4	# Copyright (C) 2002-2009 SQLFairy Authors
14d7eb56	5	#
	6	# This program is free software; you can redistribute it and/or
	7	# modify it under the terms of the GNU General Public License as
	8	# published by the Free Software Foundation; version 2.
	9	#
	10	# This program is distributed in the hope that it will be useful, but
	11	# WITHOUT ANY WARRANTY; without even the implied warranty of
	12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	13	# General Public License for more details.
	14	#
	15	# You should have received a copy of the GNU General Public License
	16	# along with this program; if not, write to the Free Software
	17	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
	18	# 02111-1307 USA
	19	# -------------------------------------------------------------------
	20
d491c962	21	=pod
	22
	23	=head1 NAME
	24
	25	SQL::Translator::Producer::GraphViz - GraphViz producer for SQL::Translator
	26
	27	=head1 SYNOPSIS
	28
	29	use SQL::Translator;
	30
	31	my $trans = new SQL::Translator(
	32	from => 'MySQL', # or your db of choice
	33	to => 'GraphViz',
	34	producer_args => {
	35	out_file => 'schema.png',
	36	add_color => 1,
	37	show_constraints => 1,
	38	show_datatypes => 1,
9d93edab	39	show_sizes => 1
d491c962	40	}
	41	) or die SQL::Translator->error;
	42
	43	$trans->translate or die $trans->error;
	44
	45	=head1 DESCRIPTION
	46
	47	Creates a graph of a schema using the amazing graphviz
	48	(see http://www.graphviz.org/) application (via
	49	the GraphViz module). It's nifty--you should try it!
	50
	51	=head1 PRODUCER ARGS
	52
	53	=over 4
	54
	55	=item * out_file
	56
d8324f08	57	The name of the file where the resulting GraphViz output will be
	58	written. Alternatively an open filehandle can be supplied. If
	59	undefined (the default) - the result is returned as a string.
d491c962	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
44435b87	174	=item * skip_tables
44435b87	175
818e0d98	176	A comma-separated list of table names that should be skipped.
	177
	178	=item * skip_tables_like
	179
	180	A comma-separated list of regular expressions describing table names
	181	that should be skipped.
44435b87	182
b7478526	183	=item * show_indexes
	184
	185	if set to a true value, each record will also show the indexes
	186	set on each table. it describes the index types along with
	187	which columns are included in the index. this option requires
	188	that show_fields is a true value as well
	189
4d5d28cb	190	=item * show_index_names
d6d6b205	191
	192	if show_indexes is set to a true value, then the value of this
	193	parameter determines whether or not to print names of indexes.
d8324f08	194	if show_index_names is false, then a list of indexed columns
d6d6b205	195	will appear below the field list. otherwise, it will be a list
	196	prefixed with the name of each index. it defaults to true.
	197
b7478526	198	=item * friendly_ints
	199
	200	if set to a true value, each integer type field will be displayed
d44b5f54	201	as a smallint, integer or bigint depending on the field's
b7478526	202	associated size parameter. this only applies for the 'integer'
	203	type (and not the lowercase 'int' type, which is assumed to be a
	204	32-bit integer).
	205
d44b5f54	206	=item * friendly_ints_extended
	207
	208	if set to a true value, the friendly ints displayed will take into
	209	account the non-standard types, 'tinyint' and 'mediumint' (which,
	210	as far as I am aware, is only implemented in MySQL)
	211
d491c962	212	=back
	213
	214	=cut
	215
14d7eb56	216	use strict;
14d7eb56	217	use GraphViz;
997f14b2	218	use SQL::Translator::Schema::Constants;
14d7eb56	219	use SQL::Translator::Utils qw(debug);
d8324f08	220	use Scalar::Util qw/openhandle/;
14d7eb56	221
14d7eb56	222	use vars qw[ $VERSION $DEBUG ];
4ab3763d	223	$VERSION = '1.59';
14d7eb56	224	$DEBUG = 0 unless defined $DEBUG;
	225
	226	use constant VALID_LAYOUT => {
	227	dot => 1,
	228	neato => 1,
	229	twopi => 1,
	230	};
	231
	232	use constant VALID_NODE_SHAPE => {
	233	record => 1,
	234	plaintext => 1,
	235	ellipse => 1,
	236	circle => 1,
	237	egg => 1,
	238	triangle => 1,
	239	box => 1,
	240	diamond => 1,
	241	trapezium => 1,
	242	parallelogram => 1,
	243	house => 1,
	244	hexagon => 1,
	245	octagon => 1,
	246	};
	247
14d7eb56	248	sub produce {
997f14b2	249	my $t = shift;
997f14b2	250	my $schema = $t->schema;
14d7eb56	251	my $args = $t->producer_args;
14d7eb56	252	local $DEBUG = $t->debug;
14d7eb56	253
59cbb03f	254	my $out_file = $args->{'out_file'} \|\| '';
	255	my $layout = $args->{'layout'} \|\| 'dot';
	256	my $node_shape = $args->{'node_shape'} \|\| 'record';
	257	my $output_type = $args->{'output_type'} \|\| 'png';
	258	my $width = defined $args->{'width'}
	259	? $args->{'width'} : 8.5;
	260	my $height = defined $args->{'height'}
	261	? $args->{'height'} : 11;
027cebc7	262	my $fontsize = $args->{'fontsize'};
	263	my $fontname = $args->{'fontname'};
	264	my $edgeattrs = $args->{'edgeattrs'} \|\| {};
	265	my $graphattrs = $args->{'graphattrs'} \|\| {};
	266	my $nodeattrs = $args->{'nodeattrs'} \|\| {};
59cbb03f	267	my $show_fields = defined $args->{'show_fields'}
	268	? $args->{'show_fields'} : 1;
	269	my $add_color = $args->{'add_color'};
	270	my $natural_join = $args->{'natural_join'};
	271	my $show_fk_only = $args->{'show_fk_only'};
	272	my $show_datatypes = $args->{'show_datatypes'};
	273	my $show_sizes = $args->{'show_sizes'};
b7478526	274	my $show_indexes = $args->{'show_indexes'};
818e0d98	275	my $show_index_names = defined $args->{'show_index_names'}
818e0d98	276	? $args->{'show_index_names'} : 1;
b7478526	277	my $friendly_ints = $args->{'friendly_ints'};
d44b5f54	278	my $friendly_ints_ex = $args->{'friendly_ints_extended'};
37ce746e	279	my $show_constraints = $args->{'show_constraints'};
59cbb03f	280	my $join_pk_only = $args->{'join_pk_only'};
818e0d98	281	my $skip_fields = $args->{'skip_fields'} \|\| '';
	282	my $skip_tables = $args->{'skip_tables'} \|\| '';
	283	my $skip_tables_like = $args->{'skip_tables_like'} \|\| '';
9d93edab	284	my %skip = map { s/^\s+\|\s+$//g; length $_ ? ($_, 1) : () }
59cbb03f	285	split ( /,/, $skip_fields );
59cbb03f	286	$natural_join \|\|= $join_pk_only;
14d7eb56	287
997f14b2	288	$schema->make_natural_joins(
	289	join_pk_only => $join_pk_only,
	290	skip_fields => $args->{'skip_fields'},
	291	) if $natural_join;
	292
14d7eb56	293	die "Invalid layout '$layout'" unless VALID_LAYOUT->{ $layout };
14d7eb56	294	die "Invalid node shape'$node_shape'"
	295	unless VALID_NODE_SHAPE->{ $node_shape };
	296
e36752ea	297	for ( $height, $width ) {
	298	$_ = 0 unless $_ =~ /^\d+(.\d)?$/;
	299	$_ = 0 if $_ < 0;
	300	}
	301
e36752ea	302	my %args = (
14d7eb56	303	directed => $natural_join ? 0 : 1,
	304	layout => $layout,
	305	no_overlap => 1,
	306	bgcolor => $add_color ? 'lightgoldenrodyellow' : 'white',
	307	node => {
	308	shape => $node_shape,
	309	style => 'filled',
027cebc7	310	fillcolor => 'white',
027cebc7	311	},
e36752ea	312	);
771479d7	313
e36752ea	314	$args{'width'} = $width if $width;
e36752ea	315	$args{'height'} = $height if $height;
771479d7	316
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	}
771479d7	323
027cebc7	324	# set the font name globally for node, edge, and graph labels if
	325	# specified (use node, edge, or graph attributes for individual
	326	# font specification)
	327	if ($fontname) {
	328	$args{'node'}->{'fontname'} = $fontname;
	329	$args{'edge'} = {} unless $args{'edge'};
	330	$args{'edge'}->{'fontname'} = $fontname;
	331	$args{'graph'} = {} unless $args{'graph'};
	332	$args{'graph'}->{'fontname'} = $fontname;
	333	}
771479d7	334
027cebc7	335	# set additional node, edge, and graph attributes; these may
	336	# possibly override ones set before
	337	while (my ($key,$val) = each %$nodeattrs) {
	338	$args{'node'}->{$key} = $val;
	339	}
771479d7	340
027cebc7	341	$args{'edge'} = {} if %$edgeattrs && !$args{'edge'};
771479d7	342
027cebc7	343	while (my ($key,$val) = each %$edgeattrs) {
	344	$args{'edge'}->{$key} = $val;
	345	}
771479d7	346
027cebc7	347	$args{'graph'} = {} if %$edgeattrs && !$args{'graph'};
771479d7	348
027cebc7	349	while (my ($key,$val) = each %$graphattrs) {
	350	$args{'graph'}->{$key} = $val;
	351	}
e36752ea	352
771479d7	353	my %cluster;
	354	if ( defined $args->{'cluster'} ) {
	355	my @clusters;
	356	if ( ref $args->{'cluster'} eq 'ARRAY' ) {
	357	@clusters = @{ $args->{'cluster'} };
	358	}
	359	else {
	360	@clusters = split /\s;\s/, $args->{'cluster'};
	361	}
	362
	363	for my $c ( @clusters ) {
	364	my ( $cluster_name, @cluster_tables );
	365	if ( ref $c eq 'HASH' ) {
	366	$cluster_name = $c->{'name'} \|\| $c->{'cluster_name'};
	367	@cluster_tables = @{ $c->{'tables'} \|\| [] };
	368	}
	369	else {
	370	my ( $name, $tables ) = split /\s=\s/, $c;
	371	$cluster_name = $name;
	372	@cluster_tables = split /\s,\s/, $tables;
	373	}
	374
	375	for my $table ( @cluster_tables ) {
	376	$cluster{ $table } = $cluster_name;
	377	}
	378	}
	379	}
	380
d8324f08	381	#
	382	# Create a blank GraphViz object and see if we can produce the output type.
	383	#
	384	my $gv = GraphViz->new( %args ) or die "Can't create GraphViz object\n";
	385	my $output_method = "as_$output_type";
	386
	387	# the generators are AUTOLOADed so can't use ->can ($output_method)
	388	eval { $gv->$output_method };
	389	die "Invalid output type: '$output_type'" if $@;
	390
818e0d98	391	my %skip_table = map { $_, 1 } split /\s,\s/, $skip_tables;
818e0d98	392	my @skip_tables_like = map { qr/$_/ } split /\s,\s/, $skip_tables_like;
14d7eb56	393	my %nj_registry; # for locations of fields for natural joins
	394	my @fk_registry; # for locations of fields for foreign keys
	395
44435b87	396	TABLE:
997f14b2	397	for my $table ( $schema->get_tables ) {
44435b87	398	my $tname = $table->name;
	399
	400	if ( %skip_table ) {
	401	next TABLE if $skip_table{ $tname };
	402
818e0d98	403	for my $regex ( @skip_tables_like ) {
818e0d98	404	next TABLE if $tname =~ $regex;
44435b87	405	}
	406	}
	407
771479d7	408	my @fields = $table->get_fields;
997f14b2	409	if ( $show_fk_only ) {
997f14b2	410	@fields = grep { $_->is_foreign_key } @fields;
14d7eb56	411	}
14d7eb56	412
6264cdc8	413	my $field_str = '';
771479d7	414	my $field_num = 0;
818e0d98	415	if ( $show_fields ) {
	416	my @fmt_fields;
	417	for my $field ( @fields ) {
	418	my $field_type;
	419	if ($show_datatypes) {
	420	$field_type = $field->data_type;
	421
	422	# For the integer type, transform into different
	423	# types based on requested size, if a size is given.
	424	if ( $field->size
	425	and $friendly_ints
	426	and ( lc $field_type ) eq 'integer'
	427	) {
	428	# Automatically translate to int2, int4, int8
	429	# Type (Bits) Max. Signed/Unsigned Length
	430	# tinyint* (8) 128 3
	431	# 255 3
	432	# smallint (16) 32767 5
	433	# 65535 5
	434	# mediumint* (24) 8388607 7
	435	# 16777215 8
	436	# int (32) 2147483647 10
	437	# 4294967295 11
	438	# bigint (64) 9223372036854775807 19
	439	# 18446744073709551615 20
	440	#
	441	# * tinyint and mediumint are nonstandard extensions
	442	# which are only available under MySQL (to my knowledge)
	443	my $size = $field->size;
	444	if ( $size <= 3 and $friendly_ints_ex ) {
	445	$field_type = 'tinyint',;
	446	}
	447	elsif ( $size <= 5 ) {
	448	$field_type = 'smallint';
	449	}
	450	elsif ( $size <= 8 and $friendly_ints_ex ) {
	451	$field_type = 'mediumint';
	452	}
	453	elsif ( $size <= 11 ) {
	454	$field_type = 'integer';
	455	}
	456	else {
	457	$field_type = 'bigint';
	458	}
	459	}
	460
	461	if (
	462	$show_sizes
	463	and $field->size
	464	and ( $field_type =~ /^(var)?char2?$/
	465	or $field_type eq 'numeric'
	466	or $field_type eq 'decimal' )
	467	) {
	468	$field_type .= '(' . $field->size . ')';
	469	}
b7478526	470	}
b7478526	471
818e0d98	472	my $constraints;
	473	if ( $show_constraints ) {
	474	my @constraints;
6264cdc8	475
818e0d98	476	push( @constraints, 'PK' ) if $field->is_primary_key;
	477	push( @constraints, 'FK' ) if $field->is_foreign_key;
	478	push( @constraints, 'U' ) if $field->is_unique;
6264cdc8	479
818e0d98	480	$constraints = join( ',', @constraints );
818e0d98	481	}
6264cdc8	482
818e0d98	483	# construct the field line from all info gathered so far
818e0d98	484	push @fmt_fields, join( ' ',
771479d7	485	'-',
771479d7	486	$field->name,
818e0d98	487	$field_type \|\| (),
	488	$constraints ? "[$constraints]" : (),
	489	);
	490	}
6264cdc8	491
818e0d98	492	# join field lines with graphviz formatting
818e0d98	493	$field_str = join( '\l', @fmt_fields ) . '\l';
b7478526	494	}
b7478526	495
6264cdc8	496	my $index_str = '';
b7478526	497	if ($show_indexes) {
818e0d98	498	my @fmt_indexes;
	499	for my $index ( $table->get_indices ) {
	500	next unless $index->is_valid;
	501
	502	push @fmt_indexes, join( ' ',
	503	'*',
	504	$show_index_names ? $index->name . ':' : (),
	505	join( ', ', $index->fields ),
	506	( $index->type eq 'UNIQUE' ) ? '[U]' : (),
	507	);
	508	}
6264cdc8	509
818e0d98	510	# join index lines with graphviz formatting (if any indexes at all)
818e0d98	511	$index_str = join( '\l', @fmt_indexes ) . '\l' if @fmt_indexes;
6264cdc8	512	}
	513
	514	my $table_name = $table->name;
	515	my $name_str = $table_name . '\n';
	516
	517	# escape spaces
	518	for ($name_str, $field_str, $index_str) {
818e0d98	519	$_ =~ s/ /\\ /g;
b7478526	520	}
6264cdc8	521
6264cdc8	522	# only the 'record' type supports nice formatting
818e0d98	523	if ( $node_shape eq 'record' ) {
818e0d98	524	# the necessity to supply shape => 'record' is a graphviz bug
771479d7	525	my %node_args = (
818e0d98	526	shape => 'record',
	527	label => sprintf( '{%s}',
	528	join( '\|', $name_str, $field_str \|\| (), $index_str \|\| (), ),
6264cdc8	529	),
6264cdc8	530	);
771479d7	531
	532	if ( my $cluster_name = $cluster{ $table->name } ) {
	533	$node_args{'cluster'} = $cluster_name;
	534	}
	535
	536	$gv->add_node( $table_name, %node_args );
6264cdc8	537	}
	538	else {
	539	my $sep = sprintf ('%s\n',
	540	'-' x ( (length $table_name) + 2)
	541	);
	542
	543	$gv->add_node( $table_name,
	544	label => join ($sep,
	545	$name_str,
	546	$field_str \|\| (),
	547	$index_str \|\| (),
	548	),
	549	);
	550	}
	551
e36752ea	552	debug("Processing table '$table_name'");
e36752ea	553
997f14b2	554	debug("Fields = ", join(', ', map { $_->name } @fields));
14d7eb56	555
14d7eb56	556	for my $f ( @fields ) {
997f14b2	557	my $name = $f->name or next;
	558	my $is_pk = $f->is_primary_key;
	559	my $is_unique = $f->is_unique;
14d7eb56	560
	561	#
	562	# Decide if we should skip this field.
	563	#
	564	if ( $natural_join ) {
997f14b2	565	next unless $is_pk \|\| $f->is_foreign_key;
14d7eb56	566	}
	567
	568	my $constraints = $f->{'constraints'};
	569
	570	if ( $natural_join && !$skip{ $name } ) {
	571	push @{ $nj_registry{ $name } }, $table_name;
	572	}
997f14b2	573	}
	574
	575	unless ( $natural_join ) {
	576	for my $c ( $table->get_constraints ) {
	577	next unless $c->type eq FOREIGN_KEY;
	578	my $fk_table = $c->reference_table or next;
	579
	580	for my $field_name ( $c->fields ) {
	581	for my $fk_field ( $c->reference_fields ) {
	582	next unless defined $schema->get_table( $fk_table );
14d7eb56	583	push @fk_registry, [ $table_name, $fk_table ];
	584	}
	585	}
	586	}
	587	}
	588	}
	589
	590	#
	591	# Make the connections.
	592	#
	593	my @table_bunches;
	594	if ( $natural_join ) {
	595	for my $field_name ( keys %nj_registry ) {
	596	my @table_names = @{ $nj_registry{ $field_name } \|\| [] } or next;
	597	next if scalar @table_names == 1;
	598	push @table_bunches, [ @table_names ];
	599	}
	600	}
	601	else {
	602	@table_bunches = @fk_registry;
	603	}
	604
	605	my %done;
	606	for my $bunch ( @table_bunches ) {
	607	my @tables = @$bunch;
	608
	609	for my $i ( 0 .. $#tables ) {
	610	my $table1 = $tables[ $i ];
771479d7	611	for my $j ( 1 .. $#tables ) {
d51a158e	612	next if $i == $j;
14d7eb56	613	my $table2 = $tables[ $j ];
14d7eb56	614	next if $done{ $table1 }{ $table2 };
13811af0	615	$gv->add_edge( $table2, $table1 );
14d7eb56	616	$done{ $table1 }{ $table2 } = 1;
14d7eb56	617	}
	618	}
	619	}
	620
	621	#
	622	# Print the image.
	623	#
14d7eb56	624	if ( $out_file ) {
818e0d98	625	if ( openhandle( $out_file ) ) {
	626	print $out_file $gv->$output_method;
	627	}
	628	else {
8180e21a	629	open my $fh, '>', $out_file or die "Can't write '$out_file': $!\n";
818e0d98	630	binmode $fh;
	631	print $fh $gv->$output_method;
	632	close $fh;
	633	}
14d7eb56	634	}
14d7eb56	635	else {
818e0d98	636	return $gv->$output_method;
14d7eb56	637	}
	638	}
	639
	640	1;
	641
977651a5	642	# -------------------------------------------------------------------
977651a5	643
14d7eb56	644	=pod
14d7eb56	645
14d7eb56	646	=head1 AUTHOR
14d7eb56	647
818e0d98	648	Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
d44b5f54	649	Jonathan Yu E<lt>frequency@cpan.orgE<gt>
d44b5f54	650
d491c962	651	=head1 SEE ALSO
d491c962	652
818e0d98	653	SQL::Translator, GraphViz.
d491c962	654
14d7eb56	655	=cut