X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FDBI.pm;h=5dcc71a857d8bc74c9283664eb235b7dc23b56ca;hb=8da6f199355a4caf252f0c42e6ab139922af6204;hp=47e42480e40566a2f3f0f461583b9b62b30002e6;hpb=08886922039afb28ccc7a47a9d79eb2eb042f2d8;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm
index 47e4248..5dcc71a 100644
--- 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 ();
 
@@ -94,7 +97,31 @@ sub _build_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 { }