# HG changeset patch
# User cin
# Date 1334923596 -14400
# Node ID 2ffe6f66160550198dfe03e91cb083822815b4e6
# Parent  6b1dda99883933afe907b487ee2456e42939d278
Implemented IMPL::Web::Handler::RestController
fixes in IMPL::Serialization
completed IMPL::Web::Application::RestResource
added IMPL::Web::Handler::JSONView
added IMPL::Web::RestContract

diff -r 6b1dda998839 -r 2ffe6f661605 Lib/IMPL/Config/Reference.pm
--- a/Lib/IMPL/Config/Reference.pm	Thu Apr 19 02:10:02 2012 +0400
+++ b/Lib/IMPL/Config/Reference.pm	Fri Apr 20 16:06:36 2012 +0400
@@ -3,8 +3,6 @@
 
 use IMPL::Exception;
 
-__PACKAGE__->PassThroughArgs;
-
 sub restore {
 	my ($self,$data,$surrogate) = @_;
 	
@@ -13,9 +11,8 @@
 	my ($tagTarget,$target) = splice @$data, 0, 2;
 	
 	die new IMPL::Exception('A traget tag must be the first tag in the reference specification') unless $tagTarget eq 'target';
-	
 	while(my ($method,$args) = splice @$data, 0, 2 ) {
-		$target = $self->_Invoke({ method => $method, args => $args});
+		$target = $self->_InvokeMember($target,{ method => $method, args => $args});
 	}
 	return $target;
 }
@@ -24,9 +21,7 @@
     my ($self,$object,$member) = @_;
     
     my $method = $member->{method};
-    
-    local $@;
-    return eval {
+    return 
         ref $object eq 'HASH' ?
             $object->{$method}
             :
@@ -36,7 +31,7 @@
                     :
                     ()
             )
-    };
+    ;
 }
 
 sub _as_list {
diff -r 6b1dda998839 -r 2ffe6f661605 Lib/IMPL/Object/Autofill.pm
--- a/Lib/IMPL/Object/Autofill.pm	Thu Apr 19 02:10:02 2012 +0400
+++ b/Lib/IMPL/Object/Autofill.pm	Fri Apr 20 16:06:36 2012 +0400
@@ -82,9 +82,22 @@
 __END__
 
 =pod
+
+=head1 NAME
+
+C<IMPL::Object::Autofill> - автозаполнение объектов
+
 =head1 SYNOPSIS
+
+=begin code
+
 package MyClass;
-use parent qw(IMPL::Object IMPL::Object::Autofill);
+use IMPL::declare {
+	base => {
+		'IMPL::Object' => undef,
+        'IMPL::Object::Autofill' => '@_'	
+	}
+};
 
 BEGIN {
     private property PrivateData => prop_all;
@@ -93,18 +106,17 @@
 
 sub CTOR {
     my $this = shift;
-    $this->superCTOR(@_);
-    # or eqvivalent
-    # $this->supercall::CTOR(@_);
-
+    
     print $this->PrivateData,"\n";
     print $this->PublicData,"\n";
 }
 
 my $obj = new MyClass(PrivateData => 'private', PublicData => 'public', Other => 'some data');
 
-will print
-private
-public
+#will print
+#private
+#public
+
+=end code
 
 =cut
diff -r 6b1dda998839 -r 2ffe6f661605 Lib/IMPL/Serialization.pm
--- a/Lib/IMPL/Serialization.pm	Thu Apr 19 02:10:02 2012 +0400
+++ b/Lib/IMPL/Serialization.pm	Fri Apr 20 16:06:36 2012 +0400
@@ -242,7 +242,7 @@
       return 1;
     }
     
-    my $refObj = $this->{$ObjectFactory} ?$this->{$ObjectFactory}->($rhObject->{'Type'},$rhObject->{'Data'},$rhObject->{'Id'} ? $this->{$Context}->{$rhObject->{'Id'}} : undef) : DefaultFactory($rhObject->{'Type'},$rhObject->{'Data'},$rhObject->{'Id'} ? $this->{$Context}->{$rhObject->{'Id'}} : undef);
+    my $refObj = $this->{$ObjectFactory} ?$this->{$ObjectFactory}->($rhObject->{'Type'},$rhObject->{'Data'},$rhObject->{'Id'} ? $this->{$Context}->{$rhObject->{'Id'}} : undef) : DefaultFactory($rhObject->{'Type'},$rhObject->{'Data'} || [],$rhObject->{'Id'} ? $this->{$Context}->{$rhObject->{'Id'}} : undef);
       
     die new Exception("Trying to close a non existing oject") if not $rhObject;
   
@@ -284,6 +284,15 @@
   scalar keys %{"$_[0]::"} ? 1 : 0;
 }
 
