From: Daniel Westermann-Clark Date: Fri, 28 Jul 2006 03:30:28 +0000 (+0000) Subject: Remove anonymous blesses to avoid major speed hit on Fedora Core 5, or 'the anti... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=04786a4c19fe3964002b69e8a3dbb291524e0610;p=dbsrgits%2FDBIx-Class-Historic.git Remove anonymous blesses to avoid major speed hit on Fedora Core 5, or 'the anti-dead-rat fix' --- diff --git a/Changes b/Changes index 51dd4ed..ae5087f 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,9 @@ Revision history for DBIx::Class 0.07001 + - remove anonymous blesses to avoid major speed hit on Fedora Core 5's + Perl and possibly others; for more information see: + https://bugzilla.redhat.com/bugzilla/show_bug.cgi?id=196836 - fix a pathological prefetch case - table case fix for Oracle in columns_info_for diff --git a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm index 911fe2a..98e6508 100644 --- a/lib/DBIx/Class/CDBICompat/ColumnGroups.pm +++ b/lib/DBIx/Class/CDBICompat/ColumnGroups.pm @@ -64,7 +64,8 @@ sub find_column { sub __grouper { my ($class) = @_; - return bless({ class => $class}, 'DBIx::Class::CDBICompat::ColumnGroups::GrouperShim'); + my $grouper = { class => $class }; + return bless($grouper, 'DBIx::Class::CDBICompat::ColumnGroups::GrouperShim'); } sub _find_columns { diff --git a/lib/DBIx/Class/DB.pm b/lib/DBIx/Class/DB.pm index 0fb7e8a..007c82a 100644 --- a/lib/DBIx/Class/DB.pm +++ b/lib/DBIx/Class/DB.pm @@ -93,7 +93,8 @@ register themselves with it. sub setup_schema_instance { my $class = shift; - my $schema = bless({}, 'DBIx::Class::Schema'); + my $schema = {}; + bless $schema, 'DBIx::Class::Schema'; $class->mk_classdata('schema_instance' => $schema); } diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index 1ee7fb6..daf7e03 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -95,14 +95,18 @@ sub new { $attrs->{alias} ||= 'me'; - bless { + 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 1e95cba..659948f 100644 --- a/lib/DBIx/Class/ResultSource.pm +++ b/lib/DBIx/Class/ResultSource.pm @@ -45,7 +45,10 @@ Creates a new ResultSource object. Not normally called directly by end users. sub new { my ($class, $attrs) = @_; $class = ref $class if ref $class; - my $new = bless({ %{$attrs || {}}, _resultset => undef }, $class); + + my $new = { %{$attrs || {}}, _resultset => undef }; + bless $new, $class; + $new->{resultset_class} ||= 'DBIx::Class::ResultSet'; $new->{resultset_attributes} = { %{$new->{resultset_attributes} || {}} }; $new->{_ordered_columns} = [ @{$new->{_ordered_columns}||[]}]; diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm index 3efe418..ceed5a6 100644 --- a/lib/DBIx/Class/Row.pm +++ b/lib/DBIx/Class/Row.pm @@ -34,7 +34,10 @@ Creates a new row object from column => value mappings passed as a hash ref sub new { my ($class, $attrs) = @_; $class = ref $class if ref $class; - my $new = bless { _column_data => {} }, $class; + + my $new = { _column_data => {} }; + bless $new, $class; + if ($attrs) { $new->throw_exception("attrs must be a hashref") unless ref($attrs) eq 'HASH'; @@ -44,6 +47,7 @@ sub new { $new->store_column($k => $attrs->{$k}); } } + return $new; } @@ -265,7 +269,10 @@ sub copy { delete $col_data->{$col} if $self->result_source->column_info($col)->{is_auto_increment}; } - my $new = bless { _column_data => $col_data }, ref $self; + + my $new = { _column_data => $col_data }; + bless $new, ref $self; + $new->result_source($self->result_source); $new->set_columns($changes); $new->insert; @@ -310,11 +317,13 @@ Called by ResultSet to inflate a result from storage sub inflate_result { my ($class, $source, $me, $prefetch) = @_; #use Data::Dumper; print Dumper(@_); - my $new = bless({ result_source => $source, - _column_data => $me, - _in_storage => 1 - }, - ref $class || $class); + my $new = { + result_source => $source, + _column_data => $me, + _in_storage => 1 + }; + bless $new, (ref $class || $class); + my $schema; foreach my $pre (keys %{$prefetch||{}}) { my $pre_val = $prefetch->{$pre}; diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm index 47e78cf..d35b211 100644 --- a/lib/DBIx/Class/Schema.pm +++ b/lib/DBIx/Class/Schema.pm @@ -625,7 +625,9 @@ copy. sub clone { my ($self) = @_; - my $clone = bless({ (ref $self ? %$self : ()) }, ref $self || $self); + my $clone = { (ref $self ? %$self : ()) }; + bless $clone, (ref $self || $self); + foreach my $moniker ($self->sources) { my $source = $self->source($moniker); my $new = $source->new($source); diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm index 9b3dd72..735006c 100644 --- a/lib/DBIx/Class/Storage.pm +++ b/lib/DBIx/Class/Storage.pm @@ -35,7 +35,8 @@ use overload '"' => sub { sub new { my $class = shift; - return bless {}, $class; + my $self = {}; + return bless $self, $class; } 1; diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 9077631..5984c94 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -275,7 +275,9 @@ This class represents the connection to the database =cut sub new { - my $new = bless({}, ref $_[0] || $_[0]); + my $new = {}; + bless $new, (ref $_[0] || $_[0]); + $new->cursor("DBIx::Class::Storage::DBI::Cursor"); $new->transaction_depth(0); diff --git a/lib/DBIx/Class/Storage/Statistics.pm b/lib/DBIx/Class/Storage/Statistics.pm index 0599ed6..eaa3ee9 100644 --- a/lib/DBIx/Class/Storage/Statistics.pm +++ b/lib/DBIx/Class/Storage/Statistics.pm @@ -30,7 +30,8 @@ Returns a new L object. =cut sub new { - my $self = bless({}, ref($_[0]) || $_[0]); + my $self = {}; + bless $self, (ref($_[0]) || $_[0]); return $self; }