Commit | Line | Data |
dd9550a4 |
1 | #!/usr/bin/perl |
2 | |
22cb6863 |
3 | # $Id: auto-dia.pl,v 1.4 2003-04-01 16:43:34 kycl4rk Exp $ |
dd9550a4 |
4 | |
5 | =head1 NAME |
6 | |
7 | auto-dia.pl - Automatically create a diagram from a database schema |
8 | |
9 | =head1 SYNOPSIS |
10 | |
11 | ./auto-dia.pl -d|--db=db_parser [options] schema.sql |
12 | |
13 | Options: |
14 | |
7256996b |
15 | -o|--output Output file name (default STDOUT) |
16 | -i|--image Output image type (default PNG) |
17 | -t|--title Title to give schema |
18 | -c|--cols Number of columns |
19 | -n|--no-lines Don't draw lines |
20 | -s|--skip Fields to skip in natural joins |
22cb6863 |
21 | -f|--font-size "small," "medium," "large," or "huge" (default "medium") |
7256996b |
22 | --join-pk-only Perform natural joins from primary keys only |
dd9550a4 |
23 | |
24 | =head1 DESCRIPTION |
25 | |
26 | This script will create a picture of your schema. Only the database |
aa0a19b9 |
27 | driver argument (for SQL::Translator) is required. If no output file |
28 | name is given, then image will be printed to STDOUT, so you should |
29 | redirect the output into a file. |
dd9550a4 |
30 | |
31 | =cut |
32 | |
33 | use strict; |
34 | use Getopt::Long; |
35 | use GD; |
36 | use Pod::Usage; |
37 | use SQL::Translator; |
38 | |
22cb6863 |
39 | my $VERSION = (qw$Revision: 1.4 $)[-1]; |
40 | |
41 | use constant VALID_FONT_SIZE => { |
42 | small => 1, |
43 | medium => 1, |
44 | large => 1, |
45 | huge => 1, |
46 | }; |
dd9550a4 |
47 | |
aa0a19b9 |
48 | # |
49 | # Get arguments. |
50 | # |
51 | my ( $out_file, $image_type, $db_driver, $title, $no_columns, |
22cb6863 |
52 | $no_lines, $skip_fields, $font_size, $join_pk_only ); |
dd9550a4 |
53 | GetOptions( |
7256996b |
54 | 'd|db=s' => \$db_driver, |
55 | 'o|output:s' => \$out_file, |
56 | 'i|image:s' => \$image_type, |
57 | 't|title:s' => \$title, |
58 | 'c|columns:i' => \$no_columns, |
59 | 'n|no-lines' => \$no_lines, |
60 | 's|skip:s' => \$skip_fields, |
22cb6863 |
61 | 'f|font-size:s' => \$font_size, |
7256996b |
62 | '--join-pk-only' => \$join_pk_only, |
dd9550a4 |
63 | ) or die pod2usage; |
64 | my $file = shift @ARGV or pod2usage( -message => 'No input file' ); |
65 | |
66 | pod2usage( -message => "No db driver specified" ) unless $db_driver; |
22cb6863 |
67 | $image_type = $image_type ? lc $image_type : 'png'; |
68 | $title ||= $file; |
69 | $font_size = 'medium' unless VALID_FONT_SIZE->{ $font_size }; |
70 | my %skip = map { $_, 1 } split ( /,/, $skip_fields ); |
dd9550a4 |
71 | |
aa0a19b9 |
72 | # |
73 | # Parse file. |
74 | # |
dd9550a4 |
75 | my $t = SQL::Translator->new( parser => $db_driver, producer => 'Raw' ); |
76 | my $data = $t->translate( $file ) or die $t->error; |
dd9550a4 |
77 | |
aa0a19b9 |
78 | # |
79 | # Layout the image. |
80 | # |
22cb6863 |
81 | my $font = |
82 | $font_size eq 'small' ? gdTinyFont : |
83 | $font_size eq 'medium' ? gdSmallFont : |
84 | $font_size eq 'large' ? gdLargeFont : gdGiantFont; |
dd9550a4 |
85 | my $no_tables = scalar keys %$data; |
86 | $no_columns ||= sprintf( "%.0f", sqrt( $no_tables ) + .5 ); |
87 | my $no_per_col = sprintf( "%.0f", $no_tables/$no_columns + .5 ); |
dd9550a4 |
88 | |
7256996b |
89 | my @shapes; |
90 | my ( $max_x, $max_y ); # the furthest x and y used |
91 | my $orig_y = 40; # used to reset y for each column |
92 | my ( $x, $y ) = (20, $orig_y); # where to start |
93 | my $cur_col = 1; # the current column |
94 | my $no_this_col = 0; # number of tables in current column |
95 | my $this_col_x = $x; # current column's x |
96 | my $gutter = 30; # distance b/w columns |
97 | my %registry; # for locations of fields |
98 | my %table_x; # for max x of each table |
99 | my $field_no; # counter to give distinct no. to each field |
dd9550a4 |
100 | |
101 | for my $table ( |
102 | map { $_->[1] } |
103 | sort { $a->[0] <=> $b->[0] } |
104 | map { [ $_->{'order'}, $_ ] } |
105 | values %$data |
106 | ) { |
107 | my $table_name = $table->{'table_name'}; |
108 | my $top = $y; |
aa0a19b9 |
109 | push @shapes, [ 'string', $font, $this_col_x, $y, $table_name, 'black' ]; |
dd9550a4 |
110 | |
111 | $y += $font->height + 2; |
112 | my $below_table_name = $y; |
113 | $y += 2; |
114 | my $this_max_x = $this_col_x + ($font->width * length($table_name)); |
115 | |
116 | my @fields = |
117 | map { $_->[1] } |
118 | sort { $a->[0] <=> $b->[0] } |
119 | map { [ $_->{'order'}, $_ ] } |
120 | values %{ $table->{'fields'} }; |
121 | |
7256996b |
122 | my %pk; |
dd9550a4 |
123 | for my $index ( @{ $table->{'indices'} || [] } ) { |
124 | next unless $index->{'type'} eq 'primary_key'; |
125 | my @fields = @{ $index->{'fields'} || [] } or next; |
7256996b |
126 | $pk{ $_ } = 1 for @fields; |
dd9550a4 |
127 | } |
128 | |
129 | my ( @fld_desc, $max_name ); |
130 | for my $f ( @fields ) { |
7256996b |
131 | my $name = $f->{'name'} or next; |
132 | my $is_pk = $pk{ $name }; |
133 | $name .= ' *' if $is_pk; |
dd9550a4 |
134 | |
135 | my $size = @{ $f->{'size'} || [] } |
136 | ? '(' . join( ',', @{ $f->{'size'} } ) . ')' |
137 | : ''; |
138 | my $desc = join( ' ', map { $_ || () } $f->{'data_type'}, $size ); |
139 | |
140 | my $nlen = length $name; |
141 | $max_name = $nlen if $nlen > $max_name; |
7256996b |
142 | push @fld_desc, [ $name, $desc, $f->{'name'}, $is_pk ]; |
dd9550a4 |
143 | } |
144 | |
145 | $max_name += 4; |
146 | for my $fld_desc ( @fld_desc ) { |
7256996b |
147 | my ( $name, $desc, $orig_name, $is_pk ) = @$fld_desc; |
dd9550a4 |
148 | my $diff = $max_name - length $name; |
149 | $name .= ' ' x $diff; |
150 | $desc = $name . $desc; |
151 | |
aa0a19b9 |
152 | push @shapes, [ 'string', $font, $this_col_x, $y, $desc, 'black' ]; |
dd9550a4 |
153 | $y += $font->height + 2; |
154 | my $length = $this_col_x + ( $font->width * length( $desc ) ); |
155 | $this_max_x = $length if $length > $this_max_x; |
aa0a19b9 |
156 | |
157 | unless ( $skip{ $orig_name } ) { |
158 | my $y_link = $y - $font->height * .75; |
159 | push @{ $registry{ $orig_name } }, { |
160 | left => [ $this_col_x - 2, $y_link ], |
161 | right => [ $length, $y_link ], |
162 | table => $table_name, |
163 | field_no => ++$field_no, |
7256996b |
164 | is_pk => $is_pk, |
aa0a19b9 |
165 | }; |
166 | } |
dd9550a4 |
167 | } |
168 | |
169 | $this_max_x += 5; |
aa0a19b9 |
170 | $table_x{ $table_name } = $this_max_x + 5; |
dd9550a4 |
171 | push @shapes, [ 'line', $this_col_x - 5, $below_table_name, |
aa0a19b9 |
172 | $this_max_x, $below_table_name, 'black' ]; |
dd9550a4 |
173 | push @shapes, [ |
aa0a19b9 |
174 | 'rectangle', $this_col_x - 5, $top - 5, $this_max_x, $y + 5, 'black' |
dd9550a4 |
175 | ]; |
176 | $max_x = $this_max_x if $this_max_x > $max_x; |
177 | $y += 25; |
178 | |
7256996b |
179 | if ( ++$no_this_col == $no_per_col ) { # if we've filled up this column |
180 | $cur_col++; # up the column number |
181 | $no_this_col = 0; # reset the number of tables |
182 | $max_x += $gutter; # push the x over for next column |
183 | $this_col_x = $max_x; # remember the max x for this column |
184 | $max_y = $y if $y > $max_y; # note the max y |
185 | $y = $orig_y; # reset the y for next column |
dd9550a4 |
186 | } |
187 | } |
188 | |
189 | # |
aa0a19b9 |
190 | # Connect the lines. |
191 | # |
192 | my %horz_taken; |
193 | my %done; |
194 | unless ( $no_lines ) { |
195 | for my $field_name ( keys %registry ) { |
196 | my @positions = @{ $registry{ $field_name } || [] } or next; |
197 | next if scalar @positions == 1; |
198 | |
199 | for my $i ( 0 .. $#positions ) { |
200 | my $pos1 = $positions[ $i ]; |
201 | my ( $ax, $ay ) = @{ $pos1->{'left'} }; |
202 | my ( $bx, $by ) = @{ $pos1->{'right'} }; |
203 | my $table1 = $pos1->{'table'}; |
204 | my $fno1 = $pos1->{'field_no'}; |
7256996b |
205 | my $is_pk = $pos1->{'is_pk'}; |
206 | next if $join_pk_only and !$is_pk; |
aa0a19b9 |
207 | |
7256996b |
208 | for my $j ( 0 .. $#positions ) { |
aa0a19b9 |
209 | my $pos2 = $positions[ $j ]; |
210 | my ( $cx, $cy ) = @{ $pos2->{'left'} }; |
211 | my ( $dx, $dy ) = @{ $pos2->{'right'} }; |
212 | my $table2 = $pos2->{'table'}; |
213 | my $fno2 = $pos2->{'field_no'}; |
214 | next if $done{ $fno1 }{ $fno2 }; |
7256996b |
215 | next if $fno1 == $fno2; |
aa0a19b9 |
216 | |
217 | my @distances = (); |
218 | push @distances, [ |
219 | abs ( $ax - $cx ) + abs ( $ay - $cy ), |
220 | [ $ax, $ay, $cx, $cy ], |
221 | [ 'left', 'left' ] |
222 | ]; |
223 | push @distances, [ |
224 | abs ( $ax - $dx ) + abs ( $ay - $dy ), |
225 | [ $ax, $ay, $dx, $dy ], |
226 | [ 'left', 'right' ], |
227 | ]; |
228 | push @distances, [ |
229 | abs ( $bx - $cx ) + abs ( $by - $cy ), |
230 | [ $bx, $by, $cx, $cy ], |
231 | [ 'right', 'left' ], |
232 | ]; |
233 | push @distances, [ |
234 | abs ( $bx - $dx ) + abs ( $by - $dy ), |
235 | [ $bx, $by, $dx, $dy ], |
236 | [ 'right', 'right' ], |
237 | ]; |
238 | @distances = sort { $a->[0] <=> $b->[0] } @distances; |
239 | my $shortest = $distances[0]; |
240 | my ( $x1, $y1, $x2, $y2 ) = @{ $shortest->[1] }; |
241 | my ( $side1, $side2 ) = @{ $shortest->[2] }; |
242 | my ( $start, $end ); |
7256996b |
243 | my $offset = 9; |
aa0a19b9 |
244 | my $col1_right = $table_x{ $table1 }; |
245 | my $col2_right = $table_x{ $table2 }; |
246 | |
247 | my $diff = 0; |
248 | if ( $x1 == $x2 ) { |
249 | while ( $horz_taken{ $x1 + $diff } ) { |
250 | $diff = $side1 eq 'left' ? $diff - 2 : $diff + 2; |
251 | } |
252 | $horz_taken{ $x1 + $diff } = 1; |
253 | } |
254 | |
255 | if ( $side1 eq 'left' ) { |
256 | $start = $x1 - $offset + $diff; |
257 | } |
258 | else { |
259 | $start = $col1_right + $diff; |
260 | } |
261 | |
262 | if ( $side2 eq 'left' ) { |
263 | $end = $x2 - $offset + $diff; |
264 | } |
265 | else { |
266 | $end = $col2_right + $diff; |
267 | } |
268 | |
269 | push @shapes, [ 'line', $x1, $y1, $start, $y1, 'lightblue' ]; |
270 | push @shapes, [ 'line', $start, $y1, $end, $y2, 'lightblue' ]; |
271 | push @shapes, [ 'line', $end, $y2, $x2, $y2, 'lightblue' ]; |
272 | $done{ $fno1 }{ $fno2 } = 1; |
273 | $done{ $fno2 }{ $fno1 } = 1; |
274 | } |
275 | } |
276 | } |
277 | } |
278 | |
279 | # |
dd9550a4 |
280 | # Add the title and signature. |
281 | # |
282 | my $large_font = gdLargeFont; |
283 | my $title_len = $large_font->width * length $title; |
aa0a19b9 |
284 | push @shapes, [ |
285 | 'string', $large_font, $max_x/2 - $title_len/2, 10, $title, 'black' |
286 | ]; |
dd9550a4 |
287 | |
aa0a19b9 |
288 | my $sig = "auto-dia.pl $VERSION"; |
289 | my $sig_len = $font->width * length $sig; |
290 | push @shapes, [ |
291 | 'string', $font, $max_x - $sig_len, $max_y - $font->height - 4, |
292 | $sig, 'black' |
293 | ]; |
dd9550a4 |
294 | |
aa0a19b9 |
295 | # |
296 | # Render the image. |
297 | # |
dd9550a4 |
298 | my $gd = GD::Image->new( $max_x + 10, $max_y ); |
299 | unless ( $gd->can( $image_type ) ) { |
300 | die "GD can't create images of type '$image_type'\n"; |
301 | } |
aa0a19b9 |
302 | my %colors = map { $_->[0], $gd->colorAllocate( @{$_->[1]} ) } ( |
303 | [ white => [ 255, 255, 255 ] ], |
304 | [ black => [ 0, 0, 0 ] ], |
305 | [ lightblue => [ 173, 216, 230 ] ], |
306 | ); |
dd9550a4 |
307 | $gd->interlaced( 'true' ); |
aa0a19b9 |
308 | $gd->fill( 0, 0, $colors{ 'white' } ); |
dd9550a4 |
309 | for my $shape ( @shapes ) { |
310 | my $method = shift @$shape; |
aa0a19b9 |
311 | my $color = pop @$shape; |
312 | $gd->$method( @$shape, $colors{ $color } ); |
dd9550a4 |
313 | } |
314 | |
aa0a19b9 |
315 | # |
316 | # Print the image. |
317 | # |
dd9550a4 |
318 | if ( $out_file ) { |
319 | open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n"; |
320 | print $fh $gd->$image_type; |
321 | close $fh; |
322 | print "Image written to '$out_file'. Done.\n"; |
323 | } |
324 | else { |
325 | print $gd->$image_type; |
326 | } |
327 | |
328 | =pod |
329 | |
330 | =head1 AUTHOR |
331 | |
332 | Ken Y. Clark E<lt>kclark@cpan.orgE<gt> |
333 | |
334 | =cut |