# HG changeset patch
# User cin
# Date 1386938987 -14400
# Node ID d5c8b955bf8d0d7dc20ead90bb3b34d61a890dd6
# Parent  cbf4febf09304ed4f158b361aa7be8e8e2764abf
refactoring

diff -r cbf4febf0930 -r d5c8b955bf8d Lib/IMPL/Security.pm
--- a/Lib/IMPL/Security.pm	Tue Dec 10 03:02:01 2013 +0400
+++ b/Lib/IMPL/Security.pm	Fri Dec 13 16:49:47 2013 +0400
@@ -13,38 +13,6 @@
     Context => 'IMPL::Security::Context'
 };
 
-our @RULES;
-
-sub AccessCheck {
-    my ($self, $object, $desiredAccess, $context) = @_;
-    
-    $context ||= $self->context;
-    
-    $_->($self,$object,$desiredAccess,$context) or return 0 foreach @{$self->Rules};
-    
-    return 1;
-}
-
-sub Take {
-    my ($self,$principal,$refRoles) = @_;
-    
-    die new IMPL::NotImplementedException();
-}
-
-sub MakeContext {
-    my ($this,$principal,$refRoles,$auth) = @_;
-    
-    return Context->new(
-        principal => $principal,
-        rolesAssigned => $refRoles,
-        auth => $auth
-    );
-}
-
-sub Rules {
-    return \@RULES;
-}
-
 sub principal {
     return
         AbstractContext->current
@@ -58,175 +26,4 @@
 
 1;
 
-__END__
-
-=pod
-
-=head1 NAME
-
-C<IMPL::Security> - Модуль для работы с функциями авторизации и аутентификации.
-
-=head1 SINOPSYS
-
-=begin code
-
-use IMPL::Security;
-
-my Method {
-    my $this = shift;
-    
-    # access check in the current context, using standard configuration
-    IMPL::Security->AccessCheck($this,'Method') or die new IMPL::AccessDeniedException("Access is denied");
-    
-    #some more results 
-}
-
-my DelegationMethod {
-    
-    my $this = shift;
-    
-    #forced delegation 
-    my $delegatedContext = IMPL::Security::Context->new(
-        principal => IMPL::Security::Principal->new(
-            name => 'suser'
-        ),
-        rolesAssigned => ['administrator']
-    )
-    
-    my $result;
-    
-    $delegatedContext->Impersonate(sub{
-        $result = $this->Method();
-    });
-    
-    return $result;
-}
-
-my SafeDelegationMethod {
-    
-    my $this = shift;
-    
-    my $delegatedContext = IMPL::Security->Take( suser => 'administrator' );
-    
-    my $result;
-    
-    $delegatedContext->Impersonate(sub{
-        $result = $this->Method();
-    });
-    
-    return $result;
-}
-
-=end code
-
-=head1 DESCRIPTION
-
-Модуль для инфраструктуры безопасности, реализует основные функции для авторизации
-и аутентификации пользователей.
-
-Модуль аутентификации, реализиция которого зависит от приложения, аутентифицирует
-пользователя, при этом создается контекст безопасности, который содержит
-идентификатор пользователя и список активных ролей.
-
-При проверке прав доступа происходит последовательная проверка правил доступа,
-если все правила выполнены, то доступ разрешается.
-
-=head1 MEMBERS
-
-=over
-
-=item C<AccessCheck($object,$desiredAccess,$context)>
-
-Метод. Проверка доступа к объекту с определенными правами, в определенном контексте безопасности.
-
-=over
-
-=item C<$object>
-
-Объект доступа.
-
-=item C<$desiredAccess>
-
-Требуемые права доступа.
-
-=item C<$context>
-
-Контекст безопасности, если не указан, то используется текущий C<< IMPL::Security::Context->contextCurrent >>
-
-=item C<returns>
-
-C<true | false> - результат проверки
-
-=back
-
-=item C<MakeContext($principal,$role,$auth)>
-
-Создает контекст безопасности, инициализируя его передданными параметрами.
-
-=over
-
-=item C<$principal>
-
-Объект пользователя
-
-=item C<$role>
-
-Роль или ссылка на массив ролей
-
-=item C<$auth>
-
-Объект аутентификации
-
-=back
-
-=item C<Take($principal,$role)>
-
-Метод. Делегирует текущему пользователю полномочия другого пользователя. При этом выполняется проверка
-правомерности такой операции. В случае неудачи вызывается исключение.
-
-=over
-
-=item C<$principal>
-
-Либо имя пользователя либо объект C<IMPL::Security::Principal>.
-
-=item C<$role>
-
-Либо имя либо ссылка на роль, или ссылка на массив либо имен, либо ролей.
-
-=item C<returns>
-
-Новый контекст безопасности.
-
-=back
-
-=item C<Rules()>
-
-Возвращает список правил которые выполняются при проверках доступа. Пререопределите этот
-метод, чтобы возвращать собственный список правил. Список правил является ссылкой на массив
-элементами которого являются функции.
-
-=begin code
-
-package MySecurity;
-
-use parent qw(IMPL::Security);
-
-sub Rules {
-    return [
-        \&Rule1,
-        \&Rule2,
-        #...
-    ]
-}
-
-=end code
-
-=item C<[static,get] authority>
-
-Метод, позволяющий получить текущий источник системы безопасности. Источник безопасности, это модуль,
-который получает входные данные и использует их для работы системы безопасности.
-
-=back
-
-=cut
+__END__
\ No newline at end of file
diff -r cbf4febf0930 -r d5c8b955bf8d Lib/IMPL/Web/Handler/SecureCookie.pm
--- a/Lib/IMPL/Web/Handler/SecureCookie.pm	Tue Dec 10 03:02:01 2013 +0400
+++ b/Lib/IMPL/Web/Handler/SecureCookie.pm	Fri Dec 13 16:49:47 2013 +0400
@@ -21,7 +21,7 @@
     },
     props => [  
         salt => PROP_RO,
-        _security => PROP_RO,
+        _security => PROP_RW,
         _cookies => PROP_RW
     ]
 };
