From: Ken Youens-Clark Date: Thu, 24 Apr 2003 16:14:07 +0000 (+0000) Subject: Moved all the real code into a module so this script now just uses the new X-Git-Tag: v0.02~179 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=945a44d24f6faf8a7c2010f7e4f377f5f0057417;p=dbsrgits%2FSQL-Translator.git Moved all the real code into a module so this script now just uses the new GraphViz producer. --- diff --git a/bin/auto-graph.pl b/bin/auto-graph.pl index 1d93621..bed20da 100755 --- a/bin/auto-graph.pl +++ b/bin/auto-graph.pl @@ -1,6 +1,6 @@ #!/usr/bin/perl -# $Id: auto-graph.pl,v 1.1 2003-04-03 19:30:48 kycl4rk Exp $ +# $Id: auto-graph.pl,v 1.2 2003-04-24 16:14:07 kycl4rk Exp $ =head1 NAME @@ -62,61 +62,14 @@ use GraphViz; use Pod::Usage; use SQL::Translator; -my $VERSION = (qw$Revision: 1.1 $)[-1]; - -use constant VALID_LAYOUT => { - dot => 1, - neato => 1, - twopi => 1, -}; - -use constant VALID_NODE_SHAPE => { - record => 1, - plaintext => 1, - ellipse => 1, - circle => 1, - egg => 1, - triangle => 1, - box => 1, - diamond => 1, - trapezium => 1, - parallelogram => 1, - house => 1, - hexagon => 1, - 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, -}; +my $VERSION = (qw$Revision: 1.2 $)[-1]; # # Get arguments. # my ( $layout, $node_shape, $out_file, $output_type, $db_driver, $add_color, - $natural_join, $join_pk_only, $skip_fields, $debug + $natural_join, $join_pk_only, $skip_fields, $debug, $help ); GetOptions( @@ -130,199 +83,41 @@ GetOptions( 'natural-join-pk' => \$join_pk_only, 's|skip:s' => \$skip_fields, 'debug' => \$debug, + 'h|help' => \$help, ) or die pod2usage; -my $file = shift @ARGV or pod2usage( -message => 'No input file' ); +my @files = @ARGV; # the create script(s) for the original db +pod2usage(1) if $help; pod2usage( -message => "No db driver specified" ) unless $db_driver; - -my %skip = map { $_, 1 } split ( /,/, $skip_fields ); -$natural_join ||= $join_pk_only; -$layout = 'dot' unless VALID_LAYOUT->{ $layout }; -$node_shape = 'ellipse' unless VALID_NODE_SHAPE->{ $node_shape }; -$output_type = 'png' unless VALID_OUTPUT->{ $output_type }; - -# -# Create GraphViz and see if we can produce the output type. -# -my $gv = GraphViz->new( - directed => $natural_join ? 0 : 1, - layout => $layout, - no_overlap => 1, - bgcolor => $add_color ? 'lightgoldenrodyellow' : 'white', - node => { - shape => $node_shape, - style => 'filled', - fillcolor => 'white' +pod2usage( -message => 'No input file' ) unless @files; + +my $translator = SQL::Translator->new( + from => $db_driver, + to => 'GraphViz', + debug => $debug || 0, + producer_args => { + out_file => $out_file, + layout => $layout, + node_shape => $node_shape, + output_type => $output_type, + add_color => $add_color, + natural_join => $natural_join, + natural_join_pk => $join_pk_only, + skip_fields => $skip_fields, }, -) or die "Can't create GraphViz object\n"; - -#die "GraphViz cannot produce files of type '$output_type'\n" unless -# $gv->can( "as_$output_type" ); - -# -# Parse file. -# -warn "Parsing file '$file' with driver '$db_driver'\n" if $debug; - -my $t = SQL::Translator->new( parser => $db_driver, producer => 'Raw' ); -my $data = $t->translate( $file ) or die $t->error; - -warn "Data =\n", Dumper( $data ), "\n" if $debug; - -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 $field ( values %{ $table->{'fields'} } ) { - push @{ $common_keys{ $field->{'name'} } }, $table->{'table_name'}; - } - } - - 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; - } - } -} - -for my $table ( - map { $_->[1] } - sort { $a->[0] <=> $b->[0] } - map { [ $_->{'order'}, $_ ] } - values %$data -) { - my $table_name = $table->{'table_name'}; - $gv->add_node( $table_name ); +) or die SQL::Translator->error; - warn "Processing table '$table_name'\n" if $debug; - - my @fields = - map { $_->[1] } - sort { $a->[0] <=> $b->[0] } - map { [ $_->{'order'}, $_ ] } - values %{ $table->{'fields'} }; - - warn "Fields = ", join(', ', map { $_->{'name'} } @fields), "\n" if $debug; - - 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; - } +for my $file (@files) { + my $output = $translator->translate( $file ) or die + "Error: " . $translator->error; + if ( $out_file ) { + print "Image written to '$out_file'. Done.\n"; } - - warn "Primary keys = ", join(', ', sort keys %pk), "\n" if $debug; - warn "Unique = ", join(', ', sort keys %unique), "\n" if $debug; - - for my $f ( @fields ) { - my $name = $f->{'name'} or next; - my $is_pk = $pk{ $name }; - my $is_unique = $unique{ $name }; - - # - # 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'} } - ; - } - - my $constraints = $f->{'constraints'}; - - 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 }; - push @fk_registry, [ $table_name, $fk_table ]; - } - } - } + else { + print $output; } } -# -# Make the connections. -# -my @table_bunches; -if ( $natural_join ) { - for my $field_name ( keys %nj_registry ) { - my @table_names = @{ $nj_registry{ $field_name } || [] } or next; - next if scalar @table_names == 1; - push @table_bunches, [ @table_names ]; - } -} -else { - @table_bunches = @fk_registry; -} - -my %done; -for my $bunch ( @table_bunches ) { - my @tables = @$bunch; - - for my $i ( 0 .. $#tables ) { - my $table1 = $tables[ $i ]; - for my $j ( 0 .. $#tables ) { - my $table2 = $tables[ $j ]; - next if $table1 eq $table2; - next if $done{ $table1 }{ $table2 }; - $gv->add_edge( $table1, $table2 ); - $done{ $table1 }{ $table2 } = 1; - $done{ $table2 }{ $table1 } = 1; - } - } -} - -# -# Print the image. -# -my $output_method = "as_$output_type"; -if ( $out_file ) { - open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n"; - print $fh $gv->$output_method; - close $fh; - print "Image written to '$out_file'. Done.\n"; -} -else { - print $gv->$output_method; -} - =pod =head1 AUTHOR