Reduce $Id to its normal form
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / GraphViz.pm
index 46877b4..7c18c2f 100644 (file)
@@ -1,9 +1,9 @@
 package SQL::Translator::Producer::GraphViz;
 
 # -------------------------------------------------------------------
-# $Id: GraphViz.pm,v 1.4 2003-06-05 01:57:48 kycl4rk Exp $
+# $Id$
 # -------------------------------------------------------------------
-# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
+# Copyright (C) 2002-2009 SQLFairy Authors
 #
 # This program is free software; you can redistribute it and/or
 # modify it under the terms of the GNU General Public License as
@@ -20,13 +20,200 @@ package SQL::Translator::Producer::GraphViz;
 # 02111-1307  USA
 # -------------------------------------------------------------------
 
+=pod
+
+=head1 NAME
+
+SQL::Translator::Producer::GraphViz - GraphViz producer for SQL::Translator
+
+=head1 SYNOPSIS
+
+  use SQL::Translator;
+
+  my $trans = new SQL::Translator(
+      from => 'MySQL',            # or your db of choice
+      to => 'GraphViz',
+      producer_args => {
+          out_file => 'schema.png',
+          add_color => 1,
+          show_constraints => 1,
+          show_datatypes => 1,
+          show_sizes => 1
+      }
+  ) or die SQL::Translator->error;
+
+  $trans->translate or die $trans->error;
+
+=head1 DESCRIPTION
+
+Creates a graph of a schema using the amazing graphviz
+(see http://www.graphviz.org/) application (via
+the GraphViz module).  It's nifty--you should try it!
+
+=head1 PRODUCER ARGS
+
+=over 4
+
+=item * out_file
+
+The name of the file where the resulting GraphViz output will be
+written. Alternatively an open filehandle can be supplied. If
+undefined (the default) - the result is returned as a string.
+
+=item * layout (DEFAULT: 'dot')
+
+determines which layout algorithm GraphViz will use; possible
+values are 'dot' (the default GraphViz layout for directed graph
+layouts), 'neato' (for undirected graph layouts - spring model)
+or 'twopi' (for undirected graph layouts - circular)
+
+=item * node_shape (DEFAULT: 'record')
+
+sets the node shape of each table in the graph; this can be
+one of 'record', 'plaintext', 'ellipse', 'circle', 'egg',
+'triangle', 'box', 'diamond', 'trapezium', 'parallelogram',
+'house', 'hexagon', or 'octagon'
+
+=item * output_type (DEFAULT: 'png')
+
+sets the file type of the output graphic; possible values are
+'ps', 'hpgl', 'pcl', 'mif', 'pic', 'gd', 'gd2', 'gif', 'jpeg',
+'png', 'wbmp', 'cmap', 'ismap', 'imap', 'vrml', 'vtx', 'mp',
+'fig', 'svg', 'canon', 'plain' or 'text' (see GraphViz for
+details on each of these)
+
+=item * width (DEFAULT: 8.5)
+
+width (in inches) of the output graphic
+
+=item * height (DEFAULT: 11)
+
+height (in inches) of the output grahic
+
+=item * fontsize
+
+custom font size for node and edge labels (note that arbitrarily large
+sizes may be ignored due to page size or graph size constraints)
+
+=item * fontname
+
+custom font name (or full path to font file) for node, edge, and graph
+labels
+
+=item * nodeattrs
+
+reference to a hash of node attribute names and their values; these
+may override general fontname or fontsize parameter
+
+=item * edgeattrs
+
+reference to a hash of edge attribute names and their values; these
+may override general fontname or fontsize parameter
+
+=item * graphattrs
+
+reference to a hash of graph attribute names and their values; these
+may override the general fontname parameter
+
+=item * show_fields (DEFAULT: true)
+
+if set to a true value, the names of the colums in a table will
+be displayed in each table's node
+
+=item * show_fk_only
+
+if set to a true value, only columns which are foreign keys
+will be displayed in each table's node
+
+=item * show_datatypes
+
+if set to a true value, the datatype of each column will be
+displayed next to each column's name; this option will have no
+effect if the value of show_fields is set to false
+
+=item * show_sizes
+
+if set to a true value, the size (in bytes) of each CHAR and
+VARCHAR column will be displayed in parentheses next to the
+column's name; this option will have no effect if the value of
+show_fields is set to false
+
+=item * show_constraints
+
+if set to a true value, a field's constraints (i.e., its
+primary-key-ness, its foreign-key-ness and/or its uniqueness)
+will appear as a comma-separated list in brackets next to the
+field's name; this option will have no effect if the value of
+show_fields is set to false
+
+=item * add_color
+
+if set to a true value, the graphic will have a background
+color of 'lightgoldenrodyellow'; otherwise the background
+color will be white
+
+=item * natural_join
+
+if set to a true value, the make_natural_join method of
+SQL::Translator::Schema will be called before generating the
+graph; a true value for join_pk_only (see below) implies a
+true value for this option
+
+=item * join_pk_only
+
+the value of this option will be passed as the value of the
+like-named argument in the make_natural_join method (see
+natural_join above) of SQL::Translator::Schema, if either the
+value of this option or the natural_join option is set to true
+
+=item * skip_fields
+
+the value of this option will be passed as the value of the
+like-named argument in the make_natural_join method (see
+natural_join above) of SQL::Translator::Schema, if either
+the natural_join or join_pk_only options has a true value
+
+=item * show_indexes
+
+if set to a true value, each record will also show the indexes
+set on each table. it describes the index types along with
+which columns are included in the index. this option requires
+that show_fields is a true value as well
+
+=item * show_index_names
+
+if show_indexes is set to a true value, then the value of this
+parameter determines whether or not to print names of indexes.
+if show_index_names is false, then a list of indexed columns
+will appear below the field list. otherwise, it will be a list
+prefixed with the name of each index. it defaults to true.
+
+=item * friendly_ints
+
+if set to a true value, each integer type field will be displayed
+as a smallint, integer or bigint depending on the field's
+associated size parameter. this only applies for the 'integer'
+type (and not the lowercase 'int' type, which is assumed to be a
+32-bit integer).
+
+=item * friendly_ints_extended
+
+if set to a true value, the friendly ints displayed will take into
+account the non-standard types, 'tinyint' and 'mediumint' (which,
+as far as I am aware, is only implemented in MySQL)
+
+=back
+
+=cut
+
 use strict;
 use GraphViz;
