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';
251 ( delete $args->{$old_arg}, delete $args->{$argtype} )
254 $args->{$argtype} = \%arglist if keys %arglist;
257 # explode font settings
258 for (qw/fontsize fontname/) {
259 if (defined $args->{$_}) {
260 $args->{node}{$_} ||= $args->{$_};
261 $args->{edge}{$_} ||= $args->{$_};
262 $args->{graph}{$_} ||= $args->{$_};
266 # legacy add_color setting, trumped by bgcolor if set
267 $args->{bgcolor} ||= 'lightgoldenrodyellow' if $args->{add_color};
269 # legacy node_shape setting, defaults to 'record', trumped by {node}{shape}
270 $args->{node}{shape} ||= ( $args->{node_shape} || 'record' );
273 $args->{layout} ||= 'dot';
274 $args->{output_type} ||= 'png';
275 $args->{overlap} ||= 'false';
276 $args->{node}{style} ||= 'filled';
277 $args->{node}{fillcolor} ||= 'white';
279 $args->{show_fields} = 1 if not exists $args->{show_fields};
280 $args->{show_index_names} = 1 if not exists $args->{show_index_names};
281 $args->{width} = 8.5 if not defined $args->{width};
282 $args->{height} = 11 if not defined $args->{height};
283 for ( $args->{height}, $args->{width} ) {
284 $_ = 0 unless $_ =~ /^\d+(?:.\d+)?$/;
288 # so split won't warn
289 $args->{$_} ||= '' for qw/skip_fields skip_tables skip_tables_like cluster/;
291 my %skip_fields = map { s/^\s+|\s+$//g; length $_ ? ($_, 1) : () }
292 split ( /,/, $args->{skip_fields} );
294 my %skip_tables = map { $_, 1 } (
295 ref $args->{skip_tables} eq 'ARRAY'
296 ? @{$args->{skip_tables}}
297 : split (/\s*,\s*/, $args->{skip_tables})
300 my @skip_tables_like = map { qr/$_/ } (
301 ref $args->{skip_tables_like} eq 'ARRAY'
302 ? @{$args->{skip_tables_like}}
303 : split (/\s*,\s*/, $args->{skip_tables_like})
306 # join_pk_only/skip_fields implies natural_join
307 $args->{natural_join} = 1
308 if ($args->{join_pk_only} or scalar keys %skip_fields);
310 # usually we do not want direction when using natural join
311 $args->{directed} = ($args->{natural_join} ? 0 : 1)
312 if not exists $args->{directed};
314 $schema->make_natural_joins(
315 join_pk_only => $args->{join_pk_only},
316 skip_fields => $args->{skip_fields},
317 ) if $args->{natural_join};
320 if ( defined $args->{'cluster'} ) {
322 if ( ref $args->{'cluster'} eq 'ARRAY' ) {
323 @clusters = @{ $args->{'cluster'} };
326 @clusters = split /\s*;\s*/, $args->{'cluster'};
329 for my $c ( @clusters ) {
330 my ( $cluster_name, @cluster_tables );
331 if ( ref $c eq 'HASH' ) {
332 $cluster_name = $c->{'name'} || $c->{'cluster_name'};
333 @cluster_tables = @{ $c->{'tables'} || [] };
336 my ( $name, $tables ) = split /\s*=\s*/, $c;
337 $cluster_name = $name;
338 @cluster_tables = split /\s*,\s*/, $tables;
341 for my $table ( @cluster_tables ) {
342 $cluster{ $table } = $cluster_name;
348 # Create a blank GraphViz object and see if we can produce the output type.
350 my $gv = GraphViz->new( %$args )
351 or die sprintf ("Can't create GraphViz object: %s\n",
352 $@ || 'reason unknown'
355 my $output_method = "as_$args->{output_type}";
357 # the generators are AUTOLOADed so can't use ->can ($output_method)
358 eval { $gv->$output_method };
359 die "Invalid output type: '$args->{output_type}'" if $@;
362 # Process tables definitions, create nodes
364 my %nj_registry; # for locations of fields for natural joins
365 my @fk_registry; # for locations of fields for foreign keys
368 for my $table ( $schema->get_tables ) {
370 my $table_name = $table->name;
371 if ( @skip_tables_like or keys %skip_tables ) {
372 next TABLE if $skip_tables{ $table_name };
373 for my $regex ( @skip_tables_like ) {
374 next TABLE if $table_name =~ $regex;
378 my @fields = $table->get_fields;
379 if ( $args->{show_fk_only} ) {
380 @fields = grep { $_->is_foreign_key } @fields;
384 if ($args->{show_fields}) {
386 for my $field (@fields) {
389 if ($args->{show_datatypes}) {
391 my $field_type = $field->data_type;
392 my $size = $field->size;
394 if ( $args->{friendly_ints} && $size && (lc ($field_type) eq 'integer') ) {
395 # Automatically translate to int2, int4, int8
396 # Type (Bits) Max. Signed/Unsigned Length
399 # smallint (16) 32767 5
401 # mediumint* (24) 8388607 7
403 # int (32) 2147483647 10
405 # bigint (64) 9223372036854775807 19
406 # 18446744073709551615 20
408 # * tinyint and mediumint are nonstandard extensions which are
409 # only available under MySQL (to my knowledge)
410 if ($size <= 3 and $args->{friendly_ints_extended}) {
411 $field_type = 'tinyint';
414 $field_type = 'smallint';
416 elsif ($size <= 8 and $args->{friendly_ints_extended}) {
417 $field_type = 'mediumint';
419 elsif ($size <= 11) {
420 $field_type = 'integer';
423 $field_type = 'bigint';
427 $field_info = $field_type;
428 if ($args->{show_sizes} && $size && ($field_type =~ /^ (?: NUMERIC | DECIMAL | (VAR)?CHAR2? ) $/ix ) ) {
429 $field_info .= '(' . $size . ')';
434 if ($args->{show_constraints}) {
436 push(@constraints, 'PK') if $field->is_primary_key;
437 push(@constraints, 'FK') if $field->is_foreign_key;
438 push(@constraints, 'U') if $field->is_unique;
439 push(@constraints, 'N') if $field->is_nullable;
441 $constraints = join (',', @constraints);
444 # construct the field line from all info gathered so far
445 push @fmt_fields, join (' ',
449 $constraints ? "[$constraints]" : (),
453 # join field lines with graphviz formatting
454 $field_str = join ('\l', @fmt_fields) . '\l';
459 if ($args->{show_indexes}) {
462 for my $index ($table->get_indices) {
463 next unless $index->is_valid;
465 push @fmt_indexes, join (' ',
467 $args->{show_index_names}
471 join (', ', $index->fields),
472 ($index->type eq 'UNIQUE') ? '[U]' : (),
476 # join index lines with graphviz formatting (if any indexes at all)
477 $index_str = join ('\l', @fmt_indexes) . '\l' if @fmt_indexes;
480 my $name_str = $table_name . '\n';
483 for ($name_str, $field_str, $index_str) {
489 # only the 'record' type supports nice formatting
490 if ($args->{node}{shape} eq 'record') {
492 # the necessity to supply shape => 'record' is a graphviz bug
495 label => sprintf ('{%s}',
505 my $sep = sprintf ('%s\n',
506 '-' x ( (length $table_name) + 2)
518 if (my $cluster_name = $cluster{$table_name} ) {
519 $node_args->{cluster} = $cluster_name;
522 $gv->add_node ($table_name, %$node_args);
524 debug("Processing table '$table_name'");
526 debug("Fields = ", join(', ', map { $_->name } @fields));
528 for my $f ( @fields ) {
529 my $name = $f->name or next;
530 my $is_pk = $f->is_primary_key;
531 my $is_unique = $f->is_unique;
534 # Decide if we should skip this field.
536 if ( $args->{natural_join} ) {
537 next unless $is_pk || $f->is_foreign_key;
540 my $constraints = $f->{'constraints'};
542 if ( $args->{natural_join} && !$skip_fields{ $name } ) {
543 push @{ $nj_registry{ $name } }, $table_name;
547 unless ( $args->{natural_join} ) {
548 for my $c ( $table->get_constraints ) {
549 next unless $c->type eq FOREIGN_KEY;
550 my $fk_table = $c->reference_table or next;
552 for my $field_name ( $c->fields ) {
553 for my $fk_field ( $c->reference_fields ) {
554 next unless defined $schema->get_table( $fk_table );
556 # a condition is optional if at least one fk is nullable
560 scalar (grep { $_->is_nullable } ($c->fields))
569 # Process relationships, create edges
571 my (@table_bunches, %optional_constraints);
572 if ( $args->{natural_join} ) {
573 for my $field_name ( keys %nj_registry ) {
574 my @table_names = @{ $nj_registry{ $field_name } || [] } or next;
575 next if scalar @table_names == 1;
576 push @table_bunches, [ @table_names ];
580 for my $i (0 .. $#fk_registry) {
581 my $fk = $fk_registry[$i];
582 push @table_bunches, [$fk->[0], $fk->[1]];
583 $optional_constraints{$i} = $fk->[2];
588 for my $bi (0 .. $#table_bunches) {
589 my @tables = @{$table_bunches[$bi]};
591 for my $i ( 0 .. $#tables ) {
592 my $table1 = $tables[ $i ];
593 for my $j ( 1 .. $#tables ) {
595 my $table2 = $tables[ $j ];
596 next if $done{ $table1 }{ $table2 };
600 arrowhead => $optional_constraints{$bi} ? 'empty' : 'normal',
602 $done{ $table1 }{ $table2 } = 1;
610 if ( my $out = $args->{out_file} ) {
611 if (openhandle ($out)) {
612 print $out $gv->$output_method;
615 open my $fh, '>', $out or die "Can't write '$out': $!\n";
617 print $fh $gv->$output_method;
622 return $gv->$output_method;
628 # -------------------------------------------------------------------
634 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>
636 Jonathan Yu E<lt>frequency@cpan.orgE<gt>
640 SQL::Translator, GraphViz