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

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

# -------------------------------------------------------------------
# $Id: GraphViz.pm 1451 2009-02-10 11:48:37Z ribasushi $
# -------------------------------------------------------------------
# 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 * 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.99';
$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             = 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;
    }

    #
    # 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 %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 @fields     = $table->get_fields;
        if ( $show_fk_only ) {
            @fields = grep { $_->is_foreign_key } @fields;
        }

        my $field_str = '';
        if ($show_fields) {

          my @fmt_fields;
          foreach 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;
          foreach 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 
            $gv->add_node( $table_name,
              shape => 'record',
              label => sprintf ('{%s}',
                join ('|',
                  $name_str,
                  $field_str || (),
                  $index_str || (),
                ),
              ),
            );
        }
        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 ( 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.
    #
    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 Y. Clark E<lt>kclark@cpan.orgE<gt>

=head2 CONTRIBUTORS

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	# -------------------------------------------------------------------
d4f84dd1	4	# $Id: GraphViz.pm 1451 2009-02-10 11:48:37Z ribasushi $
14d7eb56	5	# -------------------------------------------------------------------
6264cdc8	6	# Copyright (C) 2002-2009 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
d8324f08	59	The name of the file where the resulting GraphViz output will be
	60	written. Alternatively an open filehandle can be supplied. If
	61	undefined (the default) - the result is returned as a string.
d491c962	62
	63	=item * layout (DEFAULT: 'dot')
	64
	65	determines which layout algorithm GraphViz will use; possible
	66	values are 'dot' (the default GraphViz layout for directed graph
	67	layouts), 'neato' (for undirected graph layouts - spring model)
	68	or 'twopi' (for undirected graph layouts - circular)
	69
	70	=item * node_shape (DEFAULT: 'record')
	71
	72	sets the node shape of each table in the graph; this can be
	73	one of 'record', 'plaintext', 'ellipse', 'circle', 'egg',
	74	'triangle', 'box', 'diamond', 'trapezium', 'parallelogram',
	75	'house', 'hexagon', or 'octagon'
	76
	77	=item * output_type (DEFAULT: 'png')
	78
	79	sets the file type of the output graphic; possible values are
	80	'ps', 'hpgl', 'pcl', 'mif', 'pic', 'gd', 'gd2', 'gif', 'jpeg',
	81	'png', 'wbmp', 'cmap', 'ismap', 'imap', 'vrml', 'vtx', 'mp',
	82	'fig', 'svg', 'canon', 'plain' or 'text' (see GraphViz for
	83	details on each of these)
	84
	85	=item * width (DEFAULT: 8.5)
	86
	87	width (in inches) of the output graphic
	88
	89	=item * height (DEFAULT: 11)
	90
	91	height (in inches) of the output grahic
	92
027cebc7	93	=item * fontsize
	94
	95	custom font size for node and edge labels (note that arbitrarily large
	96	sizes may be ignored due to page size or graph size constraints)
	97
9d93edab	98	=item * fontname
027cebc7	99
	100	custom font name (or full path to font file) for node, edge, and graph
	101	labels
	102
9d93edab	103	=item * nodeattrs
027cebc7	104
	105	reference to a hash of node attribute names and their values; these
	106	may override general fontname or fontsize parameter
	107
9d93edab	108	=item * edgeattrs
027cebc7	109
	110	reference to a hash of edge attribute names and their values; these
	111	may override general fontname or fontsize parameter
	112
9d93edab	113	=item * graphattrs
027cebc7	114
	115	reference to a hash of graph attribute names and their values; these
	116	may override the general fontname parameter
	117
d491c962	118	=item * show_fields (DEFAULT: true)
	119
	120	if set to a true value, the names of the colums in a table will
	121	be displayed in each table's node
	122
	123	=item * show_fk_only
	124
	125	if set to a true value, only columns which are foreign keys
	126	will be displayed in each table's node
	127
	128	=item * show_datatypes
	129
	130	if set to a true value, the datatype of each column will be
	131	displayed next to each column's name; this option will have no
	132	effect if the value of show_fields is set to false
	133
9d93edab	134	=item * show_sizes
d491c962	135
	136	if set to a true value, the size (in bytes) of each CHAR and
	137	VARCHAR column will be displayed in parentheses next to the
	138	column's name; this option will have no effect if the value of
	139	show_fields is set to false
	140
	141	=item * show_constraints
	142
	143	if set to a true value, a field's constraints (i.e., its
	144	primary-key-ness, its foreign-key-ness and/or its uniqueness)
	145	will appear as a comma-separated list in brackets next to the
	146	field's name; this option will have no effect if the value of
	147	show_fields is set to false
	148
	149	=item * add_color
	150
	151	if set to a true value, the graphic will have a background
	152	color of 'lightgoldenrodyellow'; otherwise the background
	153	color will be white
	154
	155	=item * natural_join
	156
	157	if set to a true value, the make_natural_join method of
	158	SQL::Translator::Schema will be called before generating the
	159	graph; a true value for join_pk_only (see below) implies a
	160	true value for this option
	161
	162	=item * join_pk_only
	163
	164	the value of this option will be passed as the value of the
	165	like-named argument in the make_natural_join method (see
	166	natural_join above) of SQL::Translator::Schema, if either the
	167	value of this option or the natural_join option is set to true
	168
	169	=item * skip_fields
	170
	171	the value of this option will be passed as the value of the
	172	like-named argument in the make_natural_join method (see
	173	natural_join above) of SQL::Translator::Schema, if either
	174	the natural_join or join_pk_only options has a true value
	175