-use Data::Dumper;
+use SQL::Translator::Schema::Constants;
 use SQL::Translator::Utils qw(debug);
+use Scalar::Util qw/openhandle/;
 
 use vars qw[ $VERSION $DEBUG ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/;
+$VERSION = '1.99';
 $DEBUG   = 0 unless defined $DEBUG;
 
 use constant VALID_LAYOUT => {
@@ -51,59 +238,49 @@ use constant VALID_NODE_SHAPE => {
     octagon       => 1, 
 };
 
-use constant VALID_OUTPUT => {
-    canon => 1, 
-    text  => 1, 
-    ps    => 1, 
-    hpgl  => 1,
-    pcl   => 1, 
-    mif   => 1, 
-    pic   => 1, 
-    gd    => 1, 
-    gd2   => 1, 
-    gif   => 1, 
-    jpeg  => 1,
-    png   => 1, 
-    wbmp  => 1, 
-    cmap  => 1, 
-    ismap => 1, 
-    imap  => 1, 
-    vrml  => 1,
-    vtx   => 1, 
-    mp    => 1, 
-    fig   => 1, 
-    svg   => 1, 
-    plain => 1,
-};
-
 sub produce {
-    my ($t, $data) = @_;
+    my $t          = shift;
+    my $schema     = $t->schema;
     my $args       = $t->producer_args;
     local $DEBUG   = $t->debug;
-    debug("Data =\n", Dumper( $data ));
-    debug("Producer args =\n", Dumper( $args ));
-
-    my $out_file        = $args->{'out_file'}    || '';
-    my $layout          = $args->{'layout'}      || 'neato';
-    my $node_shape      = $args->{'node_shape'}  || 'record';
-    my $output_type     = $args->{'output_type'} || 'png';
-    my $width           = defined $args->{'width'} 
-                          ? $args->{'width'} : 8.5;
-    my $height          = defined $args->{'height'}
-                          ? $args->{'height'} : 11;
-    my $show_fields     = defined $args->{'show_fields'} 
-                          ? $args->{'show_fields'} : 1;
-    my $add_color       = $args->{'add_color'};
-    my $natural_join    = $args->{'natural_join'};
-    my $join_pk_only    = $args->{'join_pk_only'};
-    my $skip_fields     = $args->{'skip_fields'};
-    my %skip            = map { s/^\s+|\s+$//g; $_, 1 }
-                          split ( /,/, $skip_fields );
-    $natural_join     ||= $join_pk_only;
+
+    my $out_file         = $args->{'out_file'}    || '';
+    my $layout           = $args->{'layout'}      || 'dot';
+    my $node_shape       = $args->{'node_shape'}  || 'record';
+    my $output_type      = $args->{'output_type'} || 'png';
+    my $width            = defined $args->{'width'} 
+                           ? $args->{'width'} : 8.5;
+    my $height           = defined $args->{'height'}
+                           ? $args->{'height'} : 11;
+    my $fontsize         = $args->{'fontsize'};
+    my $fontname         = $args->{'fontname'};
+    my $edgeattrs        = $args->{'edgeattrs'} || {};
+    my $graphattrs       = $args->{'graphattrs'} || {};
+    my $nodeattrs        = $args->{'nodeattrs'} || {};
+    my $show_fields      = defined $args->{'show_fields'} 
+                           ? $args->{'show_fields'} : 1;
+    my $add_color        = $args->{'add_color'};
+    my $natural_join     = $args->{'natural_join'};
+    my $show_fk_only     = $args->{'show_fk_only'};
+    my $show_datatypes   = $args->{'show_datatypes'};
+    my $show_sizes       = $args->{'show_sizes'};
+    my $show_indexes     = $args->{'show_indexes'};
+    my $show_index_names = defined $args->{'show_index_names'} ? $args->{'show_index_names'} : 1;
+    my $friendly_ints    = $args->{'friendly_ints'};
+    my $friendly_ints_ex = $args->{'friendly_ints_extended'};
+    my $show_constraints = $args->{'show_constraints'};
+    my $join_pk_only     = $args->{'join_pk_only'};
+    my $skip_fields      = $args->{'skip_fields'} || '';
+    my %skip             = map { s/^\s+|\s+$//g; length $_ ? ($_, 1) : () }
+                           split ( /,/, $skip_fields );
+    $natural_join      ||= $join_pk_only;
+
+    $schema->make_natural_joins(
+        join_pk_only => $join_pk_only,
+        skip_fields  => $args->{'skip_fields'},
+    ) if $natural_join;
 
     die "Invalid layout '$layout'" unless VALID_LAYOUT->{ $layout };
-    die "Invalid output type: '$output_type'"
-        unless VALID_OUTPUT->{ $output_type };
     die "Invalid node shape'$node_shape'" 
         unless VALID_NODE_SHAPE->{ $node_shape };
 
@@ -112,9 +289,6 @@ sub produce {
         $_ = 0 if $_ < 0;
     }
 
-    #
-    # Create GraphViz and see if we can produce the output type.
-    #
     my %args = (
         directed      => $natural_join ? 0 : 1,
         layout        => $layout,
@@ -123,135 +297,215 @@ sub produce {
         node          => { 
             shape     => $node_shape, 
             style     => 'filled', 
-            fillcolor => 'white' 
-        }
+            fillcolor => 'white',
+        },
     );
     $args{'width'}  = $width  if $width;
     $args{'height'} = $height if $height;
+    # set fontsize for edge and node labels if specified
+    if ($fontsize) {
+        $args{'node'}->{'fontsize'} = $fontsize;
+        $args{'edge'} = {} unless $args{'edge'};
+        $args{'edge'}->{'fontsize'} = $fontsize;        
+    }
+    # set the font name globally for node, edge, and graph labels if
+    # specified (use node, edge, or graph attributes for individual
+    # font specification)
+    if ($fontname) {
+        $args{'node'}->{'fontname'} = $fontname;
+        $args{'edge'} = {} unless $args{'edge'};
+        $args{'edge'}->{'fontname'} = $fontname;        
+        $args{'graph'} = {} unless $args{'graph'};
+        $args{'graph'}->{'fontname'} = $fontname;        
+    }
+    # set additional node, edge, and graph attributes; these may
+    # possibly override ones set before
+    while (my ($key,$val) = each %$nodeattrs) {
+        $args{'node'}->{$key} = $val;
+    }
+    $args{'edge'} = {} if %$edgeattrs && !$args{'edge'};
+    while (my ($key,$val) = each %$edgeattrs) {
+        $args{'edge'}->{$key} = $val;
+    }
+    $args{'graph'} = {} if %$edgeattrs && !$args{'graph'};
+    while (my ($key,$val) = each %$graphattrs) {
+        $args{'graph'}->{$key} = $val;
+    }
+
+    #
+    # Create a blank GraphViz object and see if we can produce the output type.
+    #
+    my $gv = GraphViz->new( %args ) or die "Can't create GraphViz object\n";
+    my $output_method = "as_$output_type";
+
+    # the generators are AUTOLOADed so can't use ->can ($output_method) 
+    eval { $gv->$output_method };
+    die "Invalid output type: '$output_type'" if $@;
 
-    my $gv =  GraphViz->new( %args ) or die "Can't create GraphViz object\n";
 
     my %nj_registry; # for locations of fields for natural joins
     my @fk_registry; # for locations of fields for foreign keys
 
-    #
-    # If necessary, pre-process fields to find foreign keys.
-    #
-    if ( $natural_join ) {
-        my ( %common_keys, %pk );
-        for my $table ( values %$data ) {
-            for my $index ( 
-                @{ $table->{'indices'}     || [] },
-                @{ $table->{'constraints'} || [] },
-            ) {
-                my @fields = @{ $index->{'fields'} || [] } or next;
-                if ( $index->{'type'} eq 'primary_key' ) {
-                    $pk{ $_ } = 1 for @fields;
+    for my $table ( $schema->get_tables ) {
+        my @fields     = $table->get_fields;
+        if ( $show_fk_only ) {
+            @fields = grep { $_->is_foreign_key } @fields;
+        }
+
+        my $field_str = '';
+        if ($show_fields) {
+
+          my @fmt_fields;
+          foreach my $field (@fields) {
+
+            my $field_type;
+            if ($show_datatypes) {
+
+              $field_type = $field->data_type;
+
+              # For the integer type, transform into different types based on
+              # requested size, if a size is given.
+              if ($field->size and $friendly_ints and (lc $field_type) eq 'integer') {
+                # Automatically translate to int2, int4, int8
+                # Type (Bits)     Max. Signed/Unsigned    Length
+                # tinyint* (8)    128                     3
+                #                 255                     3
+                # smallint (16)   32767                   5
+                #                 65535                   5
+                # mediumint* (24) 8388607                 7
+                #                 16777215                8
+                # int (32)        2147483647              10
+                #                 4294967295              11
+                # bigint (64)     9223372036854775807     19
+                #                 18446744073709551615    20
+                #
+                # * tinyint and mediumint are nonstandard extensions which are
+                #   only available under MySQL (to my knowledge)
+                my $size = $field->size;
+                if ($size <= 3 and $friendly_ints_ex) {
+                  $field_type = 'tinyint',
+                }
+                elsif ($size <= 5) {
+                  $field_type = 'smallint';
+                }
+                elsif ($size <= 8 and $friendly_ints_ex) {
+                  $field_type = 'mediumint';
                 }
+                elsif ($size <= 11) {
+                  $field_type = 'integer';
+                }
+                else {
+                  $field_type = 'bigint';
+                }
+              }
+
+              if (
+                $show_sizes
+                  and
+                $field->size
+                  and
+                ($field_type =~ /^(var)?char2?$/ or $field_type eq 'numeric' or $field_type eq 'decimal')
+              ) {
+                $field_type .= '(' . $field->size . ')';
+              }
             }
 
-            for my $field ( values %{ $table->{'fields'} } ) {
-                push @{ $common_keys{ $field->{'name'} } }, 
-                    $table->{'table_name'};
-            }
-        }
+            my $constraints;
+            if ($show_constraints) {
+              my @constraints;
+              push(@constraints, 'PK') if $field->is_primary_key;
+              push(@constraints, 'FK') if $field->is_foreign_key;
+              push(@constraints, 'U')  if $field->is_unique;
 
-        for my $field ( keys %common_keys ) {
-            my @tables = @{ $common_keys{ $field } };
-            next unless scalar @tables > 1;
-            for my $table ( @tables ) {
-                next if $join_pk_only and !defined $pk{ $field };
-                $data->{ $table }{'fields'}{ $field }{'is_fk'} = 1;
+              $constraints = join (',', @constraints);
             }
+
+            # construct the field line from all info gathered so far
+            push @fmt_fields, join (' ',
+              '-',
+              $field->name,
+              $field_type || (),
+              $constraints ? "[$constraints]" : (),
+            );
+
+          }
+
+          # join field lines with graphviz formatting
+          $field_str = join ('\l', @fmt_fields) . '\l';
         }
-    }
-    else {
-        for my $table ( values %$data ) {
-            for my $field ( values %{ $table->{'fields'} } ) {
-                for my $constraint ( 
-                    grep { $_->{'type'} eq 'foreign_key' }
-                    @{ $field->{'constraints'} }
-                ) {
-                    my $ref_table  = $constraint->{'reference_table'} or next;
-                    my @ref_fields = @{ $constraint->{'reference_fields'}||[] };
-
-                    unless ( @ref_fields ) {
-                        for my $field ( 
-                            values %{ $data->{ $ref_table }{'fields'} } 
-                        ) {
-                            for my $pk (
-                                grep { $_->{'type'} eq 'primary_key' }
-                                @{ $field->{'constraints'} }
-                            ) {
-                                push @ref_fields, @{ $pk->{'fields'} };
-                            }
-                        }
-
-                        $constraint->{'reference_fields'} = [ @ref_fields ];
-                    }
 
-                    for my $ref_field (@{$constraint->{'reference_fields'}}) {
-                        $data->{$ref_table}{'fields'}{$ref_field}{'is_fk'} = 1;
-                    }
-                }
-            }
+        my $index_str = '';
+        if ($show_indexes) {
+
+          my @fmt_indexes;
+          foreach my $index ($table->get_indices) {
+            next unless $index->is_valid;
+
+            push @fmt_indexes, join (' ',
+              '*',
+              $show_index_names ? $index->name . ':' : (),
+              join (', ', $index->fields),
+              ($index->type eq 'UNIQUE') ? '[U]' : (),
+            );
+          }
+
+          # join index lines with graphviz formatting (if any indexes at all)
+          $index_str = join ('\l', @fmt_indexes) . '\l' if @fmt_indexes;
         }
-    }
 
-    for my $table (
-        map  { $_->[1] }
-        sort { $a->[0] <=> $b->[0] }
-        map  { [ $_->{'order'}, $_ ] }
-        values %$data 
-    ) {
-        my $table_name = $table->{'table_name'};
-        my @fields = 
-            map  { $_->[1] }
-            sort { $a->[0] <=> $b->[0] }
-            map  { [ $_->{'order'}, $_ ] }
-            values %{ $table->{'fields'} };
-
-        my $field_str = join('\l', map { $_->{'name'} } @fields);
-        my $label = $show_fields ? "{$table_name|$field_str}" : $table_name;
-        $gv->add_node( $table_name, label => $label );
+        my $table_name = $table->name;
+        my $name_str = $table_name . '\n';
 
-        debug("Processing table '$table_name'");
+        # escape spaces
+        for ($name_str, $field_str, $index_str) {
+          $_ =~ s/ /\\ /g;
+        }
 
-        debug("Fields = ", join(', ', map { $_->{'name'} } @fields));
 
-        my ( %pk, %unique );
-        for my $index ( 
-            @{ $table->{'indices'}     || [] },
-            @{ $table->{'constraints'} || [] },
-        ) {
-            my @fields = @{ $index->{'fields'} || [] } or next;
-            if ( $index->{'type'} eq 'primary_key' ) {
-                $pk{ $_ } = 1 for @fields;
-            }
-            elsif ( $index->{'type'} eq 'unique' ) {
-                $unique{ $_ } = 1 for @fields;
-            }
+        # only the 'record' type supports nice formatting
+        if ($node_shape eq 'record') {
+
+            # the necessity to supply shape => 'record' is a graphviz bug 
+            $gv->add_node( $table_name,
+              shape => 'record',
+              label => sprintf ('{%s}',
+                join ('|',
+                  $name_str,
+                  $field_str || (),
+                  $index_str || (),
+                ),
+              ),
+            );
+        }
+        else {
+            my $sep = sprintf ('%s\n',
+                '-' x ( (length $table_name) + 2)
+            );
+
+            $gv->add_node( $table_name,
+                label => join ($sep,
+                    $name_str,
+                    $field_str || (),
+                    $index_str || (),
+                ),
+            );
         }
 
-        debug("Primary keys = ", join(', ', sort keys %pk));
-        debug("Unique = ", join(', ', sort keys %unique));
+
+        debug("Processing table '$table_name'");
+
+        debug("Fields = ", join(', ', map { $_->name } @fields));
 
         for my $f ( @fields ) {
-            my $name      = $f->{'name'} or next;
-            my $is_pk     = $pk{ $name };
-            my $is_unique = $unique{ $name };
+            my $name      = $f->name or next;
+            my $is_pk     = $f->is_primary_key;
+            my $is_unique = $f->is_unique;
 
             #
             # Decide if we should skip this field.
             #
             if ( $natural_join ) {
-                next unless $is_pk || $f->{'is_fk'};
-            }
-            else {
-                next unless $is_pk ||
-                    grep { $_->{'type'} eq 'foreign_key' }
-                    @{ $f->{'constraints'} }
-                ;
+                next unless $is_pk || $f->is_foreign_key;
             }
 
             my $constraints = $f->{'constraints'};
@@ -259,14 +513,16 @@ sub produce {
             if ( $natural_join && !$skip{ $name } ) {
                 push @{ $nj_registry{ $name } }, $table_name;
             }
-            elsif ( @{ $constraints || [] } ) {
-                for my $constraint ( @$constraints ) {
-                    next unless $constraint->{'type'} eq 'foreign_key';
-                    for my $fk_field ( 
-                        @{ $constraint->{'reference_fields'} || [] }
-                    ) {
-                        my $fk_table = $constraint->{'reference_table'};
-                        next unless defined $data->{ $fk_table };
+        }
+
+        unless ( $natural_join ) {
+            for my $c ( $table->get_constraints ) {
+                next unless $c->type eq FOREIGN_KEY;
+                my $fk_table = $c->reference_table or next;
+
+                for my $field_name ( $c->fields ) {
+                    for my $fk_field ( $c->reference_fields ) {
+                        next unless defined $schema->get_table( $fk_table );
                         push @fk_registry, [ $table_name, $fk_table ];
                     }
                 }
@@ -296,10 +552,10 @@ sub produce {
         for my $i ( 0 .. $#tables ) {
             my $table1 = $tables[ $i ];
             for my $j ( 0 .. $#tables ) {
+                next if $i == $j;
                 my $table2 = $tables[ $j ];
-                next if $table1 eq $table2;
                 next if $done{ $table1 }{ $table2 };
-                $gv->add_edge( $table1, $table2 );
+                $gv->add_edge( $table2, $table1 );
                 $done{ $table1 }{ $table2 } = 1;
                 $done{ $table2 }{ $table1 } = 1;
             }
@@ -309,27 +565,38 @@ sub produce {
     #
     # Print the image.
     #
-    my $output_method = "as_$output_type";
     if ( $out_file ) {
+      if (openhandle ($out_file)) {
+        print $out_file $gv->$output_method;
+      }
+      else {
         open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
+        binmode $fh;
         print $fh $gv->$output_method;
         close $fh;
+      }
     }
     else {
-        return $gv->$output_method;
+      return $gv->$output_method;
     }
 }
 
 1;
 
-=pod
-
-=head1 NAME
+# -------------------------------------------------------------------
 
-SQL::Translator::Producer::GraphViz - GraphViz producer for SQL::Translator
+=pod
 
 =head1 AUTHOR
 
 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
 
+=head2 CONTRIBUTORS
+
+Jonathan Yu E<lt>frequency@cpan.orgE<gt>
+
+=head1 SEE ALSO
+
+SQL::Translator, GraphViz
+
 =cut