Allow "gutter" to be set by producer arg (Markus Törnqvis).

[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / Diagram.pm

diff --git a/lib/SQL/Translator/Producer/Diagram.pm b/lib/SQL/Translator/Producer/Diagram.pm
index 1d07a0b..076bb82 100644 (file)
--- a/lib/SQL/Translator/Producer/Diagram.pm
+++ b/lib/SQL/Translator/Producer/Diagram.pm
@@ -1,9 +1,9 @@
 package SQL::Translator::Producer::Diagram;
 
 # -------------------------------------------------------------------
-# $Id: Diagram.pm,v 1.7 2003-08-27 03:44:08 kycl4rk Exp $
+# $Id: Diagram.pm,v 1.12 2004-08-30 19:04:59 kycl4rk Exp $
 # -------------------------------------------------------------------
-# Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org>
+# Copyright (C) 2002-4 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,6 +20,21 @@ package SQL::Translator::Producer::Diagram;
 # 02111-1307  USA
 # -------------------------------------------------------------------
 
+=head1 NAME
+
+SQL::Translator::Producer::Diagram - ER diagram producer for SQL::Translator
+
+=head1 SYNOPSIS
+
+Use via SQL::Translator:
+
+  use SQL::Translator;
+
+  my $t = SQL::Translator->new( producer => 'Diagram', '...' );
+  $t->translate;
+
+=cut
+
 use strict;
 use GD;
 use Data::Dumper;
@@ -27,7 +42,7 @@ use SQL::Translator::Schema::Constants;
 use SQL::Translator::Utils qw(debug);
 
 use vars qw[ $VERSION $DEBUG ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/;
 $DEBUG   = 0 unless defined $DEBUG;
 
 use constant VALID_FONT_SIZE => {
@@ -56,6 +71,7 @@ sub produce {
     my $font_size    = $args->{'font_size'}    || 'medium';
     my $imap_file    = $args->{'imap_file'}    || '';
     my $imap_url     = $args->{'imap_url'}     || '';
+    my $gutter       = $args->{'gutter'}       || 30; # distance b/w columns
     my $no_columns   = $args->{'no_columns'};
     my $no_lines     = $args->{'no_lines'};
     my $add_color    = $args->{'add_color'};
@@ -96,7 +112,6 @@ sub produce {
     my $cur_col     = 1;            # the current column
     my $no_this_col = 0;            # number of tables in current column
     my $this_col_x  = $x;           # current column's x
-    my $gutter      = 30;           # distance b/w columns
     my %nj_registry;                # for locations of fields for natural joins
     my @fk_registry;                # for locations of fields for foreign keys
     my %table_x;                    # for max x of each table
@@ -121,11 +136,13 @@ sub produce {
         my @fields = $table->get_fields;
         debug("Fields = ", join(', ', map { $_->name } @fields));
 
-        my ( @fld_desc, $max_name );
+        my ( @fld_desc, $max_name, $max_desc );
         for my $f ( @fields ) {
             my $name  = $f->name or next;
             my $is_pk = $f->is_primary_key;
 
+            my @attr;
+
             #
             # Decide if we should skip this field.
             #
@@ -134,29 +151,45 @@ sub produce {
             }
 
             if ( $is_pk ) {
-                $name .= ' *';
-                $legend{'Primary key'} = '*';
+                push @attr, 'PK';
+                $legend{'Primary key'} = '[PK]';
             }
 
             if ( $f->is_unique ) {
-                $name .= ' [U]';
+                push @attr, 'U';
                 $legend{'Unique constraint'} = '[U]';
             }
 
+            if ( $f->is_foreign_key ) {
+                push @attr, 'FK';
+                $legend{'Foreign Key'} = '[FK]';
+            }
+
+            my $attr = '';
+            if ( @attr ) {
+                $attr .= '[' . join(', ', @attr) . ']';
+            }
+
             my $desc = $f->data_type;
-            $desc   .= '('.$f->size.')' if $f->size;
+            $desc   .= '('.$f->size.')' if $f->size &&
+                       $f->data_type =~ /^(VAR)?CHAR2?$/i;
             
             my $nlen  = length $name;
+            my $dlen  = length $desc;
             $max_name = $nlen if $nlen > $max_name;
-            push @fld_desc, [ $name, $desc, $f->{'name'}, $is_pk ];
+            $max_desc = $dlen if $dlen > $max_desc;
+            push @fld_desc, [ $name, $desc, $f->{'name'}, $is_pk, $attr ];
         }
 
-        $max_name += 4;
+        $max_name += 2;
+        $max_desc += 2;
         for my $fld_desc ( @fld_desc ) {
-            my ( $name, $desc, $orig_name, $is_pk ) = @$fld_desc;
-            my $diff = $max_name - length $name;
-            $name   .= ' ' x $diff;
-            $desc    = $name . $desc;
+            my ( $name, $desc, $orig_name, $is_pk, $attr ) = @$fld_desc;
+            my $diff1 = $max_name - length $name;
+            my $diff2 = $max_desc - length $desc;
+            $name    .= ' ' x $diff1;
+            $desc    .= ' ' x $diff2;
+            $desc     = $name . $desc . $attr;
 
             push @shapes, [ 'string', $font, $this_col_x, $y, $desc, 'black' ];
             $y         += $font->height + 2;
@@ -422,7 +455,7 @@ sub produce {
         }
     }
 
-    my $sig     = __PACKAGE__." $VERSION";
+    my $sig     = 'Created by SQL::Translator ' . $t->version;
     my $sig_len = $font->width * length $sig;
     push @shapes, [ 
         'string', $font, $max_x - $sig_len, $max_y - $font->height - 4, 
@@ -486,14 +519,12 @@ sub produce {
 
 1;
 
-=pod
-
-=head1 NAME
+# -------------------------------------------------------------------
 
-SQL::Translator::Producer::Diagram - ER diagram producer for SQL::Translator
+=pod
 
 =head1 AUTHOR
 
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
 
 =cut