[Jifty-commit] r2801 - in jifty/trunk: lib lib/Jifty

[jifty-commit at lists.jifty.org]

Author: alexmv
Date: Sun Feb 18 17:28:09 2007
New Revision: 2801

Modified:
   jifty/trunk/   (props changed)
   jifty/trunk/lib/Jifty.pm
   jifty/trunk/lib/Jifty/ClassLoader.pm

Log:
 r17310 at zoq-fot-pik:  chmrr | 2007-02-18 17:27:32 -0500
  * Solve copious global destruction warnings


Modified: jifty/trunk/lib/Jifty.pm
==============================================================================
--- jifty/trunk/lib/Jifty.pm	(original)
+++ jifty/trunk/lib/Jifty.pm	Sun Feb 18 17:28:09 2007
@@ -198,6 +198,13 @@
     
 }
 
+# Explicitly destroy the classloader; if this happens during global
+# destruction, there's a period of time where there's a bogus entry in
+# @INC
+END {
+    Jifty->class_loader->DESTROY if Jifty->class_loader;
+}
+
 =head2 config
 
 An accessor for the L<Jifty::Config> object that stores the

Modified: jifty/trunk/lib/Jifty/ClassLoader.pm
==============================================================================
--- jifty/trunk/lib/Jifty/ClassLoader.pm	(original)
+++ jifty/trunk/lib/Jifty/ClassLoader.pm	Sun Feb 18 17:28:09 2007
@@ -30,8 +30,13 @@
 
 sub new {
     my $class = shift;
-    my $self = bless {@_}, $class;
+    my %args = @_;
 
+    my @exist = grep {ref $_ eq $class and $_->{base} eq $args{base}} @INC;
+    return $exist[0] if @exist;
+
+    my $self = bless {%args}, $class;
+    print "CREATE $self\n";
     push @INC, $self;
     return $self;
 }
@@ -281,6 +286,24 @@
     wantarray ? @{ $self->{models} ||= [] } : $self->{models};
 }
 
+=head2 DESTROY
+
+When the ClassLoader gets garbage-collected, its entry in @INC needs
+to be removed.
+
+=cut
+
+# The entries in @INC end up having SvTYPE == SVt_RV, but SvRV(sv) ==
+# 0x0 and !SvROK(sv) (!?)  This may be something that perl should cope
+# with more cleanly.
+#
+# We call this explictly in an END block in Jifty.pm, because
+# otherwise the DESTROY block gets called *after* there's already a
+# bogus entry in @INC
+sub DESTROY {
+    my $self = shift;
+    @INC = grep {defined $_ and $_ ne $self} @INC;
+}
 
 =head1 Writing your own classes