# HG changeset patch
# User wizard
# Date 1268609889 -10800
# Node ID 76b878ad6596f70f552240dd6b533c2b5287771a
# Parent  c64bd1bf727df97e55f580f3b232b4b9e03b5d74
Added serialization support for the IMPL::Object::List
More intelligent Exception message
Fixed encoding support in the actions
Improoved tests
Minor fixes

diff -r c64bd1bf727d -r 76b878ad6596 .settings/org.eclipse.core.resources.prefs
--- a/.settings/org.eclipse.core.resources.prefs	Fri Mar 12 16:23:46 2010 +0300
+++ b/.settings/org.eclipse.core.resources.prefs	Mon Mar 15 02:38:09 2010 +0300
@@ -1,3 +1,3 @@
-#Fri Feb 26 10:46:20 MSK 2010
+#Sat Mar 13 04:39:05 MSK 2010
 eclipse.preferences.version=1
 encoding/<project>=cp1251
diff -r c64bd1bf727d -r 76b878ad6596 Lib/IMPL/Class/Property/Base.pm
--- a/Lib/IMPL/Class/Property/Base.pm	Fri Mar 12 16:23:46 2010 +0300
+++ b/Lib/IMPL/Class/Property/Base.pm	Mon Mar 15 02:38:09 2010 +0300
@@ -161,9 +161,9 @@
     \$accessor = sub {
         my \$this = shift;
         $codeAccessCheck
-        $codeValidator
         if (\@_) {
         	$codeOwnerCheck
+        	$codeValidator
         	$codeSet
         } else {
         	$codeGet
diff -r c64bd1bf727d -r 76b878ad6596 Lib/IMPL/Config.pm
--- a/Lib/IMPL/Config.pm	Fri Mar 12 16:23:46 2010 +0300
+++ b/Lib/IMPL/Config.pm	Mon Mar 15 02:38:09 2010 +0300
@@ -76,14 +76,16 @@
 
 sub save {
     my ($this,$ctx) = @_;
-
-    foreach my $info ($this->get_meta('IMPL::Class::PropertyInfo')) {
-        next if $info->Access != IMPL::Class::Member::MOD_PUBLIC; # save only public properties
+    
+    my $val;
 
-        my $name = $info->Name;
-        $ctx->AddVar($name => $this->rawGet($name)) if $this->rawGet($name);
-    }
-    
+    $val = $this->rawGet($_) and $ctx->AddVar($_ => $val) foreach map $_->Name, $this->get_meta(
+    	'IMPL::Class::PropertyInfo',
+    	sub {
+    		$_->Access == IMPL::Class::Member::MOD_PUBLIC and
+    		$_->canGet;
+    	},
+    	1);    
 }
 
 sub spawn {
diff -r c64bd1bf727d -r 76b878ad6596 Lib/IMPL/Exception.pm
--- a/Lib/IMPL/Exception.pm	Fri Mar 12 16:23:46 2010 +0300
+++ b/Lib/IMPL/Exception.pm	Mon Mar 15 02:38:09 2010 +0300
@@ -81,7 +81,7 @@
 
 sub toString {
     my ($this,$notrace) = @_;
-    $this->Message . join("\n",'',map { my $s = $_; local $_; indent("$s",1) } @{$this->Args} ) . ( $notrace ? '' : "\n" . $this->CallStack);
+    ($this->Message || ref $this) . join("\n",'',map { my $s = $_; local $_; indent("$s",1) } @{$this->Args} ) . ( $notrace ? '' : "\n" . $this->CallStack);
 }
 
 package IMPL::InvalidOperationException;
diff -r c64bd1bf727d -r 76b878ad6596 Lib/IMPL/Object/Abstract.pm
--- a/Lib/IMPL/Object/Abstract.pm	Fri Mar 12 16:23:46 2010 +0300
+++ b/Lib/IMPL/Object/Abstract.pm	Mon Mar 15 02:38:09 2010 +0300
@@ -113,8 +113,12 @@
     $sub = $_->can($methodName) and $sub->(@_) foreach @{caller().'::ISA'};
 }
 
+1;
+
+__END__
+
 =pod
-=h1 SYNOPSIS
+=head1 SYNOPSIS
 
 package MyBaseObject;
 use base qw(IMPL::Object::Abstract);
@@ -127,10 +131,8 @@
     # own implementation of the surrogate operator
 }
 
-=h1 DESCRIPTION
+=head1 DESCRIPTION
 
 Реализация механизма вызова конструкторов и других вспомогательных вещей, кроме операторов
 создания экземпляров.
 =cut
-
-1;
diff -r c64bd1bf727d -r 76b878ad6596 Lib/IMPL/Object/List.pm
--- a/Lib/IMPL/Object/List.pm	Fri Mar 12 16:23:46 2010 +0300
+++ b/Lib/IMPL/Object/List.pm	Mon Mar 15 02:38:09 2010 +0300
@@ -68,5 +68,24 @@
     return $this;
 }
 