diff -r cbf4febf0930 -r d5c8b955bf8d Lib/IMPL/Web/Handler/View.pm
--- a/Lib/IMPL/Web/Handler/View.pm	Tue Dec 10 03:02:01 2013 +0400
+++ b/Lib/IMPL/Web/Handler/View.pm	Fri Dec 13 16:49:47 2013 +0400
@@ -41,10 +41,9 @@
 
     my $result = $next ? $next->($action) : undef;
     
-    my ($model,$template);
+    my $model;
     if( ref $result and eval { $result->isa(ViewResult) } ) {
         $model = $result->model;
-        $template = $result->template;
     } else {
         $model = $result;
         $result = ViewResult->new(model => $model);
@@ -67,7 +66,7 @@
         charset => $this->contentCharset,
 	        body => $this->view->display(
 	      	$model,
-	      	$template || $this->SelectView( $action, ref $model ),
+	      	$this->SelectView( $action, ref $model ),
 	        $vars
 	    )
     );
diff -r cbf4febf0930 -r d5c8b955bf8d Lib/IMPL/Web/View/Metadata/FormMeta.pm
--- a/Lib/IMPL/Web/View/Metadata/FormMeta.pm	Tue Dec 10 03:02:01 2013 +0400
+++ b/Lib/IMPL/Web/View/Metadata/FormMeta.pm	Fri Dec 13 16:49:47 2013 +0400
@@ -1,13 +1,15 @@
 package IMPL::Web::View::Metadata::FormMeta;
 use strict;
 
