Commit | Line | Data |
036a7d3b |
1 | #!/usr/bin/perl |
2 | |
3 | # $Id: auto-graph.pl,v 1.1 2003-04-03 19:30:48 kycl4rk Exp $ |
4 | |
5 | =head1 NAME |
6 | |
7 | auto-graph.pl - Automatically create a graph from a database schema |
8 | |
9 | =head1 SYNOPSIS |
10 | |
11 | ./auto-graph.pl -d|--db=db_parser [options] schema.sql |
12 | |
13 | Options: |
14 | |
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") |
26 | --color Add colors |
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 |
31 | |
32 | =head1 DESCRIPTION |
33 | |
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. |
38 | |
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 |
50 | to acheive this. |
51 | |
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. |
55 | |
56 | =cut |
57 | |
58 | use strict; |
59 | use Data::Dumper; |
60 | use Getopt::Long; |
61 | use GraphViz; |
62 | use Pod::Usage; |
63 | use SQL::Translator; |
64 | |
65 | my $VERSION = (qw$Revision: 1.1 $)[-1]; |
66 | |
67 | use constant VALID_LAYOUT => { |
68 | dot => 1, |
69 | neato => 1, |
70 | twopi => 1, |
71 | }; |
72 | |
73 | use constant VALID_NODE_SHAPE => { |
74 | record => 1, |
75 | plaintext => 1, |
76 | ellipse => 1, |
77 | circle => 1, |
78 | egg => 1, |
79 | triangle => 1, |
80 | box => 1, |
81 | diamond => 1, |
82 | trapezium => 1, |
83 | parallelogram => 1, |
84 | house => 1, |
85 | hexagon => 1, |
86 | octagon => 1, |
87 | }; |
88 | |
89 | use constant VALID_OUTPUT => { |
90 | canon => 1, |
91 | text => 1, |
92 | ps => 1, |
93 | hpgl => 1, |
94 | pcl => 1, |
95 | mif => 1, |
96 | pic => 1, |
97 | gd => 1, |
98 | gd2 => 1, |
99 | gif => 1, |
100 | jpeg => 1, |
101 | png => 1, |
102 | wbmp => 1, |
103 | cmap => 1, |
104 | ismap => 1, |
105 | imap => 1, |
106 | vrml => 1, |
107 | vtx => 1, |
108 | mp => 1, |
109 | fig => 1, |
110 | svg => 1, |
111 | plain => 1, |
112 | }; |
113 | |
114 | # |
115 | # Get arguments. |
116 | # |
117 | my ( |
118 | $layout, $node_shape, $out_file, $output_type, $db_driver, $add_color, |
119 | $natural_join, $join_pk_only, $skip_fields, $debug |
120 | ); |
121 | |
122 | GetOptions( |
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, |
132 | 'debug' => \$debug, |
133 | ) or die pod2usage; |
134 | my $file = shift @ARGV or pod2usage( -message => 'No input file' ); |
135 | |
136 | pod2usage( -message => "No db driver specified" ) unless $db_driver; |
137 | |
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 }; |
143 | |
144 | # |
145 | # Create GraphViz and see if we can produce the output type. |
146 | # |
147 | my $gv = GraphViz->new( |
148 | directed => $natural_join ? 0 : 1, |
149 | layout => $layout, |
150 | no_overlap => 1, |
151 | bgcolor => $add_color ? 'lightgoldenrodyellow' : 'white', |
152 | node => { |
153 | shape => $node_shape, |
154 | style => 'filled', |
155 | fillcolor => 'white' |
156 | }, |
157 | ) or die "Can't create GraphViz object\n"; |
158 | |
159 | #die "GraphViz cannot produce files of type '$output_type'\n" unless |
160 | # $gv->can( "as_$output_type" ); |
161 | |
162 | # |
163 | # Parse file. |
164 | # |
165 | warn "Parsing file '$file' with driver '$db_driver'\n" if $debug; |
166 | |
167 | my $t = SQL::Translator->new( parser => $db_driver, producer => 'Raw' ); |
168 | my $data = $t->translate( $file ) or die $t->error; |
169 | |
170 | warn "Data =\n", Dumper( $data ), "\n" if $debug; |
171 | |
172 | my %nj_registry; # for locations of fields for natural joins |
173 | my @fk_registry; # for locations of fields for foreign keys |
174 | |
175 | # |
176 | # If necessary, pre-process fields to find foreign keys. |
177 | # |
178 | if ( $natural_join ) { |
179 | my ( %common_keys, %pk ); |
180 | for my $table ( values %$data ) { |
181 | for my $index ( |
182 | @{ $table->{'indices'} || [] }, |
183 | @{ $table->{'constraints'} || [] }, |
184 | ) { |
185 | my @fields = @{ $index->{'fields'} || [] } or next; |
186 | if ( $index->{'type'} eq 'primary_key' ) { |
187 | $pk{ $_ } = 1 for @fields; |
188 | } |
189 | } |
190 | |
191 | for my $field ( values %{ $table->{'fields'} } ) { |
192 | push @{ $common_keys{ $field->{'name'} } }, $table->{'table_name'}; |
193 | } |
194 | } |
195 | |
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; |
202 | } |
203 | } |
204 | } |
205 | |
206 | for my $table ( |
207 | map { $_->[1] } |
208 | sort { $a->[0] <=> $b->[0] } |
209 | map { [ $_->{'order'}, $_ ] } |
210 | values %$data |
211 | ) { |
212 | my $table_name = $table->{'table_name'}; |
213 | $gv->add_node( $table_name ); |
214 | |
215 | warn "Processing table '$table_name'\n" if $debug; |
216 | |
217 | my @fields = |
218 | map { $_->[1] } |
219 | sort { $a->[0] <=> $b->[0] } |
220 | map { [ $_->{'order'}, $_ ] } |
221 | values %{ $table->{'fields'} }; |
222 | |
223 | warn "Fields = ", join(', ', map { $_->{'name'} } @fields), "\n" if $debug; |
224 | |
225 | my ( %pk, %unique ); |
226 | for my $index ( |
227 | @{ $table->{'indices'} || [] }, |
228 | @{ $table->{'constraints'} || [] }, |
229 | ) { |
230 | my @fields = @{ $index->{'fields'} || [] } or next; |
231 | if ( $index->{'type'} eq 'primary_key' ) { |
232 | $pk{ $_ } = 1 for @fields; |
233 | } |
234 | elsif ( $index->{'type'} eq 'unique' ) { |
235 | $unique{ $_ } = 1 for @fields; |
236 | } |
237 | } |
238 | |
239 | warn "Primary keys = ", join(', ', sort keys %pk), "\n" if $debug; |
240 | warn "Unique = ", join(', ', sort keys %unique), "\n" if $debug; |
241 | |
242 | for my $f ( @fields ) { |
243 | my $name = $f->{'name'} or next; |
244 | my $is_pk = $pk{ $name }; |
245 | my $is_unique = $unique{ $name }; |
246 | |
247 | # |
248 | # Decide if we should skip this field. |
249 | # |
250 | if ( $natural_join ) { |
251 | next unless $is_pk || $f->{'is_fk'}; |
252 | } |
253 | else { |
254 | next unless $is_pk || |
255 | grep { $_->{'type'} eq 'foreign_key' } |
256 | @{ $f->{'constraints'} } |
257 | ; |
258 | } |
259 | |
260 | my $constraints = $f->{'constraints'}; |
261 | |
262 | if ( $natural_join && !$skip{ $name } ) { |
263 | push @{ $nj_registry{ $name } }, $table_name; |
264 | } |
265 | elsif ( @{ $constraints || [] } ) { |
266 | for my $constraint ( @$constraints ) { |
267 | next unless $constraint->{'type'} eq 'foreign_key'; |
268 | for my $fk_field ( |
269 | @{ $constraint->{'reference_fields'} || [] } |
270 | ) { |
271 | my $fk_table = $constraint->{'reference_table'}; |
272 | next unless defined $data->{ $fk_table }; |
273 | push @fk_registry, [ $table_name, $fk_table ]; |
274 | } |
275 | } |
276 | } |
277 | } |
278 | } |
279 | |
280 | # |
281 | # Make the connections. |
282 | # |
283 | my @table_bunches; |
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 ]; |
289 | } |
290 | } |
291 | else { |
292 | @table_bunches = @fk_registry; |
293 | } |
294 | |
295 | my %done; |
296 | for my $bunch ( @table_bunches ) { |
297 | my @tables = @$bunch; |
298 | |
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; |
308 | } |
309 | } |
310 | } |
311 | |
312 | # |
313 | # Print the image. |
314 | # |
315 | my $output_method = "as_$output_type"; |
316 | if ( $out_file ) { |
317 | open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n"; |
318 | print $fh $gv->$output_method; |
319 | close $fh; |
320 | print "Image written to '$out_file'. Done.\n"; |
321 | } |
322 | else { |
323 | print $gv->$output_method; |
324 | } |
325 | |
326 | =pod |
327 | |
328 | =head1 AUTHOR |
329 | |
330 | Ken Y. Clark E<lt>kclark@cpan.orgE<gt> |
331 | |
332 | =cut |