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 Determines the tables that will be skipped.  Can be a list of
 177 tables or a regular expression.
 178
 179 =item * show_indexes
 180
 181 if set to a true value, each record will also show the indexes
 182 set on each table. it describes the index types along with
 183 which columns are included in the index. this option requires
 184 that show_fields is a true value as well
 185
 186 =item * show_index_names
 187
 188 if show_indexes is set to a true value, then the value of this
 189 parameter determines whether or not to print names of indexes.
 190 if show_index_names is false, then a list of indexed columns
 191 will appear below the field list. otherwise, it will be a list
 192 prefixed with the name of each index. it defaults to true.
 193
 194 =item * friendly_ints
 195
 196 if set to a true value, each integer type field will be displayed
 197 as a smallint, integer or bigint depending on the field's
 198 associated size parameter. this only applies for the 'integer'
 199 type (and not the lowercase 'int' type, which is assumed to be a
 200 32-bit integer).
 201
 202 =item * friendly_ints_extended
 203
 204 if set to a true value, the friendly ints displayed will take into
 205 account the non-standard types, 'tinyint' and 'mediumint' (which,
 206 as far as I am aware, is only implemented in MySQL)
 207
 208 =back
 209
 210 =cut
 211
 212 use strict;
 213 use GraphViz;
 214 use SQL::Translator::Schema::Constants;
 215 use SQL::Translator::Utils qw(debug);
 216 use Scalar::Util qw/openhandle/;
 217
 218 use vars qw[ $VERSION $DEBUG ];
 219 $VERSION = '1.59';
 220 $DEBUG   = 0 unless defined $DEBUG;
 221
 222 use constant VALID_LAYOUT => {
 223     dot   => 1,
 224     neato => 1,
 225     twopi => 1,
 226 };
 227
 228 use constant VALID_NODE_SHAPE => {
 229     record        => 1,
 230     plaintext     => 1,
 231     ellipse       => 1,
 232     circle        => 1,
 233     egg           => 1,
 234     triangle      => 1,
 235     box           => 1,
 236     diamond       => 1,
 237     trapezium     => 1,
 238     parallelogram => 1,
 239     house         => 1,
 240     hexagon       => 1,
 241     octagon       => 1,
 242 };
 243
 244 sub produce {
 245     my $t          = shift;
 246     my $schema     = $t->schema;
 247     my $args       = $t->producer_args;
 248     local $DEBUG   = $t->debug;
 249
 250     my $out_file         = $args->{'out_file'}    || '';
 251     my $layout           = $args->{'layout'}      || 'dot';
 252     my $node_shape       = $args->{'node_shape'}  || 'record';
 253     my $output_type      = $args->{'output_type'} || 'png';
 254     my $width            = defined $args->{'width'}
 255                            ? $args->{'width'} : 8.5;
 256     my $height           = defined $args->{'height'}
 257                            ? $args->{'height'} : 11;
 258     my $fontsize         = $args->{'fontsize'};
 259     my $fontname         = $args->{'fontname'};
 260     my $edgeattrs        = $args->{'edgeattrs'} || {};
 261     my $graphattrs       = $args->{'graphattrs'} || {};
 262     my $nodeattrs        = $args->{'nodeattrs'} || {};
 263     my $show_fields      = defined $args->{'show_fields'}
 264                            ? $args->{'show_fields'} : 1;
 265     my $add_color        = $args->{'add_color'};
 266     my $natural_join     = $args->{'natural_join'};
 267     my $show_fk_only     = $args->{'show_fk_only'};
 268     my $show_datatypes   = $args->{'show_datatypes'};
 269     my $show_sizes       = $args->{'show_sizes'};
 270     my $show_indexes     = $args->{'show_indexes'};
 271     my $show_index_names = defined $args->{'show_index_names'} ? $args->{'show_index_names'} : 1;
 272     my $friendly_ints    = $args->{'friendly_ints'};
 273     my $friendly_ints_ex = $args->{'friendly_ints_extended'};
 274     my $show_constraints = $args->{'show_constraints'};
 275     my $join_pk_only     = $args->{'join_pk_only'};
 276     my $skip_fields      = $args->{'skip_fields'} || '';
 277     my $skip_tables      = $args->{'skip_tables'} || '';
 278     my %skip             = map { s/^\s+|\s+$//g; length $_ ? ($_, 1) : () }
 279                            split ( /,/, $skip_fields );
 280     $natural_join      ||= $join_pk_only;
 281
 282     $schema->make_natural_joins(
 283         join_pk_only => $join_pk_only,
 284         skip_fields  => $args->{'skip_fields'},
 285     ) if $natural_join;
 286
 287     die "Invalid layout '$layout'" unless VALID_LAYOUT->{ $layout };
 288     die "Invalid node shape'$node_shape'"
 289         unless VALID_NODE_SHAPE->{ $node_shape };
 290
 291     for ( $height, $width ) {
 292         $_ = 0 unless $_ =~ /^\d+(.\d)?$/;
 293         $_ = 0 if $_ < 0;
 294     }
 295
 296     my %args = (
 297         directed      => $natural_join ? 0 : 1,
 298         layout        => $layout,
 299         no_overlap    => 1,
 300         bgcolor       => $add_color ? 'lightgoldenrodyellow' : 'white',
 301         node          => {
 302             shape     => $node_shape,
 303             style     => 'filled',
 304             fillcolor => 'white',
 305         },
 306     );
 307     $args{'width'}  = $width  if $width;
 308     $args{'height'} = $height if $height;
 309     # set fontsize for edge and node labels if specified
 310     if ($fontsize) {
 311         $args{'node'}->{'fontsize'} = $fontsize;
 312         $args{'edge'} = {} unless $args{'edge'};
 313         $args{'edge'}->{'fontsize'} = $fontsize;
 314     }
 315     # set the font name globally for node, edge, and graph labels if
 316     # specified (use node, edge, or graph attributes for individual
 317     # font specification)
 318     if ($fontname) {
 319         $args{'node'}->{'fontname'} = $fontname;
 320         $args{'edge'} = {} unless $args{'edge'};
 321         $args{'edge'}->{'fontname'} = $fontname;
 322         $args{'graph'} = {} unless $args{'graph'};
 323         $args{'graph'}->{'fontname'} = $fontname;
 324     }
 325     # set additional node, edge, and graph attributes; these may
 326     # possibly override ones set before
 327     while (my ($key,$val) = each %$nodeattrs) {
 328         $args{'node'}->{$key} = $val;
 329     }
 330     $args{'edge'} = {} if %$edgeattrs && !$args{'edge'};
 331     while (my ($key,$val) = each %$edgeattrs) {
 332         $args{'edge'}->{$key} = $val;
 333     }
 334     $args{'graph'} = {} if %$edgeattrs && !$args{'graph'};
 335     while (my ($key,$val) = each %$graphattrs) {
 336         $args{'graph'}->{$key} = $val;
 337     }
 338
 339     #
 340     # Create a blank GraphViz object and see if we can produce the output type.
 341     #
 342     my $gv = GraphViz->new( %args ) or die "Can't create GraphViz object\n";
 343     my $output_method = "as_$output_type";
 344
 345     # the generators are AUTOLOADed so can't use ->can ($output_method)
 346     eval { $gv->$output_method };
 347     die "Invalid output type: '$output_type'" if $@;
 348
 349     my %skip_table = map { $_, 1 } split /\s*,\s*/, $skip_tables;
 350     my %nj_registry; # for locations of fields for natural joins
 351     my @fk_registry; # for locations of fields for foreign keys
 352
 353     TABLE:
 354     for my $table ( $schema->get_tables ) {
 355         my $tname = $table->name;
 356
 357         if ( %skip_table ) {
 358             next TABLE if $skip_table{ $tname };
 359
 360             for my $t ( keys %skip_table ) {
 361                 next TABLE if $tname =~ /$t/;
 362             }
 363         }
 364
 365         my @fields     = $table->get_fields;
 366         if ( $show_fk_only ) {
 367             @fields = grep { $_->is_foreign_key } @fields;
 368         }
 369
 370         my $field_str = '';
 371         if ($show_fields) {
 372
 373           my @fmt_fields;
 374           foreach my $field (@fields) {
 375
 376             my $field_type;
 377             if ($show_datatypes) {
 378
 379               $field_type = $field->data_type;
 380
 381               # For the integer type, transform into different types based on
 382               # requested size, if a size is given.
 383               if ($field->size and $friendly_ints and (lc $field_type) eq 'integer') {
 384                 # Automatically translate to int2, int4, int8
 385                 # Type (Bits)     Max. Signed/Unsigned    Length
 386                 # tinyint* (8)    128                     3
 387                 #                 255                     3
 388                 # smallint (16)   32767                   5
 389                 #                 65535                   5
 390                 # mediumint* (24) 8388607                 7
 391                 #                 16777215                8
 392                 # int (32)        2147483647              10
 393                 #                 4294967295              11
 394                 # bigint (64)     9223372036854775807     19
 395                 #                 18446744073709551615    20
 396                 #
 397                 # * tinyint and mediumint are nonstandard extensions which are
 398                 #   only available under MySQL (to my knowledge)
 399                 my $size = $field->size;
 400                 if ($size <= 3 and $friendly_ints_ex) {
 401                   $field_type = 'tinyint',
 402                 }
 403                 elsif ($size <= 5) {
 404                   $field_type = 'smallint';
 405                 }
 406                 elsif ($size <= 8 and $friendly_ints_ex) {
 407                   $field_type = 'mediumint';
 408                 }
 409                 elsif ($size <= 11) {
 410                   $field_type = 'integer';
 411                 }
 412                 else {
 413                   $field_type = 'bigint';
 414                 }
 415               }
 416
 417               if (
 418                 $show_sizes
 419                   and
 420                 $field->size
 421                   and
 422                 ($field_type =~ /^(var)?char2?$/ or $field_type eq 'numeric' or $field_type eq 'decimal')
 423               ) {
 424                 $field_type .= '(' . $field->size . ')';
 425               }
 426             }
 427
 428             my $constraints;
 429             if ($show_constraints) {
 430               my @constraints;
 431               push(@constraints, 'PK') if $field->is_primary_key;
 432               push(@constraints, 'FK') if $field->is_foreign_key;
 433               push(@constraints, 'U')  if $field->is_unique;
 434
 435               $constraints = join (',', @constraints);
 436             }
 437
 438             # construct the field line from all info gathered so far
 439             push @fmt_fields, join (' ',
 440               '-',
 441               $field->name,
 442               $field_type || (),
 443               $constraints ? "[$constraints]" : (),
 444             );
 445
 446           }
 447
 448           # join field lines with graphviz formatting
 449           $field_str = join ('\l', @fmt_fields) . '\l';
 450         }
 451
 452         my $index_str = '';
 453         if ($show_indexes) {
 454
 455           my @fmt_indexes;
 456           foreach my $index ($table->get_indices) {
 457             next unless $index->is_valid;
 458
 459             push @fmt_indexes, join (' ',
 460               '*',
 461               $show_index_names ? $index->name . ':' : (),
 462               join (', ', $index->fields),
 463               ($index->type eq 'UNIQUE') ? '[U]' : (),
 464             );
 465           }
 466
 467           # join index lines with graphviz formatting (if any indexes at all)
 468           $index_str = join ('\l', @fmt_indexes) . '\l' if @fmt_indexes;
 469         }
 470
 471         my $table_name = $table->name;
 472         my $name_str = $table_name . '\n';
 473
 474         # escape spaces
 475         for ($name_str, $field_str, $index_str) {
 476           $_ =~ s/ /\\ /g;
 477         }
 478
 479
 480         # only the 'record' type supports nice formatting
 481         if ($node_shape eq 'record') {
 482
 483             # the necessity to supply shape => 'record' is a graphviz bug
 484             $gv->add_node( $table_name,
 485               shape => 'record',
 486               label => sprintf ('{%s}',
 487                 join ('|',
 488                   $name_str,
 489                   $field_str || (),
 490                   $index_str || (),
 491                 ),
 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
 510         debug("Processing table '$table_name'");
 511
 512         debug("Fields = ", join(', ', map { $_->name } @fields));
 513
 514         for my $f ( @fields ) {
 515             my $name      = $f->name or next;
 516             my $is_pk     = $f->is_primary_key;
 517             my $is_unique = $f->is_unique;
 518
 519             #
 520             # Decide if we should skip this field.
 521             #
 522             if ( $natural_join ) {
 523                 next unless $is_pk || $f->is_foreign_key;
 524             }
 525
 526             my $constraints = $f->{'constraints'};
 527
 528             if ( $natural_join && !$skip{ $name } ) {
 529                 push @{ $nj_registry{ $name } }, $table_name;
 530             }
 531         }
 532
 533         unless ( $natural_join ) {
 534             for my $c ( $table->get_constraints ) {
 535                 next unless $c->type eq FOREIGN_KEY;
 536                 my $fk_table = $c->reference_table or next;
 537
 538                 for my $field_name ( $c->fields ) {
 539                     for my $fk_field ( $c->reference_fields ) {
 540                         next unless defined $schema->get_table( $fk_table );
 541                         push @fk_registry, [ $table_name, $fk_table ];
 542                     }
 543                 }
 544             }
 545         }
 546     }
 547
 548     #
 549     # Make the connections.
 550     #
 551     my @table_bunches;
 552     if ( $natural_join ) {
 553         for my $field_name ( keys %nj_registry ) {
 554             my @table_names = @{ $nj_registry{ $field_name } || [] } or next;
 555             next if scalar @table_names == 1;
 556             push @table_bunches, [ @table_names ];
 557         }
 558     }
 559     else {
 560         @table_bunches = @fk_registry;
 561     }
 562
 563     my %done;
 564     for my $bunch ( @table_bunches ) {
 565         my @tables = @$bunch;
 566
 567         for my $i ( 0 .. $#tables ) {
 568             my $table1 = $tables[ $i ];
 569             for my $j ( 0 .. $#tables ) {
 570                 next if $i == $j;
 571                 my $table2 = $tables[ $j ];
 572                 next if $done{ $table1 }{ $table2 };
 573                 $gv->add_edge( $table2, $table1 );
 574                 $done{ $table1 }{ $table2 } = 1;
 575                 $done{ $table2 }{ $table1 } = 1;
 576             }
 577         }
 578     }
 579
 580     #
 581     # Print the image.
 582     #
 583     if ( $out_file ) {
 584       if (openhandle ($out_file)) {
 585         print $out_file $gv->$output_method;
 586       }
 587       else {
 588         open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
 589         binmode $fh;
 590         print $fh $gv->$output_method;
 591         close $fh;
 592       }
 593     }
 594     else {
 595       return $gv->$output_method;
 596     }
 597 }
 598
 599 1;
 600
 601 # -------------------------------------------------------------------
 602
 603 =pod
 604
 605 =head1 AUTHOR
 606
 607 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
 608
 609 =head2 CONTRIBUTORS
 610
 611 Jonathan Yu E<lt>frequency@cpan.orgE<gt>
 612
 613 =head1 SEE ALSO
 614
 615 SQL::Translator, GraphViz
 616
 617 =cut