From: Brandon L. Black <blblack@gmail.com>
Date: Sun, 23 Jul 2006 21:31:35 +0000 (+0000)
Subject: Merge 'trunk' into 'DBIx-Class-current'
X-Git-Tag: v0.08010~43^2~42
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2359353990ae5b1961bb9585cfa915cf0cee5642;hp=cebfddb3f2a7b76b82e76bf24292ad5b46ab764b;p=dbsrgits%2FDBIx-Class.git

Merge 'trunk' into 'DBIx-Class-current'

r7299@moloko (orig r2592):  matthewt | 2006-07-22 19:23:56 -0500
yes, I didn't get the merge quite right. again.
r7347@moloko (orig r2603):  matthewt | 2006-07-23 14:31:41 -0500
yeah, yeah, yeah
---

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index c71043b..39611eb 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -95,14 +95,24 @@ sub new {
 
   $attrs->{alias} ||= 'me';
 
-  bless {
+  # XXXX
+  # Use a named hash here and bless afterwards to avoid a huge performance hit
+  # in perl 5.8.8-5+ FC5 and later, and possibly other distributions.
+  #
+  # See https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=196836 for more
+  # information.
+  my $self = {
     result_source => $source,
     result_class => $attrs->{result_class} || $source->result_class,
     cond => $attrs->{where},
     count => undef,
     pager => undef,
     attrs => $attrs
-  }, $class;
+  };
+
+  bless $self, $class;
+
+  return $self;
 }
 
 =head2 search
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 864f8f0..2b81444 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -12,7 +12,7 @@ __PACKAGE__->load_components(qw/AccessorGroup/);
 
 __PACKAGE__->mk_group_accessors('simple' => qw/_ordered_columns
   _columns _primaries _unique_constraints name resultset_attributes
-  schema from _relationships source_name/);
+  schema from _relationships column_info_from_storage source_name/);
 
 __PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
   result_class/);
@@ -181,6 +181,7 @@ sub column_info {
     unless exists $self->_columns->{$column};
   #warn $self->{_columns_info_loaded}, "\n";
   if ( ! $self->_columns->{$column}{data_type}
+       and $self->column_info_from_storage
        and ! $self->{_columns_info_loaded}
        and $self->schema and $self->storage )
   {
@@ -201,6 +202,15 @@ sub column_info {
   return $self->_columns->{$column};
 }
 
+=head2 load_column_info_from_storage
+
+Enables the on-demand automatic loading of the above column
+metadata from storage as neccesary.
+
+=cut
+
+sub load_column_info_from_storage { shift->column_info_from_storage(1) }
+
 =head2 columns
 
   my @column_names = $obj->columns;
diff --git a/lib/DBIx/Class/ResultSourceProxy.pm b/lib/DBIx/Class/ResultSourceProxy.pm
index f174d75..591927f 100644
--- a/lib/DBIx/Class/ResultSourceProxy.pm
+++ b/lib/DBIx/Class/ResultSourceProxy.pm
@@ -35,6 +35,9 @@ sub column_info {
   return $self->result_source_instance->column_info($column);
 }
 
+sub load_column_info_from_storage {
+  shift->result_source_instance->load_column_info_from_storage;
+}
 
 sub columns {
   return shift->result_source_instance->columns(@_);
diff --git a/t/60core.t b/t/60core.t
index aae959e..a468515 100644
--- a/t/60core.t
+++ b/t/60core.t
@@ -277,6 +277,7 @@ ok(!$@, "stringify to false value doesn't cause error");
 # test column_info
 {
   $schema->source("Artist")->{_columns}{'artistid'} = {};
+  $schema->source("Artist")->load_column_info_from_storage;
 
   my $typeinfo = $schema->source("Artist")->column_info('artistid');
   is($typeinfo->{data_type}, 'INTEGER', 'column_info ok');
diff --git a/t/72pg.t b/t/72pg.t
index f0bb3f8..f393a9a 100644
--- a/t/72pg.t
+++ b/t/72pg.t
@@ -15,6 +15,7 @@ use DBICTest;
   __PACKAGE__->load_components(qw/PK::Auto Core/);
   __PACKAGE__->table('casecheck');
   __PACKAGE__->add_columns(qw/id name NAME uc_name/);
+  __PACKAGE__->load_column_info_from_storage;
   __PACKAGE__->set_primary_key('id');
 
 }