# HG changeset patch
# User sergey
# Date 1353069856 -14400
# Node ID 9f394b27dccfed3419ae7ecb82b1bbd32a587674
# Parent  129e48bb5afbfd1b414de9a63f606e0b0ce6eafe
require can handle recursive module references

diff -r 129e48bb5afb -r 9f394b27dccf Lib/IMPL/declare.pm
--- a/Lib/IMPL/declare.pm	Wed Nov 07 04:17:53 2012 +0400
+++ b/Lib/IMPL/declare.pm	Fri Nov 16 16:44:16 2012 +0400
@@ -5,6 +5,12 @@
 use Carp qw(carp);
 use IMPL::Class::PropertyInfo();
 use IMPL::Const qw(:access);
+use IMPL::require();
+
+BEGIN {
+	*_require = *IMPL::require::_require;
+	*_trace = *IMPL::require::_trace;
+}
 
 sub import {
 	my ( $self, $args ) = @_;
@@ -18,8 +24,13 @@
 	my $caller = caller;
 
 	my $aliases = $args->{require} || {};
+	
+	_trace("declare $caller");
+	$IMPL::require::level++;
 
 	while ( my ( $alias, $class ) = each %$aliases ) {
+		_trace("$alias => $class");
+		$IMPL::require::level ++;
 		my $c = _require($class);
 
 		*{"${caller}::$alias"} = set_prototype(
@@ -28,6 +39,7 @@
 			},
 			''
 		);
+		$IMPL::require::level --;
 	}
 
 	my $base = $args->{base} || {};
@@ -39,7 +51,10 @@
 		carp "Odd elements number in require"
 		  unless scalar(@$base) % 2 == 0;
 		while ( my ( $class, $mapper ) = splice @$base, 0, 2 ) {
+			_trace("parent $class");
+			$IMPL::require::level ++;
 			$class = $aliases->{$class} || _require($class);
+			$IMPL::require::level --;
 
 			push @isa, $class;
 			$ctor{$class} = $mapper;
@@ -47,7 +62,10 @@
 	}
 	elsif ( ref $base eq 'HASH' ) {
 		while ( my ( $class, $mapper ) = each %$base ) {
+			_trace("parent $class");
+			$IMPL::require::level ++;
 			$class = $aliases->{$class} || _require($class);
+			$IMPL::require::level --;
 
 			push @isa, $class;
 			$ctor{$class} = $mapper;
@@ -86,16 +104,8 @@
 			$propInfo->Implement();
 		}
 	}
-}
-
-sub _require {
-	my ($class) = @_;
-
-	if ( not $class =~ s/^-// ) {
-		( my $file = $class ) =~ s/::|'/\//g;
-		require "$file.pm";
-	}
-	$class;
+	
+	$IMPL::require::level--;
 }
 
 1;
diff -r 129e48bb5afb -r 9f394b27dccf Lib/IMPL/require.pm
--- a/Lib/IMPL/require.pm	Wed Nov 07 04:17:53 2012 +0400
+++ b/Lib/IMPL/require.pm	Fri Nov 16 16:44:16 2012 +0400
@@ -1,7 +1,12 @@
 package IMPL::require;
 use Scalar::Util qw(set_prototype);
 use strict;
-require IMPL::Code::Loader;
+#require IMPL::Code::Loader;
+
+our %PENDING;
+our $LOADER_LOG;
+
+our $level = 0;
 
 sub import {
 	my ($self, $aliases) = @_;
@@ -15,11 +20,16 @@
 	no strict 'refs';
 	
 	while( my ($alias, $class) = each %$aliases ) {
+		_trace("$alias => $class");
+		$level++;
+	    
 	    $class = _require($class);
 		
 		*{"${caller}::$alias"} = set_prototype(sub {
             $class
         }, '');
+        
+        $level--;
 	}
 }
 
@@ -28,11 +38,27 @@
 
     if ( not $class =~ s/^-// ) {
         ( my $file = $class ) =~ s/::|'/\//g;
+        _trace("already pending") and return
+            if $PENDING{$class};
+        $PENDING{$class} = 1;
+        _trace("loading $file.pm");
+        $level++;
         require "$file.pm";
+        $level--;
+        _trace("loaded $file.pm");
+        delete $PENDING{$class};
     }
     $class;
 }
 
+sub _trace {
+	my ($message) = @_;
+	
+	$LOADER_LOG->print("\t" x $level ,"$message\n") if $LOADER_LOG;
+	
+	return 1;
+}
+
 1;
 
 __END__