Adding "auto-graph.pl" to automatically create graphs (via GraphViz) from
Ken Youens-Clark [Thu, 3 Apr 2003 19:30:48 +0000 (19:30 +0000)]
schema definitions.

bin/auto-graph.pl [new file with mode: 0755]

diff --git a/bin/auto-graph.pl b/bin/auto-graph.pl
new file mode 100755 (executable)
index 0000000..1d93621
--- /dev/null
@@ -0,0 +1,332 @@
+#!/usr/bin/perl
+
+# $Id: auto-graph.pl,v 1.1 2003-04-03 19:30:48 kycl4rk Exp $
+
+=head1 NAME 
+
+auto-graph.pl - Automatically create a graph from a database schema
+
+=head1 SYNOPSIS
+
+  ./auto-graph.pl -d|--db=db_parser [options] schema.sql
+
+  Options:
+
+    -l|--layout        Layout schema for GraphViz
+                       ("dot," "neato," "twopi"; default "dot")
+    -n|--node-shape    Shape of the nodes ("record," "plaintext," 
+                       "ellipse," "circle," "egg," "triangle," "box," 
+                       "diamond," "trapezium," "parallelogram," "house," 
+                       "hexagon," "octagon," default "ellipse")
+    -o|--output        Output file name (default STDOUT)
+    -t|--output-type   Output file type ("canon", "text," "ps," "hpgl,"
+                       "pcl," "mif," "pic," "gd," "gd2," "gif," "jpeg,"
+                       "png," "wbmp," "cmap," "ismap," "imap," "vrml,"
+                       "vtx," "mp," "fig," "svg," "plain," default "png")
+    --color            Add colors
+    --natural-join     Perform natural joins
+    --natural-join-pk  Perform natural joins from primary keys only
+    -s|--skip          Fields to skip in natural joins
+    --debug            Print debugging information
+
+=head1 DESCRIPTION
+
+This script will create a graph of your schema.  Only the database
+driver argument (for SQL::Translator) is required.  If no output file
+name is given, then image will be printed to STDOUT, so you should
+redirect the output into a file.
+
+The default action is to assume the presence of foreign key
+relationships defined via "REFERNCES" or "FOREIGN KEY" constraints on
+the tables.  If you are parsing the schema of a file that does not
+have these, you will find the natural join options helpful.  With
+natural joins, like-named fields will be considered foreign keys.
+This can prove too permissive, however, as you probably don't want a
+field called "name" to be considered a foreign key, so you could
+include it in the "skip" option, and all fields called "name" will be
+excluded from natural joins.  A more efficient method, however, might
+be to simply deduce the foriegn keys from primary keys to other fields
+named the same in other tables.  Use the "natural-join-pk" option
+to acheive this.
+
+If the schema defines foreign keys, then the graph produced will be
+directed showing the direction of the relationship.  If the foreign
+keys are intuited via natural joins, the graph will be undirected.
+
+=cut
+
+use strict;
+use Data::Dumper;
+use Getopt::Long;
+use GraphViz;
+use Pod::Usage;
+use SQL::Translator;
+
+my $VERSION = (qw$Revision: 1.1 $)[-1];
+
+use constant VALID_LAYOUT => {
+    dot   => 1, 
+    neato => 1, 
+    twopi => 1,
+};
+
+use constant VALID_NODE_SHAPE => {
+    record        => 1, 
+    plaintext     => 1, 
+    ellipse       => 1, 
+    circle        => 1, 
+    egg           => 1, 
+    triangle      => 1, 
+    box           => 1, 
+    diamond       => 1, 
+    trapezium     => 1, 
+    parallelogram => 1, 
+    house         => 1, 
+    hexagon       => 1, 
+    octagon       => 1, 
+};
+
+use constant VALID_OUTPUT => {
+    canon => 1, 
+    text  => 1, 
+    ps    => 1, 
+    hpgl  => 1,
+    pcl   => 1, 
+    mif   => 1, 
+    pic   => 1, 
+    gd    => 1, 
+    gd2   => 1, 
+    gif   => 1, 
+    jpeg  => 1,
+    png   => 1, 
+    wbmp  => 1, 
+    cmap  => 1, 
+    ismap => 1, 
+    imap  => 1, 
+    vrml  => 1,
+    vtx   => 1, 
+    mp    => 1, 
+    fig   => 1, 
+    svg   => 1, 
+    plain => 1,
+};
+
+#
+# Get arguments.
+#
+my ( 
+    $layout, $node_shape, $out_file, $output_type, $db_driver, $add_color, 
+    $natural_join, $join_pk_only, $skip_fields, $debug
+);
+
+GetOptions(
+    'd|db=s'           => \$db_driver,
+    'o|output:s'       => \$out_file,
+    'l|layout:s'       => \$layout,
+    'n|node-shape:s'   => \$node_shape,
+    't|output-type:s'  => \$output_type,
+    'color'            => \$add_color,
+    'natural-join'     => \$natural_join,
+    'natural-join-pk'  => \$join_pk_only,
+    's|skip:s'         => \$skip_fields,
+    'debug'            => \$debug,
+) or die pod2usage;
+my $file = shift @ARGV or pod2usage( -message => 'No input file' );
+
+pod2usage( -message => "No db driver specified" ) unless $db_driver;
+
+my %skip        = map { $_, 1 } split ( /,/, $skip_fields );
+$natural_join ||= $join_pk_only;
+$layout         = 'dot'     unless VALID_LAYOUT->{ $layout };
+$node_shape     = 'ellipse' unless VALID_NODE_SHAPE->{ $node_shape };
+$output_type    = 'png'     unless VALID_OUTPUT->{ $output_type };
+
+#
+# Create GraphViz and see if we can produce the output type.
+#
+my $gv            =  GraphViz->new(
+    directed      => $natural_join ? 0 : 1,
+    layout        => $layout,
+    no_overlap    => 1,
+    bgcolor       => $add_color ? 'lightgoldenrodyellow' : 'white',
+    node          => { 
+        shape     => $node_shape, 
+        style     => 'filled', 
+        fillcolor => 'white' 
+    },
+) or die "Can't create GraphViz object\n";
+
+#die "GraphViz cannot produce files of type '$output_type'\n" unless
+#    $gv->can( "as_$output_type" );
+
+#
+# Parse file.
+#
+warn "Parsing file '$file' with driver '$db_driver'\n" if $debug;
+
+my $t    = SQL::Translator->new( parser => $db_driver, producer => 'Raw' );
+my $data = $t->translate( $file ) or die $t->error;
+
+warn "Data =\n", Dumper( $data ), "\n" if $debug;
+
+my %nj_registry; # for locations of fields for natural joins
+my @fk_registry; # for locations of fields for foreign keys
+
+#
+# If necessary, pre-process fields to find foreign keys.
+#
+if ( $natural_join ) {
+    my ( %common_keys, %pk );
+    for my $table ( values %$data ) {
+        for my $index ( 
+            @{ $table->{'indices'}     || [] },
+            @{ $table->{'constraints'} || [] },
+        ) {
+            my @fields = @{ $index->{'fields'} || [] } or next;
+            if ( $index->{'type'} eq 'primary_key' ) {
+                $pk{ $_ } = 1 for @fields;
+            }
+        }
+
+        for my $field ( values %{ $table->{'fields'} } ) {
+            push @{ $common_keys{ $field->{'name'} } }, $table->{'table_name'};
+        }
+    }
+
+    for my $field ( keys %common_keys ) {
+        my @tables = @{ $common_keys{ $field } };
+        next unless scalar @tables > 1;
+        for my $table ( @tables ) {
+            next if $join_pk_only and !defined $pk{ $field };
+            $data->{ $table }{'fields'}{ $field }{'is_fk'} = 1;
+        }
+    }
+}
+
+for my $table (
+    map  { $_->[1] }
+    sort { $a->[0] <=> $b->[0] }
+    map  { [ $_->{'order'}, $_ ] }
+    values %$data 
+) {
+    my $table_name = $table->{'table_name'};
+    $gv->add_node( $table_name );
+
+    warn "Processing table '$table_name'\n" if $debug;
+
+    my @fields = 
+        map  { $_->[1] }
+        sort { $a->[0] <=> $b->[0] }
+        map  { [ $_->{'order'}, $_ ] }
+        values %{ $table->{'fields'} };
+
+    warn "Fields = ", join(', ', map { $_->{'name'} } @fields), "\n" if $debug;
+
+    my ( %pk, %unique );
+    for my $index ( 
+        @{ $table->{'indices'}     || [] },
+        @{ $table->{'constraints'} || [] },
+    ) {
+        my @fields = @{ $index->{'fields'} || [] } or next;
+        if ( $index->{'type'} eq 'primary_key' ) {
+            $pk{ $_ } = 1 for @fields;
+        }
+        elsif ( $index->{'type'} eq 'unique' ) {
+            $unique{ $_ } = 1 for @fields;
+        }
+    }
+
+    warn "Primary keys = ", join(', ', sort keys %pk), "\n" if $debug;
+    warn "Unique = ", join(', ', sort keys %unique), "\n" if $debug;
+
+    for my $f ( @fields ) {
+        my $name      = $f->{'name'} or next;
+        my $is_pk     = $pk{ $name };
+        my $is_unique = $unique{ $name };
+
+        #
+        # Decide if we should skip this field.
+        #
+        if ( $natural_join ) {
+            next unless $is_pk || $f->{'is_fk'};
+        }
+        else {
+            next unless $is_pk ||
+                grep { $_->{'type'} eq 'foreign_key' }
+                @{ $f->{'constraints'} }
+            ;
+        }
+
+        my $constraints = $f->{'constraints'};
+
+        if ( $natural_join && !$skip{ $name } ) {
+            push @{ $nj_registry{ $name } }, $table_name;
+        }
+        elsif ( @{ $constraints || [] } ) {
+            for my $constraint ( @$constraints ) {
+                next unless $constraint->{'type'} eq 'foreign_key';
+                for my $fk_field ( 
+                    @{ $constraint->{'reference_fields'} || [] }
+                ) {
+                    my $fk_table = $constraint->{'reference_table'};
+                    next unless defined $data->{ $fk_table };
+                    push @fk_registry, [ $table_name, $fk_table ];
+                }
+            }
+        }
+    }
+}
+
+#
+# Make the connections.
+#
+my @table_bunches;
+if ( $natural_join ) {
+    for my $field_name ( keys %nj_registry ) {
+        my @table_names = @{ $nj_registry{ $field_name } || [] } or next;
+        next if scalar @table_names == 1;
+        push @table_bunches, [ @table_names ];
+    }
+}
+else {
+    @table_bunches = @fk_registry;
+}
+
+my %done;
+for my $bunch ( @table_bunches ) {
+    my @tables = @$bunch;
+
+    for my $i ( 0 .. $#tables ) {
+        my $table1 = $tables[ $i ];
+        for my $j ( 0 .. $#tables ) {
+            my $table2 = $tables[ $j ];
+            next if $table1 eq $table2;
+            next if $done{ $table1 }{ $table2 };
+            $gv->add_edge( $table1, $table2 );
+            $done{ $table1 }{ $table2 } = 1;
+            $done{ $table2 }{ $table1 } = 1;
+        }
+    }
+}
+
+#
+# Print the image.
+#
+my $output_method = "as_$output_type";
+if ( $out_file ) {
+    open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
+    print $fh $gv->$output_method;
+    close $fh;
+    print "Image written to '$out_file'.  Done.\n";
+}
+else {
+    print $gv->$output_method;
+}
+
+=pod
+
+=head1 AUTHOR
+
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
+
+=cut