bin/auto-dia.pl

   1 #!/usr/bin/perl
   2
   3 # $Id: auto-dia.pl,v 1.4 2003-04-01 16:43:34 kycl4rk Exp $
   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
  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
  21     -f|--font-size  "small," "medium," "large," or "huge" (default "medium")
  22     --join-pk-only  Perform natural joins from primary keys only
  23
  24 =head1 DESCRIPTION
  25
  26 This script will create a picture of your schema.  Only the database
  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.
  30
  31 =cut
  32
  33 use strict;
  34 use Getopt::Long;
  35 use GD;
  36 use Pod::Usage;
  37 use SQL::Translator;
  38
  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 };
  47
  48 #
  49 # Get arguments.
  50 #
  51 my ( $out_file, $image_type, $db_driver, $title, $no_columns,
  52     $no_lines, $skip_fields, $font_size, $join_pk_only );
  53 GetOptions(
  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,
  61     'f|font-size:s'  => \$font_size,
  62     '--join-pk-only' => \$join_pk_only,
  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;
  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 );
  71
  72 #
  73 # Parse file.
  74 #
  75 my $t    = SQL::Translator->new( parser => $db_driver, producer => 'Raw' );
  76 my $data = $t->translate( $file ) or die $t->error;
  77
  78 #
  79 # Layout the image.
  80 #
  81 my $font         =
  82     $font_size eq 'small'  ? gdTinyFont  :
  83     $font_size eq 'medium' ? gdSmallFont :
  84     $font_size eq 'large'  ? gdLargeFont : gdGiantFont;
  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 );
  88
  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
 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;
 109     push @shapes, [ 'string', $font, $this_col_x, $y, $table_name, 'black' ];
 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
 122     my %pk;
 123     for my $index ( @{ $table->{'indices'} || [] } ) {
 124         next unless $index->{'type'} eq 'primary_key';
 125         my @fields = @{ $index->{'fields'} || [] } or next;
 126         $pk{ $_ } = 1 for @fields;
 127     }
 128
 129     my ( @fld_desc, $max_name );
 130     for my $f ( @fields ) {
 131         my $name  = $f->{'name'} or next;
 132         my $is_pk = $pk{ $name };
 133         $name   .= ' *' if $is_pk;
 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;
 142         push @fld_desc, [ $name, $desc, $f->{'name'}, $is_pk ];
 143     }
 144
 145     $max_name += 4;
 146     for my $fld_desc ( @fld_desc ) {
 147         my ( $name, $desc, $orig_name, $is_pk ) = @$fld_desc;
 148         my $diff = $max_name - length $name;
 149         $name   .= ' ' x $diff;
 150         $desc    = $name . $desc;
 151
 152         push @shapes, [ 'string', $font, $this_col_x, $y, $desc, 'black' ];
 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;
 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,
 164                 is_pk    => $is_pk,
 165             };
 166         }
 167     }
 168
 169     $this_max_x += 5;
 170     $table_x{ $table_name } = $this_max_x + 5;
 171     push @shapes, [ 'line', $this_col_x - 5, $below_table_name,
 172         $this_max_x, $below_table_name, 'black' ];
 173     push @shapes, [
 174         'rectangle', $this_col_x - 5, $top - 5, $this_max_x, $y + 5, 'black'
 175     ];
 176     $max_x = $this_max_x if $this_max_x > $max_x;
 177     $y    += 25;
 178
 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
 186     }
 187 }
 188
 189 #
 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'};
 205             my $is_pk       = $pos1->{'is_pk'};
 206             next if $join_pk_only and !$is_pk;
 207
 208             for my $j ( 0 .. $#positions ) {
 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 };
 215                 next if $fno1 == $fno2;
 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 );
 243                 my $offset     = 9;
 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 #
 280 # Add the title and signature.
 281 #
 282 my $large_font = gdLargeFont;
 283 my $title_len  = $large_font->width * length $title;
 284 push @shapes, [
 285     'string', $large_font, $max_x/2 - $title_len/2, 10, $title, 'black'
 286 ];
 287
 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 ];
 294
 295 #
 296 # Render the image.
 297 #
 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 }
 302 my %colors = map { $_->[0], $gd->colorAllocate( @{$_->[1]} ) } (
 303     [ white     => [ 255, 255, 255 ] ],
 304     [ black     => [   0,   0,   0 ] ],
 305     [ lightblue => [ 173, 216, 230 ] ],
 306 );
 307 $gd->interlaced( 'true' );
 308 $gd->fill( 0, 0, $colors{ 'white' } );
 309 for my $shape ( @shapes ) {
 310     my $method = shift @$shape;
 311     my $color  = pop   @$shape;
 312     $gd->$method( @$shape, $colors{ $color } );
 313 }
 314
 315 #
 316 # Print the image.
 317 #
 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