File Coverage

blib/lib/GraphViz/DBI.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package GraphViz::DBI;
2              
3             require 5.005_62;
4 1     1   588 use strict;
  1         2  
  1         27  
5 1     1   5 use warnings;
  1         2  
  1         22  
6              
7 1     1   5 use Carp;
  1         10  
  1         94  
8 1     1   1713 use GraphViz;
  0            
  0            
9              
10             our $AUTOLOAD;
11             our $VERSION = '0.02';
12              
13             sub new {
14             my $this = shift;
15             my $class = ref($this) || $this;
16             my $self = {};
17             bless $self, $class;
18             $self->_init(@_);
19             return $self;
20             }
21              
22             sub _init {
23             my $self = shift;
24             $self->set_dbh(+shift) if @_;
25             $self->{g} = GraphViz->new();
26             }
27              
28             sub set_dbh {
29             my ($self, $dbh) = @_;
30             $self->{dbh} = $dbh;
31             return $self;
32             }
33              
34             sub get_dbh {
35             my $self = shift;
36             return $self->{dbh};
37             }
38              
39             sub get_tables {
40             my $self = shift;
41             $self->{tables} ||= [ $self->get_dbh->tables ];
42             return @{ $self->{tables} };
43             }
44              
45             sub is_table {
46             my ($self, $table) = @_;
47             $self->{is_table} ||= { map { $_ => 1 } $self->get_tables };
48             return $self->{is_table}{$table};
49             }
50              
51             sub is_foreign_key {
52             # if the field name is of the form "_id" and
53             # "" is an actual table in the database, treat
54             # this as a foreign key.
55             # This is my convention; override it to suit your needs.
56              
57             my ($self, $table, $field) = @_;
58             return if $field =~ /$table[_-]id/i;
59             return unless $field =~ /^(.*)[_-]id$/i;
60             my $candidate = $1;
61             return unless $self->is_table($candidate);
62             return $candidate;
63             }
64              
65             sub graph_tables {
66             my $self = shift;
67              
68             my %table = map { $_ => 1 } $self->get_tables;
69              
70             for my $table ($self->get_tables) {
71             my $sth = $self->get_dbh->prepare(
72             "select * from $table where 1 = 0");
73             $sth->execute;
74             my @fields = @{ $sth->{NAME} };
75             $sth->finish;
76              
77             my $label = "{$table|";
78              
79             for my $field (@fields) {
80             $label .= $field.'\l';
81             if (my $dep = $self->is_foreign_key($table, $field)) {
82             $self->{g}->add_edge({ from => $table, to => $dep });
83             }
84             }
85             $self->{g}->add_node({ name => $table,
86             shape => 'record',
87             label => "$label}",
88             });
89              
90             }
91             return $self->{g};
92             }
93              
94             sub AUTOLOAD {
95             my $self = shift;
96             my $type = ref($self) or croak "$self is not an object";
97              
98             (my $name = $AUTOLOAD) =~ s/.*:://;
99             return if $name =~ /DESTROY/;
100              
101             # hm, maybe GraphViz knows what to do with it...
102             $self->{g}->$name(@_);
103             }
104              
105             1;
106             __END__