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

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

# -------------------------------------------------------------------
# $Id$
# -------------------------------------------------------------------
# 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 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 * 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_name 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 vars qw[ $VERSION $DEBUG ];
$VERSION = sprintf "%d.%02d", q$Revision$ =~ /(\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 $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 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 @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              10
                # 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.
    #
    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>

=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	# -------------------------------------------------------------------
821a0fde	4	# $Id$
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
	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
4d5d28cb	181	=item * show_index_names
d6d6b205	182
	183	if show_indexes is set to a true value, then the value of this
	184	parameter determines whether or not to print names of indexes.
	185	if show_index_name is false, then a list of indexed columns
	186	will appear below the field list. otherwise, it will be a list
	187	prefixed with the name of each index. it defaults to true.
	188
b7478526	189	=item * friendly_ints
	190
	191	if set to a true value, each integer type field will be displayed
d44b5f54	192	as a smallint, integer or bigint depending on the field's
b7478526	193	associated size parameter. this only applies for the 'integer'
	194	type (and not the lowercase 'int' type, which is assumed to be a
	195	32-bit integer).
	196
d44b5f54	197	=item * friendly_ints_extended
	198
	199	if set to a true value, the friendly ints displayed will take into
	200	account the non-standard types, 'tinyint' and 'mediumint' (which,
	201	as far as I am aware, is only implemented in MySQL)
	202
d491c962	203	=back
	204
	205	=cut
	206
14d7eb56	207	use strict;
14d7eb56	208	use GraphViz;
997f14b2	209	use SQL::Translator::Schema::Constants;
14d7eb56	210	use SQL::Translator::Utils qw(debug);
	211
	212	use vars qw[ $VERSION $DEBUG ];
821a0fde	213	$VERSION = sprintf "%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/;
14d7eb56	214	$DEBUG = 0 unless defined $DEBUG;
	215
	216	use constant VALID_LAYOUT => {
	217	dot => 1,
	218	neato => 1,
	219	twopi => 1,
	220	};
	221
	222	use constant VALID_NODE_SHAPE => {
	223	record => 1,
	224	plaintext => 1,
	225	ellipse => 1,
	226	circle => 1,
	227	egg => 1,
	228	triangle => 1,
	229	box => 1,
	230	diamond => 1,
	231	trapezium => 1,
	232	parallelogram => 1,
	233	house => 1,
	234	hexagon => 1,
	235	octagon => 1,
	236	};
	237
	238	use constant VALID_OUTPUT => {
	239	canon => 1,
	240	text => 1,
	241	ps => 1,
	242	hpgl => 1,
	243	pcl => 1,
	244	mif => 1,
	245	pic => 1,
	246	gd => 1,
	247	gd2 => 1,
	248	gif => 1,
	249	jpeg => 1,
	250	png => 1,
	251	wbmp => 1,
	252	cmap => 1,
	253	ismap => 1,
	254	imap => 1,
	255	vrml => 1,
	256	vtx => 1,
	257	mp => 1,
	258	fig => 1,
	259	svg => 1,
	260	plain => 1,
	261	};
	262
	263	sub produce {
997f14b2	264	my $t = shift;
997f14b2	265	my $schema = $t->schema;
14d7eb56	266	my $args = $t->producer_args;
14d7eb56	267	local $DEBUG = $t->debug;
14d7eb56	268
59cbb03f	269	my $out_file = $args->{'out_file'} \|\| '';
	270	my $layout = $args->{'layout'} \|\| 'dot';
	271	my $node_shape = $args->{'node_shape'} \|\| 'record';
	272	my $output_type = $args->{'output_type'} \|\| 'png';
	273	my $width = defined $args->{'width'}
	274	? $args->{'width'} : 8.5;
	275	my $height = defined $args->{'height'}
	276	? $args->{'height'} : 11;
027cebc7	277	my $fontsize = $args->{'fontsize'};
	278	my $fontname = $args->{'fontname'};
	279	my $edgeattrs = $args->{'edgeattrs'} \|\| {};
	280	my $graphattrs = $args->{'graphattrs'} \|\| {};
	281	my $nodeattrs = $args->{'nodeattrs'} \|\| {};
59cbb03f	282	my $show_fields = defined $args->{'show_fields'}
	283	? $args->{'show_fields'} : 1;
	284	my $add_color = $args->{'add_color'};
	285	my $natural_join = $args->{'natural_join'};
	286	my $show_fk_only = $args->{'show_fk_only'};
	287	my $show_datatypes = $args->{'show_datatypes'};
	288	my $show_sizes = $args->{'show_sizes'};
b7478526	289	my $show_indexes = $args->{'show_indexes'};
4d5d28cb	290	my $show_index_names = defined $args->{'show_index_names'} ? $args->{'show_index_names'} : 1;
b7478526	291	my $friendly_ints = $args->{'friendly_ints'};
d44b5f54	292	my $friendly_ints_ex = $args->{'friendly_ints_extended'};
37ce746e	293	my $show_constraints = $args->{'show_constraints'};
59cbb03f	294	my $join_pk_only = $args->{'join_pk_only'};
9d93edab	295	my $skip_fields = $args->{'skip_fields'} \|\| '';
9d93edab	296	my %skip = map { s/^\s+\|\s+$//g; length $_ ? ($_, 1) : () }
59cbb03f	297	split ( /,/, $skip_fields );
59cbb03f	298	$natural_join \|\|= $join_pk_only;
14d7eb56	299
997f14b2	300	$schema->make_natural_joins(
	301	join_pk_only => $join_pk_only,
	302	skip_fields => $args->{'skip_fields'},
	303	) if $natural_join;
	304
14d7eb56	305	die "Invalid layout '$layout'" unless VALID_LAYOUT->{ $layout };
	306	die "Invalid output type: '$output_type'"
	307	unless VALID_OUTPUT->{ $output_type };
	308	die "Invalid node shape'$node_shape'"
	309	unless VALID_NODE_SHAPE->{ $node_shape };
	310
e36752ea	311	for ( $height, $width ) {
	312	$_ = 0 unless $_ =~ /^\d+(.\d)?$/;
	313	$_ = 0 if $_ < 0;
	314	}
	315
14d7eb56	316	#
	317	# Create GraphViz and see if we can produce the output type.
	318	#
e36752ea	319	my %args = (
14d7eb56	320	directed => $natural_join ? 0 : 1,
	321	layout => $layout,
	322	no_overlap => 1,
	323	bgcolor => $add_color ? 'lightgoldenrodyellow' : 'white',
	324	node => {
	325	shape => $node_shape,
	326	style => 'filled',
027cebc7	327	fillcolor => 'white',
027cebc7	328	},
e36752ea	329	);
	330	$args{'width'} = $width if $width;
	331	$args{'height'} = $height if $height;
027cebc7	332	# set fontsize for edge and node labels if specified
	333	if ($fontsize) {
	334	$args{'node'}->{'fontsize'} = $fontsize;
	335	$args{'edge'} = {} unless $args{'edge'};
	336	$args{'edge'}->{'fontsize'} = $fontsize;
	337	}
	338	# set the font name globally for node, edge, and graph labels if
	339	# specified (use node, edge, or graph attributes for individual
	340	# font specification)
	341	if ($fontname) {
	342	$args{'node'}->{'fontname'} = $fontname;
	343	$args{'edge'} = {} unless $args{'edge'};
	344	$args{'edge'}->{'fontname'} = $fontname;
	345	$args{'graph'} = {} unless $args{'graph'};
	346	$args{'graph'}->{'fontname'} = $fontname;
	347	}
	348	# set additional node, edge, and graph attributes; these may
	349	# possibly override ones set before
	350	while (my ($key,$val) = each %$nodeattrs) {
	351	$args{'node'}->{$key} = $val;
	352	}
	353	$args{'edge'} = {} if %$edgeattrs && !$args{'edge'};
	354	while (my ($key,$val) = each %$edgeattrs) {
	355	$args{'edge'}->{$key} = $val;
	356	}
	357	$args{'graph'} = {} if %$edgeattrs && !$args{'graph'};
	358	while (my ($key,$val) = each %$graphattrs) {
	359	$args{'graph'}->{$key} = $val;
	360	}
e36752ea	361
e36752ea	362	my $gv = GraphViz->new( %args ) or die "Can't create GraphViz object\n";
14d7eb56	363
	364	my %nj_registry; # for locations of fields for natural joins
	365	my @fk_registry; # for locations of fields for foreign keys
	366
997f14b2	367	for my $table ( $schema->get_tables ) {
997f14b2	368	my @fields = $table->get_fields;
	369	if ( $show_fk_only ) {
	370	@fields = grep { $_->is_foreign_key } @fields;
14d7eb56	371	}
14d7eb56	372
6264cdc8	373	my $field_str = '';
b7478526	374	if ($show_fields) {
6264cdc8	375
6264cdc8	376	my @fmt_fields;
b7478526	377	foreach my $field (@fields) {
6264cdc8	378
6264cdc8	379	my $field_type;
b7478526	380	if ($show_datatypes) {
6264cdc8	381
6264cdc8	382	$field_type = $field->data_type;
b7478526	383
	384	# For the integer type, transform into different types based on
	385	# requested size, if a size is given.
6264cdc8	386	if ($field->size and $friendly_ints and (lc $field_type) eq 'integer') {
b7478526	387	# Automatically translate to int2, int4, int8
d44b5f54	388	# Type (Bits) Max. Signed/Unsigned Length
	389	# tinyint* (8) 128 3
	390	# 255 3
	391	# smallint (16) 32767 5
	392	# 65535 5
	393	# mediumint* (24) 8388607 7
	394	# 16777215 8
	395	# int (32) 2147483647 10
	396	# 4294967295 10
	397	# bigint (64) 9223372036854775807 19
	398	# 18446744073709551615 20
	399	#
	400	# * tinyint and mediumint are nonstandard extensions which are
	401	# only available under MySQL (to my knowledge)
	402	my $size = $field->size;
6264cdc8	403	if ($size <= 3 and $friendly_ints_ex) {
6264cdc8	404	$field_type = 'tinyint',
b7478526	405	}
6264cdc8	406	elsif ($size <= 5) {
	407	$field_type = 'smallint';
	408	}
	409	elsif ($size <= 8 and $friendly_ints_ex) {
	410	$field_type = 'mediumint';
	411	}
	412	elsif ($size <= 11) {
	413	$field_type = 'integer';
b7478526	414	}
d44b5f54	415	else {
6264cdc8	416	$field_type = 'bigint';
b7478526	417	}
	418	}
	419
6264cdc8	420	if (
	421	$show_sizes
	422	and
	423	$field->size
	424	and
	425	($field_type =~ /^(var)?char2?$/ or $field_type eq 'numeric' or $field_type eq 'decimal')
	426	) {
	427	$field_type .= '(' . $field->size . ')';
b7478526	428	}
	429	}
	430
6264cdc8	431	my $constraints;
b7478526	432	if ($show_constraints) {
	433	my @constraints;
	434	push(@constraints, 'PK') if $field->is_primary_key;
	435	push(@constraints, 'FK') if $field->is_foreign_key;
	436	push(@constraints, 'U') if $field->is_unique;
6264cdc8	437
6264cdc8	438	$constraints = join (',', @constraints);
b7478526	439	}
6264cdc8	440
	441	# construct the field line from all info gathered so far
	442	push @fmt_fields, join (' ',
	443	'-',
	444	$field->name,
	445	$field_type \|\| (),
	446	$constraints ? "[$constraints]" : (),
	447	);
	448
b7478526	449	}
6264cdc8	450
	451	# join field lines with graphviz formatting
	452	$field_str = join ('\l', @fmt_fields) . '\l';
b7478526	453	}
b7478526	454
6264cdc8	455	my $index_str = '';
b7478526	456	if ($show_indexes) {
6264cdc8	457
6264cdc8	458	my @fmt_indexes;
b7478526	459	foreach my $index ($table->get_indices) {
	460	next unless $index->is_valid;
	461
6264cdc8	462	push @fmt_indexes, join (' ',
6264cdc8	463	'*',
4d5d28cb	464	$show_index_names ? $index->name . ':' : (),
6264cdc8	465	join (', ', $index->fields),
	466	($index->type eq 'UNIQUE') ? '[U]' : (),
	467	);
d6d6b205	468	}
6264cdc8	469
	470	# join index lines with graphviz formatting (if any indexes at all)
	471	$index_str = join ('\l', @fmt_indexes) . '\l' if @fmt_indexes;
	472	}
	473
	474	my $table_name = $table->name;
	475	my $name_str = $table_name . '\n';
	476
	477	# escape spaces
	478	for ($name_str, $field_str, $index_str) {
	479	$_ =~ s/ /\\ /g;
b7478526	480	}
6264cdc8	481
	482
	483	# only the 'record' type supports nice formatting
	484	if ($node_shape eq 'record') {
	485
	486	# the necessity to supply shape => 'record' is a graphviz bug
	487	$gv->add_node( $table_name,
	488	shape => 'record',
	489	label => sprintf ('{%s}',
	490	join ('\|',
	491	$name_str,
	492	$field_str \|\| (),
	493	$index_str \|\| (),
	494	),
	495	),
	496	);
	497	}
	498	else {
	499	my $sep = sprintf ('%s\n',
	500	'-' x ( (length $table_name) + 2)
	501	);
	502
	503	$gv->add_node( $table_name,
	504	label => join ($sep,
	505	$name_str,
	506	$field_str \|\| (),
	507	$index_str \|\| (),
	508	),
	509	);
	510	}
	511
	512
e36752ea	513	debug("Processing table '$table_name'");
e36752ea	514
997f14b2	515	debug("Fields = ", join(', ', map { $_->name } @fields));
14d7eb56	516
14d7eb56	517	for my $f ( @fields ) {
997f14b2	518	my $name = $f->name or next;
	519	my $is_pk = $f->is_primary_key;
	520	my $is_unique = $f->is_unique;
14d7eb56	521
	522	#
	523	# Decide if we should skip this field.
	524	#
	525	if ( $natural_join ) {
997f14b2	526	next unless $is_pk \|\| $f->is_foreign_key;
14d7eb56	527	}
	528
	529	my $constraints = $f->{'constraints'};
	530
	531	if ( $natural_join && !$skip{ $name } ) {
	532	push @{ $nj_registry{ $name } }, $table_name;
	533	}
997f14b2	534	}
	535
	536	unless ( $natural_join ) {
	537	for my $c ( $table->get_constraints ) {
	538	next unless $c->type eq FOREIGN_KEY;
	539	my $fk_table = $c->reference_table or next;
	540
	541	for my $field_name ( $c->fields ) {
	542	for my $fk_field ( $c->reference_fields ) {
	543	next unless defined $schema->get_table( $fk_table );
14d7eb56	544	push @fk_registry, [ $table_name, $fk_table ];
	545	}
	546	}
	547	}
	548	}
	549	}
	550
	551	#
	552	# Make the connections.
	553	#
	554	my @table_bunches;
	555	if ( $natural_join ) {
	556	for my $field_name ( keys %nj_registry ) {
	557	my @table_names = @{ $nj_registry{ $field_name } \|\| [] } or next;
	558	next if scalar @table_names == 1;
	559	push @table_bunches, [ @table_names ];
	560	}
	561	}
	562	else {
	563	@table_bunches = @fk_registry;
	564	}
	565
	566	my %done;
	567	for my $bunch ( @table_bunches ) {
	568	my @tables = @$bunch;
	569
	570	for my $i ( 0 .. $#tables ) {
	571	my $table1 = $tables[ $i ];
	572	for my $j ( 0 .. $#tables ) {
d51a158e	573	next if $i == $j;
14d7eb56	574	my $table2 = $tables[ $j ];
14d7eb56	575	next if $done{ $table1 }{ $table2 };
13811af0	576	$gv->add_edge( $table2, $table1 );
14d7eb56	577	$done{ $table1 }{ $table2 } = 1;
	578	$done{ $table2 }{ $table1 } = 1;
	579	}
	580	}
	581	}
	582
	583	#
	584	# Print the image.
	585	#
	586	my $output_method = "as_$output_type";
	587	if ( $out_file ) {
	588	open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
28c31cbf	589	binmode $fh;
14d7eb56	590	print $fh $gv->$output_method;
	591	close $fh;
	592	}
	593	else {
	594	return $gv->$output_method;
	595	}
	596	}
	597
	598	1;
	599
977651a5	600	# -------------------------------------------------------------------
977651a5	601
14d7eb56	602	=pod
14d7eb56	603
14d7eb56	604	=head1 AUTHOR
	605
	606	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
	607
d44b5f54	608	=head2 CONTRIBUTORS
	609
	610	Jonathan Yu E<lt>frequency@cpan.orgE<gt>
	611
d491c962	612	=head1 SEE ALSO
	613
	614	SQL::Translator, GraphViz
	615
14d7eb56	616	=cut