X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema.pm;h=7b5ae64ed721efb40e027171fcfb0fce5f47ae2e;hb=d437f664a6928c3fa75abbc3b173b19582948886;hp=76395aea3afabdf232182f9ecf888814233fec2c;hpb=93d7452f38b38b66d6d8282425a928873725f43e;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Schema.pm b/lib/DBIx/Class/Schema.pm
index 76395ae..7b5ae64 100644
--- a/lib/DBIx/Class/Schema.pm
+++ b/lib/DBIx/Class/Schema.pm
@@ -8,8 +8,7 @@ use base 'DBIx::Class';
 use DBIx::Class::Carp;
 use Try::Tiny;
 use Scalar::Util qw/weaken blessed/;
-use Sub::Name 'subname';
-use B 'svref_2object';
+use DBIx::Class::_Util qw(refcount quote_sub);
 use Devel::GlobalDestruction;
 use namespace::clean;
 
@@ -109,11 +108,12 @@ are no matching Result classes like this:
 
   load_namespaces found ResultSet class $classname with no corresponding Result class
 
-If a Result class is found to already have a ResultSet class set using
-L</resultset_class> to some other class, you will be warned like this:
+If a ResultSource instance is found to already have a ResultSet class set
+using L<resultset_class|DBIx::Class::ResultSource/resultset_class> to some
+other class, you will be warned like this:
 
-  We found ResultSet class '$rs_class' for '$result', but it seems
-  that you had already set '$result' to use '$rs_set' instead
+  We found ResultSet class '$rs_class' for '$result_class', but it seems
+  that you had already set '$result_class' to use '$rs_set' instead
 
 =head3 Examples
 
@@ -897,7 +897,6 @@ sub compose_namespace {
     local *Class::C3::reinitialize = sub { } if DBIx::Class::_ENV_::OLD_MRO;
     use warnings qw/redefine/;
 
-    no strict qw/refs/;
     foreach my $source_name ($self->sources) {
       my $orig_source = $self->source($source_name);
 
@@ -919,11 +918,8 @@ sub compose_namespace {
       }
     }
 
-    foreach my $meth (qw/class source resultset/) {
-      no warnings 'redefine';
-      *{"${target}::${meth}"} = subname "${target}::${meth}" =>
-        sub { shift->schema->$meth(@_) };
-    }
+    quote_sub "${target}::${_}" => "shift->schema->$_(\@_)"
+      for qw(class source resultset);
   }
 
   Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
@@ -1122,8 +1118,8 @@ sub deploy {
 
 A convenient shortcut to
 C<< $self->storage->deployment_statements($self, @args) >>.
-Returns the SQL statements used by L</deploy> and
-L<DBIx::Class::Schema::Storage/deploy>.
+Returns the statements used by L</deploy> and
+L<DBIx::Class::Storage/deploy>.
 
 =cut
 
@@ -1217,19 +1213,17 @@ reference to any schema, so are rather useless.
 sub thaw {
   my ($self, $obj) = @_;
   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
-  require Storable;
   return Storable::thaw($obj);
 }
 
 =head2 freeze
 
-This doesn't actually do anything more than call L<Storable/nfreeze>, it is just
-provided here for symmetry.
+This doesn't actually do anything beyond calling L<nfreeze|Storable/SYNOPSIS>,
+it is just provided here for symmetry.
 
 =cut
 
 sub freeze {
-  require Storable;
   return Storable::nfreeze($_[1]);
 }
 
@@ -1252,7 +1246,6 @@ objects so their references to the schema object
 sub dclone {
   my ($self, $obj) = @_;
   local $DBIx::Class::ResultSourceHandle::thaw_schema = $self;
-  require Storable;
   return Storable::dclone($obj);
 }
 
@@ -1392,6 +1385,9 @@ sub _register_source {
 
 my $global_phase_destroy;
 sub DESTROY {
+  ### NO detected_reinvoked_destructor check
+  ### This code very much relies on being called multuple times
+
   return if $global_phase_destroy ||= in_global_destruction;
 
   my $self = shift;
@@ -1405,7 +1401,7 @@ sub DESTROY {
     # which will serve as a signal to not try doing anything else
     # however beware - on older perls the exception seems randomly untrappable
     # due to some weird race condition during thread joining :(((
-    if (ref $srcs->{$source_name} and svref_2object($srcs->{$source_name})->REFCNT > 1) {
+    if (length ref $srcs->{$source_name} and refcount($srcs->{$source_name}) > 1) {
       local $@;
       eval {
         $srcs->{$source_name}->schema($self);
@@ -1474,13 +1470,12 @@ sub compose_connection {
   carp_once "compose_connection deprecated as of 0.08000"
     unless $INC{"DBIx/Class/CDBICompat.pm"};
 
-  my $base = 'DBIx::Class::ResultSetProxy';
   try {
-    eval "require ${base};"
+    require DBIx::Class::ResultSetProxy;
   }
   catch {
     $self->throw_exception
-      ("No arguments to load_classes and couldn't load ${base} ($_)")
+      ("No arguments to load_classes and couldn't load DBIx::Class::ResultSetProxy ($_)")
   };
 
   if ($self eq $target) {
@@ -1488,7 +1483,7 @@ sub compose_connection {
     foreach my $source_name ($self->sources) {
       my $source = $self->source($source_name);
       my $class = $source->result_class;
-      $self->inject_base($class, $base);
+      $self->inject_base($class, 'DBIx::Class::ResultSetProxy');
       $class->mk_classdata(resultset_instance => $source->resultset);
       $class->mk_classdata(class_resolver => $self);
     }
@@ -1496,12 +1491,8 @@ sub compose_connection {
     return $self;
   }
 
-  my $schema = $self->compose_namespace($target, $base);
-  {
-    no strict 'refs';
-    my $name = join '::', $target, 'schema';
-    *$name = subname $name, sub { $schema };
-  }
+  my $schema = $self->compose_namespace($target, 'DBIx::Class::ResultSetProxy');
+  quote_sub "${target}::schema", '$s', { '$s' => \$schema };
 
   $schema->connection(@info);
   foreach my $source_name ($schema->sources) {
@@ -1515,14 +1506,17 @@ sub compose_connection {
   return $schema;
 }
 
-1;
-
-=head1 AUTHOR AND CONTRIBUTORS
+=head1 FURTHER QUESTIONS?
 
-See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 
-=head1 LICENSE
+=head1 COPYRIGHT AND LICENSE
 
-You may distribute this code under the same terms as Perl itself.
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 
 =cut
+
+1;