#!/usr/bin/perl
-# $Id: auto-graph.pl,v 1.1 2003-04-03 19:30:48 kycl4rk Exp $
+# $Id: auto-graph.pl,v 1.2 2003-04-24 16:14:07 kycl4rk Exp $
=head1 NAME
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,
-};
+my $VERSION = (qw$Revision: 1.2 $)[-1];
#
# Get arguments.
#
my (
$layout, $node_shape, $out_file, $output_type, $db_driver, $add_color,
- $natural_join, $join_pk_only, $skip_fields, $debug
+ $natural_join, $join_pk_only, $skip_fields, $debug, $help
);
GetOptions(
'natural-join-pk' => \$join_pk_only,
's|skip:s' => \$skip_fields,
'debug' => \$debug,
+ 'h|help' => \$help,
) or die pod2usage;
-my $file = shift @ARGV or pod2usage( -message => 'No input file' );
+my @files = @ARGV; # the create script(s) for the original db
+pod2usage(1) if $help;
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'
+pod2usage( -message => 'No input file' ) unless @files;
+
+my $translator = SQL::Translator->new(
+ from => $db_driver,
+ to => 'GraphViz',
+ debug => $debug || 0,
+ producer_args => {
+ out_file => $out_file,
+ layout => $layout,
+ node_shape => $node_shape,
+ output_type => $output_type,
+ add_color => $add_color,
+ natural_join => $natural_join,
+ natural_join_pk => $join_pk_only,
+ skip_fields => $skip_fields,
},
-) 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 );
+) or die SQL::Translator->error;
- 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;
- }
+for my $file (@files) {
+ my $output = $translator->translate( $file ) or die
+ "Error: " . $translator->error;
+ if ( $out_file ) {
+ print "Image written to '$out_file'. Done.\n";
}
-
- 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 ];
- }
- }
- }
+ else {
+ print $output;
}
}
-#
-# 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
projects / dbsrgits/SQL-Translator.git / commitdiff