+sub save {
+	my ($this,$ctx) = @_;
+	
+	$ctx->AddVar( item => $_ ) foreach @$this;
+}
+
+sub restore {
+	my ($class,$data,$surrogate) = @_;
+	
+	my $i = 0;
+	
+	if ($surrogate) {
+		@$surrogate = grep { ($i++)%2 } @$data;
+	} else {
+		$surrogate = $class->new([grep { ($i++)%2 } @$data]);
+	}
+	
+	return $surrogate;
+}
 
 1;
diff -r c64bd1bf727d -r 76b878ad6596 Lib/IMPL/Object/Meta.pm
--- a/Lib/IMPL/Object/Meta.pm	Fri Mar 12 16:23:46 2010 +0300
+++ b/Lib/IMPL/Object/Meta.pm	Mon Mar 15 02:38:09 2010 +0300
@@ -7,17 +7,42 @@
 use IMPL::Class::Property::Direct;
 
 BEGIN {
-    public _direct property Container => prop_get;
+    public _direct property Container => prop_get | owner_set;
 }
 
 sub meta {
     my $class = shift;
     my $caller = caller;
     my $meta = $class->surrogate();
-    $meta->{$Container} = $caller;
+    $meta->IMPL::Object::Meta::Container(caller);
     $meta->callCTOR(@_);
     $caller->set_meta($meta);
 }
 
+1;
 
-1;
+__END__
+
+=pod
+
+=head1 SYNOPSIS
+
+package Foo;
+
+meta BarAttribute('Simple bar attribute'); #mark Foo with BarAttribute
+
+=head1 DESCRIPTION
+
+Базовый класс для мета-свойств класса. Определяет оператор C< meta > для создания метаданных в вызвавшем классе.
+
+=head1 MEMBERS
+
+=over
+
+=item C< Container >
+
+Свойство заполняется до вызова конструктора и содержит имя модуля к которому применяется атрибут.
+
+=back
+
+=cut
\ No newline at end of file
diff -r c64bd1bf727d -r 76b878ad6596 Lib/IMPL/Web/Application.pm
--- a/Lib/IMPL/Web/Application.pm	Fri Mar 12 16:23:46 2010 +0300
+++ b/Lib/IMPL/Web/Application.pm	Mon Mar 15 02:38:09 2010 +0300
@@ -16,7 +16,7 @@
     public property handlerError => prop_all;
     public property factoryAction => prop_all;
     public property handlersQuery => prop_all | prop_list;
-    public property configuration => prop_all;
+    public property options => prop_all;
 }
 
 # custom factory
@@ -36,17 +36,19 @@
     my ($this) = @_;
     
     while (my $query = $this->FetchRequest()) {
-        my $response = new IMPL::Web::Application::Response(query => $query);
         
+        # todo: move a creation of the response to the ActionClass
         my $action = $this->factoryAction->new(
         	query => $query,
-        	response => $response,
+        	response => new IMPL::Web::Application::Response(query => $query),
         	application => $this, 
         ); 
         
         $action->ChainHandler($_) foreach $this->handlersQuery;
         
         $action->Invoke();
+        
+        $action->response->Complete;
     }
 }
 
