From: Ken Youens-Clark Date: Thu, 3 Apr 2003 19:30:48 +0000 (+0000) Subject: Adding "auto-graph.pl" to automatically create graphs (via GraphViz) from X-Git-Tag: v0.02~207 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=036a7d3b94aa4dd83016b3a870f2ac59afe1559e;p=dbsrgits%2FSQL-Translator.git Adding "auto-graph.pl" to automatically create graphs (via GraphViz) from schema definitions. --- diff --git a/bin/auto-graph.pl b/bin/auto-graph.pl new file mode 100755 index 0000000..1d93621 --- /dev/null +++ b/bin/auto-graph.pl @@ -0,0 +1,332 @@ +#!/usr/bin/perl + +# $Id: auto-graph.pl,v 1.1 2003-04-03 19:30:48 kycl4rk Exp $ + +=head1 NAME + +auto-graph.pl - Automatically create a graph from a database schema + +=head1 SYNOPSIS + + ./auto-graph.pl -d|--db=db_parser [options] schema.sql + + Options: + + -l|--layout Layout schema for GraphViz + ("dot," "neato," "twopi"; default "dot") + -n|--node-shape Shape of the nodes ("record," "plaintext," + "ellipse," "circle," "egg," "triangle," "box," + "diamond," "trapezium," "parallelogram," "house," + "hexagon," "octagon," default "ellipse") + -o|--output Output file name (default STDOUT) + -t|--output-type Output file type ("canon", "text," "ps," "hpgl," + "pcl," "mif," "pic," "gd," "gd2," "gif," "jpeg," + "png," "wbmp," "cmap," "ismap," "imap," "vrml," + "vtx," "mp," "fig," "svg," "plain," default "png") + --color Add colors + --natural-join Perform natural joins + --natural-join-pk Perform natural joins from primary keys only + -s|--skip Fields to skip in natural joins + --debug Print debugging information + +=head1 DESCRIPTION + +This script will create a graph of your schema. Only the database +driver argument (for SQL::Translator) is required. If no output file +name is given, then image will be printed to STDOUT, so you should +redirect the output into a file. + +The default action is to assume the presence of foreign key +relationships defined via "REFERNCES" or "FOREIGN KEY" constraints on +the tables. If you are parsing the schema of a file that does not +have these, you will find the natural join options helpful. With +natural joins, like-named fields will be considered foreign keys. +This can prove too permissive, however, as you probably don't want a +field called "name" to be considered a foreign key, so you could +include it in the "skip" option, and all fields called "name" will be +excluded from natural joins. A more efficient method, however, might +be to simply deduce the foriegn keys from primary keys to other fields +named the same in other tables. Use the "natural-join-pk" option +to acheive this. + +If the schema defines foreign keys, then the graph produced will be +directed showing the direction of the relationship. If the foreign +keys are intuited via natural joins, the graph will be undirected. + +=cut + +use strict; +use Data::Dumper; +use Getopt::Long; +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, +}; + +# +# Get arguments. +# +my ( + $layout, $node_shape, $out_file, $output_type, $db_driver, $add_color, + $natural_join, $join_pk_only, $skip_fields, $debug +); + +GetOptions( + 'd|db=s' => \$db_driver, + 'o|output:s' => \$out_file, + 'l|layout:s' => \$layout, + 'n|node-shape:s' => \$node_shape, + 't|output-type:s' => \$output_type, + 'color' => \$add_color, + 'natural-join' => \$natural_join, + 'natural-join-pk' => \$join_pk_only, + 's|skip:s' => \$skip_fields, + 'debug' => \$debug, +) or die pod2usage; +my $file = shift @ARGV or pod2usage( -message => 'No input file' ); + +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' + }, +) 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 ); + + 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; + } + } + + 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 ]; + } + } + } + } +} + +# +# 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 + +Ken Y. Clark Ekclark@cpan.orgE + +=cut