1 package SQL::Translator::Producer::GraphViz;
3 # -------------------------------------------------------------------
4 # Copyright (C) 2002-2009 SQLFairy Authors
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License as
8 # published by the Free Software Foundation; version 2.
10 # This program is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 # General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
19 # -------------------------------------------------------------------
25 SQL::Translator::Producer::GraphViz - GraphViz producer for SQL::Translator
31 my $trans = new SQL::Translator(
32 from => 'MySQL', # or your db of choice
35 out_file => 'schema.png',
36 bgcolor => 'lightgoldenrodyellow',
37 show_constraints => 1,
41 ) or die SQL::Translator->error;
43 $trans->translate or die $trans->error;
47 Creates a graph of a schema using the amazing graphviz
48 (see http://www.graphviz.org/) application (via
49 the L<GraphViz> module). It's nifty--you should try it!
53 All L<GraphViz> constructor attributes are accepted and passed
54 through to L<GraphViz/new>. The following defaults are assumed
70 See the documentation of L<GraphViz/new> for more info on these
73 In addition this producer accepts the following arguments:
79 An arrayref or a comma-separated list of table names that should be
80 skipped. Note that a skipped table node may still appear if another
81 table has foreign key constraints pointing to the skipped table. If
82 this happens no table field/index information will be included.
84 =item * skip_tables_like
86 An arrayref or a comma-separated list of regular expressions matching
87 table names that should be skipped.
95 The name of the file where the resulting GraphViz output will be
96 written. Alternatively an open filehandle can be supplied. If
97 undefined (the default) - the result is returned as a string.
99 =item * output_type (DEFAULT: 'png')
101 This determines which
102 L<output method|GraphViz/as_canon,_as_text,_as_gif_etc._methods>
103 will be invoked to generate the graph: C<png> translates to
104 C<as_png>, C<ps> to C<as_ps> and so on.
108 This sets the global font name (or full path to font file) for
109 node, edge, and graph labels
113 This sets the global font size for node and edge labels (note that
114 arbitrarily large sizes may be ignored due to page size or graph size
117 =item * show_fields (DEFAULT: true)
119 If set to a true value, the names of the colums in a table will
120 be displayed in each table's node
124 If set to a true value, only columns which are foreign keys
125 will be displayed in each table's node
127 =item * show_datatypes
129 If set to a true value, the datatype of each column will be
130 displayed next to each column's name; this option will have no
131 effect if the value of C<show_fields> is set to false
133 =item * friendly_ints
135 If set to a true value, each integer type field will be displayed
136 as a tinyint, smallint, integer or bigint depending on the field's
137 associated size parameter. This only applies for the C<integer>
138 type (and not the C<int> type, which is always assumed to be a
139 32-bit integer); this option will have no effect if the value of
140 C<show_fields> is set to false
142 =item * friendly_ints_extended
144 If set to a true value, the friendly ints displayed will take into
145 account the non-standard types, 'tinyint' and 'mediumint' (which,
146 as far as I am aware, is only implemented in MySQL)
150 If set to a true value, the size (in bytes) of each CHAR and
151 VARCHAR column will be displayed in parentheses next to the
152 column's name; this option will have no effect if the value of
153 C<show_fields> is set to false
155 =item * show_constraints
157 If set to a true value, a field's constraints (i.e., its
158 primary-key-ness, its foreign-key-ness and/or its uniqueness)
159 will appear as a comma-separated list in brackets next to the
160 field's name; this option will have no effect if the value of
161 C<show_fields> is set to false
165 If set to a true value, each record will also show the indexes
166 set on each table. It describes the index types along with
167 which columns are included in the index.
169 =item * show_index_names (DEFAULT: true)
171 If C<show_indexes> is set to a true value, then the value of this
172 parameter determines whether or not to print names of indexes.
173 if C<show_index_names> is false, then a list of indexed columns
174 will appear below the field list. Otherwise, it will be a list
175 prefixed with the name of each index.
179 If set to a true value, L<SQL::Translator::Schema/make_natural_joins>
180 will be called before generating the graph.
184 The value of this option will be passed as the value of the
185 like-named argument to L<SQL::Translator::Schema/make_natural_joins>;
186 implies C<< natural_join => 1 >>
190 The value of this option will be passed as the value of the
191 like-named argument to L<SQL::Translator::Schema/make_natural_joins>;
192 implies C<< natural_join => 1 >>
196 =head2 DEPRECATED ARGS
202 Deprecated, use node => { shape => ... } instead
206 Deprecated, use bgcolor => 'lightgoldenrodyellow' instead
208 If set to a true value, the graphic will have a background
209 color of 'lightgoldenrodyellow'; otherwise the default
210 white background will be used
214 Deprecated, use node => { ... } instead
218 Deprecated, use edge => { ... } instead
222 Deprecated, use graph => { ... } instead
231 use SQL::Translator::Schema::Constants;
232 use SQL::Translator::Utils qw(debug);
233 use Scalar::Util qw/openhandle/;
235 use vars qw[ $VERSION $DEBUG ];
237 $DEBUG = 0 unless defined $DEBUG;
241 my $schema = $t->schema;
242 my $args = $t->producer_args;
243 local $DEBUG = $t->debug;
245 # translate legacy {node|edge|graph}attrs to just {node|edge|graph}
246 for my $argtype (qw/node edge graph/) {
247 my $old_arg = $argtype . 'attrs';
248 $args->{$argtype} = {
249 map { %{ $_ || {} } }
250 ( delete $args->{$old_arg}, $args->{$argtype} )
254 # explode font settings
255 for (qw/fontsize fontname/) {
256 if (defined $args->{$_}) {
257 $args->{node}{$_} ||= $args->{$_};
258 $args->{edge}{$_} ||= $args->{$_};
259 $args->{graph}{$_} ||= $args->{$_};
263 # legacy add_color setting, trumped by bgcolor if set
264 $args->{bgcolor} ||= 'lightgoldenrodyellow' if $args->{add_color};
266 # legacy node_shape setting, defaults to 'record', trumped by {node}{shape}
267 $args->{node}{shape} ||= ( $args->{node_shape} || 'record' );
270 $args->{layout} ||= 'dot';
271 $args->{output_type} ||= 'png';
272 $args->{overlap} ||= 'false';
273 $args->{node}{style} ||= 'filled';
274 $args->{node}{fillcolor} ||= 'white';
276 $args->{show_fields} = 1 if not exists $args->{show_fields};
277 $args->{show_index_names} = 1 if not exists $args->{show_index_names};
278 $args->{width} = 8.5 if not defined $args->{width};
279 $args->{height} = 11 if not defined $args->{height};
280 for ( $args->{height}, $args->{width} ) {
281 $_ = 0 unless $_ =~ /^\d+(?:.\d+)?$/;
285 # so split won't warn
286 $args->{$_} ||= '' for qw/skip_fields skip_tables skip_tables_like cluster/;
288 my %skip_fields = map { s/^\s+|\s+$//g; length $_ ? ($_, 1) : () }
289 split ( /,/, $args->{skip_fields} );
291 my %skip_tables = map { $_, 1 } (
292 ref $args->{skip_tables} eq 'ARRAY'
293 ? @{$args->{skip_tables}}
294 : split (/\s*,\s*/, $args->{skip_tables})
297 my @skip_tables_like = map { qr/$_/ } (
298 ref $args->{skip_tables_like} eq 'ARRAY'
299 ? @{$args->{skip_tables_like}}
300 : split (/\s*,\s*/, $args->{skip_tables_like})
303 # join_pk_only/skip_fields implies natural_join
304 $args->{natural_join} = 1
305 if ($args->{join_pk_only} or scalar keys %skip_fields);
307 # usually we do not want direction when using natural join
308 $args->{directed} = ($args->{natural_join} ? 0 : 1)
309 if not exists $args->{directed};
311 $schema->make_natural_joins(
312 join_pk_only => $args->{join_pk_only},
313 skip_fields => $args->{skip_fields},
314 ) if $args->{natural_join};
317 if ( defined $args->{'cluster'} ) {
319 if ( ref $args->{'cluster'} eq 'ARRAY' ) {
320 @clusters = @{ $args->{'cluster'} };
323 @clusters = split /\s*;\s*/, $args->{'cluster'};
326 for my $c ( @clusters ) {
327 my ( $cluster_name, @cluster_tables );
328 if ( ref $c eq 'HASH' ) {
329 $cluster_name = $c->{'name'} || $c->{'cluster_name'};
330 @cluster_tables = @{ $c->{'tables'} || [] };
333 my ( $name, $tables ) = split /\s*=\s*/, $c;
334 $cluster_name = $name;
335 @cluster_tables = split /\s*,\s*/, $tables;
338 for my $table ( @cluster_tables ) {
339 $cluster{ $table } = $cluster_name;
346 # Create a blank GraphViz object and see if we can produce the output type.
348 my $gv = GraphViz->new( %$args )
349 or die sprintf ("Can't create GraphViz object: %s\n",
350 $@ || 'reason unknown'
353 my $output_method = "as_$args->{output_type}";
355 # the generators are AUTOLOADed so can't use ->can ($output_method)
356 eval { $gv->$output_method };
357 die "Invalid output type: '$args->{output_type}'" if $@;
360 # Process tables definitions, create nodes
362 my %nj_registry; # for locations of fields for natural joins
363 my @fk_registry; # for locations of fields for foreign keys
366 for my $table ( $schema->get_tables ) {
368 my $table_name = $table->name;
369 if ( @skip_tables_like or keys %skip_tables ) {
370 next TABLE if $skip_tables{ $table_name };
371 for my $regex ( @skip_tables_like ) {
372 next TABLE if $table_name =~ $regex;
376 my @fields = $table->get_fields;
377 if ( $args->{show_fk_only} ) {
378 @fields = grep { $_->is_foreign_key } @fields;
382 if ($args->{show_fields}) {
384 for my $field (@fields) {
387 if ($args->{show_datatypes}) {
389 my $field_type = $field->data_type;
390 my $size = $field->size;
392 if ( $args->{friendly_ints} && $size && (lc ($field_type) eq 'integer') ) {
393 # Automatically translate to int2, int4, int8
394 # Type (Bits) Max. Signed/Unsigned Length
397 # smallint (16) 32767 5
399 # mediumint* (24) 8388607 7
401 # int (32) 2147483647 10
403 # bigint (64) 9223372036854775807 19
404 # 18446744073709551615 20
406 # * tinyint and mediumint are nonstandard extensions which are
407 # only available under MySQL (to my knowledge)
408 if ($size <= 3 and $args->{friendly_ints_extended}) {
409 $field_type = 'tinyint';
412 $field_type = 'smallint';
414 elsif ($size <= 8 and $args->{friendly_ints_extended}) {
415 $field_type = 'mediumint';
417 elsif ($size <= 11) {
418 $field_type = 'integer';
421 $field_type = 'bigint';
425 $field_info = $field_type;
426 if ($args->{show_sizes} && $size && ($field_type =~ /^ (?: NUMERIC | DECIMAL | (VAR)?CHAR2? ) $/ix ) ) {
427 $field_info .= '(' . $size . ')';
432 if ($args->{show_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;
437 push(@constraints, 'N') if $field->is_nullable;
439 $constraints = join (',', @constraints);
442 # construct the field line from all info gathered so far
443 push @fmt_fields, join (' ',
447 $constraints ? "[$constraints]" : (),
451 # join field lines with graphviz formatting
452 $field_str = join ('\l', @fmt_fields) . '\l';
457 if ($args->{show_indexes}) {
460 for my $index ($table->get_indices) {
461 next unless $index->is_valid;
463 push @fmt_indexes, join (' ',
465 $args->{show_index_names}
469 join (', ', $index->fields),
470 ($index->type eq 'UNIQUE') ? '[U]' : (),
474 # join index lines with graphviz formatting (if any indexes at all)
475 $index_str = join ('\l', @fmt_indexes) . '\l' if @fmt_indexes;
478 my $name_str = $table_name . '\n';
481 for ($name_str, $field_str, $index_str) {
487 # only the 'record' type supports nice formatting
488 if ($args->{node}{shape} eq 'record') {
490 # the necessity to supply shape => 'record' is a graphviz bug
493 label => sprintf ('{%s}',
503 my $sep = sprintf ('%s\n',
504 '-' x ( (length $table_name) + 2)
516 if (my $cluster_name = $cluster{$table_name} ) {
517 $node_args->{cluster} = $cluster_name;
520 $gv->add_node ($table_name, %$node_args);
522 debug("Processing table '$table_name'");
524 debug("Fields = ", join(', ', map { $_->name } @fields));
526 for my $f ( @fields ) {
527 my $name = $f->name or next;
528 my $is_pk = $f->is_primary_key;
529 my $is_unique = $f->is_unique;
532 # Decide if we should skip this field.
534 if ( $args->{natural_join} ) {
535 next unless $is_pk || $f->is_foreign_key;
538 my $constraints = $f->{'constraints'};
540 if ( $args->{natural_join} && !$skip_fields{ $name } ) {
541 push @{ $nj_registry{ $name } }, $table_name;
545 unless ( $args->{natural_join} ) {
546 for my $c ( $table->get_constraints ) {
547 next unless $c->type eq FOREIGN_KEY;
548 my $fk_table = $c->reference_table or next;
550 for my $field_name ( $c->fields ) {
551 for my $fk_field ( $c->reference_fields ) {
552 next unless defined $schema->get_table( $fk_table );
554 # a condition is optional if at least one fk is nullable
558 scalar (grep { $_->is_nullable } ($c->fields))
567 # Process relationships, create edges
569 my (@table_bunches, %optional_constraints);
570 if ( $args->{natural_join} ) {
571 for my $field_name ( keys %nj_registry ) {
572 my @table_names = @{ $nj_registry{ $field_name } || [] } or next;
573 next if scalar @table_names == 1;
574 push @table_bunches, [ @table_names ];
578 for my $i (0 .. $#fk_registry) {
579 my $fk = $fk_registry[$i];
580 push @table_bunches, [$fk->[0], $fk->[1]];
581 $optional_constraints{$i} = $fk->[2];
586 for my $bi (0 .. $#table_bunches) {
587 my @tables = @{$table_bunches[$bi]};
589 for my $i ( 0 .. $#tables ) {
590 my $table1 = $tables[ $i ];
591 for my $j ( 1 .. $#tables ) {
593 my $table2 = $tables[ $j ];
594 next if $done{ $table1 }{ $table2 };
598 arrowhead => $optional_constraints{$bi} ? 'empty' : 'normal',
600 $done{ $table1 }{ $table2 } = 1;
608 if ( my $out = $args->{out_file} ) {
609 if (openhandle ($out)) {
610 print $out $gv->$output_method;
613 open my $fh, '>', $out or die "Can't write '$out': $!\n";
615 print $fh $gv->$output_method;
620 return $gv->$output_method;
626 # -------------------------------------------------------------------
632 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>
634 Jonathan Yu E<lt>frequency@cpan.orgE<gt>
638 SQL::Translator, GraphViz