3 # $Id: auto-graph.pl,v 1.1 2003-04-03 19:30:48 kycl4rk Exp $
7 auto-graph.pl - Automatically create a graph from a database schema
11 ./auto-graph.pl -d|--db=db_parser [options] schema.sql
15 -l|--layout Layout schema for GraphViz
16 ("dot," "neato," "twopi"; default "dot")
17 -n|--node-shape Shape of the nodes ("record," "plaintext,"
18 "ellipse," "circle," "egg," "triangle," "box,"
19 "diamond," "trapezium," "parallelogram," "house,"
20 "hexagon," "octagon," default "ellipse")
21 -o|--output Output file name (default STDOUT)
22 -t|--output-type Output file type ("canon", "text," "ps," "hpgl,"
23 "pcl," "mif," "pic," "gd," "gd2," "gif," "jpeg,"
24 "png," "wbmp," "cmap," "ismap," "imap," "vrml,"
25 "vtx," "mp," "fig," "svg," "plain," default "png")
27 --natural-join Perform natural joins
28 --natural-join-pk Perform natural joins from primary keys only
29 -s|--skip Fields to skip in natural joins
30 --debug Print debugging information
34 This script will create a graph of your schema. Only the database
35 driver argument (for SQL::Translator) is required. If no output file
36 name is given, then image will be printed to STDOUT, so you should
37 redirect the output into a file.
39 The default action is to assume the presence of foreign key
40 relationships defined via "REFERNCES" or "FOREIGN KEY" constraints on
41 the tables. If you are parsing the schema of a file that does not
42 have these, you will find the natural join options helpful. With
43 natural joins, like-named fields will be considered foreign keys.
44 This can prove too permissive, however, as you probably don't want a
45 field called "name" to be considered a foreign key, so you could
46 include it in the "skip" option, and all fields called "name" will be
47 excluded from natural joins. A more efficient method, however, might
48 be to simply deduce the foriegn keys from primary keys to other fields
49 named the same in other tables. Use the "natural-join-pk" option
52 If the schema defines foreign keys, then the graph produced will be
53 directed showing the direction of the relationship. If the foreign
54 keys are intuited via natural joins, the graph will be undirected.
65 my $VERSION = (qw$Revision: 1.1 $)[-1];
67 use constant VALID_LAYOUT => {
73 use constant VALID_NODE_SHAPE => {
89 use constant VALID_OUTPUT => {
118 $layout, $node_shape, $out_file, $output_type, $db_driver, $add_color,
119 $natural_join, $join_pk_only, $skip_fields, $debug
123 'd|db=s' => \$db_driver,
124 'o|output:s' => \$out_file,
125 'l|layout:s' => \$layout,
126 'n|node-shape:s' => \$node_shape,
127 't|output-type:s' => \$output_type,
128 'color' => \$add_color,
129 'natural-join' => \$natural_join,
130 'natural-join-pk' => \$join_pk_only,
131 's|skip:s' => \$skip_fields,
134 my $file = shift @ARGV or pod2usage( -message => 'No input file' );
136 pod2usage( -message => "No db driver specified" ) unless $db_driver;
138 my %skip = map { $_, 1 } split ( /,/, $skip_fields );
139 $natural_join ||= $join_pk_only;
140 $layout = 'dot' unless VALID_LAYOUT->{ $layout };
141 $node_shape = 'ellipse' unless VALID_NODE_SHAPE->{ $node_shape };
142 $output_type = 'png' unless VALID_OUTPUT->{ $output_type };
145 # Create GraphViz and see if we can produce the output type.
147 my $gv = GraphViz->new(
148 directed => $natural_join ? 0 : 1,
151 bgcolor => $add_color ? 'lightgoldenrodyellow' : 'white',
153 shape => $node_shape,
157 ) or die "Can't create GraphViz object\n";
159 #die "GraphViz cannot produce files of type '$output_type'\n" unless
160 # $gv->can( "as_$output_type" );
165 warn "Parsing file '$file' with driver '$db_driver'\n" if $debug;
167 my $t = SQL::Translator->new( parser => $db_driver, producer => 'Raw' );
168 my $data = $t->translate( $file ) or die $t->error;
170 warn "Data =\n", Dumper( $data ), "\n" if $debug;
172 my %nj_registry; # for locations of fields for natural joins
173 my @fk_registry; # for locations of fields for foreign keys
176 # If necessary, pre-process fields to find foreign keys.
178 if ( $natural_join ) {
179 my ( %common_keys, %pk );
180 for my $table ( values %$data ) {
182 @{ $table->{'indices'} || [] },
183 @{ $table->{'constraints'} || [] },
185 my @fields = @{ $index->{'fields'} || [] } or next;
186 if ( $index->{'type'} eq 'primary_key' ) {
187 $pk{ $_ } = 1 for @fields;
191 for my $field ( values %{ $table->{'fields'} } ) {
192 push @{ $common_keys{ $field->{'name'} } }, $table->{'table_name'};
196 for my $field ( keys %common_keys ) {
197 my @tables = @{ $common_keys{ $field } };
198 next unless scalar @tables > 1;
199 for my $table ( @tables ) {
200 next if $join_pk_only and !defined $pk{ $field };
201 $data->{ $table }{'fields'}{ $field }{'is_fk'} = 1;
208 sort { $a->[0] <=> $b->[0] }
209 map { [ $_->{'order'}, $_ ] }
212 my $table_name = $table->{'table_name'};
213 $gv->add_node( $table_name );
215 warn "Processing table '$table_name'\n" if $debug;
219 sort { $a->[0] <=> $b->[0] }
220 map { [ $_->{'order'}, $_ ] }
221 values %{ $table->{'fields'} };
223 warn "Fields = ", join(', ', map { $_->{'name'} } @fields), "\n" if $debug;
227 @{ $table->{'indices'} || [] },
228 @{ $table->{'constraints'} || [] },
230 my @fields = @{ $index->{'fields'} || [] } or next;
231 if ( $index->{'type'} eq 'primary_key' ) {
232 $pk{ $_ } = 1 for @fields;
234 elsif ( $index->{'type'} eq 'unique' ) {
235 $unique{ $_ } = 1 for @fields;
239 warn "Primary keys = ", join(', ', sort keys %pk), "\n" if $debug;
240 warn "Unique = ", join(', ', sort keys %unique), "\n" if $debug;
242 for my $f ( @fields ) {
243 my $name = $f->{'name'} or next;
244 my $is_pk = $pk{ $name };
245 my $is_unique = $unique{ $name };
248 # Decide if we should skip this field.
250 if ( $natural_join ) {
251 next unless $is_pk || $f->{'is_fk'};
254 next unless $is_pk ||
255 grep { $_->{'type'} eq 'foreign_key' }
256 @{ $f->{'constraints'} }
260 my $constraints = $f->{'constraints'};
262 if ( $natural_join && !$skip{ $name } ) {
263 push @{ $nj_registry{ $name } }, $table_name;
265 elsif ( @{ $constraints || [] } ) {
266 for my $constraint ( @$constraints ) {
267 next unless $constraint->{'type'} eq 'foreign_key';
269 @{ $constraint->{'reference_fields'} || [] }
271 my $fk_table = $constraint->{'reference_table'};
272 next unless defined $data->{ $fk_table };
273 push @fk_registry, [ $table_name, $fk_table ];
281 # Make the connections.
284 if ( $natural_join ) {
285 for my $field_name ( keys %nj_registry ) {
286 my @table_names = @{ $nj_registry{ $field_name } || [] } or next;
287 next if scalar @table_names == 1;
288 push @table_bunches, [ @table_names ];
292 @table_bunches = @fk_registry;
296 for my $bunch ( @table_bunches ) {
297 my @tables = @$bunch;
299 for my $i ( 0 .. $#tables ) {
300 my $table1 = $tables[ $i ];
301 for my $j ( 0 .. $#tables ) {
302 my $table2 = $tables[ $j ];
303 next if $table1 eq $table2;
304 next if $done{ $table1 }{ $table2 };
305 $gv->add_edge( $table1, $table2 );
306 $done{ $table1 }{ $table2 } = 1;
307 $done{ $table2 }{ $table1 } = 1;
315 my $output_method = "as_$output_type";
317 open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
318 print $fh $gv->$output_method;
320 print "Image written to '$out_file'. Done.\n";
323 print $gv->$output_method;
330 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>