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
 314     $args{'width'}  = $width  if $width;
 315     $args{'height'} = $height if $height;
 316
 317     # set fontsize for edge and node labels if specified
 318     if ($fontsize) {
 319         $args{'node'}->{'fontsize'} = $fontsize;
 320         $args{'edge'} = {} unless $args{'edge'};
 321         $args{'edge'}->{'fontsize'} = $fontsize;
 322     }
 323
 324     # set the font name globally for node, edge, and graph labels if
 325     # specified (use node, edge, or graph attributes for individual
 326     # font specification)
 327     if ($fontname) {
 328         $args{'node'}->{'fontname'} = $fontname;
 329         $args{'edge'} = {} unless $args{'edge'};
 330         $args{'edge'}->{'fontname'} = $fontname;
 331         $args{'graph'} = {} unless $args{'graph'};
 332         $args{'graph'}->{'fontname'} = $fontname;
 333     }
 334
 335     # set additional node, edge, and graph attributes; these may
 336     # possibly override ones set before
 337     while (my ($key,$val) = each %$nodeattrs) {
 338         $args{'node'}->{$key} = $val;
 339     }
 340
 341     $args{'edge'} = {} if %$edgeattrs && !$args{'edge'};
 342
 343     while (my ($key,$val) = each %$edgeattrs) {
 344         $args{'edge'}->{$key} = $val;
 345     }
 346
 347     $args{'graph'} = {} if %$edgeattrs && !$args{'graph'};
 348
 349     while (my ($key,$val) = each %$graphattrs) {
 350         $args{'graph'}->{$key} = $val;
 351     }
 352
 353     my %cluster;
 354     if ( defined $args->{'cluster'} ) {
 355         my @clusters;
 356         if ( ref $args->{'cluster'} eq 'ARRAY' ) {
 357             @clusters = @{ $args->{'cluster'} };
 358         }
 359         else {
 360             @clusters = split /\s*;\s*/, $args->{'cluster'};
 361         }
 362
 363         for my $c ( @clusters ) {
 364             my ( $cluster_name, @cluster_tables );
 365             if ( ref $c eq 'HASH' ) {
 366                 $cluster_name   = $c->{'name'} || $c->{'cluster_name'};
 367                 @cluster_tables = @{ $c->{'tables'} || [] };
 368             }
 369             else {
 370                 my ( $name, $tables ) = split /\s*=\s*/, $c;
 371                 $cluster_name   = $name;
 372                 @cluster_tables = split /\s*,\s*/, $tables;
 373             }
 374
 375             for my $table ( @cluster_tables ) {
 376                 $cluster{ $table } = $cluster_name;
 377             }
 378         }
 379     }
 380
 381     #
 382     # Create a blank GraphViz object and see if we can produce the output type.
 383     #
 384     my $gv = GraphViz->new( %args ) or die "Can't create GraphViz object\n";
 385     my $output_method = "as_$output_type";
 386
 387     # the generators are AUTOLOADed so can't use ->can ($output_method)
 388     eval { $gv->$output_method };
 389     die "Invalid output type: '$output_type'" if $@;
 390
 391     my %skip_table       = map { $_, 1 }  split /\s*,\s*/, $skip_tables;
 392     my @skip_tables_like = map { qr/$_/ } split /\s*,\s*/, $skip_tables_like;
 393     my %nj_registry; # for locations of fields for natural joins
 394     my @fk_registry; # for locations of fields for foreign keys
 395
 396     TABLE:
 397     for my $table ( $schema->get_tables ) {
 398         my $tname = $table->name;
 399
 400         if ( %skip_table ) {
 401             next TABLE if $skip_table{ $tname };
 402
 403             for my $regex ( @skip_tables_like ) {
 404                 next TABLE if $tname =~ $regex;
 405             }
 406         }
 407
 408         my @fields = $table->get_fields;
 409         if ( $show_fk_only ) {
 410             @fields = grep { $_->is_foreign_key } @fields;
 411         }
 412
 413         my $field_str = '';
 414         my $field_num = 0;
 415         if ( $show_fields ) {
 416             my @fmt_fields;
 417             for my $field ( @fields ) {
 418                 my $field_type;
 419                 if ($show_datatypes) {
 420                     $field_type = $field->data_type;
 421
 422                     # For the integer type, transform into different
 423                     # types based on requested size, if a size is given.
 424                     if (    $field->size
 425                         and $friendly_ints
 426                         and ( lc $field_type ) eq 'integer'
 427                     ) {
 428                         # Automatically translate to int2, int4, int8
 429                         # Type (Bits)     Max. Signed/Unsigned    Length
 430                         # tinyint* (8)    128                     3
 431                         #                 255                     3
 432                         # smallint (16)   32767                   5
 433                         #                 65535                   5
 434                         # mediumint* (24) 8388607                 7
 435                         #                 16777215                8
 436                         # int (32)        2147483647              10
 437                         #                 4294967295              11
 438                         # bigint (64)     9223372036854775807     19
 439                         #                 18446744073709551615    20
 440                         #
 441                         # * tinyint and mediumint are nonstandard extensions
 442                         # which are only available under MySQL (to my knowledge)
 443                         my $size = $field->size;
 444                         if ( $size <= 3 and $friendly_ints_ex ) {
 445                             $field_type = 'tinyint',;
 446                         }
 447                         elsif ( $size <= 5 ) {
 448                             $field_type = 'smallint';
 449                         }
 450                         elsif ( $size <= 8 and $friendly_ints_ex ) {
 451                             $field_type = 'mediumint';
 452                         }
 453                         elsif ( $size <= 11 ) {
 454                             $field_type = 'integer';
 455                         }
 456                         else {
 457                             $field_type = 'bigint';
 458                         }
 459                     }
 460
 461                     if (
 462                             $show_sizes
 463                         and $field->size
 464                         and (  $field_type =~ /^(var)?char2?$/
 465                             or $field_type eq 'numeric'
 466                             or $field_type eq 'decimal' )
 467                     ) {
 468                         $field_type .= '(' . $field->size . ')';
 469                     }
 470                 }
 471
 472                 my $constraints;
 473                 if ( $show_constraints ) {
 474                     my @constraints;
 475
 476                     push( @constraints, 'PK' ) if $field->is_primary_key;
 477                     push( @constraints, 'FK' ) if $field->is_foreign_key;
 478                     push( @constraints, 'U' )  if $field->is_unique;
 479
 480                     $constraints = join( ',', @constraints );
 481                 }
 482
 483                 # construct the field line from all info gathered so far
 484                 push @fmt_fields, join( ' ',
 485                     '-',
 486                     $field->name,
 487                     $field_type || (),
 488                     $constraints ? "[$constraints]" : (),
 489                 );
 490             }
 491
 492             # join field lines with graphviz formatting
 493             $field_str = join( '\l', @fmt_fields ) . '\l';
 494         }
 495
 496         my $index_str = '';
 497         if ($show_indexes) {
 498             my @fmt_indexes;
 499             for my $index ( $table->get_indices ) {
 500                 next unless $index->is_valid;
 501
 502                 push @fmt_indexes, join( ' ',
 503                     '*',
 504                     $show_index_names ? $index->name . ':' : (),
 505                     join( ', ', $index->fields ),
 506                     ( $index->type eq 'UNIQUE' ) ? '[U]' : (),
 507                 );
 508             }
 509
 510             # join index lines with graphviz formatting (if any indexes at all)
 511             $index_str = join( '\l', @fmt_indexes ) . '\l' if @fmt_indexes;
 512         }
 513
 514         my $table_name = $table->name;
 515         my $name_str = $table_name . '\n';
 516
 517         # escape spaces
 518         for ($name_str, $field_str, $index_str) {
 519             $_ =~ s/ /\\ /g;
 520         }
 521
 522         # only the 'record' type supports nice formatting
 523         if ( $node_shape eq 'record' ) {
 524             # the necessity to supply shape => 'record' is a graphviz bug
 525             my %node_args = (
 526                 shape => 'record',
 527                 label => sprintf( '{%s}',
 528                     join( '|', $name_str, $field_str || (), $index_str || (), ),
 529                 ),
 530             );
 531
 532             if ( my $cluster_name = $cluster{ $table->name } ) {
 533                 $node_args{'cluster'} = $cluster_name;
 534             }
 535
 536             $gv->add_node( $table_name, %node_args );
 537         }
 538         else {
 539             my $sep = sprintf ('%s\n',
 540                 '-' x ( (length $table_name) + 2)
 541             );
 542
 543             $gv->add_node( $table_name,
 544                 label => join ($sep,
 545                     $name_str,
 546                     $field_str || (),
 547                     $index_str || (),
 548                 ),
 549             );
 550         }
 551
 552         debug("Processing table '$table_name'");
 553
 554         debug("Fields = ", join(', ', map { $_->name } @fields));
 555
 556         for my $f ( @fields ) {
 557             my $name      = $f->name or next;
 558             my $is_pk     = $f->is_primary_key;
 559             my $is_unique = $f->is_unique;
 560
 561             #
 562             # Decide if we should skip this field.
 563             #
 564             if ( $natural_join ) {
 565                 next unless $is_pk || $f->is_foreign_key;
 566             }
 567
 568             my $constraints = $f->{'constraints'};
 569
 570             if ( $natural_join && !$skip{ $name } ) {
 571                 push @{ $nj_registry{ $name } }, $table_name;
 572             }
 573         }
 574
 575         unless ( $natural_join ) {
 576             for my $c ( $table->get_constraints ) {
 577                 next unless $c->type eq FOREIGN_KEY;
 578                 my $fk_table = $c->reference_table or next;
 579
 580                 for my $field_name ( $c->fields ) {
 581                     for my $fk_field ( $c->reference_fields ) {
 582                         next unless defined $schema->get_table( $fk_table );
 583                         push @fk_registry, [ $table_name, $fk_table ];
 584                     }
 585                 }
 586             }
 587         }
 588     }
 589
 590     #
 591     # Make the connections.
 592     #
 593     my @table_bunches;
 594     if ( $natural_join ) {
 595         for my $field_name ( keys %nj_registry ) {
 596             my @table_names = @{ $nj_registry{ $field_name } || [] } or next;
 597             next if scalar @table_names == 1;
 598             push @table_bunches, [ @table_names ];
 599         }
 600     }
 601     else {
 602         @table_bunches = @fk_registry;
 603     }
 604
 605     my %done;
 606     for my $bunch ( @table_bunches ) {
 607         my @tables = @$bunch;
 608
 609         for my $i ( 0 .. $#tables ) {
 610             my $table1 = $tables[ $i ];
 611             for my $j ( 1 .. $#tables ) {
 612                 next if $i == $j;
 613                 my $table2 = $tables[ $j ];
 614                 next if $done{ $table1 }{ $table2 };
 615                 $gv->add_edge( $table2, $table1 );
 616                 $done{ $table1 }{ $table2 } = 1;
 617             }
 618         }
 619     }
 620
 621     #
 622     # Print the image.
 623     #
 624     if ( $out_file ) {
 625         if ( openhandle( $out_file ) ) {
 626             print $out_file $gv->$output_method;
 627         }
 628         else {
 629             open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
 630             binmode $fh;
 631             print $fh $gv->$output_method;
 632             close $fh;
 633         }
 634     }
 635     else {
 636         return $gv->$output_method;
 637     }
 638 }
 639
 640 1;
 641
 642 # -------------------------------------------------------------------
 643
 644 =pod
 645
 646 =head1 AUTHOR
 647
 648 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
 649 Jonathan Yu E<lt>frequency@cpan.orgE<gt>
 650
 651 =head1 SEE ALSO
 652
 653 SQL::Translator, GraphViz.
 654
 655 =cut