line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package GraphViz::DBI::FromSchema; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
GraphViz::DBI::FromSchema - Create a diagram of database tables, using the |
6
|
|
|
|
|
|
|
foreign key information in the schema |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 SYNOPSIS |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
use DBI; |
11
|
|
|
|
|
|
|
use GraphViz::DBI::FromSchema; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
my $db = DBI->connect(@dsn_etc); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
my $filename = 'DB_diagram.ps'; |
16
|
|
|
|
|
|
|
open my $file, '>', $filename or die "Opening $filename failed: $!\n"; |
17
|
|
|
|
|
|
|
print $file GraphViz::DBI::FromSchema->new($db)->graph_tables->as_ps; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=cut |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
|
22
|
1
|
|
|
1
|
|
24389
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
35
|
|
23
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
42
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
|
26
|
1
|
|
|
1
|
|
7
|
use base qw; |
|
1
|
|
|
|
|
6
|
|
|
1
|
|
|
|
|
1049
|
|
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
our $VERSION = 0.5; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 DESCRIPTION |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
This module creates a diagram of the tables in a database, listing the fields |
34
|
|
|
|
|
|
|
in each table and with arrows indicating foreign keys between tables. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
Note if you simply wish to create a diagram for a database and save it to a |
37
|
|
|
|
|
|
|
file, the provided L command does this. You only need to use |
38
|
|
|
|
|
|
|
this module if you want to manipulate the diagram programmatically. |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
L provides functionality for creating database diagrams. By |
41
|
|
|
|
|
|
|
default it identifies foreign keys based on fields being named in a particular |
42
|
|
|
|
|
|
|
way, and suggests subclassing it to implement different heuristics. This |
43
|
|
|
|
|
|
|
module is a subclass which uses the L to interrogate the database about |
44
|
|
|
|
|
|
|
the foreign keys defined for each table -- which, for databases which support |
45
|
|
|
|
|
|
|
referential integrity, should work irrespective of your naming scheme. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
The interface is identical to L's, so see its documentation for |
48
|
|
|
|
|
|
|
details. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=cut |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
{ |
53
|
|
|
|
|
|
|
my %column_name_name = |
54
|
|
|
|
|
|
|
( |
55
|
|
|
|
|
|
|
PKTABLE_NAME => 'FKCOLUMN_NAME', |
56
|
|
|
|
|
|
|
UK_TABLE_NAME => 'FK_COLUMN_NAME', |
57
|
|
|
|
|
|
|
); |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub is_foreign_key { |
61
|
0
|
|
|
0
|
0
|
|
my ($self, $table, $field) = @_; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# Grab all the foreign keys for this table (unless we've already done so): |
64
|
0
|
0
|
|
|
|
|
unless ($self->{foreign_key}{$table}) |
65
|
|
|
|
|
|
|
{ |
66
|
0
|
|
|
|
|
|
my $keys_query = $self->get_dbh |
67
|
|
|
|
|
|
|
->foreign_key_info(undef, undef, undef, undef, undef, $table); |
68
|
0
|
0
|
|
|
|
|
if ($keys_query) |
69
|
|
|
|
|
|
|
{ |
70
|
|
|
|
|
|
|
|
71
|
0
|
|
|
|
|
|
while (local $_ = $keys_query->fetchrow_hashref) |
72
|
|
|
|
|
|
|
{ |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# There are two different standards for the names of columns that could |
75
|
|
|
|
|
|
|
# be returned here, so try each of them in turn: |
76
|
0
|
|
|
|
|
|
while (my ($pk_table_name_name, $fk_column_name_name) |
77
|
|
|
|
|
|
|
= each %column_name_name) |
78
|
|
|
|
|
|
|
{ |
79
|
0
|
0
|
|
|
|
|
if ($_->{$pk_table_name_name}) |
80
|
|
|
|
|
|
|
{ |
81
|
0
|
|
|
|
|
|
$self->{foreign_key}{$table}{$_->{$fk_column_name_name}} |
82
|
|
|
|
|
|
|
= $_->{$pk_table_name_name}; |
83
|
0
|
|
|
|
|
|
last; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
0
|
|
|
|
|
|
$self->{foreign_key}{$table}{$field}; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=head2 Printing Large Diagrams |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
For reasonably sized databases, the diagrams generated by this module can be |
101
|
|
|
|
|
|
|
too large to fit on to paper that fits in your printer. Unix has a C |
102
|
|
|
|
|
|
|
command which can help with this, splitting a large diagram up into 'tiles' |
103
|
|
|
|
|
|
|
printed on separate sheets, complete with crop marks for trimming and |
104
|
|
|
|
|
|
|
assembling into a giant poster. Sample usage: |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
$ poster -m A4 -s 0.45 DB_diagram_big.ps > DB_diagram_A4.ps |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head2 Fixing Table Names |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
The table names retrieved by C can suffer from a couple of |
111
|
|
|
|
|
|
|
problems: |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=over 2 |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=item * |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
They are prefixed by the database name (and a dot). |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=item * |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
With MySQL they are surrounded by backticks. There are several reports of this |
122
|
|
|
|
|
|
|
in the C RT queue. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=back |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Both of these get in the way of matching up foreign keys with the tables they |
127
|
|
|
|
|
|
|
reference, so this module overrides fetching the list of table names to remove |
128
|
|
|
|
|
|
|
them. It's currently hacky and fragile; I'm planning on improving this. |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=cut |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub get_tables |
134
|
|
|
|
|
|
|
{ |
135
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
136
|
|
|
|
|
|
|
|
137
|
0
|
|
|
|
|
|
my $db = $self->get_dbh; |
138
|
0
|
|
|
|
|
|
my $driver = $db->{Driver}{Name}; |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
# TODO See if there's a better way round this, such as filtering out bogus |
141
|
|
|
|
|
|
|
# rows from the return call before stripping the leading parts off. If we |
142
|
|
|
|
|
|
|
# need to switch on driver type then use subclasses, not hardcoding all the |
143
|
|
|
|
|
|
|
# logic in here: |
144
|
0
|
|
|
|
|
|
my $schema; |
145
|
0
|
0
|
|
|
|
|
$schema = 'public' if $driver eq 'Pg'; |
146
|
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
$self->{tables} ||= [map |
148
|
|
|
|
|
|
|
{ |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# TODO Get the separator char from DBI, rather than presuming dot: |
151
|
0
|
|
0
|
|
|
|
s/ .* \. //x; |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# TODO Work out what to do here. Maybe quote table names returned by |
154
|
|
|
|
|
|
|
# foreign_key_info rather than unquoting them here. Deal with table names |
155
|
|
|
|
|
|
|
# that are also keywords, and with Postgres only quoting those that need to |
156
|
|
|
|
|
|
|
# be and MySQL quoting everything by default. |
157
|
0
|
0
|
|
|
|
|
tr/`//d if $driver eq 'mysql'; |
158
|
|
|
|
|
|
|
|
159
|
0
|
|
|
|
|
|
$_; |
160
|
|
|
|
|
|
|
} $self->get_dbh->tables(undef, $schema, undef, undef)]; |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
# TODO Option to include views or not? ('table' as final param) |
163
|
|
|
|
|
|
|
|
164
|
0
|
|
|
|
|
|
@{$self->{tables}}; |
|
0
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
=head1 FUTURE PLANS |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
In the common case where you have a C object and you want a diagram (like |
170
|
|
|
|
|
|
|
in the L) it's irritating to have deal with the |
171
|
|
|
|
|
|
|
C object, which is really an implementation detail. |
172
|
|
|
|
|
|
|
So it may be worth creating a functional interface to hide this. |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
It may further make sense to have a function which saves the diagram to a file |
175
|
|
|
|
|
|
|
as well, since that's likely to be what people want to do with it. |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
=head1 CAVEATS |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
This has been developed and tried out with Postgres and MySQL. It should work |
180
|
|
|
|
|
|
|
with other database software, but given there are some differences between |
181
|
|
|
|
|
|
|
MySQL and Postgres, others may have further differences which are not yet taken |
182
|
|
|
|
|
|
|
into account. |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
The L described above may be a bad |
185
|
|
|
|
|
|
|
idea, or not work in some circumstances. Arguably this should be done in |
186
|
|
|
|
|
|
|
C rather than here. |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
This module is lacking substantive tests, because of the difficulty of |
189
|
|
|
|
|
|
|
automatically testing something which needs a database and generates graphical |
190
|
|
|
|
|
|
|
output. Suggestions on what to do about this welcome. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=head1 SEE ALSO |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=over 2 |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=item * |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
L, which provides most of the functionality |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=back |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=head1 CREDITS |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
Written by Ovid and Smylers at Webfusion, |
205
|
|
|
|
|
|
|
L. |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
Maintained by Smylers |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
Thanks to Marcel GrEnauer for writing C. |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENCE |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
Copyright 2007-2008 by Pipex Communications UK Ltd, 2008-2011 Webfusion Ltd |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
This library is software libre; you may redistribute it and modify it under the |
216
|
|
|
|
|
|
|
terms of any of these licences: |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=over 2 |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=item * |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
L |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=item * |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
The GNU General Public License, version 3 |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=item * |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
L |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=item * |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
The Artistic License 2.0 |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=back |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=cut |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
1; |