lib/SQL/Translator/Producer/GraphViz.pm

   1 package SQL::Translator::Producer::GraphViz;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: GraphViz.pm,v 1.14 2007-09-26 13:20:09 schiffbruechige Exp $
   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 =back
 175
 176 =cut
 177
 178 use strict;
 179 use GraphViz;
 180 use Data::Dumper;
 181 use SQL::Translator::Schema::Constants;
 182 use SQL::Translator::Utils qw(debug);
 183
 184 use vars qw[ $VERSION $DEBUG ];
 185 $VERSION = sprintf "%d.%02d", q$Revision: 1.14 $ =~ /(\d+)\.(\d+)/;
 186 $DEBUG   = 0 unless defined $DEBUG;
 187
 188 use constant VALID_LAYOUT => {
 189     dot   => 1,
 190     neato => 1,
 191     twopi => 1,
 192 };
 193
 194 use constant VALID_NODE_SHAPE => {
 195     record        => 1,
 196     plaintext     => 1,
 197     ellipse       => 1,
 198     circle        => 1,
 199     egg           => 1,
 200     triangle      => 1,
 201     box           => 1,
 202     diamond       => 1,
 203     trapezium     => 1,
 204     parallelogram => 1,
 205     house         => 1,
 206     hexagon       => 1,
 207     octagon       => 1,
 208 };
 209
 210 use constant VALID_OUTPUT => {
 211     canon => 1,
 212     text  => 1,
 213     ps    => 1,
 214     hpgl  => 1,
 215     pcl   => 1,
 216     mif   => 1,
 217     pic   => 1,
 218     gd    => 1,
 219     gd2   => 1,
 220     gif   => 1,
 221     jpeg  => 1,
 222     png   => 1,
 223     wbmp  => 1,
 224     cmap  => 1,
 225     ismap => 1,
 226     imap  => 1,
 227     vrml  => 1,
 228     vtx   => 1,
 229     mp    => 1,
 230     fig   => 1,
 231     svg   => 1,
 232     plain => 1,
 233 };
 234
 235 sub produce {
 236     my $t          = shift;
 237     my $schema     = $t->schema;
 238     my $args       = $t->producer_args;
 239     local $DEBUG   = $t->debug;
 240
 241     my $out_file         = $args->{'out_file'}    || '';
 242     my $layout           = $args->{'layout'}      || 'dot';
 243     my $node_shape       = $args->{'node_shape'}  || 'record';
 244     my $output_type      = $args->{'output_type'} || 'png';
 245     my $width            = defined $args->{'width'}
 246                            ? $args->{'width'} : 8.5;
 247     my $height           = defined $args->{'height'}
 248                            ? $args->{'height'} : 11;
 249     my $fontsize         = $args->{'fontsize'};
 250     my $fontname         = $args->{'fontname'};
 251     my $edgeattrs        = $args->{'edgeattrs'} || {};
 252     my $graphattrs       = $args->{'graphattrs'} || {};
 253     my $nodeattrs        = $args->{'nodeattrs'} || {};
 254     my $show_fields      = defined $args->{'show_fields'}
 255                            ? $args->{'show_fields'} : 1;
 256     my $add_color        = $args->{'add_color'};
 257     my $natural_join     = $args->{'natural_join'};
 258     my $show_fk_only     = $args->{'show_fk_only'};
 259     my $show_datatypes   = $args->{'show_datatypes'};
 260     my $show_sizes       = $args->{'show_sizes'};
 261     my $show_constraints = $args->{'show_constraints'};
 262     my $join_pk_only     = $args->{'join_pk_only'};
 263     my $skip_fields      = $args->{'skip_fields'} || '';
 264     my %skip             = map { s/^\s+|\s+$//g; length $_ ? ($_, 1) : () }
 265                            split ( /,/, $skip_fields );
 266     $natural_join      ||= $join_pk_only;
 267
 268     $schema->make_natural_joins(
 269         join_pk_only => $join_pk_only,
 270         skip_fields  => $args->{'skip_fields'},
 271     ) if $natural_join;
 272
 273     die "Invalid layout '$layout'" unless VALID_LAYOUT->{ $layout };
 274     die "Invalid output type: '$output_type'"
 275         unless VALID_OUTPUT->{ $output_type };
 276     die "Invalid node shape'$node_shape'"
 277         unless VALID_NODE_SHAPE->{ $node_shape };
 278
 279     for ( $height, $width ) {
 280         $_ = 0 unless $_ =~ /^\d+(.\d)?$/;
 281         $_ = 0 if $_ < 0;
 282     }
 283
 284     #
 285     # Create GraphViz and see if we can produce the output type.
 286     #
 287     my %args = (
 288         directed      => $natural_join ? 0 : 1,
 289         layout        => $layout,
 290         no_overlap    => 1,
 291         bgcolor       => $add_color ? 'lightgoldenrodyellow' : 'white',
 292         node          => {
 293             shape     => $node_shape,
 294             style     => 'filled',
 295             fillcolor => 'white',
 296         },
 297     );
 298     $args{'width'}  = $width  if $width;
 299     $args{'height'} = $height if $height;
 300     # set fontsize for edge and node labels if specified
 301     if ($fontsize) {
 302         $args{'node'}->{'fontsize'} = $fontsize;
 303         $args{'edge'} = {} unless $args{'edge'};
 304         $args{'edge'}->{'fontsize'} = $fontsize;
 305     }
 306     # set the font name globally for node, edge, and graph labels if
 307     # specified (use node, edge, or graph attributes for individual
 308     # font specification)
 309     if ($fontname) {
 310         $args{'node'}->{'fontname'} = $fontname;
 311         $args{'edge'} = {} unless $args{'edge'};
 312         $args{'edge'}->{'fontname'} = $fontname;
 313         $args{'graph'} = {} unless $args{'graph'};
 314         $args{'graph'}->{'fontname'} = $fontname;
 315     }
 316     # set additional node, edge, and graph attributes; these may
 317     # possibly override ones set before
 318     while (my ($key,$val) = each %$nodeattrs) {
 319         $args{'node'}->{$key} = $val;
 320     }
 321     $args{'edge'} = {} if %$edgeattrs && !$args{'edge'};
 322     while (my ($key,$val) = each %$edgeattrs) {
 323         $args{'edge'}->{$key} = $val;
 324     }
 325     $args{'graph'} = {} if %$edgeattrs && !$args{'graph'};
 326     while (my ($key,$val) = each %$graphattrs) {
 327         $args{'graph'}->{$key} = $val;
 328     }
 329
 330     my $gv =  GraphViz->new( %args ) or die "Can't create GraphViz object\n";
 331
 332     my %nj_registry; # for locations of fields for natural joins
 333     my @fk_registry; # for locations of fields for foreign keys
 334
 335     for my $table ( $schema->get_tables ) {
 336         my $table_name = $table->name;
 337         my @fields     = $table->get_fields;
 338         if ( $show_fk_only ) {
 339             @fields = grep { $_->is_foreign_key } @fields;
 340         }
 341
 342         my $field_str = join(
 343             '\l',
 344             map {
 345                 '-\ '
 346                 . $_->name
 347                 . ( $show_datatypes ? '\ ' . $_->data_type : '')
 348                 . ( $show_sizes && ! $show_datatypes ? '\ ' : '')
 349                 . ( $show_sizes && $_->data_type =~ /^(VAR)?CHAR2?$/i ? '(' . $_->size . ')' : '')
 350                 . ( $show_constraints ?
 351                     ( $_->is_primary_key || $_->is_foreign_key || $_->is_unique ? '\ [' : '' )
 352                     . ( $_->is_primary_key ? 'PK' : '' )
 353                     . ( $_->is_primary_key && ($_->is_foreign_key || $_->is_unique) ? ',' : '' )
 354                     . ( $_->is_foreign_key ? 'FK' : '' )
 355                     . ( $_->is_unique && ($_->is_primary_key || $_->is_foreign_key) ? ',' : '' )
 356                     . ( $_->is_unique ? 'U' : '' )
 357                     . ( $_->is_primary_key || $_->is_foreign_key || $_->is_unique ? ']' : '' )
 358                 : '' )
 359                 . '\ '
 360             } @fields
 361         ) . '\l';
 362         my $label = $show_fields ? "{$table_name|$field_str}" : $table_name;
 363 #        $gv->add_node( $table_name, label => $label );
 364         $gv->add_node( $table_name, label => $label, ($node_shape eq 'record' ? ( shape => $node_shape ) : ()) );
 365         debug("Processing table '$table_name'");
 366
 367         debug("Fields = ", join(', ', map { $_->name } @fields));
 368
 369         for my $f ( @fields ) {
 370             my $name      = $f->name or next;
 371             my $is_pk     = $f->is_primary_key;
 372             my $is_unique = $f->is_unique;
 373
 374             #
 375             # Decide if we should skip this field.
 376             #
 377             if ( $natural_join ) {
 378                 next unless $is_pk || $f->is_foreign_key;
 379             }
 380
 381             my $constraints = $f->{'constraints'};
 382
 383             if ( $natural_join && !$skip{ $name } ) {
 384                 push @{ $nj_registry{ $name } }, $table_name;
 385             }
 386         }
 387
 388         unless ( $natural_join ) {
 389             for my $c ( $table->get_constraints ) {
 390                 next unless $c->type eq FOREIGN_KEY;
 391                 my $fk_table = $c->reference_table or next;
 392
 393                 for my $field_name ( $c->fields ) {
 394                     for my $fk_field ( $c->reference_fields ) {
 395                         next unless defined $schema->get_table( $fk_table );
 396                         push @fk_registry, [ $table_name, $fk_table ];
 397                     }
 398                 }
 399             }
 400         }
 401     }
 402
 403     #
 404     # Make the connections.
 405     #
 406     my @table_bunches;
 407     if ( $natural_join ) {
 408         for my $field_name ( keys %nj_registry ) {
 409             my @table_names = @{ $nj_registry{ $field_name } || [] } or next;
 410             next if scalar @table_names == 1;
 411             push @table_bunches, [ @table_names ];
 412         }
 413     }
 414     else {
 415         @table_bunches = @fk_registry;
 416     }
 417
 418     my %done;
 419     for my $bunch ( @table_bunches ) {
 420         my @tables = @$bunch;
 421
 422         for my $i ( 0 .. $#tables ) {
 423             my $table1 = $tables[ $i ];
 424             for my $j ( 0 .. $#tables ) {
 425                 my $table2 = $tables[ $j ];
 426                 next if $table1 eq $table2;
 427                 next if $done{ $table1 }{ $table2 };
 428                 $gv->add_edge( $table2, $table1 );
 429                 $done{ $table1 }{ $table2 } = 1;
 430                 $done{ $table2 }{ $table1 } = 1;
 431             }
 432         }
 433     }
 434
 435     #
 436     # Print the image.
 437     #
 438     my $output_method = "as_$output_type";
 439     if ( $out_file ) {
 440         open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
 441         binmode $fh;
 442         print $fh $gv->$output_method;
 443         close $fh;
 444     }
 445     else {
 446         return $gv->$output_method;
 447     }
 448 }
 449
 450 1;
 451
 452 # -------------------------------------------------------------------
 453
 454 =pod
 455
 456 =head1 AUTHOR
 457
 458 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
 459
 460 =head1 SEE ALSO
 461
 462 SQL::Translator, GraphViz
 463
 464 =cut