lib/DBIx/Class/GlobalDestruction.pm

   1 # This is just a concept-test. If works as intended will ship in its own
   2 # right as Devel::GlobalDestruction::PP or perhaps even as part of rafls
   3 # D::GD itself
   4
   5 package # hide from pause
   6   DBIx::Class::GlobalDestruction;
   7
   8 use strict;
   9 use warnings;
  10
  11 use base 'Exporter';
  12 our @EXPORT = 'in_global_destruction';
  13
  14 use DBIx::Class::Exception;
  15
  16 if (defined ${^GLOBAL_PHASE}) {
  17   eval 'sub in_global_destruction () { ${^GLOBAL_PHASE} eq q[DESTRUCT] }';
  18 }
  19 elsif (eval { require Devel::GlobalDestruction }) { # use the XS version if available
  20   *in_global_destruction = \&Devel::GlobalDestruction::in_global_destruction;
  21 }
  22 else {
  23   my ($in_global_destruction, $before_is_installed);
  24
  25   eval <<'PP_IGD';
  26
  27 sub in_global_destruction () { $in_global_destruction }
  28
  29 END {
  30   # SpeedyCGI runs END blocks every cycle but keeps object instances
  31   # hence we have to disable the globaldestroy hatch, and rely on the
  32   # eval traps (which appears to work, but are risky done so late)
  33   $in_global_destruction = 1 unless $CGI::SpeedyCGI::i_am_speedy;
  34 }
  35
  36 # threads do not execute the global ENDs (it would be stupid). However
  37 # one can register a new END via simple string eval within a thread, and
  38 # achieve the same result. A logical place to do this would be CLONE, which
  39 # is claimed to run in the context of the new thread. However this does
  40 # not really seem to be the case - any END evaled in a CLONE is ignored :(
  41 # Hence blatantly hooking threads::create
  42 if ($INC{'threads.pm'}) {
  43   require Class::Method::Modifiers;
  44   Class::Method::Modifiers::install_modifier( threads => before => create => sub {
  45     my $orig_target_cref = $_[1];
  46     $_[1] = sub {
  47       { local $@; eval 'END { $in_global_destruction = 1 }' }
  48       $orig_target_cref->();
  49     };
  50   });
  51   $before_is_installed = 1;
  52 }
  53
  54 # just in case threads got loaded after DBIC (silly)
  55 sub CLONE {
  56   DBIx::Class::Exception->throw("You must load the 'threads' module before @{[ __PACKAGE__ ]}")
  57     unless $before_is_installed;
  58 }
  59
  60 PP_IGD
  61
  62 }
  63
  64 1;