Adding a producer to replicate (and extend) what was being done in the

[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 689a043..c23633b 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.6 2003-08-21 20:27:39 kycl4rk Exp $
+# $Id: Diagram.pm,v 1.11 2004-03-04 14:39:15 dlc 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.6 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/;
 $DEBUG   = 0 unless defined $DEBUG;
 
 use constant VALID_FONT_SIZE => {
@@ -51,7 +66,7 @@ sub produce {
     debug("Producer args =\n", Dumper( $args ));
 
     my $out_file     = $args->{'out_file'}     || '';
-    my $image_type   = $args->{'image_type'}   || 'png';
+    my $output_type  = $args->{'output_type'}   || 'png';
     my $title        = $args->{'title'}        || $t->filename;
     my $font_size    = $args->{'font_size'}    || 'medium';
     my $imap_file    = $args->{'imap_file'}    || '';
@@ -70,8 +85,8 @@ sub produce {
         skip_fields  => $args->{'skip_fields'},
     ) if $natural_join;
 
-    die "Invalid image type '$image_type'"
-        unless VALID_IMAGE_TYPE ->{ $image_type  };
+    die "Invalid image type '$output_type'"
+        unless VALID_IMAGE_TYPE ->{ $output_type  };
     die "Invalid font size '$font_size'"
         unless VALID_FONT_SIZE->{ $font_size };
 
@@ -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, 
@@ -433,8 +466,8 @@ sub produce {
     # Render the image.
     #
     my $gd = GD::Image->new( $max_x + 30, $max_y );
-    unless ( $gd->can( $image_type ) ) {
-        die "GD can't create images of type '$image_type'\n";
+    unless ( $gd->can( $output_type ) ) {
+        die "GD can't create images of type '$output_type'\n";
     }
     my %colors = map { $_->[0], $gd->colorAllocate( @{$_->[1]} ) } (
         [ white                => [ 255, 255, 255 ] ],
@@ -476,24 +509,22 @@ sub produce {
     #
     if ( $out_file ) {
         open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
-        print $fh $gd->$image_type;
+        print $fh $gd->$output_type;
         close $fh;
     }
     else {
-        return $gd->$image_type;
+        return $gd->$output_type;
     }
 }
 
 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