File Coverage

blib/lib/Autodia/Handler/DBI.pm

Criterion	Covered	Total	%
statement	22	24	91.6
branch			n/a
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	30	32	93.7

################################################################
# 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