[dbsrgits/SQL-Translator.git] / bin / auto-graph.pl

#!/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
Commit	Line	Data
036a7d3b	1	#!/usr/bin/perl
	2
	3	# $Id: auto-graph.pl,v 1.1 2003-04-03 19:30:48 kycl4rk Exp $
	4
	5	=head1 NAME
	6
	7	auto-graph.pl - Automatically create a graph from a database schema
	8
	9	=head1 SYNOPSIS
	10
	11	./auto-graph.pl -d\|--db=db_parser [options] schema.sql
	12
	13	Options:
	14
	15	-l\|--layout Layout schema for GraphViz
	16	("dot," "neato," "twopi"; default "dot")
	17	-n\|--node-shape Shape of the nodes ("record," "plaintext,"
	18	"ellipse," "circle," "egg," "triangle," "box,"
	19	"diamond," "trapezium," "parallelogram," "house,"
	20	"hexagon," "octagon," default "ellipse")
	21	-o\|--output Output file name (default STDOUT)
	22	-t\|--output-type Output file type ("canon", "text," "ps," "hpgl,"
	23	"pcl," "mif," "pic," "gd," "gd2," "gif," "jpeg,"
	24	"png," "wbmp," "cmap," "ismap," "imap," "vrml,"
	25	"vtx," "mp," "fig," "svg," "plain," default "png")
	26	--color Add colors
	27	--natural-join Perform natural joins
	28	--natural-join-pk Perform natural joins from primary keys only
	29	-s\|--skip Fields to skip in natural joins
	30	--debug Print debugging information
	31
	32	=head1 DESCRIPTION
	33
	34	This script will create a graph of your schema. Only the database
	35	driver argument (for SQL::Translator) is required. If no output file
	36	name is given, then image will be printed to STDOUT, so you should
	37	redirect the output into a file.
	38
	39	The default action is to assume the presence of foreign key
	40	relationships defined via "REFERNCES" or "FOREIGN KEY" constraints on
	41	the tables. If you are parsing the schema of a file that does not
	42	have these, you will find the natural join options helpful. With
	43	natural joins, like-named fields will be considered foreign keys.
	44	This can prove too permissive, however, as you probably don't want a
	45	field called "name" to be considered a foreign key, so you could
	46	include it in the "skip" option, and all fields called "name" will be
	47	excluded from natural joins. A more efficient method, however, might
	48	be to simply deduce the foriegn keys from primary keys to other fields
	49	named the same in other tables. Use the "natural-join-pk" option
	50	to acheive this.
	51
	52	If the schema defines foreign keys, then the graph produced will be
	53	directed showing the direction of the relationship. If the foreign
	54	keys are intuited via natural joins, the graph will be undirected.
	55
	56	=cut
	57
	58	use strict;
	59	use Data::Dumper;
	60	use Getopt::Long;
	61	use GraphViz;
	62	use Pod::Usage;
	63	use SQL::Translator;
	64
