changeset 173:aaab45153411

minor bugfixes
author sourcer
date Wed, 14 Sep 2011 18:59:01 +0400
parents 068acfe903c3
children d920d2b70230
files Lib/IMPL/Class/Meta.pm Lib/IMPL/DOM/Node.pm Lib/IMPL/Mailer.pm Lib/IMPL/Security/Context.pm Lib/IMPL/Web/Application/Action.pm Lib/IMPL/Web/Application/ControllerUnit.pm Lib/IMPL/Web/Application/Response.pm Lib/IMPL/Web/QueryHandler/JsonFormat.pm Lib/IMPL/Web/TT/Form.pm Lib/IMPL/clone.pm Lib/IMPL/lang.pm
diffstat 11 files changed, 82 insertions(+), 11 deletions(-) [+]
line wrap: on
line diff
--- a/Lib/IMPL/Class/Meta.pm	Mon Jun 20 23:42:44 2011 +0400
+++ b/Lib/IMPL/Class/Meta.pm	Wed Sep 14 18:59:01 2011 +0400
@@ -1,7 +1,7 @@
 package IMPL::Class::Meta;
 use strict;
 
-use Clone qw(clone);
+use IMPL::clone qw(clone);
 
 my %class_meta;
 my %class_data;
--- a/Lib/IMPL/DOM/Node.pm	Mon Jun 20 23:42:44 2011 +0400
+++ b/Lib/IMPL/DOM/Node.pm	Wed Sep 14 18:59:01 2011 +0400
@@ -329,7 +329,7 @@
     # prevent cyclic
     weaken($this->{$document}) if $this->{$document};
     
