X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass.pm;h=cdcbcbbefd824cc028a97d4ba3c3f27bebed97a8;hb=adcc1df0049e0093cb94c867bd2be8c9fe242a61;hp=ef1c60e2d1287bd4491d287655c2c16eac581799;hpb=7bd921c01e7ad780f701c30d53300c610a7202b9;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm
index ef1c60e..cdcbcbb 100644
--- a/lib/DBIx/Class.pm
+++ b/lib/DBIx/Class.pm
@@ -14,117 +14,27 @@ our $VERSION;
 # $VERSION declaration must stay up here, ahead of any other package
 # declarations, as to not confuse various modules attempting to determine
 # this ones version, whether that be s.c.o. or Module::Metadata, etc
-$VERSION = '0.082899_15';
+$VERSION = '0.082899_25';
 
 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
 
 use mro 'c3';
 
 use base qw/DBIx::Class::Componentised DBIx::Class::AccessorGroup/;
-use DBIx::Class::Exception;
-
-use DBIx::Class::_Util qw( uniq refdesc visit_namespaces );
-use Scalar::Util qw( weaken refaddr );
-use namespace::clean;
-
-__PACKAGE__->mk_group_accessors(inherited => '_skip_namespace_frames');
-__PACKAGE__->_skip_namespace_frames('^DBIx::Class|^SQL::Abstract|^Try::Tiny|^Class::Accessor::Grouped|^Context::Preserve|^Moose::Meta::');
-
-# FIXME - this is not really necessary, and is in
-# fact going to slow things down a bit
-# However it is the right thing to do in order to get
-# various install bases to highlight their brokenness
-# Remove at some unknown point in the future
-#
-# The oddball BEGIN is there for... reason unknown
-# It does make non-segfaulty difference on pre-5.8.5 perls, so shrug
-BEGIN {
-  sub DESTROY { &DBIx::Class::_Util::detected_reinvoked_destructor };
-}
-
-sub component_base_class { 'DBIx::Class' }
-
-
-my $cref_registry;
-sub DBIx::Class::__Attr_iThreads_handler__::CLONE {
 
-  # this is disgusting, but the best we can do without even more surgery
-  visit_namespaces( action => sub {
-    my $pkg = shift;
-
-    # skip dangerous namespaces
-    return 1 if $pkg =~ /^ (?:
-      DB | next | B | .+? ::::ISA (?: ::CACHE ) | Class::C3
-    ) $/x;
-
-    no strict 'refs';
-
-    if (
-      exists ${"${pkg}::"}{__cag___attr_cache}
-        and
-      ref( my $attr_stash = ${"${pkg}::__cag___attr_cache"} ) eq 'HASH'
-    ) {
-      $attr_stash->{ $cref_registry->{$_} } = delete $attr_stash->{$_}
-        for keys %$attr_stash;
-    }
-
-    return 1;
-  })
-}
+__PACKAGE__->mk_classaccessor(
+  _skip_namespace_frames => join( '|', map { '^' . $_ } qw(
+    DBIx::Class
+    SQL::Abstract
+    SQL::Translator
+    Try::Tiny
+    Class::Accessor::Grouped
+    Context::Preserve
+    Moose::Meta::
+  )),
+);
 
-sub MODIFY_CODE_ATTRIBUTES {
-  my ($class,$code,@attrs) = @_;
-  $class->mk_classaccessor('__attr_cache' => {})
-    unless $class->can('__attr_cache');
-
-  # compaction step
-  defined $cref_registry->{$_} or delete $cref_registry->{$_}
-    for keys %$cref_registry;
-
-  # The original API used stringification instead of refaddr - can't change that now
-  if( $cref_registry->{$code} ) {
-    Carp::confess( sprintf
-      "Coderefs '%s' and '%s' stringify to the same value '%s': nothing will work",
-      refdesc($code),
-      refdesc($cref_registry->{$code}),
-      "$code"
-    ) if refaddr($cref_registry->{$code}) != refaddr($code);
-  }
-  else {
-    weaken( $cref_registry->{$code} = $code )
-  }
-
-  $class->__attr_cache->{$code} = [ sort( uniq(
-    @{ $class->__attr_cache->{$code} || [] },
-    @attrs,
-  ))];
-
-  # FIXME - DBIC essentially gobbles up any attribute it can lay its hands on:
-  # decidedly not cool
-  #
-  # There should be some sort of warning on unrecognized attributes or
-  # somesuch... OTOH people do use things in the wild hence the plan of action
-  # is anything but clear :/
-  #
-  # https://metacpan.org/source/ZIGOROU/DBIx-Class-Service-0.02/lib/DBIx/Class/Service.pm#L93-110
-  # https://metacpan.org/source/ZIGOROU/DBIx-Class-Service-0.02/t/lib/DBIC/Test/Service/User.pm#L29
-  # https://metacpan.org/source/ZIGOROU/DBIx-Class-Service-0.02/t/lib/DBIC/Test/Service/User.pm#L36
-  #
-  return ();
-}
-
-sub FETCH_CODE_ATTRIBUTES {
-  my ($class,$code) = @_;
-  @{ $class->_attr_cache->{$code} || [] }
-}
-
-sub _attr_cache {
-  my $self = shift;
-  +{
-    %{ $self->can('__attr_cache') ? $self->__attr_cache : {} },
-    %{ $self->maybe::next::method || {} },
-  };
-}
+sub component_base_class { 'DBIx::Class' }
 
 # *DO NOT* change this URL nor the identically named =head1 below
 # it is linked throughout the ecosystem