################################################################
# AutoDIA - Automatic Dia XML. (C)Copyright 2001 A Trevena #
# #
# AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file #
# This is free software, and you are welcome to redistribute #
# it under certain conditions; see COPYING file for details #
################################################################
package Autodia::Handler::DBI;
require Exporter;
use strict;
use warnings;
use warnings::register;
use vars qw($VERSION @ISA @EXPORT);
use Autodia::Handler;
@ISA = qw(Autodia::Handler Exporter);
use Autodia::Diagram;
use Data::Dumper;
use DBI;
#---------------------------------------------------------------
#####################
# Constructor Methods
# new inherited from Autodia::Handler
#------------------------------------------------------------------------
# Access Methods
# parse_file inherited from Autodia::Handler
#-----------------------------------------------------------------------------
# Internal Methods
# _initialise inherited from Autodia::Handler
sub _parse_file { # parses dbi-connection string
my $self = shift();
my $filename = shift();
my %config = %{$self->{Config}};
$self->{Diagram}->directed(0);
# new dbi connection
my $dbh = DBI->connect("DBI:$filename", $config{username}, $config{password});
my $escape_tablenames = 0;
my $unescape_tablenames=0;
my $database_type = $dbh->get_info( 17 );
warn "database_type : $database_type\n";
my ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn) = DBI->parse_dsn("DBI:$filename") or die "Can't parse DBI DSN '$filename'";
my $dbname;
if ($driver_dsn =~ m/(?:db|dbname)=([^\:]+)/) {
$dbname = $1;
} else {
( $dbname = $driver_dsn) =~ s/([^\:]+)/$1/;
}
my $schema = '' ;
# only keep tables in schema public for PostgreSQL
# could be given as a parameter... (+ a list of tables...)
$schema = 'public' if (lc($database_type) =~ m/(oracle|postgres)/);
# Manage database tablenames that need to be escaped before calling DBI
# and those that need to be unescaped before calling DBI
$escape_tablenames = 1 if (lc($database_type) =~ m/(oracle|postgres)/);
$unescape_tablenames = 1 if (lc($database_type) =~ m/(mysql)/);
# pre-process tables
foreach my $table ($dbh->tables(undef, $schema, '%', '')) {
$table =~ s/['`"]//g;
$table =~ s/.*\.(.*)$/$1/;
my $esc_table = $table;
$esc_table = qq{"$esc_table"} if ($escape_tablenames);
my $sth = $dbh->prepare("select * from $esc_table where 1 = 0");
$sth->execute;
$self->{tables}{$table}{fields} = $sth->{NAME};
$sth->finish;
}
# got to about here applying dbi datatypes patch
foreach my $table (keys %{$self->{tables}}) {
# create new 'class' representing table
my $Class = Autodia::Diagram::Class->new($table);
# add 'class' to diagram
$self->{Diagram}->add_class($Class);
# get fields
my $esc_table = $table;
$esc_table = qq{"${dbname}.$esc_table"} if ($escape_tablenames);
warn "using dbname $dbname / table $esc_table\n";
my @key_columns;
my $primary_key = { name=>'Key', type=>'Primary', Params=>[], visibility=>0, };
my $sth = $dbh->primary_key_info( $schema || undef, $dbname, $esc_table );
if (defined $sth) {
@key_columns = keys %{$sth->fetchall_hashref('COLUMN_NAME')};
} else {
warn "trying dbh -> primary key method using schema $schema, dbname : $dbname, table $esc_table\n";
# from DBIx::Class::Schema::Loader::DBI / Rose::DBI
@key_columns = map { lc } $dbh->primary_key($schema || undef, $dbname, $esc_table);
}
warn "got key columns for table $esc_table : @key_columns\n";
if (@key_columns) {
push (@{$primary_key->{Params}}, map ({ Name=>$_, Type=>''}, @key_columns));
$Class->add_operation($primary_key);
}
# FIXME : need to subclass db's that don't work
# try using DBD, then use subclass to do horrid hacks
my $guess_foreign_keys = 1;
# get foreign keys
$sth = $dbh->foreign_key_info( $schema || undef, $dbname, '', $schema || undef, $dbname, $esc_table );
if ($sth) {
my %rels;
my $i = 1; # for unnamed rels, which hopefully have only 1 column ...
while(my $raw_rel = $sth->fetchrow_arrayref) {
$guess_foreign_keys = 0 if ($guess_foreign_keys);
warn "got relation $raw_rel\n";
my $pk_tbl = $raw_rel->[2];
my $pk_col = lc $raw_rel->[3];
my $fk_col = lc $raw_rel->[7];
my $relid = ($raw_rel->[11] || ( "__dcsld__" . $i++ ));
$rels{$relid}->{tbl} = $pk_tbl;
$rels{$relid}->{cols}->{$pk_col} = $fk_col;
push(@{$self->{foreign_tables}{$pk_tbl}}, {field => $pk_col, table => $esc_table, class => $Class });
$Class->add_operation( { name=>'Key', type=>'Foreign', Params=>[ { Name => $pk_col }], visibility=>0, } );
}
$sth->finish;
}
for my $field (@{$self->{tables}{$table}{fields}}) {
my $sth = $dbh->column_info( $schema || undef, $dbname, $esc_table, $field );
my $field_info = $sth->fetchrow_hashref;
$Class->add_attribute({
name => $field,
visibility => 0,
type => $field_info->{TYPE_NAME},
});
if ($guess_foreign_keys) {
if (my $dep = $self->_guess_foreign_key($table, $field)) {
# fix - need to handle multiple relations per table
push(@{$self->{foreign_tables}{$dep}}, {field => $field, table => $esc_table, class => $Class });
$Class->add_operation( { name=>'Key', type=>'Foreign', Params=>[ { Name => $field, Type => $field_info->{TYPE_NAME}, }], visibility=>0, } );
}
}
}
}
# fix - need to handle multiple relations per table
foreach my $fk_table (keys %{$self->{foreign_tables}} ) {
foreach my $relation ( @{$self->{foreign_tables}{$fk_table}}) {
$self->_add_foreign_keytable($relation->{table},
$relation->{field},
$relation->{class},
$fk_table);
}
}
$dbh->disconnect;
}
sub _add_foreign_keytable {
my ($self,$table,$field,$Class,$dep) = @_;
my $Superclass = Autodia::Diagram::Superclass->new($dep);
my $exists_already = $self->{Diagram}->add_superclass($Superclass);
$Superclass = $exists_already if (ref $exists_already);
# create new relationship
my $Relationship = Autodia::Diagram::Relation->new($Class, $Superclass);
# add Relationship to superclass
$Superclass->add_relation($Relationship);
# add Relationship to class
$Class->add_relation($Relationship);
# add Relationship to diagram
$self->{Diagram}->add_relation($Relationship);
return;
}
sub _guess_foreign_key {
my ($self, $table, $field) = @_;
my $is_fk = undef;
$field =~ s/'"`//g;
if ($field =~ m/^(.*)_u?id$/i) {
my $foreign_table = $1;
unless ($foreign_table eq $table) {
$is_fk = $foreign_table if ($self->{tables}{$foreign_table});
}
} elsif (($field ne $table ) && ($self->{tables}{$field})) {
$is_fk = $field;
}
return $is_fk;
}
sub _discard_line
{
warn "not implemented\n";
return 0;
}
1;
###############################################################################
=head1 NAME
Autodia::Handler::DBI.pm - AutoDia handler for DBI connections
=head1 INTRODUCTION
This module parses the contents of a database through a dbi connection and builds a diagram
%language_handlers = { .. , dbi => "Autodia::Handler::DBI", .. };
=head1 CONSTRUCTION METHOD
use Autodia::Handler::DBI;
my $handler = Autodia::Handler::DBI->New(\%Config);
This creates a new handler using the Configuration hash to provide rules selected at the command line.
=head1 ACCESS METHODS
$handler->Parse($connection); # where connection includes full or dbi connection string
$handler->output(); # any arguments are ignored.
=cut