lib/SQL/Translator/Producer/GraphViz.pm

   1 package SQL::Translator::Producer::GraphViz;
   2
   3 # -------------------------------------------------------------------
   4 # Copyright (C) 2002-2009 SQLFairy Authors
   5 #
   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.
   9 #
  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.
  14 #
  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
  18 # 02111-1307  USA
  19 # -------------------------------------------------------------------
  20
  21 =pod
  22
  23 =head1 NAME
  24
  25 SQL::Translator::Producer::GraphViz - GraphViz producer for SQL::Translator
  26
  27 =head1 SYNOPSIS
  28
  29   use SQL::Translator;
  30
  31   my $trans = new SQL::Translator(
  32       from => 'MySQL',            # or your db of choice
  33       to => 'GraphViz',
  34       producer_args => {
  35           out_file => 'schema.png',
  36           add_color => 1,
  37           show_constraints => 1,
  38           show_datatypes => 1,
  39           show_sizes => 1
  40       }
  41   ) or die SQL::Translator->error;
  42
  43   $trans->translate or die $trans->error;
  44
  45 =head1 DESCRIPTION
  46
  47 Creates a graph of a schema using the amazing graphviz
  48 (see http://www.graphviz.org/) application (via
  49 the GraphViz module).  It's nifty--you should try it!
  50
  51 =head1 PRODUCER ARGS
  52
  53 =over 4
  54
  55 =item * out_file
  56
  57 The name of the file where the resulting GraphViz output will be
  58 written. Alternatively an open filehandle can be supplied. If
  59 undefined (the default) - the result is returned as a string.
  60
  61 =item * layout (DEFAULT: 'dot')
  62
  63 determines which layout algorithm GraphViz will use; possible
  64 values are 'dot' (the default GraphViz layout for directed graph
  65 layouts), 'neato' (for undirected graph layouts - spring model)
  66 or 'twopi' (for undirected graph layouts - circular)
  67
  68 =item * node_shape (DEFAULT: 'record')
  69
  70 sets the node shape of each table in the graph; this can be
  71 one of 'record', 'plaintext', 'ellipse', 'circle', 'egg',
  72 'triangle', 'box', 'diamond', 'trapezium', 'parallelogram',
  73 'house', 'hexagon', or 'octagon'
  74
  75 =item * output_type (DEFAULT: 'png')
  76
  77 sets the file type of the output graphic; possible values are
  78 'ps', 'hpgl', 'pcl', 'mif', 'pic', 'gd', 'gd2', 'gif', 'jpeg',
  79 'png', 'wbmp', 'cmap', 'ismap', 'imap', 'vrml', 'vtx', 'mp',
  80 'fig', 'svg', 'canon', 'plain' or 'text' (see GraphViz for
  81 details on each of these)
  82
  83 =item * width (DEFAULT: 8.5)
  84
  85 width (in inches) of the output graphic
  86
  87 =item * height (DEFAULT: 11)
  88
  89 height (in inches) of the output grahic
  90
  91 =item * fontsize
  92
  93 custom font size for node and edge labels (note that arbitrarily large
  94 sizes may be ignored due to page size or graph size constraints)
  95
  96 =item * fontname
  97
  98 custom font name (or full path to font file) for node, edge, and graph
  99 labels
 100
 101 =item * nodeattrs
 102
 103 reference to a hash of node attribute names and their values; these
 104 may override general fontname or fontsize parameter
 105
 106 =item * edgeattrs
 107
 108 reference to a hash of edge attribute names and their values; these
 109 may override general fontname or fontsize parameter
 110
 111 =item * graphattrs
 112
 113 reference to a hash of graph attribute names and their values; these
 114 may override the general fontname parameter
 115
 116 =item * show_fields (DEFAULT: true)
 117
 118 if set to a true value, the names of the colums in a table will
 119 be displayed in each table's node
 120
 121 =item * show_fk_only
 122
 123 if set to a true value, only columns which are foreign keys
 124 will be displayed in each table's node
 125
 126 =item * show_datatypes
 127
 128 if set to a true value, the datatype of each column will be
 129 displayed next to each column's name; this option will have no
 130 effect if the value of show_fields is set to false
 131
 132 =item * show_sizes
 133
 134 if set to a true value, the size (in bytes) of each CHAR and
 135 VARCHAR column will be displayed in parentheses next to the
 136 column's name; this option will have no effect if the value of
 137 show_fields is set to false
 138
 139 =item * show_constraints
 140
 141 if set to a true value, a field's constraints (i.e., its
 142 primary-key-ness, its foreign-key-ness and/or its uniqueness)
 143 will appear as a comma-separated list in brackets next to the
 144 field's name; this option will have no effect if the value of
 145 show_fields is set to false
 146
 147 =item * add_color
 148
 149 if set to a true value, the graphic will have a background
 150 color of 'lightgoldenrodyellow'; otherwise the background
 151 color will be white
 152
 153 =item * natural_join
 154
 155 if set to a true value, the make_natural_join method of
 156 SQL::Translator::Schema will be called before generating the
 157 graph; a true value for join_pk_only (see below) implies a
 158 true value for this option
 159
 160 =item * join_pk_only
 161
 162 the value of this option will be passed as the value of the
 163 like-named argument in the make_natural_join method (see
 164 natural_join above) of SQL::Translator::Schema, if either the
 165 value of this option or the natural_join option is set to true
 166
 167 =item * skip_fields
 168
 169 the value of this option will be passed as the value of the
 170 like-named argument in the make_natural_join method (see
 171 natural_join above) of SQL::Translator::Schema, if either
 172 the natural_join or join_pk_only options has a true value
 173
 174 =item * skip_tables
 175
 176 A comma-separated list of table names that should be skipped.
 177
 178 =item * skip_tables_like
 179
 180 A comma-separated list of regular expressions describing table names
 181 that should be skipped.
 182
 183 =item * show_indexes
 184
 185 if set to a true value, each record will also show the indexes
 186 set on each table. it describes the index types along with
 187 which columns are included in the index. this option requires
 188 that show_fields is a true value as well
 189
 190 =item * show_index_names
 191
 192 if show_indexes is set to a true value, then the value of this
 193 parameter determines whether or not to print names of indexes.
 194 if show_index_names is false, then a list of indexed columns
 195 will appear below the field list. otherwise, it will be a list
 196 prefixed with the name of each index. it defaults to true.
 197
 198 =item * friendly_ints
 199
 200 if set to a true value, each integer type field will be displayed
 201 as a smallint, integer or bigint depending on the field's
 202 associated size parameter. this only applies for the 'integer'
 203 type (and not the lowercase 'int' type, which is assumed to be a
 204 32-bit integer).
 205
 206 =item * friendly_ints_extended
 207
 208 if set to a true value, the friendly ints displayed will take into
 209 account the non-standard types, 'tinyint' and 'mediumint' (which,
 210 as far as I am aware, is only implemented in MySQL)
 211
 212 =back
 213
 214 =cut
 215
 216 use strict;
 217 use GraphViz;
 218 use SQL::Translator::Schema::Constants;
 219 use SQL::Translator::Utils qw(debug);
 220 use Scalar::Util qw/openhandle/;
 221
 222 use vars qw[ $VERSION $DEBUG ];
 223 $VERSION = '1.59';
 224 $DEBUG   = 0 unless defined $DEBUG;
 225
 226 use constant VALID_LAYOUT => {
 227     dot   => 1,
 228     neato => 1,
 229     twopi => 1,
 230 };
 231
 232 use constant VALID_NODE_SHAPE => {
 233     record        => 1,
 234     plaintext     => 1,
 235     ellipse       => 1,
 236     circle        => 1,
 237     egg           => 1,
 238     triangle      => 1,
 239     box           => 1,
 240     diamond       => 1,
 241     trapezium     => 1,
 242     parallelogram => 1,
 243     house         => 1,
 244     hexagon       => 1,
 245     octagon       => 1,
 246 };
 247
 248 sub produce {
 249     my $t          = shift;
 250     my $schema     = $t->schema;
 251     my $args       = $t->producer_args;
 252     local $DEBUG   = $t->debug;
 253
 254     my $out_file         = $args->{'out_file'}    || '';
 255     my $layout           = $args->{'layout'}      || 'dot';
 256     my $node_shape       = $args->{'node_shape'}  || 'record';
 257     my $output_type      = $args->{'output_type'} || 'png';
 258     my $width            = defined $args->{'width'}
 259                            ? $args->{'width'} : 8.5;
 260     my $height           = defined $args->{'height'}
 261                            ? $args->{'height'} : 11;
 262     my $fontsize         = $args->{'fontsize'};
 263     my $fontname         = $args->{'fontname'};
 264     my $edgeattrs        = $args->{'edgeattrs'} || {};
 265     my $graphattrs       = $args->{'graphattrs'} || {};
 266     my $nodeattrs        = $args->{'nodeattrs'} || {};
 267     my $show_fields      = defined $args->{'show_fields'}
 268                            ? $args->{'show_fields'} : 1;
 269     my $add_color        = $args->{'add_color'};
 270     my $natural_join     = $args->{'natural_join'};
 271     my $show_fk_only     = $args->{'show_fk_only'};
 272     my $show_datatypes   = $args->{'show_datatypes'};
 273     my $show_sizes       = $args->{'show_sizes'};
 274     my $show_indexes     = $args->{'show_indexes'};
 275     my $show_index_names = defined $args->{'show_index_names'}
 276                          ? $args->{'show_index_names'} : 1;
 277     my $friendly_ints    = $args->{'friendly_ints'};
 278     my $friendly_ints_ex = $args->{'friendly_ints_extended'};
 279     my $show_constraints = $args->{'show_constraints'};
 280     my $join_pk_only     = $args->{'join_pk_only'};
 281     my $skip_fields      = $args->{'skip_fields'}      || '';
 282     my $skip_tables      = $args->{'skip_tables'}      || '';
 283     my $skip_tables_like = $args->{'skip_tables_like'} || '';
 284     my %skip             = map { s/^\s+|\s+$//g; length $_ ? ($_, 1) : () }
 285                            split ( /,/, $skip_fields );
 286     $natural_join      ||= $join_pk_only;
 287
 288     $schema->make_natural_joins(
 289         join_pk_only => $join_pk_only,
 290         skip_fields  => $args->{'skip_fields'},
 291     ) if $natural_join;
 292
 293     die "Invalid layout '$layout'" unless VALID_LAYOUT->{ $layout };
 294     die "Invalid node shape'$node_shape'"
 295         unless VALID_NODE_SHAPE->{ $node_shape };
 296
 297     for ( $height, $width ) {
 298         $_ = 0 unless $_ =~ /^\d+(.\d)?$/;
 299         $_ = 0 if $_ < 0;
 300     }
 301
 302     my %args = (
 303         directed      => $natural_join ? 0 : 1,
 304         layout        => $layout,
 305         no_overlap    => 1,
 306         bgcolor       => $add_color ? 'lightgoldenrodyellow' : 'white',
 307         node          => {
 308             shape     => $node_shape,
 309             style     => 'filled',
 310             fillcolor => 'white',
 311         },
 312     );
 313     $args{'width'}  = $width  if $width;
 314     $args{'height'} = $height if $height;
 315     # set fontsize for edge and node labels if specified
 316     if ($fontsize) {
 317         $args{'node'}->{'fontsize'} = $fontsize;
 318         $args{'edge'} = {} unless $args{'edge'};
 319         $args{'edge'}->{'fontsize'} = $fontsize;
 320     }
 321     # set the font name globally for node, edge, and graph labels if
 322     # specified (use node, edge, or graph attributes for individual
 323     # font specification)
 324     if ($fontname) {
 325         $args{'node'}->{'fontname'} = $fontname;
 326         $args{'edge'} = {} unless $args{'edge'};
 327         $args{'edge'}->{'fontname'} = $fontname;
 328         $args{'graph'} = {} unless $args{'graph'};
 329         $args{'graph'}->{'fontname'} = $fontname;
 330     }
 331     # set additional node, edge, and graph attributes; these may
 332     # possibly override ones set before
 333     while (my ($key,$val) = each %$nodeattrs) {
 334         $args{'node'}->{$key} = $val;
 335     }
 336     $args{'edge'} = {} if %$edgeattrs && !$args{'edge'};
 337     while (my ($key,$val) = each %$edgeattrs) {
 338         $args{'edge'}->{$key} = $val;
 339     }
 340     $args{'graph'} = {} if %$edgeattrs && !$args{'graph'};
 341     while (my ($key,$val) = each %$graphattrs) {
 342         $args{'graph'}->{$key} = $val;
 343     }
 344
 345     #
 346     # Create a blank GraphViz object and see if we can produce the output type.
 347     #
 348     my $gv = GraphViz->new( %args ) or die "Can't create GraphViz object\n";
 349     my $output_method = "as_$output_type";
 350
 351     # the generators are AUTOLOADed so can't use ->can ($output_method)
 352     eval { $gv->$output_method };
 353     die "Invalid output type: '$output_type'" if $@;
 354
 355     my %skip_table       = map { $_, 1 }  split /\s*,\s*/, $skip_tables;
 356     my @skip_tables_like = map { qr/$_/ } split /\s*,\s*/, $skip_tables_like;
 357     my %nj_registry; # for locations of fields for natural joins
 358     my @fk_registry; # for locations of fields for foreign keys
 359
 360     TABLE:
 361     for my $table ( $schema->get_tables ) {
 362         my $tname = $table->name;
 363
 364         if ( %skip_table ) {
 365             next TABLE if $skip_table{ $tname };
 366
 367             for my $regex ( @skip_tables_like ) {
 368                 next TABLE if $tname =~ $regex;
 369             }
 370         }
 371
 372         my @fields     = $table->get_fields;
 373         if ( $show_fk_only ) {
 374             @fields = grep { $_->is_foreign_key } @fields;
 375         }
 376
 377         my $field_str = '';
 378         if ( $show_fields ) {
 379             my @fmt_fields;
 380             for my $field ( @fields ) {
 381                 my $field_type;
 382                 if ($show_datatypes) {
 383                     $field_type = $field->data_type;
 384
 385                     # For the integer type, transform into different
 386                     # types based on requested size, if a size is given.
 387                     if (    $field->size
 388                         and $friendly_ints
 389                         and ( lc $field_type ) eq 'integer'
 390                     ) {
 391                         # Automatically translate to int2, int4, int8
 392                         # Type (Bits)     Max. Signed/Unsigned    Length
 393                         # tinyint* (8)    128                     3
 394                         #                 255                     3
 395                         # smallint (16)   32767                   5
 396                         #                 65535                   5
 397                         # mediumint* (24) 8388607                 7
 398                         #                 16777215                8
 399                         # int (32)        2147483647              10
 400                         #                 4294967295              11
 401                         # bigint (64)     9223372036854775807     19
 402                         #                 18446744073709551615    20
 403                         #
 404                         # * tinyint and mediumint are nonstandard extensions
 405                         # which are only available under MySQL (to my knowledge)
 406                         my $size = $field->size;
 407                         if ( $size <= 3 and $friendly_ints_ex ) {
 408                             $field_type = 'tinyint',;
 409                         }
 410                         elsif ( $size <= 5 ) {
 411                             $field_type = 'smallint';
 412                         }
 413                         elsif ( $size <= 8 and $friendly_ints_ex ) {
 414                             $field_type = 'mediumint';
 415                         }
 416                         elsif ( $size <= 11 ) {
 417                             $field_type = 'integer';
 418                         }
 419                         else {
 420                             $field_type = 'bigint';
 421                         }
 422                     }
 423
 424                     if (
 425                             $show_sizes
 426                         and $field->size
 427                         and (  $field_type =~ /^(var)?char2?$/
 428                             or $field_type eq 'numeric'
 429                             or $field_type eq 'decimal' )
 430                     ) {
 431                         $field_type .= '(' . $field->size . ')';
 432                     }
 433                 }
 434
 435                 my $constraints;
 436                 if ( $show_constraints ) {
 437                     my @constraints;
 438
 439                     push( @constraints, 'PK' ) if $field->is_primary_key;
 440                     push( @constraints, 'FK' ) if $field->is_foreign_key;
 441                     push( @constraints, 'U' )  if $field->is_unique;
 442
 443                     $constraints = join( ',', @constraints );
 444                 }
 445
 446                 # construct the field line from all info gathered so far
 447                 push @fmt_fields, join( ' ',
 448                     '-', $field->name,
 449                     $field_type || (),
 450                     $constraints ? "[$constraints]" : (),
 451                 );
 452             }
 453
 454             # join field lines with graphviz formatting
 455             $field_str = join( '\l', @fmt_fields ) . '\l';
 456         }
 457
 458         my $index_str = '';
 459         if ($show_indexes) {
 460             my @fmt_indexes;
 461             for my $index ( $table->get_indices ) {
 462                 next unless $index->is_valid;
 463
 464                 push @fmt_indexes, join( ' ',
 465                     '*',
 466                     $show_index_names ? $index->name . ':' : (),
 467                     join( ', ', $index->fields ),
 468                     ( $index->type eq 'UNIQUE' ) ? '[U]' : (),
 469                 );
 470             }
 471
 472             # join index lines with graphviz formatting (if any indexes at all)
 473             $index_str = join( '\l', @fmt_indexes ) . '\l' if @fmt_indexes;
 474         }
 475
 476         my $table_name = $table->name;
 477         my $name_str = $table_name . '\n';
 478
 479         # escape spaces
 480         for ($name_str, $field_str, $index_str) {
 481             $_ =~ s/ /\\ /g;
 482         }
 483
 484
 485         # only the 'record' type supports nice formatting
 486         if ( $node_shape eq 'record' ) {
 487             # the necessity to supply shape => 'record' is a graphviz bug
 488             $gv->add_node( $table_name,
 489                 shape => 'record',
 490                 label => sprintf( '{%s}',
 491                     join( '|', $name_str, $field_str || (), $index_str || (), ),
 492                 ),
 493             );
 494         }
 495         else {
 496             my $sep = sprintf ('%s\n',
 497                 '-' x ( (length $table_name) + 2)
 498             );
 499
 500             $gv->add_node( $table_name,
 501                 label => join ($sep,
 502                     $name_str,
 503                     $field_str || (),
 504                     $index_str || (),
 505                 ),
 506             );
 507         }
 508
 509         debug("Processing table '$table_name'");
 510
 511         debug("Fields = ", join(', ', map { $_->name } @fields));
 512
 513         for my $f ( @fields ) {
 514             my $name      = $f->name or next;
 515             my $is_pk     = $f->is_primary_key;
 516             my $is_unique = $f->is_unique;
 517
 518             #
 519             # Decide if we should skip this field.
 520             #
 521             if ( $natural_join ) {
 522                 next unless $is_pk || $f->is_foreign_key;
 523             }
 524
 525             my $constraints = $f->{'constraints'};
 526
 527             if ( $natural_join && !$skip{ $name } ) {
 528                 push @{ $nj_registry{ $name } }, $table_name;
 529             }
 530         }
 531
 532         unless ( $natural_join ) {
 533             for my $c ( $table->get_constraints ) {
 534                 next unless $c->type eq FOREIGN_KEY;
 535                 my $fk_table = $c->reference_table or next;
 536
 537                 for my $field_name ( $c->fields ) {
 538                     for my $fk_field ( $c->reference_fields ) {
 539                         next unless defined $schema->get_table( $fk_table );
 540                         push @fk_registry, [ $table_name, $fk_table ];
 541                     }
 542                 }
 543             }
 544         }
 545     }
 546
 547     #
 548     # Make the connections.
 549     #
 550     my @table_bunches;
 551     if ( $natural_join ) {
 552         for my $field_name ( keys %nj_registry ) {
 553             my @table_names = @{ $nj_registry{ $field_name } || [] } or next;
 554             next if scalar @table_names == 1;
 555             push @table_bunches, [ @table_names ];
 556         }
 557     }
 558     else {
 559         @table_bunches = @fk_registry;
 560     }
 561
 562     my %done;
 563     for my $bunch ( @table_bunches ) {
 564         my @tables = @$bunch;
 565
 566         for my $i ( 0 .. $#tables ) {
 567             my $table1 = $tables[ $i ];
 568             for my $j ( 0 .. $#tables ) {
 569                 next if $i == $j;
 570                 my $table2 = $tables[ $j ];
 571                 next if $done{ $table1 }{ $table2 };
 572                 $gv->add_edge( $table2, $table1 );
 573                 $done{ $table1 }{ $table2 } = 1;
 574                 $done{ $table2 }{ $table1 } = 1;
 575             }
 576         }
 577     }
 578
 579     #
 580     # Print the image.
 581     #
 582     if ( $out_file ) {
 583         if ( openhandle( $out_file ) ) {
 584             print $out_file $gv->$output_method;
 585         }
 586         else {
 587             open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
 588             binmode $fh;
 589             print $fh $gv->$output_method;
 590             close $fh;
 591         }
 592     }
 593     else {
 594         return $gv->$output_method;
 595     }
 596 }
 597
 598 1;
 599
 600 # -------------------------------------------------------------------
 601
 602 =pod
 603
 604 =head1 AUTHOR
 605
 606 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
 607 Jonathan Yu E<lt>frequency@cpan.orgE<gt>
 608
 609 =head1 SEE ALSO
 610
 611 SQL::Translator, GraphViz.
 612
 613 =cut