File Coverage

blib/lib/DBIx/Admin/TableInfo.pm
Criterion Covered Total %
statement 9 85 10.5
branch 0 26 0.0
condition 0 14 0.0
subroutine 3 9 33.3
pod 4 5 80.0
total 16 139 11.5


line stmt bran cond sub pod time code
1             package DBIx::Admin::TableInfo;
2              
3 1     1   15803 use strict;
  1         1  
  1         32  
4 1     1   4 use warnings;
  1         1  
  1         21  
5              
6 1     1   484 use Moo;
  1         11210  
  1         5  
7              
8             has catalog =>
9             (
10             is => 'rw',
11             default => sub{return undef},
12             required => 0,
13             );
14              
15             has dbh =>
16             (
17             is => 'rw',
18             isa => sub{die "The 'dbh' parameter to new() is mandatory\n" if (! $_[0])},
19             default => sub{return ''},
20             required => 1,
21             );
22              
23             has info =>
24             (
25             is => 'rw',
26             default => sub{return {} },
27             required => 0,
28             );
29              
30             has schema =>
31             (
32             is => 'rw',
33             default => sub{return undef}, # See BUILD().
34             required => 0,
35             );
36              
37             has table =>
38             (
39             is => 'rw',
40             default => sub{return '%'},
41             required => 0,
42             );
43              
44             has type =>
45             (
46             is => 'rw',
47             default => sub{return 'TABLE'},
48             required => 0,
49             );
50              
51             our $VERSION = '3.01';
52              
53             # -----------------------------------------------
54              
55             sub BUILD
56             {
57 0     0 0   my($self) = @_;
58              
59 0 0         $self -> schema(dbh2schema($self -> dbh) ) if (! defined $self -> schema);
60 0           $self -> _info;
61              
62             } # End of BUILD.
63              
64             # -----------------------------------------------
65              
66             sub columns
67             {
68 0     0 1   my($self, $table, $by_position) = @_;
69 0           my($info) = $self -> info;
70              
71 0 0         if ($by_position)
72             {
73 0           return [sort{$$info{$table}{columns}{$a}{ORDINAL_POSITION} <=> $$info{$table}{columns}{$b}{ORDINAL_POSITION} } keys %{$$info{$table}{columns} }];
  0            
  0            
74             }
75             else
76             {
77 0           return [sort{$a cmp $b} keys %{$$info{$table}{columns} }];
  0            
  0            
78             }
79              
80             } # End of columns.
81              
82             # -----------------------------------------------
83             # Warning: This is a function, not a method.
84              
85             sub dbh2schema
86             {
87 0     0 1   my($dbh) = @_;
88 0           my($vendor) = uc $dbh -> get_info(17); # SQL_DBMS_NAME.
89 0           my(%schema) =
90             (
91             MYSQL => undef,
92             ORACLE => uc $$dbh{Username},
93             POSTGRESQL => 'public',
94             SQLITE => 'main',
95             );
96              
97 0           return $schema{$vendor};
98              
99             } # End of dbh2schema.
100              
101             # -----------------------------------------------
102              
103             sub _info
104             {
105 0     0     my($self) = @_;
106 0           my($info) = {};
107 0           my($vendor) = uc $self -> dbh -> get_info(17); # SQL_DBMS_NAME.
108 0           my($table_sth) = $self -> dbh -> table_info($self -> catalog, $self -> schema, $self -> table, $self -> type);
109              
110 0           my($column_data, $column_name, $column_sth, $count);
111 0           my($foreign_table);
112 0           my($primary_key_info);
113 0           my($table_data, $table_name, @table_name);
114              
115 0           while ($table_data = $table_sth -> fetchrow_hashref() )
116             {
117 0           $table_name = $$table_data{TABLE_NAME};
118              
119 0 0 0       next if ( ($vendor eq 'ORACLE') && ($table_name =~ /^BIN\$.+\$./) );
120 0 0 0       next if ( ($vendor eq 'POSTGRESQL') && ($table_name =~ /^(?:pg_|sql_)/) );
121 0 0 0       next if ( ($vendor eq 'SQLITE') && ($table_name eq 'sqlite_sequence') );
122              
123 0           $$info{$table_name} =
124             {
125             attributes => {%$table_data},
126             columns => {},
127             foreign_keys => {},
128             primary_keys => {},
129             };
130 0           $column_sth = $self -> dbh -> column_info($self -> catalog, $self -> schema, $table_name, '%');
131 0           $primary_key_info = [];
132              
133 0           push @table_name, $table_name;
134              
135 0           while ($column_data = $column_sth -> fetchrow_hashref() )
136             {
137 0           $column_name = $$column_data{COLUMN_NAME};
138 0           $$info{$table_name}{columns}{$column_name} = {%$column_data};
139              
140 0 0 0       push @$primary_key_info, $column_name if ( ($vendor eq 'MYSQL') && $$column_data{mysql_is_pri_key});
141             }
142              
143 0 0         if ($vendor eq 'MYSQL')
144             {
145 0           $count = 0;
146              
147 0           for (@$primary_key_info)
148             {
149 0           $count++;
150              
151 0 0         $$info{$table_name}{primary_keys}{$_} = {} if (! $$info{$table_name}{primary_keys}{$_});
152 0           $$info{$table_name}{primary_keys}{$_}{COLUMN_NAME} = $_;
153 0           $$info{$table_name}{primary_keys}{$_}{KEY_SEQ} = $count;
154             }
155             }
156             else
157             {
158 0           $column_sth = $self -> dbh -> primary_key_info($self -> catalog, $self -> schema, $table_name);
159              
160 0 0         if (defined $column_sth)
161             {
162 0           for $column_data (@{$column_sth -> fetchall_arrayref({})})
  0            
163             {
164 0           $$info{$table_name}{primary_keys}{$$column_data{COLUMN_NAME} } = {%$column_data};
165             }
166             }
167             }
168             }
169              
170 0           my(%referential_action) =
171             (
172             'CASCADE' => 0,
173             'RESTRICT' => 1,
174             'SET NULL' => 2,
175             'NO ACTION' => 3,
176             'SET DEFAULT' => 4,
177             );
178              
179 0           for $table_name (@table_name)
180             {
181 0           $$info{$table_name}{foreign_keys} = [];
182              
183 0           for $foreign_table (grep{! /^$table_name$/} @table_name)
  0            
184             {
185 0 0         if ($vendor eq 'SQLITE')
186             {
187 0           for my $row (@{$self -> dbh -> selectall_arrayref("pragma foreign_key_list($foreign_table)")})
  0            
188             {
189 0 0         next if ($$row[2] ne $table_name);
190              
191 0           push @{$$info{$table_name}{foreign_keys} },
  0            
192             {
193             DEFERABILITY => undef,
194             DELETE_RULE => $referential_action{$$row[6]},
195             FK_COLUMN_NAME => $$row[3],
196             FK_DATA_TYPE => undef,
197             FK_NAME => undef,
198             FK_TABLE_CAT => undef,
199             FK_TABLE_NAME => $foreign_table,
200             FK_TABLE_SCHEM => undef,
201             ORDINAL_POSITION => $$row[1],
202             UK_COLUMN_NAME => $$row[4],
203             UK_DATA_TYPE => undef,
204             UK_NAME => undef,
205             UK_TABLE_CAT => undef,
206             UK_TABLE_NAME => $$row[2],
207             UK_TABLE_SCHEM => undef,
208             UNIQUE_OR_PRIMARY => undef,
209             UPDATE_RULE => $referential_action{$$row[5]},
210             };
211             }
212             }
213             else
214             {
215 0   0       $table_sth = $self -> dbh -> foreign_key_info($self -> catalog, $self -> schema, $table_name, $self -> catalog, $self -> schema, $foreign_table) || next;
216              
217 0 0         if ($vendor eq 'MYSQL')
218             {
219 0           my($hashref) = $table_sth->fetchall_hashref(['PKTABLE_NAME']);
220              
221 0 0         push @{$$info{$table_name}{foreign_keys} }, $$hashref{$table_name} if ($$hashref{$table_name});
  0            
222             }
223             else
224             {
225 0           for $column_data (@{$table_sth -> fetchall_arrayref({})})
  0            
226             {
227 0           push @{$$info{$table_name}{foreign_keys} }, {%$column_data};
  0            
228             }
229             }
230             }
231             }
232             }
233              
234 0           $self -> info($info);
235              
236             } # End of _info.
237              
238             # -----------------------------------------------
239              
240             sub refresh
241             {
242 0     0 1   my($self) = @_;
243              
244 0           $self -> _info();
245              
246 0           return $self -> info;
247              
248             } # End of refresh.
249              
250             # -----------------------------------------------
251              
252             sub tables
253             {
254 0     0 1   my($self) = @_;
255              
256 0           return [sort keys %{$self -> info}];
  0            
257              
258             } # End of tables.
259              
260             # -----------------------------------------------
261              
262             1;
263              
264             =head1 NAME
265              
266             DBIx::Admin::TableInfo - A wrapper for all of table_info(), column_info(), *_key_info()
267              
268             =head1 Synopsis
269              
270             This is scripts/synopsis.pl:
271              
272             #!/usr/bin/env perl
273              
274             use strict;
275             use warnings;
276              
277             use DBI;
278             use DBIx::Admin::TableInfo 2.10;
279              
280             use Lingua::EN::PluralToSingular 'to_singular';
281              
282             use Text::TabularDisplay;
283              
284             # ---------------------
285              
286             my($attr) = {};
287             $$attr{sqlite_unicode} = 1 if ($ENV{DBI_DSN} =~ /SQLite/i);
288             my($dbh) = DBI -> connect($ENV{DBI_DSN}, $ENV{DBI_USER}, $ENV{DBI_PASS}, $attr);
289             my($vendor_name) = uc $dbh -> get_info(17);
290             my($info) = DBIx::Admin::TableInfo -> new(dbh => $dbh) -> info;
291              
292             $dbh -> do('pragma foreign_keys = on') if ($ENV{DBI_DSN} =~ /SQLite/i);
293              
294             my($temp_1, $temp_2, $temp_3);
295              
296             if ($vendor_name eq 'MYSQL')
297             {
298             $temp_1 = 'PKTABLE_NAME';
299             $temp_2 = 'FKTABLE_NAME';
300             $temp_3 = 'FKCOLUMN_NAME';
301             }
302             else # ORACLE && POSTGRESQL && SQLITE (at least).
303             {
304             $temp_1 = 'UK_TABLE_NAME';
305             $temp_2 = 'FK_TABLE_NAME';
306             $temp_3 = 'FK_COLUMN_NAME';
307             }
308              
309             my(%special_fk_column) =
310             (
311             spouse_id => 'person_id',
312             );
313              
314             my($destination_port);
315             my($fk_column_name, $fk_table_name, %foreign_key);
316             my($pk_table_name, $primary_key_name);
317             my($singular_name, $source_port);
318              
319             for my $table_name (sort keys %$info)
320             {
321             for my $item (@{$$info{$table_name}{foreign_keys} })
322             {
323             $pk_table_name = $$item{$temp_1};
324             $fk_table_name = $$item{$temp_2};
325             $fk_column_name = $$item{$temp_3};
326              
327             if ($pk_table_name)
328             {
329             $singular_name = to_singular($pk_table_name);
330              
331             if ($special_fk_column{$fk_column_name})
332             {
333             $primary_key_name = $special_fk_column{$fk_column_name};
334             }
335             elsif (defined($$info{$table_name}{columns}{$fk_column_name}) )
336             {
337             $primary_key_name = $fk_column_name;
338             }
339             elsif (defined($$info{$table_name}{columns}{id}) )
340             {
341             $primary_key_name = 'id';
342             }
343             else
344             {
345             die "Primary table '$pk_table_name'. Foreign table '$fk_table_name'. Unable to find primary key name for foreign key '$fk_column_name'\n"
346             }
347              
348             $foreign_key{$fk_table_name} = {} if (! $foreign_key{$fk_table_name});
349             $foreign_key{$fk_table_name}{$fk_column_name} = {} if (! $foreign_key{$fk_table_name}{$fk_column_name});
350             $primary_key_name =~ s/${singular_name}_//;
351             $foreign_key{$fk_table_name}{$fk_column_name}{$table_name} = $primary_key_name;
352             }
353             }
354             }
355              
356             my(@header) =
357             (
358             'Name',
359             'Type',
360             'Null?',
361             'Key?',
362             'Auto increment?',
363             );
364             for my $table_name (sort keys %$info)
365             {
366             print "Table: $table_name: \n";
367              
368             my($table) = Text::TabularDisplay -> new(@header);
369              
370             my(@data);
371              
372             for my $column_name (sort map{s/^"(.+)"$/$1/; $_} keys %{$$info{$table_name}{columns} })
373             {
374             $table -> add
375             (
376             $column_name,
377             $$info{$table_name}{columns}{$column_name}{mysql_type_name},
378             $$info{$table_name}{columns}{$column_name}{IS_NULLABLE} eq 'NO' ? 'not null' : '',
379             $$info{$table_name}{columns}{$column_name}{mysql_is_pri_key} ? 'primary key' : '',
380             $$info{$table_name}{columns}{$column_name}{mysql_is_auto_increment} ? 'auto_increment' : '',
381             );
382             }
383              
384             print $table -> render, "\n\n";
385             }
386              
387             If the environment vaiables DBI_DSN, DBI_USER and DBI_PASS are set (the latter 2 are optional [e.g.
388             for SQLite), then this demonstrates extracting a lot of information from a database schema.
389              
390             Also, for Postgres, you can set DBI_SCHEMA to a list of schemas, e.g. when processing the
391             MusicBrainz database.
392              
393             For details, see L.
394              
395             See also xt/author/fk.t, xt/author/mysql.fk.pl and xt/author/person.spouse.t.
396              
397             =head1 Description
398              
399             C is a pure Perl module.
400              
401             It is a convenient wrapper around all of these DBI methods:
402              
403             =over 4
404              
405             =item o table_info()
406              
407             =item o column_info()
408              
409             =item o primary_key_info()
410              
411             =item o foreign_key_info()
412              
413             =back
414              
415             =over 4
416              
417             =item o MySQL
418              
419             Warning:
420              
421             To get foreign key information in the output, the create table statement has to:
422              
423             =over 4
424              
425             =item o Include an index clause
426              
427             =item o Include a foreign key clause
428              
429             =item o Include an engine clause
430              
431             As an example, a column definition for Postgres and SQLite, which looks like:
432              
433             site_id integer not null references sites(id),
434              
435             has to, for MySql, look like:
436              
437             site_id integer not null, index (site_id), foreign key (site_id) references sites(id),
438              
439             Further, the create table statement, which for Postgres and SQLite looks like:
440              
441             create table designs (...)
442              
443             has to, for MySql, look like:
444              
445             create table designs (...) engine=innodb
446              
447             =back
448              
449             =item o Oracle
450              
451             See the L for which tables are ignored under Oracle.
452              
453             =item o Postgres
454              
455             The latter now takes '%' as the value of the 'table' parameter to new(), whereas
456             older versions of DBD::Pg required 'table' to be set to 'table'.
457              
458             See the L for which tables are ignored under Postgres.
459              
460             =item o SQLite
461              
462             See the L for which tables are ignored under SQLite.
463              
464             =back
465              
466             =head1 Distributions
467              
468             This module is available both as a Unix-style distro (*.tgz) and an
469             ActiveState-style distro (*.ppd). The latter is shipped in a *.zip file.
470              
471             See http://savage.net.au/Perl-modules.html for details.
472              
473             See http://savage.net.au/Perl-modules/html/installing-a-module.html for
474             help on unpacking and installing each type of distro.
475              
476             =head1 Constructor and initialization
477              
478             new(...) returns a C object.
479              
480             This is the class contructor.
481              
482             Usage: DBIx::Admin::TableInfo -> new().
483              
484             This method takes a set of parameters. Only the dbh parameter is mandatory.
485              
486             For each parameter you wish to use, call new as new(param_1 => value_1, ...).
487              
488             =over 4
489              
490             =item o catalog
491              
492             This is the value passed in as the catalog parameter to table_info() and column_info().
493              
494             The default value is undef.
495              
496             undef was chosen because it given the best results with MySQL.
497              
498             Note: The MySQL driver DBD::mysql V 2.9002 has a bug in it, in that it aborts if an empty string is
499             used here, even though the DBI docs say an empty string can be used for the catalog parameter to
500             C.
501              
502             This parameter is optional.
503              
504             =item o dbh
505              
506             This is a database handle.
507              
508             This parameter is mandatory.
509              
510             =item o schema
511              
512             This is the value passed in as the schema parameter to table_info() and column_info().
513              
514             The default value is undef.
515              
516             Note: If you are using Oracle, call C with schema set to uc $user_name.
517              
518             Note: If you are using Postgres, call C with schema set to 'public'.
519              
520             Note: If you are using SQLite, call C with schema set to 'main'.
521              
522             This parameter is optional.
523              
524             =item o table
525              
526             This is the value passed in as the table parameter to table_info().
527              
528             The default value is '%'.
529              
530             Note: If you are using an 'old' version of DBD::Pg, call C with table set to 'table'.
531              
532             Sorry - I cannot tell you exactly what 'old' means. As stated above, the default value (%)
533             works fine with DBD::Pg V 2.17.1.
534              
535             This parameter is optional.
536              
537             =item o type
538              
539             This is the value passed in as the type parameter to table_info().
540              
541             The default value is 'TABLE'.
542              
543             This parameter is optional.
544              
545             =back
546              
547             =head1 Methods
548              
549             =head2 columns($table_name, $by_position)
550              
551             Returns an array ref of column names.
552              
553             By default they are sorted by name.
554              
555             However, if you pass in a true value for $by_position, they are sorted by the column attribute
556             ORDINAL_POSITION. This is Postgres-specific.
557              
558             =head2 dbh2schema($dbh)
559              
560             Warning: This is a function, not a method. It is called like this:
561              
562             my($schema) = DBIx::Admin::TableInfo::dbh2schema($dbh);
563              
564             The code is just:
565              
566             my($dbh) = @_;
567             my($vendor) = uc $dbh -> get_info(17); # SQL_DBMS_NAME.
568             my(%schema) =
569             (
570             MYSQL => undef,
571             ORACLE => uc $$dbh{Username},
572             POSTGRESQL => 'public',
573             SQLITE => 'main',
574             );
575              
576             return $schema{$vendor};
577              
578             =head2 info()
579              
580             Returns a hash ref of all available data.
581              
582             The structure of this hash is described next:
583              
584             =over 4
585              
586             =item o First level: The keys are the names of the tables
587              
588             my($info) = $obj -> info();
589             my(@table_name) = sort keys %$info;
590              
591             I use singular names for my arrays, hence @table_name rather than @table_names.
592              
593             =item o Second level: The keys are 'attributes', 'columns', 'foreign_keys' and 'primary_keys'
594              
595             my($table_attributes) = $$info{$table_name}{attributes};
596              
597             This is a hash ref of the attributes of the table.
598             The keys of this hash ref are determined by the database server.
599              
600             my($columns) = $$info{$table_name}{columns};
601              
602             This is a hash ref of the columns of the table. The keys of this hash ref are the names of the
603             columns.
604              
605             my($foreign_keys) = $$info{$table_name}{foreign_keys};
606              
607             This is a hash ref of the foreign keys of the table. The keys of this hash ref are the names of the
608             tables which contain foreign keys pointing to $table_name.
609              
610             For MySQL, $foreign_keys will be the empty hash ref {}, as explained above.
611              
612             my($primary_keys) = $$info{$table_name}{primary_keys};
613              
614             This is a hash ref of the primary keys of the table. The keys of this hash ref are the names of the
615             columns which make up the primary key of $table_name.
616              
617             For any database server, if there is more than 1 column in the primary key, they will be numbered
618             (ordered) according to the hash key 'KEY_SEQ'.
619              
620             For MySQL, if there is more than 1 column in the primary key, they will be artificially numbered
621             according to the order in which they are returned by C, as explained above.
622              
623             =item o Third level, after 'attributes': Table attributes
624              
625             my($table_attributes) = $$info{$table_name}{attributes};
626              
627             while ( ($name, $value) = each(%$table_attributes) )
628             {
629             Use...
630             }
631              
632             For the attributes of the tables, there are no more levels in the hash ref.
633              
634             =item o Third level, after 'columns': The keys are the names of the columns.
635              
636             my($columns) = $$info{$table_name}{columns};
637              
638             my(@column_name) = sort keys %$columns;
639              
640             =over 4
641              
642             =item o Fourth level: Column attributes
643              
644             for $column_name (@column_name)
645             {
646             while ( ($name, $value) = each(%{$columns{$column_name} }) )
647             {
648             Use...
649             }
650             }
651              
652             =back
653              
654             =item o Third level, after 'foreign_keys': An arrayref contains the details (if any)
655              
656             But beware slightly differing spellings depending on the database server. This is documented in
657             L. Look closely at the usage of the '_' character.
658              
659             my($vendor) = uc $dbh -> get_info(17); # SQL_DBMS_NAME.
660              
661             for $item (@{$$info{$table_name}{foreign_keys} })
662             {
663             # Get the name of the table pointed to.
664              
665             $primary_table = ($vendor eq 'MYSQL') ? $$item{PKTABLE_NAME} : $$item{UK_TABLE_NAME};
666             }
667              
668             =item o Third level, after 'primary_keys': The keys are the names of columns
669              
670             These columns make up the primary key of the current table.
671              
672             my($primary_keys) = $$info{$table_name}{primary_keys};
673              
674             for $primary_key (sort{$$a{KEY_SEQ} <=> $$b{KEY_SEQ} } keys %$primary_keys)
675             {
676             $primary = $$primary_keys{$primary_key};
677              
678             for $attribute (sort keys %$primary)
679             {
680             Use...
681             }
682             }
683              
684             =back
685              
686             =head2 refresh()
687              
688             Returns the same hash ref as info().
689              
690             Use this after changing the database schema, when you want this module to re-interrogate
691             the database server.
692              
693             =head2 tables()
694              
695             Returns an array ref of table names.
696              
697             They are sorted by name.
698              
699             See the L for which tables are ignored under which databases.
700              
701             =head1 Example code
702              
703             Here are tested parameter values for various database vendors:
704              
705             =over 4
706              
707             =item o MS Access
708              
709             my($admin) = DBIx::Admin::TableInfo -> new(dbh => $dbh);
710              
711             In other words, the default values for catalog, schema, table and type will Just Work.
712              
713             =item o MySQL
714              
715             my($admin) = DBIx::Admin::TableInfo -> new(dbh => $dbh);
716              
717             In other words, the default values for catalog, schema, table and type will Just Work.
718              
719             =item o Oracle
720              
721             my($dbh) = DBI -> connect($dsn, $username, $password);
722             my($admin) = DBIx::Admin::TableInfo -> new
723             (
724             dbh => $dbh,
725             schema => uc $username, # Yep, upper case.
726             );
727              
728             See the FAQ for which tables are ignored under Oracle.
729              
730             =item o PostgreSQL
731              
732             my($admin) = DBIx::Admin::TableInfo -> new
733             (
734             dbh => $dbh,
735             schema => 'public',
736             );
737              
738             For PostgreSQL, you probably want to ignore table names matching /^(pg_|sql_)/.
739              
740             As stated above, for 'old' versions of DBD::Pg, use:
741              
742             my($admin) = DBIx::Admin::TableInfo -> new
743             (
744             dbh => $dbh,
745             schema => 'public',
746             table => 'table', # Yep, lower case.
747             );
748              
749             See the FAQ for which tables are ignored under Postgres.
750              
751             =item o SQLite
752              
753             my($admin) = DBIx::Admin::TableInfo -> new
754             (
755             dbh => $dbh,
756             schema => 'main',
757             );
758              
759             In other words, the default values for catalog, table and type will Just Work.
760              
761             See the FAQ for which tables are ignored under SQLite.
762              
763             =back
764              
765             See the examples/ directory in the distro.
766              
767             =head1 FAQ
768              
769             =head2 Which versions of the servers did you test?
770              
771             Versions as at 2014-08-06:
772             +----------|-------------+
773             | Vendor | V |
774             +----------|-------------+
775             | MariaDB | 5.5.38 |
776             +----------|-------------+
777             | Oracle | 10.2.0.1.0 | (Not tested for years)
778             +----------|-------------+
779             | Postgres | 9.1.3 |
780             +----------|-------------+
781             | SQLite | 3.8.4.1 |
782             +----------|-------------+
783              
784             But see these L when using
785             MySQL/MariaDB.
786              
787             =head2 Which tables are ignored for which databases?
788              
789             Here is the code which skips some tables:
790              
791             next if ( ($vendor eq 'ORACLE') && ($table_name =~ /^BIN\$.+\$./) );
792             next if ( ($vendor eq 'POSTGRESQL') && ($table_name =~ /^(?:pg_|sql_)/) );
793             next if ( ($vendor eq 'SQLITE') && ($table_name eq 'sqlite_sequence') );
794              
795             =head2 How do I identify foreign keys?
796              
797             Note: The table names here come from xt/author/person.spouse.t.
798              
799             See L for database server-specific create statements to activate
800             foreign keys.
801              
802             Then try:
803              
804             my($info) = DBIx::Admin::TableInfo -> new(dbh => $dbh) -> info;
805              
806             print Data::Dumper::Concise::Dumper($$info{people}{foreign_keys}), "\n";
807              
808             Output follows.
809              
810             But beware slightly differing spellings depending on the database server. This is documented in
811             L. Look closely at the usage of the '_' character.
812              
813             =over 4
814              
815             =item o MySQL
816              
817             [
818             {
819             DEFERABILITY => undef,
820             DELETE_RULE => undef,
821             FKCOLUMN_NAME => "spouse_id",
822             FKTABLE_CAT => "def",
823             FKTABLE_NAME => "spouses",
824             FKTABLE_SCHEM => "testdb",
825             FK_NAME => "spouses_ibfk_2",
826             KEY_SEQ => 1,
827             PKCOLUMN_NAME => "id",
828             PKTABLE_CAT => undef,
829             PKTABLE_NAME => "people",
830             PKTABLE_SCHEM => "testdb",
831             PK_NAME => undef,
832             UNIQUE_OR_PRIMARY => undef,
833             UPDATE_RULE => undef
834             }
835             ]
836              
837             Yes, there is just 1 element in this arrayref. MySQL can sliently drop an index if another index
838             can be used.
839              
840             =item o Postgres
841              
842             [
843             {
844             DEFERABILITY => 7,
845             DELETE_RULE => 3,
846             FK_COLUMN_NAME => "person_id",
847             FK_DATA_TYPE => "int4",
848             FK_NAME => "spouses_person_id_fkey",
849             FK_TABLE_CAT => undef,
850             FK_TABLE_NAME => "spouses",
851             FK_TABLE_SCHEM => "public",
852             ORDINAL_POSITION => 1,
853             UK_COLUMN_NAME => "id",
854             UK_DATA_TYPE => "int4",
855             UK_NAME => "people_pkey",
856             UK_TABLE_CAT => undef,
857             UK_TABLE_NAME => "people",
858             UK_TABLE_SCHEM => "public",
859             UNIQUE_OR_PRIMARY => "PRIMARY",
860             UPDATE_RULE => 3
861             },
862             {
863             DEFERABILITY => 7,
864             DELETE_RULE => 3,
865             FK_COLUMN_NAME => "spouse_id",
866             FK_DATA_TYPE => "int4",
867             FK_NAME => "spouses_spouse_id_fkey",
868             FK_TABLE_CAT => undef,
869             FK_TABLE_NAME => "spouses",
870             FK_TABLE_SCHEM => "public",
871             ORDINAL_POSITION => 1,
872             UK_COLUMN_NAME => "id",
873             UK_DATA_TYPE => "int4",
874             UK_NAME => "people_pkey",
875             UK_TABLE_CAT => undef,
876             UK_TABLE_NAME => "people",
877             UK_TABLE_SCHEM => "public",
878             UNIQUE_OR_PRIMARY => "PRIMARY",
879             UPDATE_RULE => 3
880             }
881             ]
882              
883             =item o SQLite
884              
885             [
886             {
887             DEFERABILITY => undef,
888             DELETE_RULE => 3,
889             FK_COLUMN_NAME => "spouse_id",
890             FK_DATA_TYPE => undef,
891             FK_NAME => undef,
892             FK_TABLE_CAT => undef,
893             FK_TABLE_NAME => "spouses",
894             FK_TABLE_SCHEM => undef,
895             ORDINAL_POSITION => 0,
896             UK_COLUMN_NAME => "id",
897             UK_DATA_TYPE => undef,
898             UK_NAME => undef,
899             UK_TABLE_CAT => undef,
900             UK_TABLE_NAME => "people",
901             UK_TABLE_SCHEM => undef,
902             UNIQUE_OR_PRIMARY => undef,
903             UPDATE_RULE => 3
904             },
905             {
906             DEFERABILITY => undef,
907             DELETE_RULE => 3,
908             FK_COLUMN_NAME => "person_id",
909             FK_DATA_TYPE => undef,
910             FK_NAME => undef,
911             FK_TABLE_CAT => undef,
912             FK_TABLE_NAME => "spouses",
913             FK_TABLE_SCHEM => undef,
914             ORDINAL_POSITION => 0,
915             UK_COLUMN_NAME => "id",
916             UK_DATA_TYPE => undef,
917             UK_NAME => undef,
918             UK_TABLE_CAT => undef,
919             UK_TABLE_NAME => "people",
920             UK_TABLE_SCHEM => undef,
921             UNIQUE_OR_PRIMARY => undef,
922             UPDATE_RULE => 3
923             }
924             ]
925              
926             =back
927              
928             You can also play with xt/author/fk.t and xt/author/dsn.ini (especially the 'active' option).
929              
930             fk.t does not delete the tables as it exits. This is so xt/author/mysql.fk.pl has something to play
931             with.
932              
933             See also xt/author/person.spouse.t.
934              
935             =head2 Does DBIx::Admin::TableInfo work with SQLite databases?
936              
937             Yes. As of V 2.08, this module uses the SQLite code "pragma foreign_key_list($table_name)" to
938             emulate the L call to foreign_key_info(...).
939              
940             =head2 What is returned by the SQLite "pragma foreign_key_list($table_name)" call?
941              
942             An arrayref is returned. Indexes and their interpretations:
943              
944             0: COUNT (0, 1, ...)
945             1: KEY_SEQ (0, or column # (1, 2, ...) within multi-column key)
946             2: PK_TABLE_NAME
947             3: FK_COLUMN_NAME
948             4: PK_COLUMN_NAME
949             5: UPDATE_RULE
950             6: DELETE_RULE
951             7: 'NONE' (Constant string)
952              
953             As these are stored in an arrayref, I use $$row[$i] just below to refer to the elements of the
954             array.
955              
956             =head2 How are these values mapped into the output?
957              
958             See also the next point.
959              
960             my(%referential_action) =
961             (
962             'CASCADE' => 0,
963             'RESTRICT' => 1,
964             'SET NULL' => 2,
965             'NO ACTION' => 3,
966             'SET DEFAULT' => 4,
967             );
968              
969             The hashref returned for foreign keys contains these key-value pairs:
970              
971             {
972             DEFERABILITY => undef,
973             DELETE_RULE => $referential_action{$$row[6]},
974             FK_COLUMN_NAME => $$row[3],
975             FK_DATA_TYPE => undef,
976             FK_NAME => undef,
977             FK_TABLE_CAT => undef,
978             FK_TABLE_NAME => $table_name,
979             FK_TABLE_SCHEM => undef,
980             ORDINAL_POSITION => $$row[1],
981             UK_COLUMN_NAME => $$row[4],
982             UK_DATA_TYPE => undef,
983             UK_NAME => undef,
984             UK_TABLE_CAT => undef,
985             UK_TABLE_NAME => $$row[2],
986             UK_TABLE_SCHEM => undef,
987             UNIQUE_OR_PRIMARY => undef,
988             UPDATE_RULE => $referential_action{$$row[5]},
989             }
990              
991             This list of keys matches what is returned when processing a Postgres database.
992              
993             =head2 Have you got FK and PK backwards?
994              
995             I certainly hope not. To me the FK_TABLE_NAME points to the UK_TABLE_NAME.
996              
997             The "pragma foreign_key_list($table_name)" call for SQLite returns data from the create statement,
998             and thus it reports what the given table points to. The DBI call to foreign_key_info(...) returns
999             data about foreign keys referencing (pointing to) the given table. This can be confusing.
1000              
1001             Here is a method from the module L, part of
1002             L.
1003              
1004             sub create_organizations_table
1005             {
1006             my($self) = @_;
1007             my($table_name) = 'organizations';
1008             my($primary_key) = $self -> creator -> generate_primary_key_sql($table_name);
1009             my($engine) = $self -> engine;
1010             my($result) = $self -> creator -> create_table(<
1011             create table $table_name
1012             (
1013             id $primary_key,
1014             visibility_id integer not null references visibilities(id),
1015             communication_type_id integer not null references communication_types(id),
1016             creator_id integer not null,
1017             role_id integer not null references roles(id),
1018             deleted integer not null,
1019             facebook_tag varchar(255) not null,
1020             homepage varchar(255) not null,
1021             name varchar(255) not null,
1022             timestamp timestamp not null default localtimestamp,
1023             twitter_tag varchar(255) not null,
1024             upper_name varchar(255) not null
1025             ) $engine
1026             SQL
1027              
1028             $self -> dbh -> do("create index ${table_name}_upper_name on $table_name (upper_name)");
1029              
1030             $self -> report($table_name, 'created', $result);
1031              
1032             } # End of create_organizations_table.
1033              
1034             Consider this line:
1035              
1036             visibility_id integer not null references visibilities(id),
1037              
1038             That means, for the 'visibilities' table, the info() method in the current module will return a
1039             hashref like:
1040              
1041             {
1042             visibilities =>
1043             {
1044             ...
1045             foreign_keys =>
1046             {
1047             ...
1048             organizations =>
1049             {
1050             UK_COLUMN_NAME => 'id',
1051             DEFERABILITY => undef,
1052             ORDINAL_POSITION => 0,
1053             FK_TABLE_CAT => undef,
1054             UK_NAME => undef,
1055             UK_DATA_TYPE => undef,
1056             UNIQUE_OR_PRIMARY => undef,
1057             UK_TABLE_SCHEM => undef,
1058             UK_TABLE_CAT => undef,
1059             FK_COLUMN_NAME => 'visibility_id',
1060             FK_TABLE_NAME => 'organizations',
1061             FK_TABLE_SCHEM => undef,
1062             FK_DATA_TYPE => undef,
1063             UK_TABLE_NAME => 'visibilities',
1064             DELETE_RULE => 3,
1065             FK_NAME => undef,
1066             UPDATE_RULE => 3
1067             },
1068             },
1069             }
1070              
1071             This is saying that for the table 'visibilities', there is a foreign key in the 'organizations'
1072             table. That foreign key is called 'visibility_id', and it points to the key called 'id' in the
1073             'visibilities' table.
1074              
1075             =head2 How do I use schemas in Postgres?
1076              
1077             You may need to do something like this:
1078              
1079             $dbh -> do("set search_path to $ENV{DBI_SCHEMA}") if ($ENV{DBI_SCHEMA});
1080              
1081             $ENV{DBI_SCHEMA} can be a comma-separated list, as in:
1082              
1083             $dbh -> do("set search_path to my_schema, public");
1084              
1085             See L for details.
1086              
1087             =head2 See Also
1088              
1089             L.
1090              
1091             L.
1092              
1093             =head1 Version Numbers
1094              
1095             Version numbers < 1.00 represent development versions. From 1.00 up, they are production versions.
1096              
1097             =head1 Repository
1098              
1099             L
1100              
1101             =head1 Support
1102              
1103             Log a bug on RT: L.
1104              
1105             =head1 Author
1106              
1107             C was written by Ron Savage Iron@savage.net.auE> in 2004.
1108              
1109             Home page: http://savage.net.au/index.html
1110              
1111             =head1 Copyright
1112              
1113             Australian copyright (c) 2004, Ron Savage.
1114              
1115             All Programs of mine are 'OSI Certified Open Source Software';
1116             you can redistribute them and/or modify them under the terms of
1117             The Artistic License 2.0, a copy of which is available at:
1118             http://www.opensource.org/licenses/index.html
1119              
1120             =cut