+use IMPL::lang;
 use IMPL::Const qw(:prop);
 use IMPL::declare {
 	require => {
 		Exception => 'IMPL::Exception',
 		ArgException => '-IMPL::InvalidArgumentException',
 		OpException => '-IMPL::InvalidOperationException',
-		SchemaNavigator => 'IMPL::DOM::Navigator::SchemaNavigator'
+		SchemaNavigator => 'IMPL::DOM::Navigator::SchemaNavigator',
+		DOMNode => '-IMPL::DOM::Node'
 	},
 	base => [
 		'IMPL::Web::View::Metadata::BaseMeta' => '@_'
@@ -36,6 +38,39 @@
 		foreach qw(schema);
 }
 
+sub GetSchemaProperty {
+	my ($this,$name) = @_;
+	
+	return $this->decl ? $this->decl->nodeProperty($name) || $this->schema->nodeProperty($name) : $this->schema->nodeProperty($name);
+}
+
+sub template {
+	shift->GetSchemaProperty('template');
+}
+
+sub label {
+	shift->GetSchemaProperty('display');
+}
+
+sub inputType {
+	shift->GetSchemaProperty('inputType');
+}
+
+sub inputValue {
+	my ($this) = @_;
+	
+	if($this->isMultiple) {
+		return [
+			map {
+				$_ ? $_->nodeValue || $_->nodeProperty('rawValue') : undef
+			}
+			@{$this->model || []}
+		]
+	} else {
+		return $this->model ? $this->model->nodeValue || $this->model->nodeProperty('rawValue') : undef;
+	}
+}
+
 sub isMultiple {
 	my ($this) = @_;
 	$this->decl && $this->decl->isMultiple;
@@ -51,15 +86,17 @@
 	
 	my $nodes = $this->nodes;
 	
-	return [
+	my $errors = [
 		grep _IsOwnError($nodes,$this->decl,$_), @{$this->errors || []}
 	];
+	
+	return $errors;
 }
 
 sub _IsOwnError {
     my ($nodes,$source,$err) = @_;
-    
-    return 1 if ($err->node && grep($err->node == $_, @$nodes)) || (not(@$nodes) && $err->schema == $source );
+
+ 	return 1 if ($err->node && grep($err->node == $_, @$nodes)) || (not(@$nodes) && $err->schema == $source );
     
     return 0;
 }
@@ -102,14 +139,14 @@
 			name => $decl->name,
 			decl => $decl,
 			schema => $schema,
-			nodes => \@nodes,
+			nodes => [@nodes],
 			errors => [grep _IsErrorRelates(\@nodes,$decl,$_), @{$this->errors || []}]
 		);
 		
 		my ($model,$type);
 		
 		if ($decl->isMultiple) {
-			$model = \@nodes; 
+			$model = [@nodes]; 
 			$type = 'ARRAY';
 			$args{holdingType} = $schema->type;
 		} else {
@@ -166,6 +203,28 @@
 	);
 }
 
+sub GetMetadataForModel {
+	my ($self,$model,$args) = @_;
+	
+	$args ||= {};
+	
+	my $modelType = delete $args->{modelType};
+	
+	if($model) {
+		die ArgException->new(model => "A node is required")
+			unless is($model,DOMNode);
+		
+		$args->{decl} ||= $model->schemaSource;
+		$args->{schema} ||= $model->schema; 
+	}
+	
+	return $self->new(
+		$model,
+		$modelType,
+		$args
+	);
+}
+
 1;
 
 __END__
@@ -243,9 +302,9 @@
 	my ($index,$tmpl) = @_;
 	
 	if ($index =~ /^\d+$/) {
-		return render($tmpl, meta => { $meta->GetItem($index) });
+		return render($tmpl, metadata => { $meta->GetItem($index) });
 	} else {
-		return render($tmpl, meta => { $meta->GetProperty($index) });
+		return render($tmpl, metadata => { $meta->GetProperty($index) });
 	}
 }
 
diff -r cbf4febf0930 -r d5c8b955bf8d Lib/IMPL/Web/View/Metadata/ObjectMeta.pm
--- a/Lib/IMPL/Web/View/Metadata/ObjectMeta.pm	Tue Dec 10 03:02:01 2013 +0400
+++ b/Lib/IMPL/Web/View/Metadata/ObjectMeta.pm	Fri Dec 13 16:49:47 2013 +0400
@@ -2,7 +2,7 @@
 use strict;
 
 use IMPL::lang;
