bin/auto-dia.pl

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