X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FProducer%2FDiagram.pm;h=ac7013e8b7aa4f2541910d82922ee1357b7634e2;hb=1c8ec56e310980f823b2ea35fab59d7a139fa96a;hp=4f2b4a98f9f2900f7d5f357ac07ac80ae0c177af;hpb=6a20798b3cbca00f2d7d37b9d1b3de3d91bb26df;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Producer/Diagram.pm b/lib/SQL/Translator/Producer/Diagram.pm index 4f2b4a9..ac7013e 100644 --- a/lib/SQL/Translator/Producer/Diagram.pm +++ b/lib/SQL/Translator/Producer/Diagram.pm @@ -1,9 +1,7 @@ package SQL::Translator::Producer::Diagram; # ------------------------------------------------------------------- -# $Id: Diagram.pm,v 1.4 2003-07-18 22:54:17 kycl4rk Exp $ -# ------------------------------------------------------------------- -# Copyright (C) 2003 Ken Y. Clark +# 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,6 +18,45 @@ 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( + from => 'MySQL', + to => 'GraphViz', + producer_args => { + # All args are optional + out_file => 'schema.png',# if not provided will go to STDOUT + output_type => 'png', # is default or 'jpeg' + title => 'My Schema', # default is filename + font_size => 'medium', # is default or 'small,' 'large' + imap_file => '', # filename to write image map coords + imap_url => '', # base URL for image map + gutter => 30 # is default, px distance b/w cols + num_columns => 5, # the number of columns + no_lines => 1, # do not draw lines to show FKs + add_color => 1, # give it some color + show_fk_only => 1, # show only fields used in FKs + join_pk_only => 1, # use only primary keys to figure PKs + natural_join => 1, # intuit FKs if not defined + skip_fields => [...], # list* of field names to exclude + skip_tables => [...], # list* of table names to exclude + skip_tables_like => [...], # list* of regexen to exclude tables + } + ) or die SQL::Translator->error; + $t->translate; + +* "list" can be either an array-ref or a comma-separated string + +=cut + use strict; use GD; use Data::Dumper; @@ -27,7 +64,7 @@ use SQL::Translator::Schema::Constants; use SQL::Translator::Utils qw(debug); use vars qw[ $VERSION $DEBUG ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use constant VALID_FONT_SIZE => { @@ -51,43 +88,72 @@ 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'} || ''; my $imap_url = $args->{'imap_url'} || ''; - my $no_columns = $args->{'no_columns'}; + my $gutter = $args->{'gutter'} || 30; # distance b/w columns + my $num_columns = $args->{'num_columns'} || $args->{'no_columns'} || ''; my $no_lines = $args->{'no_lines'}; my $add_color = $args->{'add_color'}; my $show_fk_only = $args->{'show_fk_only'}; my $join_pk_only = $args->{'join_pk_only'}; my $natural_join = $args->{'natural_join'} || $join_pk_only; - my $skip_fields = $args->{'skip_fields'}; - my %skip = map { s/^\s+|\s+$//g; $_,1 } split (/,/, $skip_fields); + my %skip_field = map { $_, 1 } ( + ref $args->{'skip_fields'} eq 'ARRAY' + ? @{ $args->{'skip_fields'} } + : split ( /\s*,\s*/, $args->{'skip_fields'} ) + ); - $schema->make_natural_joins( - join_pk_only => $join_pk_only, - skip_fields => $args->{'skip_fields'}, - ) if $natural_join; + my %skip_table = map { $_, 1 } ( + ref $args->{'skip_tables'} eq 'ARRAY' + ? @{ $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'} ) + ); + + my @table_names; + if ( $natural_join ) { + $schema->make_natural_joins( + join_pk_only => $join_pk_only, + skip_fields => $args->{'skip_fields'}, + ); + + my $g = $schema->as_graph_pm; + my $d = Graph::Traversal::DFS->new( $g, next_alphabetic => 1 ); + $d->preorder; + + @table_names = $d->dfs; + } + else { + @table_names = map { $_->name } $schema->get_tables; + } - 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 }; # # Layout the image. # - my $font = - $font_size eq 'small' ? gdTinyFont : - $font_size eq 'medium' ? gdSmallFont : - $font_size eq 'large' ? gdLargeFont : gdGiantFont; - my @tables = $schema->get_tables; - my $no_tables = scalar @tables; - $no_columns = 0 unless $no_columns =~ /^\d+$/; - $no_columns ||= sprintf( "%.0f", sqrt( $no_tables ) + .5 ); - $no_columns ||= .5; - my $no_per_col = sprintf( "%.0f", $no_tables/$no_columns + .5 ); + my $font + = $font_size eq 'small' ? gdTinyFont + : $font_size eq 'medium' ? gdSmallFont + : $font_size eq 'large' ? gdLargeFont + : gdGiantFont; + + my $num_tables = scalar @table_names; + $num_columns = 0 unless $num_columns =~ /^\d+$/; + $num_columns ||= sprintf( "%.0f", sqrt( $num_tables ) + .5 ); + $num_columns ||= .5; + my $no_per_col = sprintf( "%.0f", $num_tables/$num_columns + .5 ); my @shapes; my ( $max_x, $max_y ); # the furthest x and y used @@ -96,7 +162,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 @@ -105,9 +170,18 @@ sub produce { my @imap_coords; # for making clickable image map my %legend; - for my $table ( @tables ) { - my $table_name = $table->name; - my $top = $y; + TABLE: + for my $table_name ( @table_names ) { + my $table = $schema->get_table( $table_name ); + + if ( @skip_tables_like or keys %skip_table ) { + next TABLE if $skip_table{ $table_name }; + for my $regex ( @skip_tables_like ) { + next TABLE if $table_name =~ $regex; + } + } + + my $top = $y; push @shapes, [ 'string', $font, $this_col_x, $y, $table_name, 'black' ]; $y += $font->height + 2; @@ -121,11 +195,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,28 +210,45 @@ sub produce { } if ( $is_pk ) { - $name .= ' *'; - $legend{'Primary key'} = '*'; + push @attr, 'PK'; + $legend{'Primary key'} = '[PK]'; } - elsif ( $f->is_unique ) { - $name .= ' [U]'; + + if ( $f->is_unique ) { + 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; @@ -164,7 +257,7 @@ sub produce { my $constraints = $table->{'fields'}{ $orig_name }{'constraints'}; - if ( $natural_join && !$skip{ $orig_name } ) { + if ( $natural_join && !$skip_field{ $orig_name } ) { push @{ $nj_registry{ $orig_name } }, $table_name; } @@ -193,8 +286,8 @@ sub produce { for my $fk_field ( $c->reference_fields ) { next unless defined $schema->get_table( $fk_table ); push @fk_registry, [ - [ $table_name, $field_name ], [ $fk_table , $fk_field ], + [ $table_name, $field_name ], ]; } } @@ -421,7 +514,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, @@ -432,8 +525,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 ] ], @@ -459,7 +552,7 @@ sub produce { # debug("imap file = '$imap_file'"); if ( $imap_file && @imap_coords ) { - open my $fh, ">$imap_file" or die "Can't write '$imap_file': $!\n"; + open my $fh, '>', $imap_file or die "Can't write '$imap_file': $!\n"; print $fh qq[\n]. qq[\n]; for my $rec ( @imap_coords ) { @@ -474,25 +567,24 @@ sub produce { # Print the image. # if ( $out_file ) { - open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n"; - print $fh $gd->$image_type; + open my $fh, '>', $out_file or die "Can't write '$out_file': $!\n"; + binmode $fh; + 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 Ekclark@cpan.orgE +Ken Youens-Clark Ekclark@cpan.orgE. =cut