diff -r c64bd1bf727d -r 76b878ad6596 Lib/IMPL/Web/Application/Action.pm
--- a/Lib/IMPL/Web/Application/Action.pm	Fri Mar 12 16:23:46 2010 +0300
+++ b/Lib/IMPL/Web/Application/Action.pm	Mon Mar 15 02:38:09 2010 +0300
@@ -3,6 +3,8 @@
 
 use base qw(IMPL::Object IMPL::Object::Autofill);
 
+__PACKAGE__->PassThroughArgs;
+
 use IMPL::Class::Property;
 
 BEGIN {
@@ -13,6 +15,8 @@
 	private property _entryPoint => prop_all;
 }
 
+#todo: make ability to discard old and create new response
+
 sub Invoke {
 	my ($this) = @_;
 	
@@ -32,18 +36,32 @@
 		$this->_entryPoint( sub {
 			$handler->($this,$delegateNext);			
 		} );
-	} elsif (UNIVERSAL::isa($handler,'IMPL::Web::Application::QueryHandler')) {
+	} elsif (ref $handler and UNIVERSAL::isa($handler,'IMPL::Web::QueryHandler')) {
 		$this->_entryPoint( sub {
 			$handler->Invoke($this,$delegateNext);
 		} );
 	} elsif ($handler and not ref $handler) {
-		my $method = $this->can($handler) or die new IMPL::InvalidArgumentException("An invalid handler supplied");
 		
-		$this->_entryPoint( sub {
-			$method->($this,$delegateNext);			
-		} );
+		if (my $method = $this->can($handler) ) {
+			$this->_entryPoint( sub {
+				$method->($this,$delegateNext);			
+			} );
+		} else {
+			{
+				no strict 'refs';
+				eval "require $handler; 1;" or die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler,"Failed to load module") unless keys %{"${handler}::"};
+			}
+			
+			if (UNIVERSAL::isa($handler,'IMPL::Web::QueryHandler')) {
+				$this->_entryPoint( sub {
+					$handler->Invoke($this,$delegateNext);
+				} );	
+			} else {
+				die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler);
+			}
+		}
 	} else {
-		die new IMPL::InvalidArgumentException("An invalid handler supplied");
+		die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler);
 	}
 	
 }
diff -r c64bd1bf727d -r 76b878ad6596 Lib/IMPL/Web/Application/Response.pm
--- a/Lib/IMPL/Web/Application/Response.pm	Fri Mar 12 16:23:46 2010 +0300
+++ b/Lib/IMPL/Web/Application/Response.pm	Mon Mar 15 02:38:09 2010 +0300
@@ -8,8 +8,11 @@
 require CGI::Cookie;
 
 use Carp;
+use Encode;
 use IMPL::Class::Property;
 