+{
+	my %classes;
+	sub _load_class {
+		my $class = shift;
+		$classes{$class} = 1;
+		eval "require $class";
+	}
+}
+
 sub DefaultSurrogateHelper {
   my ($Type) = @_;
   
@@ -295,7 +304,7 @@
   } elsif ($Type eq 'HASH') {
     return {};
   } elsif ($Type) {
-    eval "require $Type" unless _is_class($Type);
+    _load_class($Type);
     if (UNIVERSAL::can($Type,'surrogate')) {
       return $Type->surrogate();
     } else {
@@ -350,7 +359,7 @@
       return $refSurogate;
     }
   } else {
-    eval "require $Type; 1;" or warn $@ unless _is_class($Type);
+    _load_class($Type);
     if ( $Type->UNIVERSAL::can('restore') ) {
       return $Type->restore($Data,$refSurogate);
     } else {
diff -r 6b1dda998839 -r 2ffe6f661605 Lib/IMPL/Transform.pm
--- a/Lib/IMPL/Transform.pm	Thu Apr 19 02:10:02 2012 +0400
+++ b/Lib/IMPL/Transform.pm	Fri Apr 20 16:06:36 2012 +0400
@@ -15,12 +15,13 @@
 }
 
 sub CTOR {
-    my ($this,%args) = @_;
+    my $this = shift;
+    my $args = @_ == 1 ? shift : { @_ };
     
-    $this->{$plain} = delete $args{-plain};
-    $this->{$default} = delete $args{-default};
+    $this->{$plain} = delete $args->{-plain};
+    $this->{$default} = delete $args->{-default};
     
-    $this->{$templates} = \%args;
+    $this->{$templates} = $args;
 }
 
 sub Transform {
@@ -59,6 +60,7 @@
             	
             	$t = $this->{$templates}->{$sclass};
             	
+            	#cache and return
             	return $this->{$_cache}->{$class} = $t if $t;
             	
             	push @isa, @{"${sclass}::ISA"};
diff -r 6b1dda998839 -r 2ffe6f661605 Lib/IMPL/Web/Application.pm
--- a/Lib/IMPL/Web/Application.pm	Thu Apr 19 02:10:02 2012 +0400
+++ b/Lib/IMPL/Web/Application.pm	Fri Apr 20 16:06:36 2012 +0400
@@ -2,29 +2,46 @@
 use strict;
 use warnings;
 
-use parent qw(IMPL::Config IMPL::Object::Singleton);
+use IMPL::lang qw(:declare :constants);
+use CGI;
+use Carp qw(carp);
 
-require IMPL::Web::Application::Action;
-require IMPL::Web::Application::Response;
-
-use IMPL::Class::Property;
-use CGI;
+use IMPL::declare {
+	require => {
+        TAction => 'IMPL::Web::Application::Action',
+        TResponse => 'IMPL::Web::Application::Response',
+        TFactory => '-IMPL::Object::Factory'
+	},
+	base => {
+		'IMPL::Config' => '@_',
+		'IMPL::Object::Singleton' => '@_'
+	}
+};
 
-__PACKAGE__->PassThroughArgs;
+BEGIN {
+	public property handlerError => PROP_ALL;
+	public property actionFactory => PROP_ALL;
+	public property handlers => PROP_ALL | PROP_LIST;
+	public property responseCharset => PROP_ALL;
+	public property security => PROP_ALL;
+	public property options => PROP_ALL;
+	public property fetchRequestMethod => PROP_ALL;
+}
 
-public property handlerError => prop_all;
-public property actionFactory => prop_all;
-public property handlersQuery => prop_all | prop_list;
-public property responseCharset => prop_all;
-public property security => prop_all;
-public property options => prop_all;
-public property fetchRequestMethod => prop_all;
+
+#TODO: remove
+sub handlersQuery {
+	carp "handlersQuery is obsolete use handlers instead";
+	goto &handlers;
+}
 
 
 sub CTOR {
     my ($this) = @_;
     
-    $this->actionFactory(typeof IMPL::Web::Application::Action) unless $this->actionFactory;
+    die IMPL::InvalidArgumentException->new("handlers","At least one handler should be supplied") unless $this->handlers->Count;
+    
+    $this->actionFactory(TAction) unless $this->actionFactory;
     $this->responseCharset('utf-8') unless $this->responseCharset;
     $this->fetchRequestMethod(\&defaultFetchRequest) unless $this->fetchRequestMethod;
     $this->handlerError(\&defaultHandlerError) unless $this->handlerError;
@@ -33,6 +50,10 @@
 sub Run {
     my ($this) = @_;
     
+    my $handler;
+    
+    $handler = _ChainHandler($_,$handler) foreach $this->handlers;
+    
     while (my $query = $this->FetchRequest()) {
         
         my $action = $this->actionFactory->new(
@@ -43,9 +64,7 @@
         eval {
             $action->response->charset($this->responseCharset);
             
-            $action->ChainHandler($_) foreach $this->handlersQuery;
-            
-            $action->Invoke();
+            $handler->($action);
             
             $action->response->Complete;
         };
@@ -57,6 +76,45 @@
     }
 }
 
+sub _ChainHandler {
+	my ($handler,$next) = @_;
+	
+	if (ref $handler eq 'CODE') {
+		return sub {
+			my ($action) = @_;
+			return $handler->($action,$next);
+		};
+	} elsif (eval { $handler->can('Invoke') } ) {
+		return sub {
+			my ($action) = @_;
+			return $handler->Invoke($action,$next);
+		};
+	} elsif (eval{ $handler->isa(TFactory) }) {
+		return sub {
+			my ($action) = @_;
+			my $inst = $handler->new();
+			return $inst->Invoke($action,$next);
+		}
+	} elsif ($handler and not ref $handler and $handler =~ m/^(-)?(\w+(?:::\w+)*)$/) {
+		my $class = $2;
+		if (not $1) {
+			my $mod = $class;
+			$mod =~ s/::/\//g;
+			require "$mod.pm";
+			
+			die IMPL::InvalidArgumentException->("An invalid handler supplied",$handler) unless $class->can('Invoke');
+		}
+		
+		return sub {
+			my ($action) = @_;
+			my $inst = $class->new();
+			return $inst->Invoke($action,$next);
+		};
+	} else {
+		die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler);
+	}
+}
+
 sub FetchRequest {
     my ($this) = @_;
     
diff -r 6b1dda998839 -r 2ffe6f661605 Lib/IMPL/Web/Application/RestResource.pm
--- a/Lib/IMPL/Web/Application/RestResource.pm	Thu Apr 19 02:10:02 2012 +0400
+++ b/Lib/IMPL/Web/Application/RestResource.pm	Fri Apr 20 16:06:36 2012 +0400
@@ -1,13 +1,19 @@
 package IMPL::Web::Application::RestResource;
 use strict;
 
-use IMPL::lang qw(:declare :constants);
+use IMPL::lang qw(:declare :constants is);
+use IMPL::Exception();
+
 use IMPL::declare {
 	require => {
-		ForbiddenException => 'IMPL::Web::ForbiddenException'
+		ForbiddenException => 'IMPL::Web::ForbiddenException',
+		InvalidOpException => '-IMPL::InvalidOperationException',
+		ArgumentException => '-IMPL::InvalidArgumentException',
+		TTransform => '-IMPL::Transform'
 	},
 	base => {
-		'IMPL::Object' => undef
+		'IMPL::Object' => undef,
+		'IMPL::Object::Autofill' => '@_'
 	}
 };
 
@@ -22,6 +28,12 @@
 	public property delete => PROP_GET | PROP_OWNERSET;
 }
 
+sub CTOR {
+	my ($this) = @_;
+	
+	die ArgumentException->new("target") unless $this->target;
+}
+
 sub GetHttpImpl {
 	my($this,$method) = @_;
 	
@@ -36,11 +48,11 @@
 }
 
 sub InvokeHttpMethod {
-	my ($this,$method,$child,$action) = @_;
+	my ($this,$method,$childId,$action) = @_;
 	
-	my $impl = $this->GetHttpImpl($method) || 'FallbackImpl';
+	my $impl = $this->GetHttpImpl($method) || 'HttpFallbackImpl';
 	
-	return $this->$impl($child,$action);
+	return $this->$impl($childId,$action);
 }
 
 sub GetImpl {
@@ -49,8 +61,8 @@
     my $rx;
     my $method;
     if (length $id == 0) {
-    	$method = $this->list;
-    } elsif ($method = $this->methods->{$id}) {
+    	$method = $this->list or die ForbiddenException->new();
+    } elsif ($this->methods and $method = $this->methods->{$id}) {
     	if (ref $method eq 'HASH' and not $method->{allowGet}) {
     		die ForbiddenException->new();
     	}
@@ -62,8 +74,6 @@
         	parameters => [qw(id)]
         } unless ref $method;
         
-    } else {    
-        die ForbiddenException->new();
     }
     
     return $this->InvokeMember($method,$id,$action);
@@ -131,8 +141,57 @@
 
 sub InvokeMember {
 	my ($this,$method,$id,$action) = @_;
+	
+	#normalize method info
+	if (not ref $method) {
+		$method = {
+			method => $method
+		};
+	}
+	
+	if (ref $method eq 'HASH') {
+		my @args;
+		my $member = $method->{method} or die InvalidOpException->new("A member name isn't specified");
+		if (my $params = $method->{parameters}) {
+			if (ref $params eq 'HASH') {
+				@args = map {
+					$_,
+					$this->MakeParameter($params->{$_},$id,$action)
+				} keys %$params;				
+			} elsif (ref $params eq 'ARRAY') {
+				@args = map $this->MakeParameter($_,$id,$action), @$params;
+			} else {
+				@args = ($this->MakeParameter($params,$id,$action)); 
+			}
+		}
+		$this->target->$member(@args);
+	} else {
+		die InvalidOpException->new("Unsupported type of the method information", ref $method);
+	}
 }
 
+sub MakeParameter {
+	my ($this,$param,$id,$action) = @_;
+	
+	if ($param) {
+		if (is $param, TTransform ) {
+			return $param->Transform($this,$action->query);
+		} elsif ($param and not ref $param) {
+			my %std = (
+                id => $id,
+                action => $action,
+                query => $action->query
+			);
+			
+			return $std{$param} || $action->query->param($param);
+		}
+	} else {
+		return undef;
+	}
+}
+
+
+
 
 1;
 
@@ -195,16 +254,14 @@
     DataContext->Default,
     {
     	methods => {
-    		get => {
-    			
+    		history => {
+    			allowGet => 1,
+    			method => 'GetHistory',
+    			parameters => [qw(from to)] 
     		},
-    		post => {
-    			
-    		}
     	}
-    	get => 'search',
-    	
-    	
+    	list => 'search',
+    	fetch => 'GetItemById'
     }   
 );
 
@@ -241,6 +298,10 @@
 
 Добавляет новый дочерний ресурс в коллекцию.
 
+=head3 C<POST {method}>
+
+Вызывает метод C<method>.
+
 =head2 HTTP METHOD MAPPING 
 
 =head3 C<POST {method}>
@@ -256,26 +317,161 @@
 
 =head2 C<[get]methods>
 
+Содержит описания методов, которые будут публиковаться как дочерние ресурсы.
+
 =head2 C<[get]childRegex>
 
+Содержит регулярное выражение для идентификаторов дочерних объектов. Если оно
+не задано, то данный ресурс не является коллекцией.
+
 =head2 C<[get]fetch>
 
+Содержит описание метода для получения дочернего объекта. Если данный метод
+отсутствует, то дочерние ресурсы не получится адресовать относительно данного.
+По умолчанию получает идентификатор дочернего ресурса первым параметром.  
+
 =head2 C<[get]list>
 
+Описание метода для получения списка дочерних объектов. По умолчанию не
+получает параметров.
+
 =head2 C<[get]insert>
 
+Описание метода для добавление дочернего ресурса. По умолчанию получает
+объект C<CGI> описывабщий текущий запрос первым параметром.
+
 =head2 C<[get]update>
 
+Описание метода для обновления дочернего ресурса. По умолчанию получает
+идентификатор дочернего ресурса и объект C<CGI> текущего запроса.
+
 =head2 C<[get]delete>
 
+Описание метода для удаления дочернего ресурса. По умолчанию получает
+идентификатор дочернего ресурса.
+
 =head2 C<GetImpl($child,$action)>
 
+=over
+
+=item C<$child>
+
+Идентификатор дочернего ресутсра
+
+=item C<$action>
+
+Текущий запрос C<IMPL::Web::Application::Action>.
+
+=back
+
+Переадресует запрос нужному методу внутреннего объекта C<target> при
+помощи C<InvokeMember>.
+
 =head2 C<PutImpl($child,$action)>
 
+=over
+
+=item C<$child>
+
+Идентификатор дочернего ресутсра
+
+=item C<$action>
+
+Текущий запрос C<IMPL::Web::Application::Action>.
+
+=back
+
+Переадресует запрос нужному методу внутреннего объекта C<target> при
+помощи C<InvokeMember>.
+
 =head2 C<PostImpl($child,$action)>
 
+=over
+
+=item C<$child>
+
+Идентификатор дочернего ресутсра
+
+=item C<$action>
+
+Текущий запрос C<IMPL::Web::Application::Action>.
+
+=back
+
+Переадресует запрос нужному методу внутреннего объекта C<target> при
+помощи C<InvokeMember>.
+
 =head2 C<DeleteImpl($child,$action)>
 
+=over
+
+=item C<$child>
+
+Идентификатор дочернего ресутсра
+
+=item C<$action>
+
+Текущий запрос C<IMPL::Web::Application::Action>.
+
+=back
+
+Переадресует запрос нужному методу внутреннего объекта C<target> при
+помощи C<InvokeMember>.
+
 =head2 C<InvokeMember($memberInfo,$child,$action)>
 
+=over
+
+=item C<$memberInfo>
+
+Описание члена внутреннего объекта C<target>, который нужно вызвать.
+
+=item C<$child>
+
+Идентификатор дочернего ресутсра
+
+=item C<$action>
+
+Текущий запрос C<IMPL::Web::Application::Action>.
+
+=back
+
+Вызывает метод внутреннего объекта C<target>, предварительно подготовив
+параметры на основе описания C<$memberInfo> и при помощи С<MakeParameter()>.
+
+=head2 C<MakeParameter($paramDef,$child,$action)>
+
+=over
+
+=item C<$paramDef>
+
+Описание параметра, может быть C<IMPL::Transform> или простая строка.
+
+Если описание параметра - простая строка, то ее имя либо
+
+=over
+
+=item C<id>
+
+Идентификатор дочернего ресурса
+
+=item C<query>
+
+Объект C<CGI> текущего запроса
+
+=item C<action>
+
+Текущий запрос C<IMPL::Web::Application::Action>
+
+=item C<любое другое значение>
+
+Интерпретируется как параметр текущего запроса.
+
+=back
+
+Если описание параметра - объект C<IMPL::Transform>, то будет выполнено это преобразование над C<CGI>
+объектом текущего запроса C<< $paramDef->Transform($action->query) >>.
+
+=back
+
 =cut
\ No newline at end of file
diff -r 6b1dda998839 -r 2ffe6f661605 Lib/IMPL/Web/Handler/JSONView.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Handler/JSONView.pm	Fri Apr 20 16:06:36 2012 +0400
@@ -0,0 +1,35 @@
+package IMPL::Web::Handler::JSONView;
+use strict;
+use JSON;
+
+use IMPL::lang qw(:declare :constants);
+use IMPL::declare {
+	base => {
+		'IMPL::Object' => undef,
+		'IMPL::Object::Serializable' => undef,
+		'IMPL::Object::Autofill' => '@_'
+	}
+};
+
+sub Invoke {
+	my ($this,$action,$next) = @_;
+	
+	my $result = $next->($action);
+	$result = [$result] unless ref $result;
+	
+	$action->response->contentType('text/javascript');
+    
+    my $hout = $action->response->streamBody;
+    
+    print $hout JSON->new->utf8->pretty->encode($result);
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1
+
+=cut
\ No newline at end of file
diff -r 6b1dda998839 -r 2ffe6f661605 Lib/IMPL/Web/Handler/RestController.pm
--- a/Lib/IMPL/Web/Handler/RestController.pm	Thu Apr 19 02:10:02 2012 +0400
+++ b/Lib/IMPL/Web/Handler/RestController.pm	Fri Apr 20 16:06:36 2012 +0400
@@ -5,15 +5,18 @@
 
 use IMPL::declare {
 	require => {
+		HttpException => 'IMPL::Web::Exception',
         NotFoundException => 'IMPL::Web::NotFoundException'
 	},
 	base => {
 		'IMPL::Object' => undef,
+		'IMPL::Object::Autofill' => '@_',
+		'IMPL::Object::Serializable' => undef
 	}	
 };
 
 BEGIN {
-	public property rootResource => PROP_GET | PROP_OWNERSET;
+	public property root => PROP_GET | PROP_OWNERSET;
 	public property contract => PROP_GET | PROP_OWNERSET;
 }
 
@@ -29,19 +32,22 @@
 	
 	my @segments = split /\//, $pathInfo;
 	
+	# remove first segment since it's always empty
+	shift @segments;
+	
 	my ($obj,$view) = (pop(@segments) =~ m/(.*?)(?:\.(\w+))?$/);
 	
 	$action->context->{view} = $view;
 	
-	my $res = $this->rootResource;
+	my $res = $this->contract->Transform($this->root);
 	
 	while(@segments) {
-		$res = $res->InvokeHttpMethod('GET',shift @segments);
+		$res = $this->contract->Transform( $res->InvokeHttpMethod('GET',shift @segments,$action) );
 		
 		die NotFoundException->new() unless $res;
 	}
 	
-	return $res->InvokeHttpMethod($method,$obj);
+	$res = $res->InvokeHttpMethod($method,$obj,$action);
 }
 
 1;
diff -r 6b1dda998839 -r 2ffe6f661605 Lib/IMPL/Web/RestContract.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/RestContract.pm	Fri Apr 20 16:06:36 2012 +0400
@@ -0,0 +1,57 @@
+package IMPL::Web::RestContract;
+use strict;
+
+use IMPL::lang qw(:declare :constants);
+use IMPL::declare {
+	require => {
+		Exception => 'IMPL::Exception',
+		InvalidOpException => '-IMPL::InvalidOperationException',
+		ForbiddenException => 'IMPL::Web::ForbiddenException',
+		TRestResource => 'IMPL::Web::Application::RestResource',
+	},
+	base => {
+		'IMPL::Transform' => sub { my %args = @_; $args{resources} },
+		'IMPL::Object::Serializable' => undef
+	}
+};
+
+sub CTOR {
+	my ($this) = @_;
+	
+	$this->templates->{-plain} = sub { die ForbiddenException->new(); };
+	$this->templates->{-default} = sub { die ForbiddenException->new(); };
+	$this->templates->{TRestResource} = sub { $_[0] };
+}
+
+sub ProcessTemplate {
+	my ($this,$t,$obj,@args) = @_;
+	
+	if (ref $t eq 'HASH') {
+		my $factory = $t->{factory} || TRestResource;
+		return $factory->new(%$t, target => $obj);
+	} elsif (ref $t eq 'CODE') {
+		return $this->$t($obj,@args);
+	} else {
+		die InvalidOpException->new();
+	}
+}
+
+
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Web::RestContract> Описывает правила публикации ресурсов.
+
+=head1 SYNOPSIS
+
+=begin code
+
+=end code 
+
+=cut
\ No newline at end of file
diff -r 6b1dda998839 -r 2ffe6f661605 Lib/IMPL/declare.pm
--- a/Lib/IMPL/declare.pm	Thu Apr 19 02:10:02 2012 +0400
+++ b/Lib/IMPL/declare.pm	Fri Apr 20 16:06:36 2012 +0400
@@ -17,10 +17,10 @@
 	my $aliases = $args->{require} || {};
 	
 	while( my ($alias, $class) = each %$aliases ) {
-		_require($class);
+		my $c = _require($class);
         
         *{"${caller}::$alias"} = set_prototype(sub {
-            $class
+            $c
         }, '');
     }
     
diff -r 6b1dda998839 -r 2ffe6f661605 _test/temp.pl
--- a/_test/temp.pl	Thu Apr 19 02:10:02 2012 +0400
+++ b/_test/temp.pl	Fri Apr 20 16:06:36 2012 +0400
@@ -1,29 +1,4 @@
 #!/usr/bin/perl
 use strict;
 
-package Bar;
-
-sub CTOR {
-	shift;
-	warn @_;
-}
-
-package Foo;
-
-use IMPL::declare {
-	require => {
-		TObject => 'IMPL::Object'
-	},
-	base => {
-		TObject => '@_',
-		-Bar => '@_'
-	}
-};
-
-sub hello {
-	return TObject;
-}
-
-package main;
-
-print Foo->new(qw(one for me))->hello;
\ No newline at end of file
+print join ',', "-some::mod::here" =~ m/^(-)?(\w+(?:::\w+)*)$/;
\ No newline at end of file