65	my $VERSION = (qw$Revision: 1.1 $)[-1];
66
67	use constant VALID_LAYOUT => {
68	dot => 1,
69	neato => 1,
70	twopi => 1,
71	};
72
73	use constant VALID_NODE_SHAPE => {
74	record => 1,
75	plaintext => 1,
76	ellipse => 1,
77	circle => 1,
78	egg => 1,
79	triangle => 1,
80	box => 1,
81	diamond => 1,
82	trapezium => 1,
83	parallelogram => 1,
84	house => 1,
85	hexagon => 1,
86	octagon => 1,
87	};
88
89	use constant VALID_OUTPUT => {
90	canon => 1,
91	text => 1,
92	ps => 1,
93	hpgl => 1,
94	pcl => 1,
95	mif => 1,
96	pic => 1,
97	gd => 1,
98	gd2 => 1,
99	gif => 1,
100	jpeg => 1,
101	png => 1,
102	wbmp => 1,
103	cmap => 1,
104	ismap => 1,
105	imap => 1,
106	vrml => 1,
107	vtx => 1,
108	mp => 1,
109	fig => 1,
110	svg => 1,
111	plain => 1,
112	};
113
114	#
115	# Get arguments.
116	#
117	my (
118	$layout, $node_shape, $out_file, $output_type, $db_driver, $add_color,
119	$natural_join, $join_pk_only, $skip_fields, $debug
120	);
121
122	GetOptions(
123	'd\|db=s' => \$db_driver,
124	'o\|output:s' => \$out_file,
125	'l\|layout:s' => \$layout,
126	'n\|node-shape:s' => \$node_shape,
127	't\|output-type:s' => \$output_type,
128	'color' => \$add_color,
129	'natural-join' => \$natural_join,
130	'natural-join-pk' => \$join_pk_only,
131	's\|skip:s' => \$skip_fields,
132	'debug' => \$debug,
133	) or die pod2usage;
134	my $file = shift @ARGV or pod2usage( -message => 'No input file' );
135
136	pod2usage( -message => "No db driver specified" ) unless $db_driver;
137
138	my %skip = map { $_, 1 } split ( /,/, $skip_fields );
139	$natural_join \|\|= $join_pk_only;
140	$layout = 'dot' unless VALID_LAYOUT->{ $layout };
141	$node_shape = 'ellipse' unless VALID_NODE_SHAPE->{ $node_shape };
142	$output_type = 'png' unless VALID_OUTPUT->{ $output_type };
143
144	#
145	# Create GraphViz and see if we can produce the output type.
146	#
147	my $gv = GraphViz->new(
148	directed => $natural_join ? 0 : 1,
149	layout => $layout,
150	no_overlap => 1,
151	bgcolor => $add_color ? 'lightgoldenrodyellow' : 'white',
152	node => {
153	shape => $node_shape,
154	style => 'filled',
155	fillcolor => 'white'
156	},
157	) or die "Can't create GraphViz object\n";
158
159	#die "GraphViz cannot produce files of type '$output_type'\n" unless
160	# $gv->can( "as_$output_type" );
161
162	#
163	# Parse file.
164	#
165	warn "Parsing file '$file' with driver '$db_driver'\n" if $debug;
166
167	my $t = SQL::Translator->new( parser => $db_driver, producer => 'Raw' );
168	my $data = $t->translate( $file ) or die $t->error;
169
170	warn "Data =\n", Dumper( $data ), "\n" if $debug;
171
172	my %nj_registry; # for locations of fields for natural joins
173	my @fk_registry; # for locations of fields for foreign keys
174
175	#
176	# If necessary, pre-process fields to find foreign keys.
177	#
178	if ( $natural_join ) {
179	my ( %common_keys, %pk );
180	for my $table ( values %$data ) {
181	for my $index (
182	@{ $table->{'indices'} \|\| [] },
183	@{ $table->{'constraints'} \|\| [] },
184	) {
185	my @fields = @{ $index->{'fields'} \|\| [] } or next;
186	if ( $index->{'type'} eq 'primary_key' ) {
187	$pk{ $_ } = 1 for @fields;
188	}
189	}
190
191	for my $field ( values %{ $table->{'fields'} } ) {
192	push @{ $common_keys{ $field->{'name'} } }, $table->{'table_name'};
193	}
194	}
195
196	for my $field ( keys %common_keys ) {
197	my @tables = @{ $common_keys{ $field } };
198	next unless scalar @tables > 1;
199	for my $table ( @tables ) {
200	next if $join_pk_only and !defined $pk{ $field };
201	$data->{ $table }{'fields'}{ $field }{'is_fk'} = 1;
202	}
203	}
204	}
205
206	for my $table (
207	map { $_->[1] }
208	sort { $a->[0] <=> $b->[0] }
209	map { [ $_->{'order'}, $_ ] }
210	values %$data
211	) {
212	my $table_name = $table->{'table_name'};
213	$gv->add_node( $table_name );
214
215	warn "Processing table '$table_name'\n" if $debug;
216
217	my @fields =
218	map { $_->[1] }
219	sort { $a->[0] <=> $b->[0] }
220	map { [ $_->{'order'}, $_ ] }
221	values %{ $table->{'fields'} };
222
223	warn "Fields = ", join(', ', map { $_->{'name'} } @fields), "\n" if $debug;
224
225	my ( %pk, %unique );
226	for my $index (
227	@{ $table->{'indices'} \|\| [] },
228	@{ $table->{'constraints'} \|\| [] },
229	) {
230	my @fields = @{ $index->{'fields'} \|\| [] } or next;
231	if ( $index->{'type'} eq 'primary_key' ) {
232	$pk{ $_ } = 1 for @fields;
233	}
234	elsif ( $index->{'type'} eq 'unique' ) {
235	$unique{ $_ } = 1 for @fields;
236	}
237	}
238
239	warn "Primary keys = ", join(', ', sort keys %pk), "\n" if $debug;
240	warn "Unique = ", join(', ', sort keys %unique), "\n" if $debug;
241
242	for my $f ( @fields ) {
243	my $name = $f->{'name'} or next;
244	my $is_pk = $pk{ $name };
245	my $is_unique = $unique{ $name };
246
247	#
248	# Decide if we should skip this field.
249	#
250	if ( $natural_join ) {
251	next unless $is_pk \|\| $f->{'is_fk'};
252	}
253	else {
254	next unless $is_pk \|\|
255	grep { $_->{'type'} eq 'foreign_key' }
256	@{ $f->{'constraints'} }
257	;
258	}
259
260	my $constraints = $f->{'constraints'};
261
262	if ( $natural_join && !$skip{ $name } ) {
263	push @{ $nj_registry{ $name } }, $table_name;
264	}
265	elsif ( @{ $constraints \|\| [] } ) {
266	for my $constraint ( @$constraints ) {
267	next unless $constraint->{'type'} eq 'foreign_key';
268	for my $fk_field (
269	@{ $constraint->{'reference_fields'} \|\| [] }
270	) {
271	my $fk_table = $constraint->{'reference_table'};
272	next unless defined $data->{ $fk_table };
273	push @fk_registry, [ $table_name, $fk_table ];
274	}
275	}
276	}
277	}
278	}
279
280	#
281	# Make the connections.
282	#
283	my @table_bunches;
284	if ( $natural_join ) {
285	for my $field_name ( keys %nj_registry ) {
286	my @table_names = @{ $nj_registry{ $field_name } \|\| [] } or next;
287	next if scalar @table_names == 1;
288	push @table_bunches, [ @table_names ];
289	}
290	}
291	else {
292	@table_bunches = @fk_registry;
293	}
294
295	my %done;
296	for my $bunch ( @table_bunches ) {
297	my @tables = @$bunch;
298
299	for my $i ( 0 .. $#tables ) {
300	my $table1 = $tables[ $i ];
301	for my $j ( 0 .. $#tables ) {
302	my $table2 = $tables[ $j ];
303	next if $table1 eq $table2;
304	next if $done{ $table1 }{ $table2 };
305	$gv->add_edge( $table1, $table2 );
306	$done{ $table1 }{ $table2 } = 1;
307	$done{ $table2 }{ $table1 } = 1;
308	}
309	}
310	}
311
312	#
313	# Print the image.
314	#
315	my $output_method = "as_$output_type";
316	if ( $out_file ) {
317	open my $fh, ">$out_file" or die "Can't write '$out_file': $!\n";
318	print $fh $gv->$output_method;
319	close $fh;
320	print "Image written to '$out_file'. Done.\n";
321	}
322	else {
323	print $gv->$output_method;
324	}
325
326	=pod
327
328	=head1 AUTHOR
329
330	Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
331
332	=cut