Cache column and primary/foreign/unique key info

[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / DBI.pm

diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm
index f890c61..5dcc71a 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/DBI.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI.pm
@@ -5,8 +5,11 @@ use warnings;
 use base qw/DBIx::Class::Schema::Loader::Base/;
 use mro 'c3';
 use Try::Tiny;
+use Scalar::Util 'blessed';
 use List::Util 'any';
 use Carp::Clan qw/^DBIx::Class/;
+use Class::Method::Modifiers 'install_modifier';
+
 use namespace::clean;
 use DBIx::Class::Schema::Loader::Table ();
 
@@ -74,8 +77,8 @@ sub _build_quote_char {
     my $self = shift;
 
     my $quote_char = $self->dbh->get_info(29)
-           || $self->schema->storage->sql_maker->quote_char
-           || q{"};
+        || $self->schema->storage->sql_maker->quote_char
+        || q{"};
 
     # For our usage as regex matches, concatenating multiple quote_char
     # values works fine (e.g. s/[\Q<>\E]// if quote_char was [ '<', '>' ])
@@ -89,12 +92,36 @@ sub _build_quote_char {
 sub _build_name_sep {
     my $self = shift;
     return $self->dbh->get_info(41)
-           || $self->schema->storage->sql_maker->name_sep
-           || '.';
+        || $self->schema->storage->sql_maker->name_sep
+        || '.';
 }
 
 # Override this in vendor modules to do things at the end of ->new()
-sub _setup { }
+sub _setup {
+    my ($self) = @_;
+
+    for my $method (qw(
+        _columns_info_for _table_columns
+        _table_pk_info _table_fk_info _table_uniq_info
+    )) {
+        $self->_setup_per_table_cache($method);
+    }
+}
+
+{
+    my %has_cache_setup;
+    sub _setup_per_table_cache {
+        my ($self, $method) = @_;
+        my $class = blessed($self);
+
+        return if $has_cache_setup{$class}{$method}++;
+
+        install_modifier($class, around => $method => sub {
+            my ($orig, $self, $table) = @_;
+            $self->{_cache}{$method}{$table->sql_name} ||= $self->$orig($table);
+        });
+    }
+}
 
 # Override this in vendor module to load a subclass if necessary
 sub _rebless { }
@@ -118,7 +145,7 @@ sub _supports_db_schema { 1 }
 
 # Returns an array of table objects
 sub _tables_list {
-    my ($self, $opts) = (shift, shift);
+    my ($self) = @_;
 
     my @tables;
 
@@ -128,7 +155,7 @@ sub _tables_list {
     my $nns = qr/[^\Q$self->{name_sep}\E]/;
 
     foreach my $schema (@{ $self->db_schema || [undef] }) {
-        my @raw_table_names = $self->_dbh_tables($schema, @_);
+        my @raw_table_names = $self->_dbh_tables($schema);
 
         TABLE: foreach my $raw_table_name (@raw_table_names) {
             my $quoted = $raw_table_name =~ /^$qt/;
@@ -149,7 +176,7 @@ sub _tables_list {
                     if (ref $system_schema) {
                         $matches = 1
                             if $schema_name =~ $system_schema
-                                 && $schema !~ $system_schema;
+                                && $schema  !~ $system_schema;
                     }
                     else {
                         $matches = 1
@@ -189,7 +216,7 @@ sub _tables_list {
         }
     }
 
-    return $self->_filter_tables(\@tables, $opts);
+    return $self->_filter_tables(\@tables);
 }
 
 sub _recurse_constraint {
@@ -228,14 +255,13 @@ sub _check_constraint {
 
 # apply constraint/exclude and ignore bad tables and views
 sub _filter_tables {
-    my ($self, $tables, $opts) = @_;
+    my ($self, $tables) = @_;
 
     my @tables = @$tables;
     my @filtered_tables;
 
-    $opts ||= {};
-    @tables = _check_constraint(1, $opts->{constraint}, @tables);
-    @tables = _check_constraint(0, $opts->{exclude}, @tables);
+    @tables = _check_constraint(1, $self->constraint, @tables);
+    @tables = _check_constraint(0, $self->exclude, @tables);
 
     TABLE: for my $table (@tables) {
         try {