b7478526	176	=item * show_indexes
	177
	178	if set to a true value, each record will also show the indexes
	179	set on each table. it describes the index types along with
	180	which columns are included in the index. this option requires
	181	that show_fields is a true value as well
	182
4d5d28cb	183	=item * show_index_names
d6d6b205	184
	185	if show_indexes is set to a true value, then the value of this
	186	parameter determines whether or not to print names of indexes.
d8324f08	187	if show_index_names is false, then a list of indexed columns
d6d6b205	188	will appear below the field list. otherwise, it will be a list
	189	prefixed with the name of each index. it defaults to true.
	190
b7478526	191	=item * friendly_ints
	192
	193	if set to a true value, each integer type field will be displayed
d44b5f54	194	as a smallint, integer or bigint depending on the field's
b7478526	195	associated size parameter. this only applies for the 'integer'
	196	type (and not the lowercase 'int' type, which is assumed to be a
	197	32-bit integer).
	198
d44b5f54	199	=item * friendly_ints_extended
	200
	201	if set to a true value, the friendly ints displayed will take into
	202	account the non-standard types, 'tinyint' and 'mediumint' (which,
	203	as far as I am aware, is only implemented in MySQL)
	204
d491c962	205	=back
	206
	207	=cut
	208
14d7eb56	209	use strict;
14d7eb56	210	use GraphViz;
997f14b2	211	use SQL::Translator::Schema::Constants;
14d7eb56	212	use SQL::Translator::Utils qw(debug);
d8324f08	213	use Scalar::Util qw/openhandle/;
14d7eb56	214
14d7eb56	215	use vars qw[ $VERSION $DEBUG ];
da06ac74	216	$VERSION = '1.99';
14d7eb56	217	$DEBUG = 0 unless defined $DEBUG;
	218
	219	use constant VALID_LAYOUT => {
	220	dot => 1,
	221	neato => 1,
	222	twopi => 1,
	223	};
	224
	225	use constant VALID_NODE_SHAPE => {
	226	record => 1,
	227	plaintext => 1,
	228	ellipse => 1,
	229	circle => 1,
	230	egg => 1,
	231	triangle => 1,
	232	box => 1,
	233	diamond => 1,
	234	trapezium => 1,
	235	parallelogram => 1,
	236	house => 1,
	237	hexagon => 1,
	238	octagon => 1,
	239	};
	240
