bin/auto-dia.pl

   1 #!/usr/bin/perl
   2
   3 # $Id: auto-dia.pl,v 1.1 2003-02-14 20:29:12 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
  20 =head1 DESCRIPTION
  21
  22 This script will create a picture of your schema.  Only the database
  23 driver argument is required.  If no output file name is given, then
  24 image will be printed to STDOUT, so you should redirect the output
  25 into a file.
  26
  27 =cut
  28
  29 use strict;
  30 use Getopt::Long;
  31 use GD;
  32 use Pod::Usage;
  33 use SQL::Translator;
  34
  35 my $VERSION = (qw$Revision: 1.1 $)[-1];
  36
  37 my ( $out_file, $image_type, $db_driver, $title, $no_columns );
  38 GetOptions(
  39     'd|db=s'      => \$db_driver,
  40     'o|output:s'  => \$out_file,
  41     'i|image:s'   => \$image_type,
  42     't|title:s'   => \$title,
  43     'c|columns:i' => \$no_columns,
  44 ) or die pod2usage;
  45 my $file = shift @ARGV or pod2usage( -message => 'No input file' );
  46
  47 pod2usage( -message => "No db driver specified" ) unless $db_driver;
  48 $image_type = $image_type ? lc $image_type : 'png';
  49 $title    ||= $file;
  50
  51 my $t    = SQL::Translator->new( parser => $db_driver, producer => 'Raw' );
  52 my $data = $t->translate( $file ) or die $t->error;
  53 my $font = gdTinyFont;
  54
  55 my $no_tables    = scalar keys %$data;
  56 $no_columns    ||= sprintf( "%.0f", sqrt( $no_tables ) + .5 );
  57 my $no_per_col   = sprintf( "%.0f", $no_tables/$no_columns + .5 );
  58 warn "no per col = '$no_per_col'\n";
  59
  60 my ( @shapes, $max_x, $max_y );
  61 my $orig_y      = 40;
  62 my ( $x, $y )   = ( 20, $orig_y );
  63 my $cur_col     = 1;
  64 my $no_this_col = 0;
  65 my $this_col_x  = $x;
  66
  67 for my $table (
  68     map  { $_->[1] }
  69     sort { $a->[0] <=> $b->[0] }
  70     map  { [ $_->{'order'}, $_ ] }
  71     values %$data
  72 ) {
  73     my $table_name = $table->{'table_name'};
  74     my $top        = $y;
  75     push @shapes, [ 'string', $font, $this_col_x, $y, $table_name ];
  76
  77     $y                   += $font->height + 2;
  78     my $below_table_name  = $y;
  79     $y                   += 2;
  80     my $this_max_x        = $this_col_x + ($font->width * length($table_name));
  81
  82     my @fields =
  83         map  { $_->[1] }
  84         sort { $a->[0] <=> $b->[0] }
  85         map  { [ $_->{'order'}, $_ ] }
  86         values %{ $table->{'fields'} };
  87
  88     my $pk;
  89     for my $index ( @{ $table->{'indices'} || [] } ) {
  90         next unless $index->{'type'} eq 'primary_key';
  91         my @fields = @{ $index->{'fields'} || [] } or next;
  92         $pk = $fields[0];
  93     }
  94
  95     my ( @fld_desc, $max_name );
  96     for my $f ( @fields ) {
  97         my $name = $f->{'name'} or next;
  98         $name   .= ' *' if $name eq $pk;
  99
 100         my $size = @{ $f->{'size'} || [] }
 101             ? '(' . join( ',', @{ $f->{'size'} } ) . ')'
 102             : '';
 103         my $desc = join( ' ', map { $_ || () } $f->{'data_type'}, $size );
 104
 105         my $nlen  = length $name;
 106         $max_name = $nlen if $nlen > $max_name;
 107         push @fld_desc, [ $name, $desc ];
 108     }
 109
 110     $max_name += 4;
 111     for my $fld_desc ( @fld_desc ) {
 112         my ( $name, $desc ) = @$fld_desc;
 113         my $diff = $max_name - length $name;
 114         $name   .= ' ' x $diff;
 115         $desc    = $name . $desc;
 116
 117         push @shapes, [ 'string', $font, $this_col_x, $y, $desc ];
 118         $y         += $font->height + 2;
 119         my $length  = $this_col_x + ( $font->width * length( $desc ) );
 120         $this_max_x = $length if $length > $this_max_x;
 121     }
 122
 123     $this_max_x += 5;
 124     push @shapes, [ 'line', $this_col_x - 5, $below_table_name,
 125         $this_max_x, $below_table_name ];
 126     push @shapes, [
 127         'rectangle', $this_col_x - 5, $top - 5, $this_max_x, $y + 5
 128     ];
 129     $max_x = $this_max_x if $this_max_x > $max_x;
 130     $y    += 25;
 131
 132     if ( ++$no_this_col == $no_per_col ) {
 133         $cur_col++;
 134         $no_this_col = 0;
 135         $max_x      += 20;
 136         $this_col_x  = $max_x;
 137         $max_y       = $y if $y > $max_y;
 138         $y           = $orig_y;
 139     }
 140 }
 141
 142 #
 143 # Add the title and signature.
 144 #
 145 my $large_font = gdLargeFont;
 146 my $title_len  = $large_font->width * length $title;
 147 push @shapes, [ 'string', $large_font, $max_x/2 - $title_len/2, 10, $title ];
 148
 149 my $sig = "auto-dia.pl $VERSION";
 150 push @shapes, [ 'string', $font, $max_x/2 - $title_len/2, 10, $title ];
 151
 152 my $gd = GD::Image->new( $max_x + 10, $max_y );
 153 unless ( $gd->can( $image_type ) ) {
 154     die "GD can't create images of type '$image_type'\n";
 155 }
 156 my $white = $gd->colorAllocate(255,255,255);
 157 my $black = $gd->colorAllocate(00,00,00);
 158 $gd->interlaced( 'true' );
 159 $gd->fill( 0, 0, $white );
 160 for my $shape ( @shapes ) {
 161     my $method = shift @$shape;
 162     $gd->$method( @$shape, $black );
 163 }
 164
 165 if ( $out_file ) {
 166     open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
 167     print $fh $gd->$image_type;
 168     close $fh;
 169     print "Image written to '$out_file'.  Done.\n";
 170 }
 171 else {
 172     print $gd->$image_type;
 173 }
 174
 175 =pod
 176
 177 =head1 AUTHOR
 178
 179 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
 180
 181 =cut