package SQL::Translator::Producer::GraphViz;
# -------------------------------------------------------------------
-# $Id: GraphViz.pm,v 1.2 2003-04-24 20:02:31 kycl4rk Exp $
+# $Id: GraphViz.pm,v 1.12 2004-02-20 02:41:47 dlc Exp $
# -------------------------------------------------------------------
-# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
+# 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
# 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_col_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 * 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_col_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
+
+=back
+
+=cut
+
use strict;
use GraphViz;
use Data::Dumper;
+use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(debug);
use vars qw[ $VERSION $DEBUG ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/;
$DEBUG = 0 unless defined $DEBUG;
use constant VALID_LAYOUT => {
};
sub produce {
- my ($t, $data) = @_;
+ my $t = shift;
+ my $schema = $t->schema;
my $args = $t->producer_args;
local $DEBUG = $t->debug;
- debug("Data =\n", Dumper( $data ));
- debug("Producer args =\n", Dumper( $args ));
-
- my $out_file = $args->{'out_file'} || '';
- my $layout = $args->{'layout'} || 'neato';
- my $node_shape = $args->{'node_shape'} || 'ellipse';
- my $output_type = $args->{'output_type'} || 'png';
- my $add_color = $args->{'add_color'};
- my $natural_join = $args->{'natural_join'};
- my $join_pk_only = $args->{'join_pk_only'};
- my $skip_fields = $args->{'skip_fields'};
- my %skip = map { s/^\s+|\s+$//g; $_, 1 }
- split ( /,/, $skip_fields );
- $natural_join ||= $join_pk_only;
+
+ 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 $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; $_, 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'"
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 $gv = GraphViz->new(
+ my %args = (
directed => $natural_join ? 0 : 1,
layout => $layout,
no_overlap => 1,
shape => $node_shape,
style => 'filled',
fillcolor => 'white'
- },
- ) or die "Can't create GraphViz object\n";
+ }
+ );
+ $args{'width'} = $width if $width;
+ $args{'height'} = $height if $height;
+
+ 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
- #
- # If necessary, pre-process fields to find foreign keys.
- #
- if ( $natural_join ) {
- my ( %common_keys, %pk );
- for my $table ( values %$data ) {
- for my $index (
- @{ $table->{'indices'} || [] },
- @{ $table->{'constraints'} || [] },
- ) {
- my @fields = @{ $index->{'fields'} || [] } or next;
- if ( $index->{'type'} eq 'primary_key' ) {
- $pk{ $_ } = 1 for @fields;
- }
- }
-
- for my $field ( values %{ $table->{'fields'} } ) {
- push @{ $common_keys{ $field->{'name'} } },
- $table->{'table_name'};
- }
+ for my $table ( $schema->get_tables ) {
+ my $table_name = $table->name;
+ my @fields = $table->get_fields;
+ if ( $show_fk_only ) {
+ @fields = grep { $_->is_foreign_key } @fields;
}
- for my $field ( keys %common_keys ) {
- my @tables = @{ $common_keys{ $field } };
- next unless scalar @tables > 1;
- for my $table ( @tables ) {
- next if $join_pk_only and !defined $pk{ $field };
- $data->{ $table }{'fields'}{ $field }{'is_fk'} = 1;
- }
- }
- }
- else {
- for my $table ( values %$data ) {
- for my $field ( values %{ $table->{'fields'} } ) {
- for my $constraint (
- grep { $_->{'type'} eq 'foreign_key' }
- @{ $field->{'constraints'} }
- ) {
- my $ref_table = $constraint->{'reference_table'} or next;
- my @ref_fields = @{ $constraint->{'reference_fields'}||[] };
-
- unless ( @ref_fields ) {
- for my $field (
- values %{ $data->{ $ref_table }{'fields'} }
- ) {
- for my $pk (
- grep { $_->{'type'} eq 'primary_key' }
- @{ $field->{'constraints'} }
- ) {
- push @ref_fields, @{ $pk->{'fields'} };
- }
- }
-
- $constraint->{'reference_fields'} = [ @ref_fields ];
- }
-
- for my $ref_field (@{$constraint->{'reference_fields'}}) {
- $data->{$ref_table}{'fields'}{$ref_field}{'is_fk'} = 1;
- }
- }
- }
- }
- }
-
- for my $table (
- map { $_->[1] }
- sort { $a->[0] <=> $b->[0] }
- map { [ $_->{'order'}, $_ ] }
- values %$data
- ) {
- my $table_name = $table->{'table_name'};
- $gv->add_node( $table_name );
+ 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 );
debug("Processing table '$table_name'");
- my @fields =
- map { $_->[1] }
- sort { $a->[0] <=> $b->[0] }
- map { [ $_->{'order'}, $_ ] }
- values %{ $table->{'fields'} };
-
- debug("Fields = ", join(', ', map { $_->{'name'} } @fields));
-
- my ( %pk, %unique );
- for my $index (
- @{ $table->{'indices'} || [] },
- @{ $table->{'constraints'} || [] },
- ) {
- my @fields = @{ $index->{'fields'} || [] } or next;
- if ( $index->{'type'} eq 'primary_key' ) {
- $pk{ $_ } = 1 for @fields;
- }
- elsif ( $index->{'type'} eq 'unique' ) {
- $unique{ $_ } = 1 for @fields;
- }
- }
-
- debug("Primary keys = ", join(', ', sort keys %pk));
- debug("Unique = ", join(', ', sort keys %unique));
+ debug("Fields = ", join(', ', map { $_->name } @fields));
for my $f ( @fields ) {
- my $name = $f->{'name'} or next;
- my $is_pk = $pk{ $name };
- my $is_unique = $unique{ $name };
+ 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_fk'};
- }
- else {
- next unless $is_pk ||
- grep { $_->{'type'} eq 'foreign_key' }
- @{ $f->{'constraints'} }
- ;
+ next unless $is_pk || $f->is_foreign_key;
}
my $constraints = $f->{'constraints'};
if ( $natural_join && !$skip{ $name } ) {
push @{ $nj_registry{ $name } }, $table_name;
}
- elsif ( @{ $constraints || [] } ) {
- for my $constraint ( @$constraints ) {
- next unless $constraint->{'type'} eq 'foreign_key';
- for my $fk_field (
- @{ $constraint->{'reference_fields'} || [] }
- ) {
- my $fk_table = $constraint->{'reference_table'};
- next unless defined $data->{ $fk_table };
+ }
+
+ 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 ];
}
}
my $table2 = $tables[ $j ];
next if $table1 eq $table2;
next if $done{ $table1 }{ $table2 };
- $gv->add_edge( $table1, $table2 );
+ $gv->add_edge( $table2, $table1 );
$done{ $table1 }{ $table2 } = 1;
$done{ $table2 }{ $table1 } = 1;
}
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;
}
1;
-=pod
-
-=head1 NAME
+# -------------------------------------------------------------------
-SQL::Translator::Producer::GraphViz - GraphViz producer for SQL::Translator
+=pod
=head1 AUTHOR
Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
+=head1 SEE ALSO
+
+SQL::Translator, GraphViz
+
=cut