1 package SQL::Translator::Producer::GraphViz;
3 # -------------------------------------------------------------------
4 # $Id: GraphViz.pm,v 1.9 2004-02-02 20:28:26 allenday Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
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.
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.
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
21 # -------------------------------------------------------------------
26 use SQL::Translator::Schema::Constants;
27 use SQL::Translator::Utils qw(debug);
29 use vars qw[ $VERSION $DEBUG ];
30 $VERSION = sprintf "%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/;
31 $DEBUG = 0 unless defined $DEBUG;
33 use constant VALID_LAYOUT => {
39 use constant VALID_NODE_SHAPE => {
55 use constant VALID_OUTPUT => {
82 my $schema = $t->schema;
83 my $args = $t->producer_args;
84 local $DEBUG = $t->debug;
86 my $out_file = $args->{'out_file'} || '';
87 my $layout = $args->{'layout'} || 'dot';
88 my $node_shape = $args->{'node_shape'} || 'record';
89 my $output_type = $args->{'output_type'} || 'png';
90 my $width = defined $args->{'width'}
91 ? $args->{'width'} : 8.5;
92 my $height = defined $args->{'height'}
93 ? $args->{'height'} : 11;
94 my $show_fields = defined $args->{'show_fields'}
95 ? $args->{'show_fields'} : 1;
96 my $add_color = $args->{'add_color'};
97 my $natural_join = $args->{'natural_join'};
98 my $show_fk_only = $args->{'show_fk_only'};
99 my $show_datatypes = $args->{'show_datatypes'};
100 my $show_sizes = $args->{'show_sizes'};
101 my $show_constraints = $args->{'show_constraints'};
102 my $join_pk_only = $args->{'join_pk_only'};
103 my $skip_fields = $args->{'skip_fields'};
104 my %skip = map { s/^\s+|\s+$//g; $_, 1 }
105 split ( /,/, $skip_fields );
106 $natural_join ||= $join_pk_only;
108 $schema->make_natural_joins(
109 join_pk_only => $join_pk_only,
110 skip_fields => $args->{'skip_fields'},
113 die "Invalid layout '$layout'" unless VALID_LAYOUT->{ $layout };
114 die "Invalid output type: '$output_type'"
115 unless VALID_OUTPUT->{ $output_type };
116 die "Invalid node shape'$node_shape'"
117 unless VALID_NODE_SHAPE->{ $node_shape };
119 for ( $height, $width ) {
120 $_ = 0 unless $_ =~ /^\d+(.\d)?$/;
125 # Create GraphViz and see if we can produce the output type.
128 directed => $natural_join ? 0 : 1,
131 bgcolor => $add_color ? 'lightgoldenrodyellow' : 'white',
133 shape => $node_shape,
138 $args{'width'} = $width if $width;
139 $args{'height'} = $height if $height;
141 my $gv = GraphViz->new( %args ) or die "Can't create GraphViz object\n";
143 my %nj_registry; # for locations of fields for natural joins
144 my @fk_registry; # for locations of fields for foreign keys
146 for my $table ( $schema->get_tables ) {
147 my $table_name = $table->name;
148 my @fields = $table->get_fields;
149 if ( $show_fk_only ) {
150 @fields = grep { $_->is_foreign_key } @fields;
153 my $field_str = join(
158 . ( $show_datatypes ? '\ ' . $_->data_type : '')
159 . ( $show_sizes && ! $show_datatypes ? '\ ' : '')
160 . ( $show_sizes && $_->data_type =~ /^(VARCHAR2?|CHAR)$/ ? '(' . $_->size . ')' : '')
161 . ( $show_constraints ?
162 ( $_->is_primary_key || $_->is_foreign_key || $_->is_unique ? '\ [' : '' )
163 . ( $_->is_primary_key ? 'PK' : '' )
164 . ( $_->is_primary_key && ($_->is_foreign_key || $_->is_unique) ? ',' : '' )
165 . ( $_->is_foreign_key ? 'FK' : '' )
166 . ( $_->is_unique && ($_->is_primary_key || $_->is_foreign_key) ? ',' : '' )
167 . ( $_->is_unique ? 'U' : '' )
168 . ( $_->is_primary_key || $_->is_foreign_key || $_->is_unique ? ']' : '' )
173 my $label = $show_fields ? "{$table_name|$field_str}" : $table_name;
174 $gv->add_node( $table_name, label => $label );
176 debug("Processing table '$table_name'");
178 debug("Fields = ", join(', ', map { $_->name } @fields));
180 for my $f ( @fields ) {
181 my $name = $f->name or next;
182 my $is_pk = $f->is_primary_key;
183 my $is_unique = $f->is_unique;
186 # Decide if we should skip this field.
188 if ( $natural_join ) {
189 next unless $is_pk || $f->is_foreign_key;
192 my $constraints = $f->{'constraints'};
194 if ( $natural_join && !$skip{ $name } ) {
195 push @{ $nj_registry{ $name } }, $table_name;
199 unless ( $natural_join ) {
200 for my $c ( $table->get_constraints ) {
201 next unless $c->type eq FOREIGN_KEY;
202 my $fk_table = $c->reference_table or next;
204 for my $field_name ( $c->fields ) {
205 for my $fk_field ( $c->reference_fields ) {
206 next unless defined $schema->get_table( $fk_table );
207 push @fk_registry, [ $table_name, $fk_table ];
215 # Make the connections.
218 if ( $natural_join ) {
219 for my $field_name ( keys %nj_registry ) {
220 my @table_names = @{ $nj_registry{ $field_name } || [] } or next;
221 next if scalar @table_names == 1;
222 push @table_bunches, [ @table_names ];
226 @table_bunches = @fk_registry;
230 for my $bunch ( @table_bunches ) {
231 my @tables = @$bunch;
233 for my $i ( 0 .. $#tables ) {
234 my $table1 = $tables[ $i ];
235 for my $j ( 0 .. $#tables ) {
236 my $table2 = $tables[ $j ];
237 next if $table1 eq $table2;
238 next if $done{ $table1 }{ $table2 };
239 $gv->add_edge( $table2, $table1 );
240 $done{ $table1 }{ $table2 } = 1;
241 $done{ $table2 }{ $table1 } = 1;
249 my $output_method = "as_$output_type";
251 open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
253 print $fh $gv->$output_method;
257 return $gv->$output_method;
267 SQL::Translator::Producer::GraphViz - GraphViz producer for SQL::Translator
271 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>