-    $_->_updateDocRefs foreach @{$this->{$childNodes}};
+    map $_->_updateDocRefs, @{$this->{$childNodes}} if $this->{$childNodes};
 }
 
 sub _setParent {
--- a/Lib/IMPL/Mailer.pm	Mon Jun 20 23:42:44 2011 +0400
+++ b/Lib/IMPL/Mailer.pm	Wed Sep 14 18:59:01 2011 +0400
@@ -32,7 +32,7 @@
 sub _find_sendmail {
     return $SENDMAIL if defined $SENDMAIL;
 
-    my @path = split /:/, $ENV{PATH};
+    my @path = split (/:/, $ENV{PATH});
     my $sendmail;
     for (@path) {
         if ( -x "$_/sendmail" ) {
--- a/Lib/IMPL/Security/Context.pm	Mon Jun 20 23:42:44 2011 +0400
+++ b/Lib/IMPL/Security/Context.pm	Wed Sep 14 18:59:01 2011 +0400
@@ -67,7 +67,7 @@
 
 sub nobody {
     my ($self) = @_;
-    $nobody = $self->new(principal => IMPL::Security::Principal->nobody, rolesAssigned => undef) unless $nobody;
+    $nobody = $self->new(principal => IMPL::Security::Principal->nobody) unless $nobody;
     $nobody;
 }
 
--- a/Lib/IMPL/Web/Application/Action.pm	Mon Jun 20 23:42:44 2011 +0400
+++ b/Lib/IMPL/Web/Application/Action.pm	Wed Sep 14 18:59:01 2011 +0400
@@ -12,7 +12,7 @@
 	public property query => prop_get | owner_set;
 	public property response => prop_get | owner_set;
 	public property responseFactory => prop_get | owner_set;
-	
+	public property context => prop_get | owner_set;
 	private property _entryPoint => prop_all;
 }
 
@@ -21,6 +21,7 @@
 	
 	$this->responseFactory('IMPL::Web::Application::Response') unless $this->responseFactory; 
 	$this->response( $this->responseFactory->new(query => $this->query) );
+	$this->context({});
 }
 
 sub Invoke {
@@ -49,7 +50,7 @@
 	
 	if (ref $handler eq 'CODE') {
 		$this->_entryPoint( sub {
-			$handler->($this,$delegateNext);			
+			$handler->($this,$delegateNext);	
 		} );
 	} elsif (ref $handler and UNIVERSAL::isa($handler,'IMPL::Web::QueryHandler')) {
 		$this->_entryPoint( sub {
--- a/Lib/IMPL/Web/Application/ControllerUnit.pm	Mon Jun 20 23:42:44 2011 +0400
+++ b/Lib/IMPL/Web/Application/ControllerUnit.pm	Wed Sep 14 18:59:01 2011 +0400
@@ -13,7 +13,9 @@
 	CONTROLLER_METHODS => 'controller_methods',
 	STATE_CORRECT => 'correct',
 	STATE_NEW => 'new',
-	STATE_INVALID => 'invalid'
+	STATE_INVALID => 'invalid',
+	TTYPE_FORM => 'form',
+	TTYPE_TRANS => 'tran'
 };
 
 BEGIN {
@@ -58,6 +60,7 @@
 		
 		$info->{wrapper} = 'TransactionWrapper';
 		$info->{method} ||= $method;
+		$info->{context}{transactionType} = TTYPE_TRANS;
 		$self->class_data(CONTROLLER_METHODS)->{$method} = $info;
 	}
 }
@@ -71,11 +74,13 @@
 			$self->class_data(CONTROLLER_METHODS)->{$method} = {
 				wrapper => 'FormWrapper',
 				schema => $info,
-				method => $method
+				method => $method,
+				context => { transactionType => TTYPE_FORM }
 			};
 		} elsif (ref $info eq 'HASH') {
 			$info->{wrapper} = 'FormWrapper';
 			$info->{method} ||= $method;
+			$info->{context}{transactionType} = TTYPE_FORM;
 			
 			$self->class_data(CONTROLLER_METHODS)->{$method} = $info;
 		} else {
@@ -88,6 +93,9 @@
 	my ($self,$method,$action) = @_;
 	
 	if (my $methodInfo = $self->class_data(CONTROLLER_METHODS)->{$method}) {
+		if (my $ctx = $methodInfo->{context}) {
+			$action->context->{$_} = $ctx->{$_} foreach keys %$ctx;
+		}
 		if (my $wrapper = $methodInfo->{wrapper}) {
 			return $self->$wrapper($method,$action,$methodInfo);
 		} else {
--- a/Lib/IMPL/Web/Application/Response.pm	Mon Jun 20 23:42:44 2011 +0400
+++ b/Lib/IMPL/Web/Application/Response.pm	Wed Sep 14 18:59:01 2011 +0400
@@ -267,7 +267,7 @@
 
 Поток для записи в тело ответа.
 
-=item C< [get] isHeadPrinted >
+=item C< [get] isHeaderPrinted >
 
 Признак того, что заголовок уже был отправлен клиенту.
 
--- a/Lib/IMPL/Web/QueryHandler/JsonFormat.pm	Mon Jun 20 23:42:44 2011 +0400
+++ b/Lib/IMPL/Web/QueryHandler/JsonFormat.pm	Wed Sep 14 18:59:01 2011 +0400
@@ -10,7 +10,6 @@
 	my ($this,$action,$nextHandler) = @_;
 	
 	my $result;
-	my $t = new IMPL::Transform::Json;
 	
 	try {
 		$result = $nextHandler->();
@@ -20,6 +19,15 @@
 		$result = { error => $err };
 	};
 	
+	my $t = new IMPL::Transform::Json($action->context->{json});
+	
+	if ($action->context->{transactionType} and $action->context->{transactionType} eq 'form') {
+		delete @$result{qw(formData formSchema)};
+		my $errors = @$result{formErrors};
+		
+		$result->{formErrors} = [ map $_->Message, @$errors ] if $errors;
+	}
+	
 	$action->response->contentType('text/javascript');
 	
 	my $hout = $action->response->streamBody;
@@ -41,6 +49,10 @@
 
 our %CTOR = (
 	'IMPL::Transform' => sub {
+		my $options = shift;
+		(
+			$options ? %{$options} : ()
+		),
 		ARRAY => sub {
 			my ($this,$object) = @_;
 			
--- a/Lib/IMPL/Web/TT/Form.pm	Mon Jun 20 23:42:44 2011 +0400
+++ b/Lib/IMPL/Web/TT/Form.pm	Wed Sep 14 18:59:01 2011 +0400
@@ -136,7 +136,7 @@
 	my ($this,$path) = @_;
 	
 	my $navi = new IMPL::DOM::Navigator::SchemaNavigator($this->schema);
-	my @path = ($this->base, split /\./,$path); 
+	my @path = ($this->base, split(/\./,$path) ); 
 	
 	$navi->NavigateName($_) or die new IMPL::InvalidArgumentException(
 		"Can't find a definition for an element",
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/clone.pm	Wed Sep 14 18:59:01 2011 +0400
@@ -0,0 +1,48 @@
+package IMPL::clone;
+
+use Scalar::Util qw(blessed reftype);
+
+use base qw(Exporter);
+our @EXPORT_OK = qw(&clone);
+
+{
+	my %handlers = (
+		HASH => sub {
+			my $class = blessed($_[0]);
+			
+			my $new = {};
+			while (my ($key,$val) = each %{$_[0]}) {
+				$new->{$key} = clone($val);
+			}
+			$class ? bless $new, $class : $new;
+		},
+		ARRAY => sub {
+			my $class = blessed($_[0]);
+			$class ? bless( [ map clone($_), @{$_[0]} ], $class ) : [ map clone($_), @{$_[0]} ];
+		},
+		SCALAR => sub {
+			my $class = blessed($_[0]);
+			
+			my $v = ${$_[0]};
+			$class ? bless \$v, $class : \$v;
+		},
+		REF => sub {
+			my $class = blessed($_[0]);
+			my $v = clone ( ${$_[0]} );
+			$class ? bless \$v, $class : \$v;
+			
+		},
+		REGEXP => sub {
+			$_[0];
+		}
+	);
+	sub clone {
+		return unless @_;
+		
+		return $_[0] unless ref $_[0];
+		
+		return ($handlers{reftype($_[0])} || sub { die "Unknown reftype " . reftype($_[0])} )->($_[0]);
+	}
+}
+
+1;
--- a/Lib/IMPL/lang.pm	Mon Jun 20 23:42:44 2011 +0400
+++ b/Lib/IMPL/lang.pm	Wed Sep 14 18:59:01 2011 +0400
@@ -4,6 +4,7 @@
 
 use parent qw(Exporter);
 use IMPL::_core::version;
+use IMPL::clone qw(clone);
 
 require IMPL::Class::PropertyInfo;
 
@@ -12,6 +13,7 @@
 	base => [
 		qw(
 		  &is
+		  &clone
 		  )
 	],
 	constants => [