+#todo: add binary method to set a binary encoding, set it automatic when type isn't a text 
+
 BEGIN {
 	public property query => prop_get | owner_set; # cgi query
 	public property status => prop_all, { validator => \&_checkHeaderPrinted };
@@ -33,9 +36,10 @@
 	my ($this,%args) = @_;
 	
 	$this->query(CGI->new($this->query() | {})) unless $this->query;
-	$this->charset($this->query->charset) unless $this->charset;
 	
 	$this->streamOut(*STDOUT) unless $this->streamOut;
+	$this->buffered(1) unless defined $this->buffered;
+	binmode $this->streamOut, ":encoding(".$this->charset.")";
 }
 
 sub _checkHeaderPrinted {
@@ -53,7 +57,18 @@
 sub _charset {
 	my $this = shift;
 	
-	return $this->query->charset(@_);
+	if (@_) {
+		my $charset = $this->query->charset(@_);
+		
+		my $hout = $this->streamOut;
+		
+		binmode $hout;
+		binmode $hout, ":encoding($charset)";
+		
+		return $charset;
+	} else {
+		return $this->query->charset;
+	}
 }
 
 sub _PrintHeader {
@@ -87,9 +102,12 @@
 	unless ($this->_streamBody) {
 		if ($this->buffered) {
 			my $buffer = "";
+			
 			$this->_bufferBody(\$buffer);
 				
-			open my $hBody, ">", \$buffer or die new IMPL::Exception("Failed to create buffer",$!);
+			open my $hBody, ">:encoding(utf-8)", \$buffer or die new IMPL::Exception("Failed to create buffer",$!);
+			
+			Encode::_utf8_on($buffer);
 				
 			$this->_streamBody($hBody);
 		} else {
@@ -110,11 +128,12 @@
 	
 	$this->_PrintHeader();
 	
+	$this->_streamBody(undef);
+	
 	if ($this->buffered) {
 		print $hOut ${$this->_bufferBody};	
-	}
+	}	
 	
-	$this->_streamBody(undef);
 	$this->_bufferBody(undef);
 	$this->streamOut(undef);
 	
diff -r c64bd1bf727d -r 76b878ad6596 Lib/IMPL/Web/QueryHandler/PageFormat.pm
--- a/Lib/IMPL/Web/QueryHandler/PageFormat.pm	Fri Mar 12 16:23:46 2010 +0300
+++ b/Lib/IMPL/Web/QueryHandler/PageFormat.pm	Mon Mar 15 02:38:09 2010 +0300
@@ -4,12 +4,24 @@
 __PACKAGE__->PassThroughArgs;
 
 use IMPL::Class::Property;
-use URI;
+use IMPL::Web::TDocument;
+use Error qw(:try);
 
 sub Process {
 	my ($this,$action,$nextHandler) = @_;
 	
+	my $doc = new IMPL::Web::TDocument();
 	
+	try {
+		$doc->loadFile ( $ENV{PATH_TRANSLATED}, 'cp1251' );
+		
+		$action->response->contentType('text/html');
+		my $hOut = $action->response->streamBody;
+		
+		print $hOut $doc->Render();
+	} finally {
+		$doc->Dispose;
+	};
 }
 
 1;
\ No newline at end of file
diff -r c64bd1bf727d -r 76b878ad6596 _test/Resources/app.xml
--- a/_test/Resources/app.xml	Fri Mar 12 16:23:46 2010 +0300
+++ b/_test/Resources/app.xml	Mon Mar 15 02:38:09 2010 +0300
@@ -1,21 +1,23 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <Application id='app' type="Test::Web::Application::Instance">
-	<name type='SCALAR' id='appName'>Sample application</name>
+	<name>Sample application</name>
 	<dataSource type='IMPL::Config::Activator' id='ds'>
-		<factory>Test::Config::DataSource</factory>
+		<factory>IMPL::Object</factory>
 		<parameters type='HASH'>
 			<db>data</db>
 			<user>nobody</user>
 		</parameters>
 	</dataSource>
 	<securityMod type='IMPL::Config::Activator'>
-		<factory>Test::Config::Security</factory>
+		<factory>IMPL::Object</factory>
 		<parameters type='HASH'>
 			<ds refid='ds'/>
 		</parameters>
 	</securityMod>
 	<options type="HASH">
-		<appName refid='appName'/>
 		<dataSource refid='ds'/>
 	</options>
+	<handlersQuery type="IMPL::Object::List">
+		<item>IMPL::Web::QueryHandler::PageFormat</item>
+	</handlersQuery>
 </Application>
\ No newline at end of file
diff -r c64bd1bf727d -r 76b878ad6596 _test/Test/Web/Application.pm
--- a/_test/Test/Web/Application.pm	Fri Mar 12 16:23:46 2010 +0300
+++ b/_test/Test/Web/Application.pm	Mon Mar 15 02:38:09 2010 +0300
@@ -10,6 +10,8 @@
 
 sub CTOR {
 	# simulate CGI environment
+	
+	$ENV{PATH_TRANSLATED} = "Resources/simple.tt";
 }
 
 test SpawnApp => sub {
@@ -29,7 +31,12 @@
 test SaveXml => sub {
 	my $instance = spawn Test::Web::Application::Instance('Resources/app.xml');
 	
-	warn $instance->xml;	
+	$instance->xml or failed "xml property is invalid";	
+};
+
+test Run => sub {
+	my $instance = spawn Test::Web::Application::Instance('Resources/app.xml');
+	$instance->Run();
 };
 
 package Test::Web::Application::Instance;