14d7eb56	241	sub produce {
997f14b2	242	my $t = shift;
997f14b2	243	my $schema = $t->schema;
14d7eb56	244	my $args = $t->producer_args;
14d7eb56	245	local $DEBUG = $t->debug;
14d7eb56	246
59cbb03f	247	my $out_file = $args->{'out_file'} \|\| '';
	248	my $layout = $args->{'layout'} \|\| 'dot';
	249	my $node_shape = $args->{'node_shape'} \|\| 'record';
	250	my $output_type = $args->{'output_type'} \|\| 'png';
	251	my $width = defined $args->{'width'}
	252	? $args->{'width'} : 8.5;
	253	my $height = defined $args->{'height'}
	254	? $args->{'height'} : 11;
027cebc7	255	my $fontsize = $args->{'fontsize'};
	256	my $fontname = $args->{'fontname'};
	257	my $edgeattrs = $args->{'edgeattrs'} \|\| {};
	258	my $graphattrs = $args->{'graphattrs'} \|\| {};
	259	my $nodeattrs = $args->{'nodeattrs'} \|\| {};
59cbb03f	260	my $show_fields = defined $args->{'show_fields'}
	261	? $args->{'show_fields'} : 1;
	262	my $add_color = $args->{'add_color'};
	263	my $natural_join = $args->{'natural_join'};
	264	my $show_fk_only = $args->{'show_fk_only'};
	265	my $show_datatypes = $args->{'show_datatypes'};
	266	my $show_sizes = $args->{'show_sizes'};
b7478526	267	my $show_indexes = $args->{'show_indexes'};
4d5d28cb	268	my $show_index_names = defined $args->{'show_index_names'} ? $args->{'show_index_names'} : 1;
b7478526	269	my $friendly_ints = $args->{'friendly_ints'};
d44b5f54	270	my $friendly_ints_ex = $args->{'friendly_ints_extended'};
37ce746e	271	my $show_constraints = $args->{'show_constraints'};
59cbb03f	272	my $join_pk_only = $args->{'join_pk_only'};
9d93edab	273	my $skip_fields = $args->{'skip_fields'} \|\| '';
9d93edab	274	my %skip = map { s/^\s+\|\s+$//g; length $_ ? ($_, 1) : () }
59cbb03f	275	split ( /,/, $skip_fields );
59cbb03f	276	$natural_join \|\|= $join_pk_only;
14d7eb56	277
997f14b2	278	$schema->make_natural_joins(
	279	join_pk_only => $join_pk_only,
	280	skip_fields => $args->{'skip_fields'},
	281	) if $natural_join;
	282
14d7eb56	283	die "Invalid layout '$layout'" unless VALID_LAYOUT->{ $layout };
14d7eb56	284	die "Invalid node shape'$node_shape'"
	285	unless VALID_NODE_SHAPE->{ $node_shape };
	286
e36752ea	287	for ( $height, $width ) {
	288	$_ = 0 unless $_ =~ /^\d+(.\d)?$/;
	289	$_ = 0 if $_ < 0;
	290	}
	291
e36752ea	292	my %args = (
14d7eb56	293	directed => $natural_join ? 0 : 1,
	294	layout => $layout,
	295	no_overlap => 1,
	296	bgcolor => $add_color ? 'lightgoldenrodyellow' : 'white',
	297	node => {
	298	shape => $node_shape,
	299	style => 'filled',
027cebc7	300	fillcolor => 'white',
027cebc7	301	},
e36752ea	302	);
	303	$args{'width'} = $width if $width;
	304	$args{'height'} = $height if $height;
027cebc7	305	# set fontsize for edge and node labels if specified
	306	if ($fontsize) {
	307	$args{'node'}->{'fontsize'} = $fontsize;
	308	$args{'edge'} = {} unless $args{'edge'};
	309	$args{'edge'}->{'fontsize'} = $fontsize;
	310	}
	311	# set the font name globally for node, edge, and graph labels if
	312	# specified (use node, edge, or graph attributes for individual
	313	# font specification)
	314	if ($fontname) {
	315	$args{'node'}->{'fontname'} = $fontname;
	316	$args{'edge'} = {} unless $args{'edge'};
	317	$args{'edge'}->{'fontname'} = $fontname;
	318	$args{'graph'} = {} unless $args{'graph'};
	319	$args{'graph'}->{'fontname'} = $fontname;
	320	}
	321	# set additional node, edge, and graph attributes; these may
	322	# possibly override ones set before
	323	while (my ($key,$val) = each %$nodeattrs) {
	324	$args{'node'}->{$key} = $val;
	325	}
	326	$args{'edge'} = {} if %$edgeattrs && !$args{'edge'};
	327	while (my ($key,$val) = each %$edgeattrs) {
	328	$args{'edge'}->{$key} = $val;
	329	}
	330	$args{'graph'} = {} if %$edgeattrs && !$args{'graph'};
	331	while (my ($key,$val) = each %$graphattrs) {
	332	$args{'graph'}->{$key} = $val;
	333	}
e36752ea	334
d8324f08	335	#
	336	# Create a blank GraphViz object and see if we can produce the output type.
	337	#
	338	my $gv = GraphViz->new( %args ) or die "Can't create GraphViz object\n";
	339	my $output_method = "as_$output_type";
	340
	341	# the generators are AUTOLOADed so can't use ->can ($output_method)
	342	eval { $gv->$output_method };
	343	die "Invalid output type: '$output_type'" if $@;
	344
14d7eb56	345
	346	my %nj_registry; # for locations of fields for natural joins
	347	my @fk_registry; # for locations of fields for foreign keys
	348
997f14b2	349	for my $table ( $schema->get_tables ) {
997f14b2	350	my @fields = $table->get_fields;
	351	if ( $show_fk_only ) {
	352	@fields = grep { $_->is_foreign_key } @fields;
14d7eb56	353	}
14d7eb56	354
6264cdc8	355	my $field_str = '';
b7478526	356	if ($show_fields) {
6264cdc8	357
6264cdc8	358	my @fmt_fields;
b7478526	359	foreach my $field (@fields) {
6264cdc8	360
6264cdc8	361	my $field_type;
b7478526	362	if ($show_datatypes) {
6264cdc8	363
6264cdc8	364	$field_type = $field->data_type;
b7478526	365
	366	# For the integer type, transform into different types based on
	367	# requested size, if a size is given.
6264cdc8	368	if ($field->size and $friendly_ints and (lc $field_type) eq 'integer') {
b7478526	369	# Automatically translate to int2, int4, int8
d44b5f54	370	# Type (Bits) Max. Signed/Unsigned Length
	371	# tinyint* (8) 128 3
	372	# 255 3
	373	# smallint (16) 32767 5
	374	# 65535 5
	375	# mediumint* (24) 8388607 7
	376	# 16777215 8
	377	# int (32) 2147483647 10
d8324f08	378	# 4294967295 11
d44b5f54	379	# bigint (64) 9223372036854775807 19
	380	# 18446744073709551615 20
	381	#
	382	# * tinyint and mediumint are nonstandard extensions which are
	383	# only available under MySQL (to my knowledge)
	384	my $size = $field->size;
6264cdc8	385	if ($size <= 3 and $friendly_ints_ex) {
6264cdc8	386	$field_type = 'tinyint',
b7478526	387	}
6264cdc8	388	elsif ($size <= 5) {
	389	$field_type = 'smallint';
	390	}
	391	elsif ($size <= 8 and $friendly_ints_ex) {
	392	$field_type = 'mediumint';
	393	}
	394	elsif ($size <= 11) {
	395	$field_type = 'integer';
b7478526	396	}
d44b5f54	397	else {
6264cdc8	398	$field_type = 'bigint';
b7478526	399	}
	400	}
	401
6264cdc8	402	if (
	403	$show_sizes
	404	and
	405	$field->size
	406	and
	407	($field_type =~ /^(var)?char2?$/ or $field_type eq 'numeric' or $field_type eq 'decimal')
	408	) {
	409	$field_type .= '(' . $field->size . ')';
b7478526	410	}
	411	}
	412
6264cdc8	413	my $constraints;
b7478526	414	if ($show_constraints) {
	415	my @constraints;
	416	push(@constraints, 'PK') if $field->is_primary_key;
	417	push(@constraints, 'FK') if $field->is_foreign_key;
	418	push(@constraints, 'U') if $field->is_unique;
6264cdc8	419
6264cdc8	420	$constraints = join (',', @constraints);
b7478526	421	}
6264cdc8	422
	423	# construct the field line from all info gathered so far
	424	push @fmt_fields, join (' ',
	425	'-',
	426	$field->name,
	427	$field_type \|\| (),
	428	$constraints ? "[$constraints]" : (),
	429	);
	430
b7478526	431	}
6264cdc8	432
	433	# join field lines with graphviz formatting
	434	$field_str = join ('\l', @fmt_fields) . '\l';
b7478526	435	}
b7478526	436
6264cdc8	437	my $index_str = '';
b7478526	438	if ($show_indexes) {
6264cdc8	439
6264cdc8	440	my @fmt_indexes;
b7478526	441	foreach my $index ($table->get_indices) {
	442	next unless $index->is_valid;
	443
6264cdc8	444	push @fmt_indexes, join (' ',
6264cdc8	445	'*',
4d5d28cb	446	$show_index_names ? $index->name . ':' : (),
6264cdc8	447	join (', ', $index->fields),
	448	($index->type eq 'UNIQUE') ? '[U]' : (),
	449	);
d6d6b205	450	}
6264cdc8	451
	452	# join index lines with graphviz formatting (if any indexes at all)
	453	$index_str = join ('\l', @fmt_indexes) . '\l' if @fmt_indexes;
	454	}
	455
	456	my $table_name = $table->name;
	457	my $name_str = $table_name . '\n';
	458
	459	# escape spaces
	460	for ($name_str, $field_str, $index_str) {
	461	$_ =~ s/ /\\ /g;
b7478526	462	}
6264cdc8	463
	464
	465	# only the 'record' type supports nice formatting
	466	if ($node_shape eq 'record') {
	467
	468	# the necessity to supply shape => 'record' is a graphviz bug
	469	$gv->add_node( $table_name,
	470	shape => 'record',
	471	label => sprintf ('{%s}',
	472	join ('\|',
	473	$name_str,
	474	$field_str \|\| (),
	475	$index_str \|\| (),
	476	),
	477	),
	478	);
	479	}
	480	else {
	481	my $sep = sprintf ('%s\n',
	482	'-' x ( (length $table_name) + 2)
	483	);
	484
	485	$gv->add_node( $table_name,
	486	label => join ($sep,
	487	$name_str,
	488	$field_str \|\| (),
	489	$index_str \|\| (),
	490	),
	491	);
	492	}
	493
	494
e36752ea	495	debug("Processing table '$table_name'");
e36752ea	496
997f14b2	497	debug("Fields = ", join(', ', map { $_->name } @fields));
14d7eb56	498
14d7eb56	499	for my $f ( @fields ) {
997f14b2	500	my $name = $f->name or next;
	501	my $is_pk = $f->is_primary_key;
	502	my $is_unique = $f->is_unique;
14d7eb56	503
	504	#
	505	# Decide if we should skip this field.
	506	#
	507	if ( $natural_join ) {
997f14b2	508	next unless $is_pk \|\| $f->is_foreign_key;
14d7eb56	509	}
	510
	511	my $constraints = $f->{'constraints'};
	512
	513	if ( $natural_join && !$skip{ $name } ) {
	514	push @{ $nj_registry{ $name } }, $table_name;
	515	}
997f14b2	516	}
	517
	518	unless ( $natural_join ) {
	519	for my $c ( $table->get_constraints ) {
	520	next unless $c->type eq FOREIGN_KEY;
	521	my $fk_table = $c->reference_table or next;
	522
	523	for my $field_name ( $c->fields ) {
	524	for my $fk_field ( $c->reference_fields ) {
	525	next unless defined $schema->get_table( $fk_table );
14d7eb56	526	push @fk_registry, [ $table_name, $fk_table ];
	527	}
	528	}
	529	}
	530	}
	531	}
	532
	533	#
	534	# Make the connections.
	535	#
	536	my @table_bunches;
	537	if ( $natural_join ) {
	538	for my $field_name ( keys %nj_registry ) {
	539	my @table_names = @{ $nj_registry{ $field_name } \|\| [] } or next;
	540	next if scalar @table_names == 1;
	541	push @table_bunches, [ @table_names ];
	542	}
	543	}
	544	else {
	545	@table_bunches = @fk_registry;
	546	}
	547
	548	my %done;
	549	for my $bunch ( @table_bunches ) {
	550	my @tables = @$bunch;
	551
	552	for my $i ( 0 .. $#tables ) {
	553	my $table1 = $tables[ $i ];
	554	for my $j ( 0 .. $#tables ) {
d51a158e	555	next if $i == $j;
14d7eb56	556	my $table2 = $tables[ $j ];
14d7eb56	557	next if $done{ $table1 }{ $table2 };
13811af0	558	$gv->add_edge( $table2, $table1 );
14d7eb56	559	$done{ $table1 }{ $table2 } = 1;
	560	$done{ $table2 }{ $table1 } = 1;
	561	}
	562	}
	563	}
	564
	565	#
	566	# Print the image.
	567	#
14d7eb56	568	if ( $out_file ) {
d8324f08	569	if (openhandle ($out_file)) {
	570	print $out_file $gv->$output_method;
	571	}
	572	else {
14d7eb56	573	open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
28c31cbf	574	binmode $fh;
14d7eb56	575	print $fh $gv->$output_method;
14d7eb56	576	close $fh;
d8324f08	577	}
14d7eb56	578	}
14d7eb56	579	else {
d8324f08	580	return $gv->$output_method;
14d7eb56	581	}
	582	}
	583
	584	1;
	585
977651a5	586	# -------------------------------------------------------------------
977651a5	587
14d7eb56	588	=pod
14d7eb56	589
14d7eb56	590	=head1 AUTHOR
	591
	592	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
	593
d44b5f54	594	=head2 CONTRIBUTORS
	595
	596	Jonathan Yu E<lt>frequency@cpan.orgE<gt>
	597
d491c962	598	=head1 SEE ALSO
	599
	600	SQL::Translator, GraphViz
	601
14d7eb56	602	=cut