diff Lib/IMPL/Code/Loader.pm @ 209:a8db61d0ed33

IMPL::Class::Meta refactoring
author cin
date Mon, 28 May 2012 19:58:56 +0400
parents 4d0e1962161c
children 47f77e6409f7
line wrap: on
line diff
--- a/Lib/IMPL/Code/Loader.pm	Fri May 18 18:43:00 2012 +0400
+++ b/Lib/IMPL/Code/Loader.pm	Mon May 28 19:58:56 2012 +0400
@@ -2,32 +2,47 @@
 use strict;
 use warnings;
 
-my %packages;
+use IMPL::lang qw(:declare :constants);
+
+use IMPL::declare {
+	require => {
+		Exception => 'IMPL::Exception',
+		ArgumentException => '-IMPL::InvalidArgumentException' 
+	},
+	base => {
+		'IMPL::Object' => undef,
+		'IMPL::Object::Autofill' => '@_'
+	}
+};
 
-sub Provide {
-    my ($self,$package) = @_;
-    
-    my ($declaringPackage,$file) = caller();
-    $packages{$package} = { declaringPackage => $declaringPackage, file => $file, evidence => 'provide' };
+my $default;
+sub default {
+	$default ||= new IMPL::Code::Loader;
 }
 
+my $safe;
+sub safe {
+	$safe ||= new IMPL::Code::Loader(verifyNames => 1);
+}
+
+BEGIN {
+	public property verifyNames => PROP_GET | PROP_OWNERSET;
+	public property prefix => PROP_GET | PROP_OWNERSET;
+}
+
+
 sub Require {
-    my ($self,$package) = @_;
+    my ($this,$package) = @_;
     
-    return 1 if $packages{$package};
+    if ($this->verifyNames) {
+    	$package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/ or die ArgumentException->new("package") ;
+    }
     
-    if (my $file = $INC{$package}) {
-        $packages{$package} = { file => $file, evidence => 'inc' };
-        return 1;
-    } 
+    $package = $this->prefix . $package if $this->prefix;
     
-    undef $@;
+    my $file = join('/', split(/::/,$package)) . ".pm";
     
-    if ( eval "require $package; 1;" and not $packages{$package}) {
-        $packages{$package} = { file => $INC{$package}, evidence => 'inc' };
-    };
-            
-    die $@ if $@ and not $!;
+    require $file;
 }
 
 1;