package SQL::Translator::Producer::GraphViz;
-# -------------------------------------------------------------------
-# $Id: GraphViz.pm,v 1.14 2007-09-26 13:20:09 schiffbruechige Exp $
-# -------------------------------------------------------------------
-# Copyright (C) 2002-4 SQLFairy Authors
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License as
-# published by the Free Software Foundation; version 2.
-#
-# This program is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-# 02111-1307 USA
-# -------------------------------------------------------------------
-
=pod
=head1 NAME
use SQL::Translator;
- my $trans = new SQL::Translator(
+ my $trans = SQL::Translator->new(
from => 'MySQL', # or your db of choice
- to => 'GraphViz',
+ to => 'GraphViz',
producer_args => {
- out_file => 'schema.png',
- add_color => 1,
+ out_file => 'schema.png',
+ bgcolor => 'lightgoldenrodyellow',
show_constraints => 1,
- show_datatypes => 1,
- show_sizes => 1
+ show_datatypes => 1,
+ show_sizes => 1
}
) or die SQL::Translator->error;
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!
+the L<GraphViz> module). It's nifty--you should try it!
=head1 PRODUCER ARGS
-=over 4
+All L<GraphViz> constructor attributes are accepted and passed
+through to L<GraphViz/new>. The following defaults are assumed
+for some attributes:
-=item * out_file
+ layout => 'dot',
+ overlap => 'false',
-the name of the file where the graphviz graphic is to be written
+ node => {
+ shape => 'record',
+ style => 'filled',
+ fillcolor => 'white',
+ },
-=item * layout (DEFAULT: 'dot')
+ # in inches
+ width => 8.5,
+ height => 11,
-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)
+See the documentation of L<GraphViz/new> for more info on these
+and other attributes.
-=item * node_shape (DEFAULT: 'record')
+In addition this producer accepts the following arguments:
-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'
+=over 4
-=item * output_type (DEFAULT: 'png')
+=item * skip_tables
-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)
+An arrayref or a comma-separated list of table names that should be
+skipped. Note that a skipped table node may still appear if another
+table has foreign key constraints pointing to the skipped table. If
+this happens no table field/index information will be included.
-=item * width (DEFAULT: 8.5)
+=item * skip_tables_like
-width (in inches) of the output graphic
+An arrayref or a comma-separated list of regular expressions matching
+table names that should be skipped.
-=item * height (DEFAULT: 11)
+=item * cluster
-height (in inches) of the output grahic
+Clustering of tables allows you to group and box tables according to
+function or domain or whatever criteria you choose. The syntax for
+clustering tables is:
-=item * fontsize
+ cluster => 'cluster1=table1,table2;cluster2=table3,table4'
-custom font size for node and edge labels (note that arbitrarily large
-sizes may be ignored due to page size or graph size constraints)
+Or pass it as an arrayref like so:
-=item * fontname
+ cluster => [ 'cluster1=table1,table2', 'cluster2=table3,table4' ]
-custom font name (or full path to font file) for node, edge, and graph
-labels
+Or like so:
-=item * nodeattrs
+ cluster => [
+ { name => 'cluster1', tables => [ 'table1', 'table2' ] },
+ { name => 'cluster2', tables => [ 'table3', 'table4' ] },
+ ]
-reference to a hash of node attribute names and their values; these
-may override general fontname or fontsize parameter
+=item * out_file
-=item * edgeattrs
+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.
-reference to a hash of edge attribute names and their values; these
-may override general fontname or fontsize parameter
+=item * output_type (DEFAULT: 'png')
-=item * graphattrs
+This determines which
+L<output method|GraphViz/as_canon, as_text, as_gif etc. methods>
+will be invoked to generate the graph: C<png> translates to
+C<as_png>, C<ps> to C<as_ps> and so on.
+
+=item * fontname
-reference to a hash of graph attribute names and their values; these
-may override the general fontname parameter
+This sets the global font name (or full path to font file) for
+node, edge, and graph labels
+
+=item * fontsize
+
+This sets the global font size for node and edge labels (note that
+arbitrarily large sizes may be ignored due to page size or graph size
+constraints)
=item * show_fields (DEFAULT: true)
-if set to a true value, the names of the colums in a table will
+If set to a true value, the names of the columns 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
+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
+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
+effect if the value of C<show_fields> is set to false
+
+=item * friendly_ints
+
+If set to a true value, each integer type field will be displayed
+as a tinyint, smallint, integer or bigint depending on the field's
+associated size parameter. This only applies for the C<integer>
+type (and not the C<int> type, which is always assumed to be a
+32-bit integer); this option will have no effect if the value of
+C<show_fields> is set to false
+
+=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)
=item * show_sizes
-if set to a true value, the size (in bytes) of each CHAR and
+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
+C<show_fields> is set to false
=item * show_constraints
-if set to a true value, a field's constraints (i.e., its
+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
+C<show_fields> is set to false
-=item * add_color
+=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.
+
+=item * show_index_names (DEFAULT: true)
-if set to a true value, the graphic will have a background
-color of 'lightgoldenrodyellow'; otherwise the background
-color will be white
+If C<show_indexes> is set to a true value, then the value of this
+parameter determines whether or not to print names of indexes.
+if C<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.
=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
+If set to a true value, L<SQL::Translator::Schema/make_natural_joins>
+will be called before generating the graph.
=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
+The value of this option will be passed as the value of the
+like-named argument to L<SQL::Translator::Schema/make_natural_joins>;
+implies C<< natural_join => 1 >>
=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
+The value of this option will be passed as the value of the
+like-named argument to L<SQL::Translator::Schema/make_natural_joins>;
+implies C<< natural_join => 1 >>
+
+=back
+
+=head2 DEPRECATED ARGS
+
+=over 4
+
+=item * node_shape
+
+Deprecated, use node => { shape => ... } instead
+
+=item * add_color
+
+Deprecated, use bgcolor => 'lightgoldenrodyellow' instead
+
+If set to a true value, the graphic will have a background
+color of 'lightgoldenrodyellow'; otherwise the default
+white background will be used
+
+=item * nodeattrs
+
+Deprecated, use node => { ... } instead
+
+=item * edgeattrs
+
+Deprecated, use edge => { ... } instead
+
+=item * graphattrs
+
+Deprecated, use graph => { ... } instead
=back
=cut
+use warnings;
use strict;
use GraphViz;
-use Data::Dumper;
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(debug);
+use Scalar::Util qw/openhandle/;
-use vars qw[ $VERSION $DEBUG ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.14 $ =~ /(\d+)\.(\d+)/;
+our $DEBUG;
+our $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,
-};
-
-use constant VALID_OUTPUT => {
- canon => 1,
- text => 1,
- ps => 1,
- hpgl => 1,
- pcl => 1,
- mif => 1,
- pic => 1,
- gd => 1,
- gd2 => 1,
- gif => 1,
- jpeg => 1,
- png => 1,
- wbmp => 1,
- cmap => 1,
- ismap => 1,
- imap => 1,
- vrml => 1,
- vtx => 1,
- mp => 1,
- fig => 1,
- svg => 1,
- plain => 1,
-};
-
sub produce {
my $t = shift;
my $schema = $t->schema;
my $args = $t->producer_args;
local $DEBUG = $t->debug;
- my $out_file = $args->{'out_file'} || '';
- my $layout = $args->{'layout'} || 'dot';
- my $node_shape = $args->{'node_shape'} || 'record';
- my $output_type = $args->{'output_type'} || 'png';
- my $width = defined $args->{'width'}
- ? $args->{'width'} : 8.5;
- my $height = defined $args->{'height'}
- ? $args->{'height'} : 11;
- my $fontsize = $args->{'fontsize'};
- my $fontname = $args->{'fontname'};
- my $edgeattrs = $args->{'edgeattrs'} || {};
- my $graphattrs = $args->{'graphattrs'} || {};
- my $nodeattrs = $args->{'nodeattrs'} || {};
- my $show_fields = defined $args->{'show_fields'}
- ? $args->{'show_fields'} : 1;
- my $add_color = $args->{'add_color'};
- my $natural_join = $args->{'natural_join'};
- my $show_fk_only = $args->{'show_fk_only'};
- my $show_datatypes = $args->{'show_datatypes'};
- my $show_sizes = $args->{'show_sizes'};
- my $show_constraints = $args->{'show_constraints'};
- my $join_pk_only = $args->{'join_pk_only'};
- my $skip_fields = $args->{'skip_fields'} || '';
- my %skip = map { s/^\s+|\s+$//g; length $_ ? ($_, 1) : () }
- split ( /,/, $skip_fields );
- $natural_join ||= $join_pk_only;
+ # translate legacy {node|edge|graph}attrs to just {node|edge|graph}
+ for my $argtype (qw/node edge graph/) {
+ my $old_arg = $argtype . 'attrs';
- $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;
- }
+ my %arglist = (map
+ { %{ $_ || {} } }
+ ( delete $args->{$old_arg}, delete $args->{$argtype} )
+ );
- #
- # 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;
+ $args->{$argtype} = \%arglist if keys %arglist;
}
- # 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;
+
+ # explode font settings
+ for (qw/fontsize fontname/) {
+ if (defined $args->{$_}) {
+ $args->{node}{$_} ||= $args->{$_};
+ $args->{edge}{$_} ||= $args->{$_};
+ $args->{graph}{$_} ||= $args->{$_};
+ }
}
- $args{'edge'} = {} if %$edgeattrs && !$args{'edge'};
- while (my ($key,$val) = each %$edgeattrs) {
- $args{'edge'}->{$key} = $val;
+
+ # legacy add_color setting, trumped by bgcolor if set
+ $args->{bgcolor} ||= 'lightgoldenrodyellow' if $args->{add_color};
+
+ # legacy node_shape setting, defaults to 'record', trumped by {node}{shape}
+ $args->{node}{shape} ||= ( $args->{node_shape} || 'record' );
+
+ # maintain defaults
+ $args->{layout} ||= 'dot';
+ $args->{output_type} ||= 'png';
+ $args->{overlap} ||= 'false';
+ $args->{node}{style} ||= 'filled';
+ $args->{node}{fillcolor} ||= 'white';
+
+ $args->{show_fields} = 1 if not exists $args->{show_fields};
+ $args->{show_index_names} = 1 if not exists $args->{show_index_names};
+ $args->{width} = 8.5 if not defined $args->{width};
+ $args->{height} = 11 if not defined $args->{height};
+ for ( $args->{height}, $args->{width} ) {
+ $_ = 0 unless $_ =~ /^\d+(?:.\d+)?$/;
+ $_ = 0 if $_ < 0;
}
- $args{'graph'} = {} if %$edgeattrs && !$args{'graph'};
- while (my ($key,$val) = each %$graphattrs) {
- $args{'graph'}->{$key} = $val;
+
+ # so split won't warn
+ $args->{$_} ||= '' for qw/skip_fields skip_tables skip_tables_like cluster/;
+
+ my %skip_fields = map { s/^\s+|\s+$//g; length $_ ? ($_, 1) : () }
+ split ( /,/, $args->{skip_fields} );
+
+ my %skip_tables = map { $_, 1 } (
+ ref $args->{skip_tables} eq 'ARRAY'
+ ? @{$args->{skip_tables}}
+ : split (/\s*,\s*/, $args->{skip_tables})
+ );
+
+ my @skip_tables_like = map { qr/$_/ } (
+ ref $args->{skip_tables_like} eq 'ARRAY'
+ ? @{$args->{skip_tables_like}}
+ : split (/\s*,\s*/, $args->{skip_tables_like})
+ );
+
+ # join_pk_only/skip_fields implies natural_join
+ $args->{natural_join} = 1
+ if ($args->{join_pk_only} or scalar keys %skip_fields);
+
+ # usually we do not want direction when using natural join
+ $args->{directed} = ($args->{natural_join} ? 0 : 1)
+ if not exists $args->{directed};
+
+ $schema->make_natural_joins(
+ join_pk_only => $args->{join_pk_only},
+ skip_fields => $args->{skip_fields},
+ ) if $args->{natural_join};
+
+ 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;
+ }
+ }
}
- my $gv = GraphViz->new( %args ) or die "Can't create GraphViz object\n";
+ #
+ # Create a blank GraphViz object and see if we can produce the output type.
+ #
+ my $gv = GraphViz->new( %$args )
+ or die sprintf ("Can't create GraphViz object: %s\n",
+ $@ || 'reason unknown'
+ );
+ my $output_method = "as_$args->{output_type}";
+
+ # the generators are AUTOLOADed so can't use ->can ($output_method)
+ eval { $gv->$output_method };
+ die "Invalid output type: '$args->{output_type}'" if $@;
+
+ #
+ # Process tables definitions, create nodes
+ #
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 $table_name = $table->name;
+ if ( @skip_tables_like or keys %skip_tables ) {
+ next TABLE if $skip_tables{ $table_name };
+ for my $regex ( @skip_tables_like ) {
+ next TABLE if $table_name =~ $regex;
+ }
+ }
+
my @fields = $table->get_fields;
- if ( $show_fk_only ) {
+ if ( $args->{show_fk_only} ) {
@fields = grep { $_->is_foreign_key } @fields;
}
- my $field_str = join(
- '\l',
- map {
- '-\ '
- . $_->name
- . ( $show_datatypes ? '\ ' . $_->data_type : '')
- . ( $show_sizes && ! $show_datatypes ? '\ ' : '')
- . ( $show_sizes && $_->data_type =~ /^(VAR)?CHAR2?$/i ? '(' . $_->size . ')' : '')
- . ( $show_constraints ?
- ( $_->is_primary_key || $_->is_foreign_key || $_->is_unique ? '\ [' : '' )
- . ( $_->is_primary_key ? 'PK' : '' )
- . ( $_->is_primary_key && ($_->is_foreign_key || $_->is_unique) ? ',' : '' )
- . ( $_->is_foreign_key ? 'FK' : '' )
- . ( $_->is_unique && ($_->is_primary_key || $_->is_foreign_key) ? ',' : '' )
- . ( $_->is_unique ? 'U' : '' )
- . ( $_->is_primary_key || $_->is_foreign_key || $_->is_unique ? ']' : '' )
- : '' )
- . '\ '
- } @fields
- ) . '\l';
- my $label = $show_fields ? "{$table_name|$field_str}" : $table_name;
-# $gv->add_node( $table_name, label => $label );
- $gv->add_node( $table_name, label => $label, ($node_shape eq 'record' ? ( shape => $node_shape ) : ()) );
+ my $field_str = '';
+ if ($args->{show_fields}) {
+ my @fmt_fields;
+ for my $field (@fields) {
+
+ my $field_info;
+ if ($args->{show_datatypes}) {
+
+ my $field_type = $field->data_type;
+ my $size = $field->size;
+
+ if ( $args->{friendly_ints} && $size && (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)
+ if ($size <= 3 and $args->{friendly_ints_extended}) {
+ $field_type = 'tinyint';
+ }
+ elsif ($size <= 5) {
+ $field_type = 'smallint';
+ }
+ elsif ($size <= 8 and $args->{friendly_ints_extended}) {
+ $field_type = 'mediumint';
+ }
+ elsif ($size <= 11) {
+ $field_type = 'integer';
+ }
+ else {
+ $field_type = 'bigint';
+ }
+ }
+
+ $field_info = $field_type;
+ if ($args->{show_sizes} && $size && ($field_type =~ /^ (?: NUMERIC | DECIMAL | (VAR)?CHAR2? ) $/ix ) ) {
+ $field_info .= '(' . $size . ')';
+ }
+ }
+
+ my $constraints;
+ if ($args->{show_constraints}) {
+ my @constraints;
+ push(@constraints, $field->is_auto_increment ? 'PA' : 'PK') if $field->is_primary_key;
+ push(@constraints, 'FK') if $field->is_foreign_key;
+ push(@constraints, 'U') if $field->is_unique;
+ push(@constraints, 'N') if $field->is_nullable;
+
+ $constraints = join (',', @constraints);
+ }
+
+ # construct the field line from all info gathered so far
+ push @fmt_fields, join (' ',
+ '-',
+ $field->name,
+ $field_info || (),
+ $constraints ? "[$constraints]" : (),
+ );
+ }
+
+ # join field lines with graphviz formatting
+ $field_str = join ('\l', @fmt_fields) . '\l';
+
+ }
+
+ my $index_str = '';
+ if ($args->{show_indexes}) {
+
+ my @fmt_indexes;
+ for my $index ($table->get_indices) {
+ next unless $index->is_valid;
+
+ push @fmt_indexes, join (' ',
+ '*',
+ $args->{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 $name_str = $table_name . '\n';
+
+ # escape spaces
+ for ($name_str, $field_str, $index_str) {
+ $_ =~ s/ /\\ /g;
+ }
+
+ my $node_args;
+
+ # only the 'record' type supports nice formatting
+ if ($args->{node}{shape} eq 'record') {
+
+ # the necessity to supply shape => 'record' is a graphviz bug
+ $node_args = {
+ shape => 'record',
+ label => sprintf ('{%s}',
+ join ('|',
+ $name_str,
+ $field_str || (),
+ $index_str || (),
+ ),
+ ),
+ };
+ }
+ else {
+ my $sep = sprintf ('%s\n',
+ '-' x ( (length $table_name) + 2)
+ );
+
+ $node_args = {
+ label => join ($sep,
+ $name_str,
+ $field_str || (),
+ $index_str || (),
+ ),
+ };
+ }
+
+ if (my $cluster_name = $cluster{$table_name} ) {
+ $node_args->{cluster} = $cluster_name;
+ }
+
+ $gv->add_node(qq["$table_name"], %$node_args);
+
debug("Processing table '$table_name'");
debug("Fields = ", join(', ', map { $_->name } @fields));
#
# Decide if we should skip this field.
#
- if ( $natural_join ) {
+ if ( $args->{natural_join} ) {
next unless $is_pk || $f->is_foreign_key;
}
my $constraints = $f->{'constraints'};
- if ( $natural_join && !$skip{ $name } ) {
+ if ( $args->{natural_join} && !$skip_fields{ $name } ) {
push @{ $nj_registry{ $name } }, $table_name;
}
}
- unless ( $natural_join ) {
+ unless ( $args->{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 ];
+
+ # a condition is optional if at least one fk is nullable
+ push @fk_registry, [
+ $table_name,
+ $fk_table,
+ scalar (grep { $_->is_nullable } ($c->fields))
+ ];
}
}
}
}
#
- # Make the connections.
+ # Process relationships, create edges
#
- my @table_bunches;
- if ( $natural_join ) {
+ my (@table_bunches, %optional_constraints);
+ if ( $args->{natural_join} ) {
for my $field_name ( keys %nj_registry ) {
my @table_names = @{ $nj_registry{ $field_name } || [] } or next;
next if scalar @table_names == 1;
}
}
else {
- @table_bunches = @fk_registry;
+ for my $i (0 .. $#fk_registry) {
+ my $fk = $fk_registry[$i];
+ push @table_bunches, [$fk->[0], $fk->[1]];
+ $optional_constraints{$i} = $fk->[2];
+ }
}
my %done;
- for my $bunch ( @table_bunches ) {
- my @tables = @$bunch;
+ for my $bi (0 .. $#table_bunches) {
+ my @tables = @{$table_bunches[$bi]};
for my $i ( 0 .. $#tables ) {
my $table1 = $tables[ $i ];
- for my $j ( 0 .. $#tables ) {
+ for my $j ( 1 .. $#tables ) {
+ next if $i == $j;
my $table2 = $tables[ $j ];
- next if $table1 eq $table2;
next if $done{ $table1 }{ $table2 };
- $gv->add_edge( $table2, $table1 );
+ debug("Adding edge '$table2' -> '$table1'");
+ $gv->add_edge(
+ qq["$table2"],
+ qq["$table1"],
+ arrowhead => $optional_constraints{$bi} ? 'empty' : 'normal',
+ );
$done{ $table1 }{ $table2 } = 1;
- $done{ $table2 }{ $table1 } = 1;
}
}
}
#
- # Print the image.
+ # 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;
+ if ( my $out = $args->{out_file} ) {
+ if (openhandle ($out)) {
+ print $out $gv->$output_method;
+ }
+ else {
+ open my $fh, '>', $out or die "Can't write '$out': $!\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>
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>
+
+Jonathan Yu E<lt>frequency@cpan.orgE<gt>
=head1 SEE ALSO
projects / dbsrgits/SQL-Translator.git / blobdiff