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 = SQL::Translator->new(
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.
91 Clustering of tables allows you to group and box tables according to
92 function or domain or whatever criteria you choose. The syntax for
95 cluster => 'cluster1=table1,table2;cluster2=table3,table4'
97 Or pass it as an arrayref like so:
99 cluster => [ 'cluster1=table1,table2', 'cluster2=table3,table4' ]
104 { name => 'cluster1', tables => [ 'table1', 'table2' ] },
105 { name => 'cluster2', tables => [ 'table3', 'table4' ] },
110 The name of the file where the resulting GraphViz output will be
111 written. Alternatively an open filehandle can be supplied. If
112 undefined (the default) - the result is returned as a string.
114 =item * output_type (DEFAULT: 'png')
116 This determines which
117 L<output method|GraphViz/as_canon,_as_text,_as_gif_etc._methods>
118 will be invoked to generate the graph: C<png> translates to
119 C<as_png>, C<ps> to C<as_ps> and so on.
123 This sets the global font name (or full path to font file) for
124 node, edge, and graph labels
128 This sets the global font size for node and edge labels (note that
129 arbitrarily large sizes may be ignored due to page size or graph size
132 =item * show_fields (DEFAULT: true)
134 If set to a true value, the names of the colums in a table will
135 be displayed in each table's node
139 If set to a true value, only columns which are foreign keys
140 will be displayed in each table's node
142 =item * show_datatypes
144 If set to a true value, the datatype of each column will be
145 displayed next to each column's name; this option will have no
146 effect if the value of C<show_fields> is set to false
148 =item * friendly_ints
150 If set to a true value, each integer type field will be displayed
151 as a tinyint, smallint, integer or bigint depending on the field's
152 associated size parameter. This only applies for the C<integer>
153 type (and not the C<int> type, which is always assumed to be a
154 32-bit integer); this option will have no effect if the value of
155 C<show_fields> is set to false
157 =item * friendly_ints_extended
159 If set to a true value, the friendly ints displayed will take into
160 account the non-standard types, 'tinyint' and 'mediumint' (which,
161 as far as I am aware, is only implemented in MySQL)
165 If set to a true value, the size (in bytes) of each CHAR and
166 VARCHAR column will be displayed in parentheses next to the
167 column's name; this option will have no effect if the value of
168 C<show_fields> is set to false
170 =item * show_constraints
172 If set to a true value, a field's constraints (i.e., its
173 primary-key-ness, its foreign-key-ness and/or its uniqueness)
174 will appear as a comma-separated list in brackets next to the
175 field's name; this option will have no effect if the value of
176 C<show_fields> is set to false
180 If set to a true value, each record will also show the indexes
181 set on each table. It describes the index types along with
182 which columns are included in the index.
184 =item * show_index_names (DEFAULT: true)
186 If C<show_indexes> is set to a true value, then the value of this
187 parameter determines whether or not to print names of indexes.
188 if C<show_index_names> is false, then a list of indexed columns
189 will appear below the field list. Otherwise, it will be a list
190 prefixed with the name of each index.
194 If set to a true value, L<SQL::Translator::Schema/make_natural_joins>
195 will be called before generating the graph.
199 The value of this option will be passed as the value of the
200 like-named argument to L<SQL::Translator::Schema/make_natural_joins>;
201 implies C<< natural_join => 1 >>
205 The value of this option will be passed as the value of the
206 like-named argument to L<SQL::Translator::Schema/make_natural_joins>;
207 implies C<< natural_join => 1 >>
211 =head2 DEPRECATED ARGS
217 Deprecated, use node => { shape => ... } instead
221 Deprecated, use bgcolor => 'lightgoldenrodyellow' instead
223 If set to a true value, the graphic will have a background
224 color of 'lightgoldenrodyellow'; otherwise the default
225 white background will be used
229 Deprecated, use node => { ... } instead
233 Deprecated, use edge => { ... } instead
237 Deprecated, use graph => { ... } instead
246 use SQL::Translator::Schema::Constants;
247 use SQL::Translator::Utils qw(debug);
248 use Scalar::Util qw/openhandle/;
250 use vars qw[ $VERSION $DEBUG ];
252 $DEBUG = 0 unless defined $DEBUG;
256 my $schema = $t->schema;
257 my $args = $t->producer_args;
258 local $DEBUG = $t->debug;
260 # translate legacy {node|edge|graph}attrs to just {node|edge|graph}
261 for my $argtype (qw/node edge graph/) {
262 my $old_arg = $argtype . 'attrs';
266 ( delete $args->{$old_arg}, delete $args->{$argtype} )
269 $args->{$argtype} = \%arglist if keys %arglist;
272 # explode font settings
273 for (qw/fontsize fontname/) {
274 if (defined $args->{$_}) {
275 $args->{node}{$_} ||= $args->{$_};
276 $args->{edge}{$_} ||= $args->{$_};
277 $args->{graph}{$_} ||= $args->{$_};
281 # legacy add_color setting, trumped by bgcolor if set
282 $args->{bgcolor} ||= 'lightgoldenrodyellow' if $args->{add_color};
284 # legacy node_shape setting, defaults to 'record', trumped by {node}{shape}
285 $args->{node}{shape} ||= ( $args->{node_shape} || 'record' );
288 $args->{layout} ||= 'dot';
289 $args->{output_type} ||= 'png';
290 $args->{overlap} ||= 'false';
291 $args->{node}{style} ||= 'filled';
292 $args->{node}{fillcolor} ||= 'white';
294 $args->{show_fields} = 1 if not exists $args->{show_fields};
295 $args->{show_index_names} = 1 if not exists $args->{show_index_names};
296 $args->{width} = 8.5 if not defined $args->{width};
297 $args->{height} = 11 if not defined $args->{height};
298 for ( $args->{height}, $args->{width} ) {
299 $_ = 0 unless $_ =~ /^\d+(?:.\d+)?$/;
303 # so split won't warn
304 $args->{$_} ||= '' for qw/skip_fields skip_tables skip_tables_like cluster/;
306 my %skip_fields = map { s/^\s+|\s+$//g; length $_ ? ($_, 1) : () }
307 split ( /,/, $args->{skip_fields} );
309 my %skip_tables = map { $_, 1 } (
310 ref $args->{skip_tables} eq 'ARRAY'
311 ? @{$args->{skip_tables}}
312 : split (/\s*,\s*/, $args->{skip_tables})
315 my @skip_tables_like = map { qr/$_/ } (
316 ref $args->{skip_tables_like} eq 'ARRAY'
317 ? @{$args->{skip_tables_like}}
318 : split (/\s*,\s*/, $args->{skip_tables_like})
321 # join_pk_only/skip_fields implies natural_join
322 $args->{natural_join} = 1
323 if ($args->{join_pk_only} or scalar keys %skip_fields);
325 # usually we do not want direction when using natural join
326 $args->{directed} = ($args->{natural_join} ? 0 : 1)
327 if not exists $args->{directed};
329 $schema->make_natural_joins(
330 join_pk_only => $args->{join_pk_only},
331 skip_fields => $args->{skip_fields},
332 ) if $args->{natural_join};
335 if ( defined $args->{'cluster'} ) {
337 if ( ref $args->{'cluster'} eq 'ARRAY' ) {
338 @clusters = @{ $args->{'cluster'} };
341 @clusters = split /\s*;\s*/, $args->{'cluster'};
344 for my $c ( @clusters ) {
345 my ( $cluster_name, @cluster_tables );
346 if ( ref $c eq 'HASH' ) {
347 $cluster_name = $c->{'name'} || $c->{'cluster_name'};
348 @cluster_tables = @{ $c->{'tables'} || [] };
351 my ( $name, $tables ) = split /\s*=\s*/, $c;
352 $cluster_name = $name;
353 @cluster_tables = split /\s*,\s*/, $tables;
356 for my $table ( @cluster_tables ) {
357 $cluster{ $table } = $cluster_name;
363 # Create a blank GraphViz object and see if we can produce the output type.
365 my $gv = GraphViz->new( %$args )
366 or die sprintf ("Can't create GraphViz object: %s\n",
367 $@ || 'reason unknown'
370 my $output_method = "as_$args->{output_type}";
372 # the generators are AUTOLOADed so can't use ->can ($output_method)
373 eval { $gv->$output_method };
374 die "Invalid output type: '$args->{output_type}'" if $@;
377 # Process tables definitions, create nodes
379 my %nj_registry; # for locations of fields for natural joins
380 my @fk_registry; # for locations of fields for foreign keys
383 for my $table ( $schema->get_tables ) {
385 my $table_name = $table->name;
386 if ( @skip_tables_like or keys %skip_tables ) {
387 next TABLE if $skip_tables{ $table_name };
388 for my $regex ( @skip_tables_like ) {
389 next TABLE if $table_name =~ $regex;
393 my @fields = $table->get_fields;
394 if ( $args->{show_fk_only} ) {
395 @fields = grep { $_->is_foreign_key } @fields;
399 if ($args->{show_fields}) {
401 for my $field (@fields) {
404 if ($args->{show_datatypes}) {
406 my $field_type = $field->data_type;
407 my $size = $field->size;
409 if ( $args->{friendly_ints} && $size && (lc ($field_type) eq 'integer') ) {
410 # Automatically translate to int2, int4, int8
411 # Type (Bits) Max. Signed/Unsigned Length
414 # smallint (16) 32767 5
416 # mediumint* (24) 8388607 7
418 # int (32) 2147483647 10
420 # bigint (64) 9223372036854775807 19
421 # 18446744073709551615 20
423 # * tinyint and mediumint are nonstandard extensions which are
424 # only available under MySQL (to my knowledge)
425 if ($size <= 3 and $args->{friendly_ints_extended}) {
426 $field_type = 'tinyint';
429 $field_type = 'smallint';
431 elsif ($size <= 8 and $args->{friendly_ints_extended}) {
432 $field_type = 'mediumint';
434 elsif ($size <= 11) {
435 $field_type = 'integer';
438 $field_type = 'bigint';
442 $field_info = $field_type;
443 if ($args->{show_sizes} && $size && ($field_type =~ /^ (?: NUMERIC | DECIMAL | (VAR)?CHAR2? ) $/ix ) ) {
444 $field_info .= '(' . $size . ')';
449 if ($args->{show_constraints}) {
451 push(@constraints, 'PK') if $field->is_primary_key;
452 push(@constraints, 'FK') if $field->is_foreign_key;
453 push(@constraints, 'U') if $field->is_unique;
454 push(@constraints, 'N') if $field->is_nullable;
456 $constraints = join (',', @constraints);
459 # construct the field line from all info gathered so far
460 push @fmt_fields, join (' ',
464 $constraints ? "[$constraints]" : (),
468 # join field lines with graphviz formatting
469 $field_str = join ('\l', @fmt_fields) . '\l';
474 if ($args->{show_indexes}) {
477 for my $index ($table->get_indices) {
478 next unless $index->is_valid;
480 push @fmt_indexes, join (' ',
482 $args->{show_index_names}
486 join (', ', $index->fields),
487 ($index->type eq 'UNIQUE') ? '[U]' : (),
491 # join index lines with graphviz formatting (if any indexes at all)
492 $index_str = join ('\l', @fmt_indexes) . '\l' if @fmt_indexes;
495 my $name_str = $table_name . '\n';
498 for ($name_str, $field_str, $index_str) {
504 # only the 'record' type supports nice formatting
505 if ($args->{node}{shape} eq 'record') {
507 # the necessity to supply shape => 'record' is a graphviz bug
510 label => sprintf ('{%s}',
520 my $sep = sprintf ('%s\n',
521 '-' x ( (length $table_name) + 2)
533 if (my $cluster_name = $cluster{$table_name} ) {
534 $node_args->{cluster} = $cluster_name;
537 $gv->add_node(qq["$table_name"], %$node_args);
539 debug("Processing table '$table_name'");
541 debug("Fields = ", join(', ', map { $_->name } @fields));
543 for my $f ( @fields ) {
544 my $name = $f->name or next;
545 my $is_pk = $f->is_primary_key;
546 my $is_unique = $f->is_unique;
549 # Decide if we should skip this field.
551 if ( $args->{natural_join} ) {
552 next unless $is_pk || $f->is_foreign_key;
555 my $constraints = $f->{'constraints'};
557 if ( $args->{natural_join} && !$skip_fields{ $name } ) {
558 push @{ $nj_registry{ $name } }, $table_name;
562 unless ( $args->{natural_join} ) {
563 for my $c ( $table->get_constraints ) {
564 next unless $c->type eq FOREIGN_KEY;
565 my $fk_table = $c->reference_table or next;
567 for my $field_name ( $c->fields ) {
568 for my $fk_field ( $c->reference_fields ) {
569 next unless defined $schema->get_table( $fk_table );
571 # a condition is optional if at least one fk is nullable
575 scalar (grep { $_->is_nullable } ($c->fields))
584 # Process relationships, create edges
586 my (@table_bunches, %optional_constraints);
587 if ( $args->{natural_join} ) {
588 for my $field_name ( keys %nj_registry ) {
589 my @table_names = @{ $nj_registry{ $field_name } || [] } or next;
590 next if scalar @table_names == 1;
591 push @table_bunches, [ @table_names ];
595 for my $i (0 .. $#fk_registry) {
596 my $fk = $fk_registry[$i];
597 push @table_bunches, [$fk->[0], $fk->[1]];
598 $optional_constraints{$i} = $fk->[2];
603 for my $bi (0 .. $#table_bunches) {
604 my @tables = @{$table_bunches[$bi]};
606 for my $i ( 0 .. $#tables ) {
607 my $table1 = $tables[ $i ];
608 for my $j ( 1 .. $#tables ) {
610 my $table2 = $tables[ $j ];
611 next if $done{ $table1 }{ $table2 };
612 debug("Adding edge '$table2' -> '$table1'");
616 arrowhead => $optional_constraints{$bi} ? 'empty' : 'normal',
618 $done{ $table1 }{ $table2 } = 1;
626 if ( my $out = $args->{out_file} ) {
627 if (openhandle ($out)) {
628 print $out $gv->$output_method;
631 open my $fh, '>', $out or die "Can't write '$out': $!\n";
633 print $fh $gv->$output_method;
638 return $gv->$output_method;
644 # -------------------------------------------------------------------
650 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>
652 Jonathan Yu E<lt>frequency@cpan.orgE<gt>
656 SQL::Translator, GraphViz