-use IMPL::Const qw(:prop);
+use IMPL::Const qw(:prop :access);
 use IMPL::declare {
 	require => {
 		Exception => 'IMPL::Exception',
@@ -49,8 +49,14 @@
 	my $modelType = $this->modelType;  
 
 	if ( isclass($modelType,AbstractObject) ) {
-		foreach my $pi ($this->modelType->GetMeta(PropertyInfo, sub { not($seen{$_}++) }, 1)) {
-			my $pv = $pi->getter->($this->model);
+		foreach my $pi (
+			$this->modelType->GetMeta(
+				PropertyInfo,
+				sub { not($seen{$_}++) and $_->access == ACCESS_PUBLIC },
+				1
+			)
+		) {
+			my $pv = $this->model && $pi->getter->($this->model);
 			my $pt;
 			
 			my %args = (name => $pi->name);
@@ -110,6 +116,18 @@
 	);
 }
 
+sub GetMetadataForModel {
+	my ($self,$model,$args) = @_;
+	
+	$args ||= {};
+	
+	return $self->new(
+		$model,
+		delete $args->{modelType},
+		$args
+	)
+}
+
 1;
 
 __END__
diff -r cbf4febf0930 -r d5c8b955bf8d Lib/IMPL/Web/View/TTContext.pm
--- a/Lib/IMPL/Web/View/TTContext.pm	Tue Dec 10 03:02:01 2013 +0400
+++ b/Lib/IMPL/Web/View/TTContext.pm	Fri Dec 13 16:49:47 2013 +0400
@@ -14,7 +14,9 @@
 	   TypeKeyedCollection => 'IMPL::TypeKeyedCollection',
 	   ArgException => '-IMPL::InvalidArgumentException',
 	   Resources => 'IMPL::Resources',
-	   Loader => 'IMPL::Code::Loader'
+	   Loader => 'IMPL::Code::Loader',
+	   MetadataBase => '-IMPL::Web::View::Metadata::BaseMeta',
+	   Metadata => 'IMPL::Web::View::Metadata::ObjectMeta'
 	},
 	base => [
 		'Template::Context' => '@_'
@@ -154,14 +156,15 @@
 	my $prefix = $this->prefix;
 	
 	my $info;
-	my $meta = $this->resolve_model($path,$args);
+	my $meta = $this->resolve_model($path,$args)
+		or return "[not found '$path']";
 	
-	$info->{prefix} = $prefix ? $prefix . '.' . $path : $path;
+	$info->{prefix} = join('.', grep($_, $prefix, $path));
 	$info->{model} = $meta->model;
 	$info->{metadata} = $meta;
 	
 	$template ||= $info->{template};
-	$template = $template ? $this->find_template($template) : $this->find_template_for($info->{model});
+	$template = $template ? $this->find_template($template) : $this->find_template_for($info->{metadata});
 	
 	return $this->render(
         $template,
@@ -184,25 +187,25 @@
         $args = shift;
     }
     
-    $args ||= {};
+    #copy
+    $args = { %{$args || {}} };
     
-    my $prefix = delete $args->{prefix} || $this->prefix;
-    
-    if (my $rel = delete $args->{rel}) {
-    	$prefix = $prefix ? "${prefix}.${rel}" : $rel;
+    $args->{prefix} = join('.',grep($_,$this->prefix,$args->{path}))
+    	unless defined $args->{prefix};
+    	
+    if (is($model,MetadataBase)) {
+    	$args->{model} = $model->model;
+    	$args->{metadata} = $model;
+    } else {
+    	$args->{model} = $model;
+    	$args->{metadata} = Metadata->GetMetadataForModel($model);
     }
     
-    $template = $template ? $this->find_template($template) : $this->find_template_for($model);
+    $template = $template ? $this->find_template($template) : $this->find_template_for($args->{metadata});
     
     return $this->render(
         $template,
-        hashApply(
-            {
-                prefix => $prefix,
-                model => $model,
-            },
-            $args
-        )
+        $args
     );
 }
 
@@ -325,6 +328,11 @@
 	   unless defined $prefix;
 	
 	my $meta = $this->metadata;
+	unless($meta) {
+		$meta = Metadata->GetMetadataForModel($this->model);
+		$this->metadata($meta);
+	}
+	
 	foreach my $part (grep length($_), split(/\.|\[(\d+)\]/, $prefix)) {
 		last unless $meta;
 		if ($part =~ /^\d+$/) {
@@ -340,6 +348,9 @@
 sub find_template_for {
 	my ($this,$meta, $nothrow) = @_;
 	
+	die ArgException->new(meta => 'An invalid metadata is supplied')
+		unless is($meta,MetadataBase);
+	
 	return $this->find_template($meta->template)
 		if ($meta->template);
 	
diff -r cbf4febf0930 -r d5c8b955bf8d Lib/IMPL/Web/View/TTView.pm
--- a/Lib/IMPL/Web/View/TTView.pm	Tue Dec 10 03:02:01 2013 +0400
+++ b/Lib/IMPL/Web/View/TTView.pm	Fri Dec 13 16:49:47 2013 +0400
@@ -7,7 +7,8 @@
 use IMPL::declare {
 	require => {
 		Context => 'IMPL::Web::View::TTContext',
-		Loader  => 'IMPL::Code::Loader'
+		Loader  => 'IMPL::Code::Loader',
+		Factory => 'IMPL::Web::View::ObjectFactory'
 	},
 	base => [
 		'IMPL::Object' => undef,
@@ -86,10 +87,15 @@
 						warn @_;
 					},
 					is => sub {
-						return is(shift,shift);
+						my ($obj,$class) = @_;
+						if (is($class,Factory)) {
+							return is($obj,$class->factory);
+						} else {
+							return is($obj,$class);
+						}
 					},
 					import => sub {
-						return Loader->safe->Require(shift);
+						return Factory->new(Loader->safe->Require(shift));
 					},
 					toJSON => sub {
 						return JSON->new()->utf8->pretty->encode(shift);
diff -r cbf4febf0930 -r d5c8b955bf8d Lib/IMPL/lang.pm
--- a/Lib/IMPL/lang.pm	Tue Dec 10 03:02:01 2013 +0400
+++ b/Lib/IMPL/lang.pm	Fri Dec 13 16:49:47 2013 +0400
@@ -66,15 +66,17 @@
 
 sub is($$) {
     carp "A typename can't be undefined" unless $_[1];
-    eval {ref $_[0] and $_[0]->isa( $_[1] ) };
+    blessed($_[0]) and $_[0]->isa( $_[1] );
 }
 
 sub isclass {
     carp "A typename can't be undefined" unless $_[1];
+    local $@;
     eval {not ref $_[0] and $_[0]->isa( $_[1] ) };
 }
 
 sub typeof(*) {
+	local $@;
     eval { $_[0]->_typeof } || blessed($_[0]) || ref($_[0]);
 }
 
diff -r cbf4febf0930 -r d5c8b955bf8d _test/temp.pl
--- a/_test/temp.pl	Tue Dec 10 03:02:01 2013 +0400
+++ b/_test/temp.pl	Fri Dec 13 16:49:47 2013 +0400
@@ -1,59 +1,13 @@
 #!/usr/bin/perl
 use strict;
 
-use IMPL::require {
-	TTView => 'IMPL::Web::View::TTView'
-};
-
-use Time::HiRes qw(gettimeofday tv_interval);
-
-my $t = [gettimeofday];
-
-my $view = TTView->new(
-	options => {
-		INCLUDE_PATH => './Resources/view',
-		INTERPOLATE => 1,
-		RECURSION => 1000,
-		COMPILE_DIR => '/tmp/ttc'
-	},
-	viewBase => 'site',
-	layoutBase => 'layout',
-	layout => 'default',
-	includes => [
-		'packages'
-	]
-);
+{
+	local $@;
+	eval {
+		
+		die "oops";
+	};
+}
 
-my $model = {
-	name => 'debugger',
-	manufacture => {
-		name => 'DEBUGGERS INC',
-		address => [
-			{
-				coutry => 'Russuia',
-				city => 'Moscow'
-			},
-			{
-				country => 'GB',
-				city => 'Essex'
-			}
-		]
-	}
-}; 
+print $@;
 
-print $view->display(
-	$model,
-	'product/view'
-), "\n";
-
-print "render page: ",tv_interval($t,[gettimeofday]),"s\n";
-
-$t = [gettimeofday];
-
-$view->display(
-	$model,
-	'product/view'
-);
-
-print "2nd render page: ",tv_interval($t,[gettimeofday]),"s\n";
-