lib/SQL/Translator/Producer/GraphViz.pm

   1 package SQL::Translator::Producer::GraphViz;
   2
   3 # -------------------------------------------------------------------
   4 # $Id$
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002-4 SQLFairy Authors
   7 #
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License as
  10 # published by the Free Software Foundation; version 2.
  11 #
  12 # This program is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  20 # 02111-1307  USA
  21 # -------------------------------------------------------------------
  22
  23 =pod
  24
  25 =head1 NAME
  26
  27 SQL::Translator::Producer::GraphViz - GraphViz producer for SQL::Translator
  28
  29 =head1 SYNOPSIS
  30
  31   use SQL::Translator;
  32
  33   my $trans = new SQL::Translator(
  34       from => 'MySQL',            # or your db of choice
  35       to => 'GraphViz',
  36       producer_args => {
  37           out_file => 'schema.png',
  38           add_color => 1,
  39           show_constraints => 1,
  40           show_datatypes => 1,
  41           show_sizes => 1
  42       }
  43   ) or die SQL::Translator->error;
  44
  45   $trans->translate or die $trans->error;
  46
  47 =head1 DESCRIPTION
  48
  49 Creates a graph of a schema using the amazing graphviz
  50 (see http://www.graphviz.org/) application (via
  51 the GraphViz module).  It's nifty--you should try it!
  52
  53 =head1 PRODUCER ARGS
  54
  55 =over 4
  56
  57 =item * out_file
  58
  59 the name of the file where the graphviz graphic is to be written
  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 * show_indexes
 175
 176 if set to a true value, each record will also show the indexes
 177 set on each table. it describes the index types along with
 178 which columns are included in the index. this option requires
 179 that show_fields is a true value as well
 180
 181 =item * show_index_name
 182
 183 if show_indexes is set to a true value, then the value of this
 184 parameter determines whether or not to print names of indexes.
 185 if show_index_name is false, then a list of indexed columns
 186 will appear below the field list. otherwise, it will be a list
 187 prefixed with the name of each index. it defaults to true.
 188
 189 =item * friendly_ints
 190
 191 if set to a true value, each integer type field will be displayed
 192 as a smallint, integer or bigint depending on the field's
 193 associated size parameter. this only applies for the 'integer'
 194 type (and not the lowercase 'int' type, which is assumed to be a
 195 32-bit integer).
 196
 197 =item * friendly_ints_extended
 198
 199 if set to a true value, the friendly ints displayed will take into
 200 account the non-standard types, 'tinyint' and 'mediumint' (which,
 201 as far as I am aware, is only implemented in MySQL)
 202
 203 =back
 204
 205 =cut
 206
 207 use strict;
 208 use GraphViz;
 209 use Data::Dumper;
 210 use SQL::Translator::Schema::Constants;
 211 use SQL::Translator::Utils qw(debug);
 212
 213 use vars qw[ $VERSION $DEBUG ];
 214 $VERSION = sprintf "%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/;
 215 $DEBUG   = 0 unless defined $DEBUG;
 216
 217 use constant VALID_LAYOUT => {
 218     dot   => 1,
 219     neato => 1,
 220     twopi => 1,
 221 };
 222
 223 use constant VALID_NODE_SHAPE => {
 224     record        => 1,
 225     plaintext     => 1,
 226     ellipse       => 1,
 227     circle        => 1,
 228     egg           => 1,
 229     triangle      => 1,
 230     box           => 1,
 231     diamond       => 1,
 232     trapezium     => 1,
 233     parallelogram => 1,
 234     house         => 1,
 235     hexagon       => 1,
 236     octagon       => 1,
 237 };
 238
 239 use constant VALID_OUTPUT => {
 240     canon => 1,
 241     text  => 1,
 242     ps    => 1,
 243     hpgl  => 1,
 244     pcl   => 1,
 245     mif   => 1,
 246     pic   => 1,
 247     gd    => 1,
 248     gd2   => 1,
 249     gif   => 1,
 250     jpeg  => 1,
 251     png   => 1,
 252     wbmp  => 1,
 253     cmap  => 1,
 254     ismap => 1,
 255     imap  => 1,
 256     vrml  => 1,
 257     vtx   => 1,
 258     mp    => 1,
 259     fig   => 1,
 260     svg   => 1,
 261     plain => 1,
 262 };
 263
 264 sub produce {
 265     my $t          = shift;
 266     my $schema     = $t->schema;
 267     my $args       = $t->producer_args;
 268     local $DEBUG   = $t->debug;
 269
 270     my $out_file         = $args->{'out_file'}    || '';
 271     my $layout           = $args->{'layout'}      || 'dot';
 272     my $node_shape       = $args->{'node_shape'}  || 'record';
 273     my $output_type      = $args->{'output_type'} || 'png';
 274     my $width            = defined $args->{'width'}
 275                            ? $args->{'width'} : 8.5;
 276     my $height           = defined $args->{'height'}
 277                            ? $args->{'height'} : 11;
 278     my $fontsize         = $args->{'fontsize'};
 279     my $fontname         = $args->{'fontname'};
 280     my $edgeattrs        = $args->{'edgeattrs'} || {};
 281     my $graphattrs       = $args->{'graphattrs'} || {};
 282     my $nodeattrs        = $args->{'nodeattrs'} || {};
 283     my $show_fields      = defined $args->{'show_fields'}
 284                            ? $args->{'show_fields'} : 1;
 285     my $add_color        = $args->{'add_color'};
 286     my $natural_join     = $args->{'natural_join'};
 287     my $show_fk_only     = $args->{'show_fk_only'};
 288     my $show_datatypes   = $args->{'show_datatypes'};
 289     my $show_sizes       = $args->{'show_sizes'};
 290     my $show_indexes     = $args->{'show_indexes'};
 291     my $show_index_name  = $args->{'show_index_name'} || 1;
 292     my $friendly_ints    = $args->{'friendly_ints'};
 293     my $friendly_ints_ex = $args->{'friendly_ints_extended'};
 294     my $show_constraints = $args->{'show_constraints'};
 295     my $join_pk_only     = $args->{'join_pk_only'};
 296     my $skip_fields      = $args->{'skip_fields'} || '';
 297     my %skip             = map { s/^\s+|\s+$//g; length $_ ? ($_, 1) : () }
 298                            split ( /,/, $skip_fields );
 299     $natural_join      ||= $join_pk_only;
 300
 301     $schema->make_natural_joins(
 302         join_pk_only => $join_pk_only,
 303         skip_fields  => $args->{'skip_fields'},
 304     ) if $natural_join;
 305
 306     die "Invalid layout '$layout'" unless VALID_LAYOUT->{ $layout };
 307     die "Invalid output type: '$output_type'"
 308         unless VALID_OUTPUT->{ $output_type };
 309     die "Invalid node shape'$node_shape'"
 310         unless VALID_NODE_SHAPE->{ $node_shape };
 311
 312     for ( $height, $width ) {
 313         $_ = 0 unless $_ =~ /^\d+(.\d)?$/;
 314         $_ = 0 if $_ < 0;
 315     }
 316
 317     #
 318     # Create GraphViz and see if we can produce the output type.
 319     #
 320     my %args = (
 321         directed      => $natural_join ? 0 : 1,
 322         layout        => $layout,
 323         no_overlap    => 1,
 324         bgcolor       => $add_color ? 'lightgoldenrodyellow' : 'white',
 325         node          => {
 326             shape     => $node_shape,
 327             style     => 'filled',
 328             fillcolor => 'white',
 329         },
 330     );
 331     $args{'width'}  = $width  if $width;
 332     $args{'height'} = $height if $height;
 333     # set fontsize for edge and node labels if specified
 334     if ($fontsize) {
 335         $args{'node'}->{'fontsize'} = $fontsize;
 336         $args{'edge'} = {} unless $args{'edge'};
 337         $args{'edge'}->{'fontsize'} = $fontsize;
 338     }
 339     # set the font name globally for node, edge, and graph labels if
 340     # specified (use node, edge, or graph attributes for individual
 341     # font specification)
 342     if ($fontname) {
 343         $args{'node'}->{'fontname'} = $fontname;
 344         $args{'edge'} = {} unless $args{'edge'};
 345         $args{'edge'}->{'fontname'} = $fontname;
 346         $args{'graph'} = {} unless $args{'graph'};
 347         $args{'graph'}->{'fontname'} = $fontname;
 348     }
 349     # set additional node, edge, and graph attributes; these may
 350     # possibly override ones set before
 351     while (my ($key,$val) = each %$nodeattrs) {
 352         $args{'node'}->{$key} = $val;
 353     }
 354     $args{'edge'} = {} if %$edgeattrs && !$args{'edge'};
 355     while (my ($key,$val) = each %$edgeattrs) {
 356         $args{'edge'}->{$key} = $val;
 357     }
 358     $args{'graph'} = {} if %$edgeattrs && !$args{'graph'};
 359     while (my ($key,$val) = each %$graphattrs) {
 360         $args{'graph'}->{$key} = $val;
 361     }
 362
 363     my $gv =  GraphViz->new( %args ) or die "Can't create GraphViz object\n";
 364
 365     my %nj_registry; # for locations of fields for natural joins
 366     my @fk_registry; # for locations of fields for foreign keys
 367
 368     for my $table ( $schema->get_tables ) {
 369         my $table_name = $table->name;
 370         my @fields     = $table->get_fields;
 371         if ( $show_fk_only ) {
 372             @fields = grep { $_->is_foreign_key } @fields;
 373         }
 374
 375         my $label = '{' . $table_name;
 376         if ($show_fields) {
 377           my $field_str = '';
 378           foreach my $field (@fields) {
 379             $field_str .= '-\ ' . $field->name;
 380             if ($show_datatypes) {
 381               my $dt = lc($field->data_type);
 382
 383               # For the integer type, transform into different types based on
 384               # requested size, if a size is given.
 385               if ($friendly_ints && $dt eq 'integer' && $field->size) {
 386                 # Automatically translate to int2, int4, int8
 387                 # Type (Bits)     Max. Signed/Unsigned    Length
 388                 # tinyint* (8)    128                     3
 389                 #                 255                     3
 390                 # smallint (16)   32767                   5
 391                 #                 65535                   5
 392                 # mediumint* (24) 8388607                 7
 393                 #                 16777215                8
 394                 # int (32)        2147483647              10
 395                 #                 4294967295              10
 396                 # bigint (64)     9223372036854775807     19
 397                 #                 18446744073709551615    20
 398                 #
 399                 # * tinyint and mediumint are nonstandard extensions which are
 400                 #   only available under MySQL (to my knowledge)
 401                 my $size = $field->size;
 402                 if ($size > 10) {
 403                   $dt = 'bigint';
 404                 }
 405                 elsif ($size > 5) {
 406                   $dt = 'integer';
 407                   if ($friendly_ints_ex && $size <= 8) {
 408                     $dt = 'mediumint';
 409                   }
 410                 }
 411                 else {
 412                   $dt = 'smallint';
 413                   if ($friendly_ints_ex && $size <= 3) {
 414                     $dt = 'tinyint';
 415                   }
 416                 }
 417               }
 418
 419               $field_str .= '\ ' . $dt;
 420               if ($show_sizes && $field->size && ($dt =~ /^(var)?char2?$/ || $dt eq 'numeric' || $dt eq 'decimal')) {
 421                 $field_str .= '(' . $field->size . ')';
 422               }
 423             }
 424
 425             if ($show_constraints) {
 426               my @constraints;
 427               push(@constraints, 'PK') if $field->is_primary_key;
 428               push(@constraints, 'FK') if $field->is_foreign_key;
 429               push(@constraints, 'U')  if $field->is_unique;
 430               if (scalar(@constraints)) {
 431                 $field_str .= '\ [' . join(',\ ', @constraints) . ']';
 432               }
 433             }
 434             $field_str .= '\l';
 435           }
 436           $label .= '|' . $field_str;
 437         }
 438
 439         if ($show_indexes) {
 440           my $index_str = '';
 441           foreach my $index ($table->get_indices) {
 442             next unless $index->is_valid;
 443
 444             $index_str .= '*\ ';
 445             if ($show_index_name) {
 446               $index_str .= $index->name . ': ';
 447             }
 448             $index_str .= join(', ', $index->fields);
 449             if ($index->type eq 'UNIQUE') {
 450               $index_str .= '\ [U]';
 451             }
 452             $index_str .= '\l';
 453           }
 454           # Only add the last box if index_str is non-null
 455           if (length $index_str) {
 456             $label .= '|' . $index_str;
 457           }
 458         }
 459         $label .= '}';
 460 #        $gv->add_node( $table_name, label => $label );
 461 #        $gv->add_node( $table_name, label => $label, ($node_shape eq 'record' ? ( shape => $node_shape ) : ()) );
 462         $gv->add_node( $table_name, label => $label, shape => $node_shape );
 463         debug("Processing table '$table_name'");
 464
 465         debug("Fields = ", join(', ', map { $_->name } @fields));
 466
 467         for my $f ( @fields ) {
 468             my $name      = $f->name or next;
 469             my $is_pk     = $f->is_primary_key;
 470             my $is_unique = $f->is_unique;
 471
 472             #
 473             # Decide if we should skip this field.
 474             #
 475             if ( $natural_join ) {
 476                 next unless $is_pk || $f->is_foreign_key;
 477             }
 478
 479             my $constraints = $f->{'constraints'};
 480
 481             if ( $natural_join && !$skip{ $name } ) {
 482                 push @{ $nj_registry{ $name } }, $table_name;
 483             }
 484         }
 485
 486         unless ( $natural_join ) {
 487             for my $c ( $table->get_constraints ) {
 488                 next unless $c->type eq FOREIGN_KEY;
 489                 my $fk_table = $c->reference_table or next;
 490
 491                 for my $field_name ( $c->fields ) {
 492                     for my $fk_field ( $c->reference_fields ) {
 493                         next unless defined $schema->get_table( $fk_table );
 494                         push @fk_registry, [ $table_name, $fk_table ];
 495                     }
 496                 }
 497             }
 498         }
 499     }
 500
 501     #
 502     # Make the connections.
 503     #
 504     my @table_bunches;
 505     if ( $natural_join ) {
 506         for my $field_name ( keys %nj_registry ) {
 507             my @table_names = @{ $nj_registry{ $field_name } || [] } or next;
 508             next if scalar @table_names == 1;
 509             push @table_bunches, [ @table_names ];
 510         }
 511     }
 512     else {
 513         @table_bunches = @fk_registry;
 514     }
 515
 516     my %done;
 517     for my $bunch ( @table_bunches ) {
 518         my @tables = @$bunch;
 519
 520         for my $i ( 0 .. $#tables ) {
 521             my $table1 = $tables[ $i ];
 522             for my $j ( 0 .. $#tables ) {
 523                 next if $i == $j;
 524                 my $table2 = $tables[ $j ];
 525                 next if $done{ $table1 }{ $table2 };
 526                 $gv->add_edge( $table2, $table1 );
 527                 $done{ $table1 }{ $table2 } = 1;
 528                 $done{ $table2 }{ $table1 } = 1;
 529             }
 530         }
 531     }
 532
 533     #
 534     # Print the image.
 535     #
 536     my $output_method = "as_$output_type";
 537     if ( $out_file ) {
 538         open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
 539         binmode $fh;
 540         print $fh $gv->$output_method;
 541         close $fh;
 542     }
 543     else {
 544         return $gv->$output_method;
 545     }
 546 }
 547
 548 1;
 549
 550 # -------------------------------------------------------------------
 551
 552 =pod
 553
 554 =head1 AUTHOR
 555
 556 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
 557
 558 =head2 CONTRIBUTORS
 559
 560 Jonathan Yu E<lt>frequency@cpan.orgE<gt>
 561
 562 =head1 SEE ALSO
 563
 564 SQL::Translator, GraphViz
 565
 566 =cut