X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FProducer%2FDiagram.pm;h=08b6dd3e1e70920f8b1ab6903f4857763ce1b3cb;hb=0c04c5a2210135419771878dc7e341a1cba52cca;hp=ac7013e8b7aa4f2541910d82922ee1357b7634e2;hpb=9d4a26be0833cbe346c08006924c6b3489ab2955;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Producer/Diagram.pm b/lib/SQL/Translator/Producer/Diagram.pm index ac7013e..08b6dd3 100644 --- a/lib/SQL/Translator/Producer/Diagram.pm +++ b/lib/SQL/Translator/Producer/Diagram.pm @@ -1,23 +1,5 @@ package SQL::Translator::Producer::Diagram; -# ------------------------------------------------------------------- -# 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 -# published by the Free Software Foundation; version 2. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA -# 02111-1307 USA -# ------------------------------------------------------------------- - =head1 NAME SQL::Translator::Producer::Diagram - ER diagram producer for SQL::Translator @@ -28,12 +10,12 @@ Use via SQL::Translator: use SQL::Translator; - my $t = SQL::Translator->new( - from => 'MySQL', + my $t = SQL::Translator->new( + from => 'MySQL', to => 'GraphViz', producer_args => { # All args are optional - out_file => 'schema.png',# if not provided will go to STDOUT + out_file => 'schema.png',# if not provided will return from translate() output_type => 'png', # is default or 'jpeg' title => 'My Schema', # default is filename font_size => 'medium', # is default or 'small,' 'large' @@ -58,13 +40,14 @@ Use via SQL::Translator: =cut use strict; +use warnings; use GD; use Data::Dumper; use SQL::Translator::Schema::Constants; use SQL::Translator::Utils qw(debug); -use vars qw[ $VERSION $DEBUG ]; -$VERSION = '1.59'; +our $DEBUG; +our $VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use constant VALID_FONT_SIZE => { @@ -103,19 +86,19 @@ sub produce { my %skip_field = map { $_, 1 } ( ref $args->{'skip_fields'} eq 'ARRAY' ? @{ $args->{'skip_fields'} } - : split ( /\s*,\s*/, $args->{'skip_fields'} ) + : split ( /\s*,\s*/, $args->{'skip_fields'}||'' ) ); my %skip_table = map { $_, 1 } ( ref $args->{'skip_tables'} eq 'ARRAY' ? @{ $args->{'skip_tables'} } - : split ( /\s*,\s*/, $args->{'skip_tables'} ) + : split ( /\s*,\s*/, $args->{'skip_tables'}||'' ) ); my @skip_tables_like = map { qr/$_/ } ( ref $args->{'skip_tables_like'} eq 'ARRAY' ? @{ $args->{'skip_tables_like'} } - : split ( /\s*,\s*/, $args->{'skip_tables_like'} ) + : split ( /\s*,\s*/, $args->{'skip_tables_like'}||'' ) ); my @table_names; @@ -125,11 +108,11 @@ sub produce { skip_fields => $args->{'skip_fields'}, ); - my $g = $schema->as_graph_pm; + my $g = $schema->as_graph_pm; my $d = Graph::Traversal::DFS->new( $g, next_alphabetic => 1 ); $d->preorder; - @table_names = $d->dfs; + @table_names = $d->dfs; } else { @table_names = map { $_->name } $schema->get_tables; @@ -144,9 +127,9 @@ sub produce { # Layout the image. # my $font - = $font_size eq 'small' ? gdTinyFont - : $font_size eq 'medium' ? gdSmallFont - : $font_size eq 'large' ? gdLargeFont + = $font_size eq 'small' ? gdTinyFont + : $font_size eq 'medium' ? gdSmallFont + : $font_size eq 'large' ? gdLargeFont : gdGiantFont; my $num_tables = scalar @table_names; @@ -155,7 +138,7 @@ sub produce { $num_columns ||= .5; my $no_per_col = sprintf( "%.0f", $num_tables/$num_columns + .5 ); - my @shapes; + my @shapes; my ( $max_x, $max_y ); # the furthest x and y used my $orig_y = 40; # used to reset y for each column my ( $x, $y ) = (30,$orig_y); # where to start @@ -182,12 +165,12 @@ sub produce { } my $top = $y; - push @shapes, + push @shapes, [ 'string', $font, $this_col_x, $y, $table_name, 'black' ]; $y += $font->height + 2; my $below_table_name = $y; $y += 2; - my $this_max_x = + my $this_max_x = $this_col_x + ($font->width * length($table_name)); debug("Processing table '$table_name'"); @@ -232,11 +215,11 @@ sub produce { my $desc = $f->data_type; $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; - $max_desc = $dlen if $dlen > $max_desc; + $max_name = $nlen if $nlen > ($max_name||0); + $max_desc = $dlen if $dlen > ($max_desc||0); push @fld_desc, [ $name, $desc, $f->{'name'}, $is_pk, $attr ]; } @@ -271,7 +254,7 @@ sub produce { fld_name => $orig_name, }; - push @imap_coords, [ + push @imap_coords, [ $imap_url."#$table_name-$orig_name", $this_col_x, $y - $font->height, $length, $y_link, ]; @@ -296,34 +279,34 @@ sub produce { $this_max_x += 5; $table_x{ $table_name } = $this_max_x + 5; - push @shapes, [ 'line', $this_col_x - 5, $below_table_name, + push @shapes, [ 'line', $this_col_x - 5, $below_table_name, $this_max_x, $below_table_name, 'black' ]; my @bounds = ( $this_col_x - 5, $top - 5, $this_max_x, $y + 5 ); if ( $add_color ) { - unshift @shapes, [ - 'filledRectangle', + unshift @shapes, [ + 'filledRectangle', $bounds[0], $bounds[1], $this_max_x, $below_table_name, - 'khaki' + 'khaki' ]; unshift @shapes, [ 'filledRectangle', @bounds, 'white' ]; } - push @imap_coords, [ + push @imap_coords, [ $imap_url."#$table_name", $bounds[0], $bounds[1], $this_max_x, $below_table_name, ]; push @shapes, [ 'rectangle', @bounds, 'black' ]; - $max_x = $this_max_x if $this_max_x > $max_x; + $max_x = $this_max_x if $this_max_x > ($max_x||0); $y += 25; - + if ( ++$no_this_col == $no_per_col ) {# if we've filled up this column $cur_col++; # up the column number $no_this_col = 0; # reset the number of tables $max_x += $gutter; # push the x over for next column $this_col_x = $max_x; # remember the max x for this col - $max_y = $y if $y > $max_y; # note the max y + $max_y = $y if $y > ($max_y||0); # note the max y $y = $orig_y; # reset the y for next column } } @@ -339,7 +322,7 @@ sub produce { if ( $natural_join ) { for my $field_name ( keys %nj_registry ) { my @positions; - my @table_names = + my @table_names = @{ $nj_registry{ $field_name } || [] } or next; next if scalar @table_names == 1; @@ -353,7 +336,7 @@ sub produce { } else { for my $pair ( @fk_registry ) { - push @position_bunches, [ + push @position_bunches, [ $coords{$pair->[0][0]}{ $pair->[0][1] }{'coords'}, $coords{$pair->[1][0]}{ $pair->[1][1] }{'coords'}, ]; @@ -417,7 +400,7 @@ sub produce { my $diff = 0; if ( $x1 == $x2 ) { while ( $horz_taken{ $x1 + $diff } ) { - $diff = $side1 eq 'left' ? $diff - 2 : $diff + 2; + $diff = $side1 eq 'left' ? $diff - 2 : $diff + 2; } $horz_taken{ $x1 + $diff } = 1; } @@ -431,16 +414,16 @@ sub produce { if ( $side2 eq 'left' ) { $end = $x2 - $offset + $diff; - } + } else { $end = $col2_right + $diff; - } + } - push @shapes, + push @shapes, [ 'line', $x1, $y1, $start, $y1, 'cadetblue' ]; - push @shapes, + push @shapes, [ 'line', $start, $y1, $end, $y2, 'cadetblue' ]; - push @shapes, + push @shapes, [ 'line', $end, $y2, $x2, $y2, 'cadetblue' ]; if ( $is_directed ) { @@ -449,27 +432,27 @@ sub produce { || $side1 eq 'left' && $side2 eq 'left' ) { - push @shapes, [ - 'line', $x2 - 3, $y2 - 3, $x2, $y2, 'cadetblue' + push @shapes, [ + 'line', $x2 - 3, $y2 - 3, $x2, $y2, 'cadetblue' ]; - push @shapes, [ - 'line', $x2 - 3, $y2 + 3, $x2, $y2, 'cadetblue' + push @shapes, [ + 'line', $x2 - 3, $y2 + 3, $x2, $y2, 'cadetblue' ]; - push @shapes, [ - 'line', $x2 - 3, $y2 - 3, $x2 - 3, $y2 +3, - 'cadetblue' + push @shapes, [ + 'line', $x2 - 3, $y2 - 3, $x2 - 3, $y2 +3, + 'cadetblue' ]; } else { - push @shapes, [ - 'line', $x2 + 3, $y2 - 3, $x2, $y2, 'cadetblue' + push @shapes, [ + 'line', $x2 + 3, $y2 - 3, $x2, $y2, 'cadetblue' ]; - push @shapes, [ - 'line', $x2 + 3, $y2 + 3, $x2, $y2, 'cadetblue' + push @shapes, [ + 'line', $x2 + 3, $y2 + 3, $x2, $y2, 'cadetblue' ]; - push @shapes, [ - 'line', $x2 + 3, $y2 - 3, $x2 + 3, $y2 +3, - 'cadetblue' + push @shapes, [ + 'line', $x2 + 3, $y2 - 3, $x2 + 3, $y2 +3, + 'cadetblue' ]; } } @@ -486,27 +469,27 @@ sub produce { # my $large_font = gdLargeFont; my $title_len = $large_font->width * length $title; - push @shapes, [ - 'string', $large_font, $max_x/2 - $title_len/2, 10, $title, 'black' + push @shapes, [ + 'string', $large_font, $max_x/2 - $title_len/2, 10, $title, 'black' ]; if ( %legend ) { $max_y += 5; - push @shapes, [ + push @shapes, [ 'string', $font, $x, $max_y - $font->height - 4, 'Legend', 'black' ]; $max_y += $font->height + 4; my $longest; for my $len ( map { length $_ } values %legend ) { - $longest = $len if $len > $longest; + $longest = $len if $len > ($longest||0); } $longest += 2; while ( my ( $key, $shape ) = each %legend ) { my $space = $longest - length $shape; - push @shapes, [ - 'string', $font, $x, $max_y - $font->height - 4, + push @shapes, [ + 'string', $font, $x, $max_y - $font->height - 4, join( '', $shape, ' ' x $space, $key ), 'black' ]; @@ -516,8 +499,8 @@ sub produce { 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, + push @shapes, [ + 'string', $font, $max_x - $sig_len, $max_y - $font->height - 4, $sig, 'black' ]; @@ -558,7 +541,7 @@ sub produce { for my $rec ( @imap_coords ) { my $href = shift @$rec; print $fh q[\n]; - } + } print $fh qq[]; close $fh; } @@ -579,8 +562,6 @@ sub produce { 1; -# ------------------------------------------------------------------- - =pod =head1 AUTHOR