# HG changeset patch
# User sergey
# Date 1348871687 -14400
# Node ID 47f77e6409f7923454c6ed1a01a2fbdcd6ea9f78
# Parent  431db7034a88a58698f0e2c3a25441e638c06731
heavily reworked the resource model of the web application:
*some ResourcesContraact functionality moved to Resource
+Added CustomResource
*Corrected action handlers

diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Class/Meta.pm
--- a/Lib/IMPL/Class/Meta.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Class/Meta.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -69,7 +69,17 @@
 }
 
 sub static_accessor {
-    my ($class,$name,$value,$clone) = @_;
+    my ($class,$name,$value,$inherit) = @_;
+    
+    $inherit ||= 'inherit';
+    
+    my $method = "static_accessor_$inherit";
+    
+    return $class->$method($name,$value);
+}
+
+sub static_accessor_clone {
+    my ($class,$name,$value) = @_;
     $class = ref $class || $class;
     
     no strict 'refs';
@@ -81,18 +91,62 @@
             $self = ref $self || $self;            
             
             if ($class ne $self) {
-                $self->static_accessor( $name => $_[0] ); # define own class data
+                $self->static_accessor_clone( $name => $_[0] ); # define own class data
+            } else {
+                $value = $_[0];
+            }
+        } else {
+        	$self->static_accessor_clone($name => clone($value));
+        }
+    };
+    $value
+};
+
+sub static_accessor_inherit {
+    my ($class,$name,$value) = @_;
+    
+    no strict 'refs';
+    
+    *{"${class}::$name"} = sub {
+        my $self = shift;
+        
+        if (@_ > 0) {            
+            $self = ref $self || $self;            
+            
+            if ($class ne $self) {
+                $self->static_accessor_inherit( $name => $_[0] ); # define own class data
             } else {
                 $value = $_[0];
             }
         } else {
-        	($clone and $class ne $self)
-        	   ? $self->static_accessor($name => clone($value),$clone)
-        	   : $value and $value ;
-        }
-    };
-    $value
-};
+            $value ;
+        }        
+    }
+}
+
+sub static_accessor_own {
+    my ($class,$name,$value) = @_;
+    
+    no strict 'refs';
+    
+    *{"${class}::$name"} = sub {
+        my $self = shift;
+        
+        if ($class ne $self) {
+            if (@_ > 0) {
+                $self->static_accessor_own( $name => $_[0] ); # define own class data
+            } else {
+                return;
+            }
+        } else {
+            if ( @_ > 0 ) {
+                $value = $_[0];
+            } else {
+                return $value;
+            }
+        }    
+    }
+}
 
 sub _find_class_data {
     my ($class,$name) = @_;
@@ -213,13 +267,39 @@
 
 =back  
 
-=head2 C<static_accessor($name[,$value[,$clone]])>
+=head2 C<static_accessor($name[,$value[,$inherit]])>
 
 Создает статическое свойство с именем C<$name> и начальным значением C<$value>.
 
-Параметр C<$clone> контролирует то, как наследуются значения, если требуется каждому классу обеспечить
-свое уникальное значение, то при первом обращении оно будет клонировано, по умолчанию клонирование не
-происходит.
+Параметр C<$inherit> контролирует то, как наследуются значения.
+
+=over
+
+=item * C<inherit>
+
+По умолчанию. Означает, что если для класса не определено значение, оно будет
+получено от родителя.
+
+=item * C<clone>
+
+Если для класса не определено значение, то оно будет клонировано из
+родительского значения при первом обращении. Полезно, когда родитель задает
+значение по-умолчанию, которое разделяется между несколькими потомками,
+которые модифицирю само значение (например значением является ссылка на хеш,
+а потомки добавляют или меняют значения в этом хеше).
+
+=item * C<own>
+
+Каждый класс имеет свое собственное значение не зависящее от того, что было
+у предка. Начальное значение для этого статического свойства C<undef>.
+
+=back
+
+Данный метод является заглушкой, он передает управление 
+C<static_accessor_inherit>, C<static_accessor_clone>, C<static_accessor_own>
+соответственно. Эти методы можно вызывать явно 
+C<static_accessor_*($name[,$value])>. 
+
 
 =begin code
 
@@ -227,12 +307,30 @@
 use parent qw(IMPL::Class::Meta);
 
 __PACKAGE__->static_accessor( info => { version => 1 } );
+__PACKAGE__->static_accessor( mappings => { toString => \&ToString }, 'clone' );
+__PACKAGE__->static_accessor( _instance => undef, 'own' );
+
+sub ToString {
+    "[object Foo]";
+}
+
+sub default {
+    my ($self) = @_;
+    
+    $self = ref $self || $self;
+    return $self->_instance ? $self->_instance : $self->_instance($self->new());
+}
 
 package Bar;
 use parent qw(Foo);
 
-__PACKAGE__->info->{language} = 'English'; # Foo->info->{language} will become 'English' to!!!
-__PACKAGE__->info({language => 'English'}); # will define own 'info' but will loose original data.
+__PACKAGE__->info({language => 'English', version => 2}); # will define own 'info' but will loose original data.
+__PACKAGE__->mappings->{sayHello} = \&SayHello; # will not affect Foo->mappings;
+
+package main;
+
+my $foo = Foo->default; # will be a Foo object
+my $bar = Bar->default; # will be a Bar object 
 
 =end code
 
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Code/Loader.pm
--- a/Lib/IMPL/Code/Loader.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Code/Loader.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -35,10 +35,11 @@
     my ($this,$package) = @_;
     
     if ($this->verifyNames) {
-    	$package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/ or die ArgumentException->new("package") ;
+    	$package =~ m/^([a-zA-Z_0-9]+(?:::[a-zA-Z_0-9]+)*)$/
+    	   or die ArgumentException->new(package => 'Invalid package name') ;
     }
     
-    $package = $this->prefix . $package if $this->prefix;
+    $package = $this->prefix . '::' . $package if $this->prefix;
     
     my $file = join('/', split(/::/,$package)) . ".pm";
     
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Config/Class.pm
--- a/Lib/IMPL/Config/Class.pm	Thu Sep 13 17:55:01 2012 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,56 +0,0 @@
-package IMPL::Config::Class;
-use strict;
-use warnings;
-
-use parent qw(IMPL::Config);
-use IMPL::Exception;
-use IMPL::Class::Property;
-use Carp qw(carp);
-
-BEGIN {
-	carp "the module is deprecated";
-	
-    public property Type => prop_all;
-    public property Parameters => prop_all;
-    public property IsSingleton => prop_all;
-    private property _Instance => prop_all;
-}
-
-__PACKAGE__->PassThroughArgs;
-
-sub CTOR {
-    my $this = shift;
-    
-    die new IMPL::Exception("A Type parameter is required") unless $this->Type;
-    
-    warn "IMPL::Config::Class is absolute, use IMPL::Config::Activator instead";
-}
-
-sub _is_class {
-    no strict 'refs';
-    scalar keys %{"$_[0]::"} ? 1 : 0;
-}
-
-sub instance {
-    my $this = shift;
-    
-    my $type = $this->Type;
-    
-    if ($this->IsSingleton) {
-        if ($this->_Instance) {
-            return $this->_Instance;
-        } else {
-            my %args = (%{$this->Parameters || {}},@_);
-            eval "require $type" unless _is_class($type);
-            my $inst = $type->new(%args);
-            $this->_Instance($inst);
-            return $inst;
-        }
-    } else {
-        my %args = (%{$this->Parameters || {}},@_);
-        eval "require $type" unless _is_class($type);
-        return $type->new(%args);
-    }
-}
-
-1;
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Config/Container.pm
--- a/Lib/IMPL/Config/Container.pm	Thu Sep 13 17:55:01 2012 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,43 +0,0 @@
-package IMPL::Config::Container;
-use strict;
-use warnings;
-
-use parent qw(IMPL::Config);
-use IMPL::Class::Property;
-use Carp qw(carp);
-
-BEGIN {
-	carp "the module is deprecated";
-	
-    public property Chidren => prop_all;
-}
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    $this->Chidren(\%args);
-}
-
-sub save {
-    my ($this,$ctx) = @_;
-    
-    while (my ($key,$value) = each %{$this->Chidren}) {
-        $ctx->AddVar($key,$value);
-    }
-}
-
-our $AUTOLOAD;
-sub AUTOLOAD {
-    my $this = shift;
-    
-    (my $prop = $AUTOLOAD) =~ s/.*?(\w+)$/$1/;
-    
-    my $child = $this->Chidren->{$prop};
-    if (UNIVERSAL::isa($child,'IMPL::Config::Class')) {
-        return $child->instance(@_);
-    } else {
-        return $child;
-    }
-}
-
-1;
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Object/Autofill.pm
--- a/Lib/IMPL/Object/Autofill.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Object/Autofill.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -23,6 +23,7 @@
 sub DisableAutofill {
     my $self = shift;
     
+    no strict 'refs';
     my $class = ref $self || $self;
     
     *{"${class}::_impl_object_autofill"} = sub {};
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Application.pm
--- a/Lib/IMPL/Web/Application.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Web/Application.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -8,147 +8,159 @@
 
 use IMPL::declare {
 	require => {
-        TAction => 'IMPL::Web::Application::Action',
-        TResponse => 'IMPL::Web::Application::Response',
-        TFactory => '-IMPL::Object::Factory'
-	},
-	base => {
-		'IMPL::Config' => '@_',
+		TAction                   => 'IMPL::Web::Application::Action',
+		HttpResponse              => 'IMPL::Web::HttpResponse',
+		TFactory                  => '-IMPL::Object::Factory',
+		Exception                 => 'IMPL::Exception',
+		InvalidOperationException => 'IMPL::InvalidOperationException',
+		Loader                    => 'IMPL::Code::Loader'
+	  },
+	  base => [
+		'IMPL::Config'            => '@_',
 		'IMPL::Object::Singleton' => '@_'
-	}
+	  ],
+	  props => [
+		actionFactory      => PROP_ALL,
+		handlers           => PROP_ALL | PROP_LIST,
+		security           => PROP_ALL,
+		options            => PROP_ALL,
+		fetchRequestMethod => PROP_ALL,
+		output             => PROP_ALL
+	  ]
 };
 
-BEGIN {
-	public property errorHandler => 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;
-}
-
+sub CTOR {
+	my ($this) = @_;
 
-#TODO: remove
-sub handlersQuery {
-	carp "handlersQuery is obsolete use handlers instead";
-	goto &handlers;
-}
-
+	die IMPL::InvalidArgumentException->new( "handlers",
+		"At least one handler should be supplied" )
+	  unless $this->handlers->Count;
 
-sub CTOR {
-    my ($this) = @_;
-    
-    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->errorHandler(\&defaultErrorHandler) unless $this->errorHandler;
+	$this->actionFactory(TAction) unless $this->actionFactory;
+	$this->fetchRequestMethod( \&defaultFetchRequest )
+	  unless $this->fetchRequestMethod;
 }
 
 sub Run {
-    my ($this) = @_;
-    
-    my $handler;
-    
-    $handler = _ChainHandler($_,$handler) foreach $this->handlers;
-    
-    while (my $query = $this->FetchRequest()) {
-        
-        my $action = $this->actionFactory->new(
-            query => $query,
-            application => $this, 
-        );
-        
-        eval {
-            $action->response->charset($this->responseCharset);
-            
-            $handler->($action);
-            
-            $action->response->Complete;
-        };
-        if ($@) {
-            my $e = $@;
-            # we are expecting this method to be safe otherwise we can trust nothing in this wolrd 
-            $this->errorHandler()->($this,$action,$e);
-        }
-    }
+	my ($this) = @_;
+
+	my $handler;
+
+	$handler = _ChainHandler( $_, $handler ) foreach $this->handlers;
+
+	while ( my $query = $this->FetchRequest() ) {
+
+		my $action = $this->actionFactory->new(
+			query       => $query,
+			application => $this,
+		);
+
+		eval {
+			my $result = $handler->($action);
+
+			die InvalidOperationException->new(
+"Invalid handlers result. A reference to IMPL::Web::HttpResponse is expexted."
+			) unless eval { $result->isa(HttpResponse) };
+
+			$result->PrintResponse( $this->output );
+		};
+		if ($@) {
+			my $e = $@;
+
+			HttpResponse->InternalError(
+				type    => 'text/plain',
+				charset => 'utf-8',
+				body    => $e
+			)->PrintResponse( $this->output );
+
+		}
+	}
 }
 
 sub _ChainHandler {
-	my ($handler,$next) = @_;
-	
-	if (ref $handler eq 'CODE') {
+	my ( $handler, $next ) = @_;
+
+	if ( ref $handler eq 'CODE' ) {
 		return sub {
 			my ($action) = @_;
-			return $handler->($action,$next);
+			return $handler->( $action, $next );
 		};
-	} elsif (eval { $handler->can('Invoke') } ) {
+	}
+	elsif ( eval { $handler->can('Invoke') } ) {
 		return sub {
 			my ($action) = @_;
-			return $handler->Invoke($action,$next);
+			return $handler->Invoke( $action, $next );
 		};
-	} elsif (eval{ $handler->isa(TFactory) }) {
+	}
+	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+)*)$/) {
+			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');
+		if ( not $1 ) {
+			Loader->safe->Require($class);
+			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);
+			return $inst->Invoke( $action, $next );
 		};
-	} else {
-		die new IMPL::InvalidArgumentException("An invalid handler supplied",$handler);
+	}
+	else {
+		die new IMPL::InvalidArgumentException( "An invalid handler supplied",
+			$handler );
 	}
 }
 
 sub FetchRequest {
-    my ($this) = @_;
-    
-    if( ref $this->fetchRequestMethod eq 'CODE' ) {
-        return $this->fetchRequestMethod->($this);
-    } else {
-        die new IMPL::Exception("Unknown fetchRequestMethod type",ref $this->fetchRequestMethod);
-    }
+	my ($this) = @_;
+
+	if ( ref $this->fetchRequestMethod eq 'CODE' ) {
+		return $this->fetchRequestMethod->($this);
+	}
+	else {
+		die new IMPL::Exception(
+			"Unknown fetchRequestMethod type",
+			ref $this->fetchRequestMethod
+		);
+	}
 }
 
 {
-    my $hasFetched = 0;
+	my $hasFetched = 0;
 
-    sub defaultFetchRequest {
-        my ($this) = @_;
-        return undef if $hasFetched;
-        $hasFetched = 1;
-        my $query = CGIWrapper->new();
-        $query->charset($this->responseCharset);
-        return $query;
-    }
+	sub defaultFetchRequest {
+		my ($this) = @_;
+		return undef if $hasFetched;
+		$hasFetched = 1;
+		$this->output(*STDOUT);
+		my $query = CGIWrapper->new();
+		return $query;
+	}
 }
 
 sub defaultErrorHandler {
-    my ($this,$action,$e) = @_;
-    warn $e;
-    if ( eval {    $action->ReinitResponse(); 1; } ) {
-        $action->response->contentType('text/plain');
-        $action->response->charset($this->responseCharset);
-        $action->response->status(500);
-        my $hout = $action->response->streamBody;
-        print $hout $e;
-        $action->response->Complete();
-    }    
+	my ( $this, $action, $e ) = @_;
+	warn $e;
+	if ( eval { $action->ReinitResponse(); 1; } ) {
+		$action->response->contentType('text/plain');
+		$action->response->charset( $this->responseCharset );
+		$action->response->status(500);
+		my $hout = $action->response->streamBody;
+		print $hout $e;
+		$action->response->Complete();
+	}
 }
 
 package CGIWrapper;
@@ -159,33 +171,38 @@
 our $NO_DECODE = 0;
 
 sub param {
-    my $this = shift;
-    
-    return $this->SUPER::param(@_) if $NO_DECODE;
-    
-    if (wantarray) {
-        my @result = $this->SUPER::param(@_);
-        
-        return map Encode::is_utf8($_) ? $_ : Encode::decode($this->charset,$_,Encode::LEAVE_SRC), @result;
-    } else {
-        my $result = $this->SUPER::param(@_);
-        
-        return Encode::is_utf8($result) ? $result : Encode::decode($this->charset,$result,Encode::LEAVE_SRC);
-    }
+	my $this = shift;
+
+	return $this->SUPER::param(@_) if $NO_DECODE;
+
+	if (wantarray) {
+		my @result = $this->SUPER::param(@_);
+
+		return map Encode::is_utf8($_)
+		  ? $_
+		  : Encode::decode( $this->charset, $_, Encode::LEAVE_SRC ), @result;
+	}
+	else {
+		my $result = $this->SUPER::param(@_);
+
+		return Encode::is_utf8($result)
+		  ? $result
+		  : Encode::decode( $this->charset, $result, Encode::LEAVE_SRC );
+	}
 
 }
 
 sub upload {
-    my $this = shift;
-    
-    local $NO_DECODE = 1;
-    my $oldCharset = $this->charset();
-    $this->charset('ISO-8859-1');
-    
-    my $fh = $this->SUPER::upload(@_);
-    
-    $this->charset($oldCharset);
-    return $fh;
+	my $this = shift;
+
+	local $NO_DECODE = 1;
+	my $oldCharset = $this->charset();
+	$this->charset('ISO-8859-1');
+
+	my $fh = $this->SUPER::upload(@_);
+
+	$this->charset($oldCharset);
+	return $fh;
 }
 
 1;
@@ -194,166 +211,32 @@
 
 =pod
 
+=head1 NAME
+
+C<IMPL::Web::Application> Класс для создания экземпляров приложения
+
 =head1 SYNOPSIS
 
 =begin code
 
-require MyApp;
+use IMPL::require {
+	App => 'IMPL::Web::Application' 
+};
 
-my $instance = spawn MyApp('app.config');
+my $instance = App->spawn(); # will use ./IMPL/Web/Application.xml as configuration
 
-$instance->Run();
+$instance->Run;
 
 =end code
 
 =head1 DESCRIPTION
 
-C< inherits IMPL::Config, IMPL::Object::Singleton >
-
-Зкземпляр приложения содержит в себе глобальные настройки, реализует контроллер запросов,
-в качестве источника запросов используется CGI или иной совместимый модуль.
-
-Процесс обработки запроса состоит из следующих частей
-
-=over
-
-=item 1
+Создает экземпляр объекта, который получает и обрабатывает C<HTTP> запрос.
+Приложение можно загрузить из C<xml> файла в котором описано состояние свойств,
+для этого используется механизм C<IMPL::Serialization>.
 
-Получение cgi запроса
-
-=item 2
-
-Создание объекта C<IMPL::Web::Application::Action>
-
-=item 3
-
-Формирование цепочки вызовов при помощи C<< IMPL::Web::Application::Action->ChainHandler >>
-
-=item 4
-
-Выполнение запроса C<< IMPL::Web::Application::Action->Invoke >>
+Приложение представлет собой модульную конструкцию, которая состоит из цепочки
+обработчиков. Цепочка обработчиков вызывается снизу вверх, при этом каждый
+обработчик самостоятельно рекурсивно вызывает следующий (более высокого уровня).
 
 =cut
-
-Также приложение поддерживает отложенное создание объектов, которые по первому обращению
-к свойствам. Это реализовано в базовом классе C< IMPL::Configuration >. Для настройки
-активаторов можно использовать свойство C<options>, в которое должен быть помещен хеш
-со ссылками на активаторы, см. пример ниже C<CONFIGURATION>. 
-
-=head2 CONFIGURATION
-
-Ниже приведен пример конфигурации приложения
-
-=begin code xml
-
-<?xml version="1.0" encoding="UTF-8"?>
-<Application id='app' type="Test::Web::Application::Instance">
-    
-    <!-- Begin custom properties -->
-    <name>Sample application</name>
-    <dataSource type='IMPL::Config::Activator' id='ds'>
-        <factory>IMPL::Object</factory>
-        <parameters type='HASH'>
-            <db>data</db>
-            <user>nobody</user>
-        </parameters>
-    </dataSource>
-    <securityMod type='IMPL::Config::Activator'>
-        <factory>IMPL::Object</factory>
-        <parameters type='HASH'>
-            <ds refid='ds'/>
-        </parameters>
-    </securityMod>    
-    <!-- End custom properties -->
-    
-    <!-- direct access to the activators -->
-    <options type="HASH">
-        <dataSource refid='ds'/>
-    </options>
-    
-    <!-- Set default output encoding, can be changed due query handling -->
-    <responseCharset>utf-8</responseCharset>
-    
-    <!-- Actions creation configuration -->
-    <actionFactory type="IMPL::Object::Factory">
-        
-        <!-- Construct actions -->        
-        <factory>IMPL::Web::Application::Action</factory>
-        <parameters type='HASH'>
-            
-            <!-- with special responseFactory -->
-            <responseFactory type='IMPL::Object::Factory'>
-            
-                <!-- Where resopnses have a special streamOut -->
-                <factory>IMPL::Web::Application::Response</factory>
-                <parameters type='HASH'>
-                
-                    <!-- in memory dummy output instead of STDOUT -->
-                    <streamOut>memory</streamOut>
-                    
-                </parameters>
-            </responseFactory>
-        </parameters>
-    </actionFactory>
-    
-    <!-- Query processing chain -->
-    <handlersQuery type="IMPL::Object::List">
-        <item type="IMPL::Web::QueryHandler::PageFormat">
-            <templatesCharset>cp1251</templatesCharset>
-        </item>
-    </handlersQuery>
-</Application>
-
-=end code xml
-
-=head1 MEMBERS
-
-=over
-
-=item C<[get,set] errorHandler>
-
-Обработчик который будет вызван в случае возникновения необработанной ошибки
-в процессе работы приложения. После чего приложение корректно завершается.
-
-=item C<[get,set] actionFactory>
-
-Фабрика объектов, которая используется приложением, для создания объектов
-типа C<IMPL::Web::Application::Action> при обработки C<CGI> запросов.
-
-=begin code
-
-my $action = $this->actionFactory->new(
-    query => $query,
-    application => $this, 
-);
-
-=end code
-
-=item C< [get,set] fetchRequestMethod >
-
-Метод получения CGI запроса. Возвращает C<CGI> объект следующего запроса, если
-запросов больше нет, то возвращает C<undef>. По-умолчанию использует C<defaultFetchRequest>.
-
-Может быть как ссылкой на функцию, так и объектом типа C<IMPL::Web::Application::RequestFetcher>.
-
-=item C< [get,set,list] handlersQuery >
-
-Список обработчиков запросов, которые будут переданы созданному объекту-действию.
-
-=item C< [get,set] responseCharset>
-
-Кодировка ответа клиенту.
-
-=item C< [get,set] security >
-
-Объект C<IMPL::Web::Security>, для работы с инфраструктурой безопасности.
-
-=item C< [get,set] options >
-
-Обычно ссылка на хеш с настраиваемыми объектами, используется для возможности
-програмной настройки активаторов, т.к. напрямую через свойства приложения получить
-к ним доступ не получится.
- 
-=back
-
-=cut
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Application/Action.pm
--- a/Lib/IMPL/Web/Application/Action.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Web/Application/Action.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -11,17 +11,12 @@
 BEGIN {
     public property application => prop_get | owner_set;
     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;
 }
 
 sub CTOR {
     my ($this) = @_;
     
-    $this->responseFactory('IMPL::Web::Application::Response') unless $this->responseFactory; 
-    $this->response( $this->responseFactory->new(query => $this->query) );
     $this->context({});
 }
 
@@ -35,56 +30,6 @@
     }
 }
 
-sub ReinitResponse {
-    my ($this) = @_;
-    
-    die new IMPL::InvalidOperationException("Response already sent") if $this->response->isHeaderPrinted;
-    
-    $this->response->Discard;
-    $this->response($this->responseFactory->new(query => $this->query));
-}
-
-sub ChainHandler {
-    my ($this,$handler) = @_;
-    
-    carp "deprecated, use Application->handlers instead";
-    
-    my $delegateNext = $this->_entryPoint();
-    
-    if (ref $handler eq 'CODE') {
-        $this->_entryPoint( sub {
-            $handler->($this,$delegateNext);    
-        } );
-    } elsif (ref $handler and UNIVERSAL::isa($handler,'IMPL::Web::QueryHandler')) {
-        $this->_entryPoint( sub {
-            $handler->Invoke($this,$delegateNext);
-        } );
-    } elsif ($handler and not ref $handler) {
-        
-        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",$handler);
-    }
-    
-}
-
 sub cookie {
     my ($this,$name,$rx) = @_;
     
@@ -97,6 +42,16 @@
     $this->_launder(scalar( $this->query->param($name) ), $rx );
 }
 
+sub requestMethod {
+    my ($this) = @_;
+    return $this->query->request_method;
+}
+
+sub pathInfo {
+    my ($this) = @_;
+    return $this->query->path_info;
+}
+
 sub _launder {
     my ($this,$value,$rx) = @_;
     
@@ -105,13 +60,13 @@
             if ( my @result = ($value =~ m/$rx/) ) {
                 return @result > 1 ? \@result : $result[0];
             } else {
-                return undef;
+                return;
             }
         } else {
             return $value;
         }
     } else {
-        return undef;
+        return;
     }
 }
 
@@ -132,11 +87,12 @@
 
 =head1 MEMBERS
 
-=head2 PROPERTIES
+=head2 C<CTOR(%args)>
 
-=over
+Инициализирует новый экземпляр. Именованными параметрами передаются значения
+свойств.
 
-=item C< [get] application>
+=head2 C< [get]application>
 
 Экземпляр приложения создавшего текущий объект
 
@@ -144,31 +100,7 @@
 
 Экземпляр C<CGI> запроса
 
-=item C< [get] response >
-
-Ответ на C<CGI> заспрос C<IMPL::Web::Application::Response>
-
-=item C< [get] responseFactory >
-
-Фабрика ответов на запрос, используется для создания нового ответа
-либо при конструировании текущего объекта C<IMPL::Web::Application::Action>,
-либо при вызове метода C<ReinitResponse> у текущего объекта.
-
-По умолчанию имеет значение C<IMPL::Web::Application::Response>
-
 =back
 
-=head2 METHODS
-
-=over
-
-=item C< ReinitResponse() >
-
-Отмена старого ответа C<response> и создание вместо него нового.
-
-Данная операция обычно проводится при обработке ошибок, когда
-уже сформированный ответ требуется отменить. Следует заметить,
-что эта операция не возможна, если ответ частично или полностью
-отправлен клиенту. Тогда возникает исключение C<IMPL::InvalidOperationException>.
 
 =cut
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Application/ActionResult.pm
--- a/Lib/IMPL/Web/Application/ActionResult.pm	Thu Sep 13 17:55:01 2012 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,130 +0,0 @@
-use strict;
-package IMPL::Web::Application::ActionResult;
-
-use CGI();
-use IMPL::lang qw(:declare);
-use IMPL::declare {
-	require => {
-		Exception => 'IMPL::Exception',
-		ArgumentException => '-IMPL::InvalidArgumentException' 
-	},
-	base => [
-		'IMPL::Object' => undef,
-		'IMPL::Object::Autofill' => '@_'
-	]
-};
-
-BEGIN {
-	public property status => PROP_ALL;
-	public property type => PROP_ALL;
-    public property charset => PROP_ALL;
-	public property cookies => PROP_ALL;
-	public property headers => PROP_ALL;
-	public property body => PROP_ALL;	
-}
-
-sub CTOR {
-	my ($this) = @_;
-	
-	$this->headers({});
-	$this->cookies({});
-}
-
-sub PrintResponse {
-	my ($this,$out) = @_;
-	
-	my $q = CGI->new({});
-	
-	my %headers = %{$this->headers};
-	
-	if(my $cookies = $this->cookies) {
-		$headers{-cookie} = [map _createCookie($_,$cookies->{$_}), keys %$cookies] if $cookies;
-	}
-	
-	$headers{'-status'} = $this->status || '200 OK';
-	$headers{'-type'} = $this->type || 'text/html';
-	
-	if(my $charset = $this->charset) {
-	   $q->charset($charset);
-	   binmode $out, ":encoding($charset)";
-	}
-	
-	$q->header(\%headers);
-	
-	if(my $body = $this->body) {
-		if(ref $body eq 'CODE') {
-			$body->($out);
-		} else {
-			print $out $body;
-		}
-	}
-}
-
-#used to map a pair name valie to a valid cookie object
-sub _createCookie {
-    return UNIVERSAL::isa($_[1], 'CGI::Cookie') ? $_[1] : CGI::Cookie->new(-name => $_[0], -value => $_[1] );
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-C<IMPL::Web::Application::ActionResult> - Результат обработки C<HTTP> запроса.
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-Базовый класс для ответов приложения на C<HTTP> запрос. Каждый вид ответа,
-например 
-
-Данный объект используется для формирования и передачи данных C<HTTP> ответа
-напрямую. Основными полями являются C<body> и C<status>.
-
-Кроме свойств относящихся непосредственно к самому C<HTTP> ответу, данный объект
-может содержать свойства относящиеся к процессу обработки запроса, например
-механизму формирования представления.
-
-=head1 MEMBERS
-
-=head2 C<[get,set]status>
-
-Статус который будет отправлен сервером клиенту, например, C<200 OK> или
-C<204 No response>. Если не указан, то будет C<200 OK>.
-
-=head2 C<[get,set]type>
-
-Тип содержимого, которое будет передано клиенту, если не указано, будет
-C<text/html>.
-
-=head2 C<[get,set]charset>
-
-Кодировка в которой будут переданны данные. Следует задавать если и только, если
-передается текстовая информация. Если указана кодировка, то она будет
-автоматически применена к потоку, который будет передан методу C<PrintResponse>. 
-
-=head2 C<[get,set]cookies>
-
-Опционально. Ссылка на хеш с печеньками.
-
-=head2 C<[get,set]headers>
-
-Опционально. Ссылка на хеш с дополнительными полями заголовка ответа. Формат
-имен полей как у модуля C<CGI>.
-
-=head2 C<[get,set]body>
-
-Тело ответа. Может быть как простой скаляр, который будет приведен к строке и
-выдан в поток вывода метода C<PrintResponse>. Также может быть ссылкой на
-процедуру, в таком случае будет вызвана эта процедура и ей будет передан
-первым параметром поток для вывода тела ответа.
-
-=head2 C<PrintResponse($outStream)>
-
-Формирует заголовок и выводит ответ сервера в указанный параметром поток. 
-
-=cut
\ No newline at end of file
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Application/CustomResource.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Application/CustomResource.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -0,0 +1,113 @@
+package IMPL::Web::Application::CustomResource;
+use strict;
+
+use IMPL::lang qw(:constants);
+
+use IMPL::declare {
+    require => {
+        CustomResourceContract => 'IMPL::Web::Application::CustomResourceContract'        
+    },
+    base => [
+        'IMPL::Web::Application::Resource' => '@_'
+    ]
+};
+
+__PACKAGE__->static_accessor(contractFactory => CustomResourceContract );
+__PACKAGE__->static_accessor_own(_contractInstance => undef);
+
+sub contractInstance {
+    my ($self) = @_;
+    
+    $self = ref $self || $self;
+    $self->_contractInstance ? $self->_contractInstance : $self->InitContract();
+}
+
+sub InitContract {
+    my ($self) = @_;
+    
+    $self->_contractInstance( $self->contractFactory->new(resourceFactory => $self ) ); 
+}
+
+sub GetChildResources {
+    
+}
+
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Web::Application::CustomResource> - базовый класс для ресурсов,
+реальзуемых в коде.
+
+=head1 SYNOPSIS
+
+=begin code
+
+package MyApp::Web::Resources::ProfileResource;
+use IMPL::declare {
+    base => [
+        'IMPL::Web::Application::CustomResource' => '@_'
+    ]
+}
+
+sub HttpGet {
+    my ($this) = @_;
+    return $this->model;
+}
+
+sub HttpPut {
+    my ($this,$action) = @_;
+    
+    my $form = MyApp::Web::Schema::UpdateUser->new();
+    
+    $this->model->update( $form->Bind($action) );
+}
+
+=end code
+
+=head1 MEMBERS
+
+=head2 C<[static]contractFactory>
+
+Фабрика, используемая для получения контракта ресурса. По умолчанию
+C<IMPL::Web::Application::CustomResourceContract>.
+
+=head2 C<[static]contractInstance>
+
+Экземпляр контракта для ресурса. Создается при первом обращении при помощи
+метода C<InitContract()>.
+
+=head2 C<[static]InitContract()>
+
+Создает новый экземпляр контракта, используя фабрику из свойства C<contractFactory>.
+
+=head2 C<[static]GetChildResources()>
+
+Статический метод, который должны переопределять новые классы ресурсов, у
+которых есть дочерние ресурсы.
+
+=begin code
+
+package MyApp::Web::MyResource
+
+sub GetChildResources {
+    my $self = shift;
+    return
+        $self->SUPER::GetChildResources(),
+        {
+            
+        }
+        {
+            
+        };
+}
+
+=end code
+
+
+=cut
\ No newline at end of file
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Application/CustomResourceContract.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Application/CustomResourceContract.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -0,0 +1,76 @@
+package IMPL::Web::Application::CustomResourceContract;
+use strict;
+
+use IMPL::lang qw(:constants);
+use IMPL::declare {
+    require => {
+        NotAllowedException => 'IMPL::Web::NotAllowedException',
+        OperationContract => 'IMPL::Web::Application::OperationContract'
+    },
+    base => [
+        'IMPL::Web::Application::ResourceContract' => '@_'
+    ]
+};
+
+our %RESOURCE_BINDINGS = (
+    GET => 'HttpGet',
+    POST => 'HttpPost',
+    PUT => 'HttpPut'
+    DELETE => 'HttpDelete',
+    HEAD => 'HttpHead'
+);
+
+sub CTOR {
+    my ($this) = @_;
+    
+    $this->verbs->{options} = OperationContract->new( binding => \&_HttpOptionsBinding );
+    
+    while(my ($verb,$methodName) = each %RESOURCE_BINDINGS) {
+        $this->verbs->{lc($verb)} = OperationContract->new (
+            binding => sub {
+                my ($resource,$action) = @_;
+                
+                if ($resource->can($methodName)) {
+                    return $resource->$methodName($action);
+                } else {
+                    die NotAllowedException->new(allow => join(',', _GetAllowedHttpMethods($resource)));
+                }
+                 
+            }
+        );
+    }
+}
+
+sub _HttpOptionsBinding {
+    my ($resource) = @_;
+    
+    my @allow = _GetAllowedHttpMethods;
+    retrun HttpResponse->new(
+        status => '200 OK',
+        headers => {
+            allow => join ( ',', @allow )
+        }
+    );
+}
+
+sub _GetAllowedHttpMethods {
+    my ($resource) = @_;
+    return grep $resource->can($RESOURCE_BINDINGS{$_}), values %RESOURCE_BINDINGS;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Web::Application::CustomResourceContract> - контракт для веб-ресурсов,
+реальзуемых в коде см. C<IMPL::Web::Application::CustomResource}>.
+
+=head1 DESCRIPTION
+
+Данный класс не используется напрямую.
+
+=cut
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Application/OperationContract.pm
--- a/Lib/IMPL/Web/Application/OperationContract.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Web/Application/OperationContract.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -1,22 +1,48 @@
 package IMPL::Web::Application::OperationContract;
 use strict;
 
+use IMPL::lang qw(:declare);
 use IMPL::declare {
-	base => [
-	   'IMPL::Object' => undef,
-	   'IMPL::Object::Autofill' => '@_'
-	],
-	props => [
-	   binding => PROP_ALL,
-	   response => PROP_ALL
-	]
+	require => {
+		'Exception'         => 'IMPL::Exception',
+		'ArgumentException' => '-IMPL::ArgumentException',
+		'ResourceBaseClass' => 'IMPL::Web::Application::ResourceBase'
+	  },
+	  base => [
+		'IMPL::Object'           => undef,
+		'IMPL::Object::Autofill' => '@_'
+	  ],
+	  props => [
+		binding    => PROP_ALL,
+		success    => PROP_ALL,
+		error      => PROP_ALL
+	  ]
 };
 
 sub Invoke {
-	my ($this, $resource, $httpAction) = @_;
+	my ( $this, $resource, $request ) = @_;
+
+	die ArgumentException( resource => 'A valid resource is required' )
+	  unless eval { $resource->isa(ResourceBaseClass) };
+	  
+	my $result = eval {
+		_InvokeDelegate($this->binding, $resource, $request)
+	};
 	
-	if ($this->)
+	if (my $e = $@) {
+		$result = _InvokeDelegate($this->error, $resource, $request, $e);
+	} else {
+		$result = _InvokeDelegate($this->success, $resource, $request, $result);
+	}
+
+	return $result;
+}
+
+sub _InvokeDelegate {
+	my $delegate = shift;
 	
+	return $delegete->(@_) if ref $delegate eq 'CODE';
+	return $delegate->Invoke(@_) if eval { $delegate->can('Invoke')};
 }
 
 1;
@@ -40,14 +66,17 @@
 };
 
 my $operation = OperationContract->new(
-    bind => sub {
-    	my ($resource,$model,$itemName) = @_;
+    binding => sub {
+    	my ($resource,$request) = @_;
+    	
+    	my $itemName = $request->param('itemName', qr/^(\w+)$/);
     	
-    	return $model->findItem($itemName);
+    	return $model->FindItem($itemName);
     },
-    response => RedirectResponse->new(
-        locator => $relativeLocator
-    ) 
+    success => sub {
+        my ($resource,$request,$result) = @_;
+        return HttpReponse->Redirect(location => $resource->location->Child($result->id));
+    }
 );
 
 my $response = $operation->InvokeOperation($resource);
@@ -56,23 +85,89 @@
 
 =head1 DESCRIPTION
 
-Связывает методы предметной области с операциями над ресурсами. Для связи с
-моделью используется функция, которой будут переданы параметры:
+Для орисания контракта операции используется понятие делегата, тоесть объекта,
+представляющего собой функцию, либо объект, имеющий метод C<Invoke>.
+
+Поскольку предметная область должна быть отделена от
+контроллеров веб-сервиса, она ничего не знает про существование ресурсов и их
+организацию и тем более о протоколе C<HTTP>, поэтому все вещи, связанные с
+формированием ответов сервера, представлениями данных и т.п. должны выполняться
+самими контроллерами. Поведение контроллеров описывается контрактами, в которых
+указываются делегаты для реализации необходимого функционала, для корректного
+отображения ресурсов в объекты предметной области и обратно.
+
+Контракт операции состоит из нескольких свойств, осуществляющих привязку к 
+предметной области:
 
 =over
 
-=item C<$reousrce> Ресурс для которого выполняется операция
+=item * C<binding>
 
-=item C<$model> Объект модели данных, связанный с данным ресурсом, тоже, что
-и C<<>$resource->model>> только для краткости
+делегат для привязки операции над ресурсом к предметной области.
+
+=item * C<success>
 
-=item C<$action> Контекст текущего C<HTTP> запроса.
+делегат для обработки результат операции, например для формирования ответа с
+перенаправлением.
+
+=item * C<error>
 
-=back
+делегат для обработки исключительной ситуации, может быть использован для
+формирования представления для повторного ввода данных на форме.  
 
-Результат выполнения будет передан дополнительному обработчику C<response>,
-который выполнит необходимое преобразование.
+=back    
 
 =head1 MEMBERS
 
-=cut
\ No newline at end of file
+=head2 C<[get,set] binding>
+
+Привязка операции к ресурсу, например
+
+=begin code
+
+$operationContract->binding(sub {
+	my ($resource,$action) = @_;
+	$resource->model
+})
+
+=end code
+
+Может быть как ссылка на процедуру, так и ссылкой на объект, имеющий метод
+C<Invoke>.
+
+=head2 C<[get,set] success>
+
+Обрабатывает результат привязки к предметной области.
+
+=begin code
+
+# redirect (for example after POST)
+$operationContract->success(sub {
+	my ($resource,$action,$result) = @_;
+	
+	return IMPL::Web::HttpResponse
+	   ->Redirect($resource->location->Child($result->id));
+})
+
+=end code
+
+Может быть как ссылка на процедуру, так и ссылкой на объект, имеющий метод
+C<Invoke>.
+
+=head2 C<[get,set] error>
+
+Обрабатывает ошибку возникшую при выполнении привязки к предметной области.
+
+=begin
+
+$operationContract->error(sub {
+	my ($resource,$action,$error) = @_;
+	
+	$action->form->errors->{''} = $error;
+	
+	return $resource->model;
+});
+
+=end 
+
+=cut
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Application/Resource.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Application/Resource.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -0,0 +1,148 @@
+package IMPL::Web::Application::Resource;
+use strict;
+
+use IMPL::lang qw(:constants);
+use IMPL::declare {
+    require => {
+        Exception           => 'IMPL::Exception',
+        ArgumentException   => '-IMPL::InvalidArgumentException',
+        OperationException  => '-IMPL::InvalidOperationException',
+        NotAllowedException => 'IMPL::Web::NotAllowedException',
+        NotFoundException   => 'IMPL::Web::NotFoundException'
+      },
+      base => [
+        'IMPL::Object'                              => undef,
+        'IMPL::Web::Application::ResourceInterface' => undef
+      ],
+      props => [
+        parent   => PROP_GET | PROP_OWNERSET,
+        model    => PROP_GET | PROP_OWNERSET,
+        id       => PROP_GET | PROP_OWNERSET,
+        contract => PROP_GET | PROP_OWNERSET,
+        location => PROP_GET | PROP_OWNERSET
+      ]
+};
+
+sub CTOR {
+    my ( $this, %args ) = @_;
+
+    die ArgumentException->new( id => 'A resource identifier is required' )
+      unless $args{id};
+    die ArgumentException->new( contract => 'A contract is required' )
+      unless $args{id};
+
+    $this->parent( $args{parent} );
+    $this->model( $args{model} );
+    $this->id( $args{id} );
+    $this->contract( $args{contract} );
+
+    # если расположение явно не указано, что обычно делается для корневого
+    # ресурса, то оно вычисляется автоматически, либо остается не заданным
+    $this->location( $args{location}
+          || eval { $this->parent->location->Child( $this->id ) } );
+    )
+
+}
+
+sub InvokeHttpVerb {
+      my ( $this, $verb, $action ) = @_;
+
+      my $verb = $this->contract->verbs->{ lc($verb) };
+
+      die NotAllowedException->new(
+          allow => join( ',' map( uc, keys %{ $this->contract->verbs } ) ) )
+        unless $verb;
+
+      return $verb->Invoke( $this, $action );
+}
+
+# это реализация по умолчанию, базируется информации о ресурсах, содержащийся
+# в контракте.
+sub FetchChildResource {
+      my ( $this, $childId ) = @_;
+      
+      my $info = $this->contract->FindChildResourceInfo($childId);
+      
+      die NotFoundException->new() unless $info;
+      
+      my $binding = $this->{binding};
+      my $contract = $this->{contract}
+        or die OperationException->new("Can't fetch a contract for the resource", $childId);
+        
+      my %args = (
+            parent => $this,
+            id     => $childId
+      );
+      
+      $args{model} = _InvokeDelegate($binding,$this);
+
+      return $contract->CreateResource(%args);
+}
+
+sub _InvokeDelegate {
+    my $delegate = shift;
+    
+    return $delegete->(@_) if ref $delegate eq 'CODE';
+    return $delegate->Invoke(@_) if eval { $delegate->can('Invoke')};
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Web::Application::Resource> - Web-ресурс.
+
+=head1 SYNOPSIS
+
+Класс для внутреннего использования. Объединяет в себе контракт и модель данных.
+Основная задача - обработать поступающий от контроллера запрос на вызов C<HTTP>
+метода.
+
+Экземпляры данного класса передаются в качестве параметров делегатам
+осуществляющим привязку к модели в C<IMPL::Web::Application::ResourceContract>
+и C<IMPL::Web::Application::OperationContract>.
+
+=head1 DESCRIPTION
+
+Весь функционал ресурса, поддерживаемые им C<HTTP> методы определяются
+контрактом. Однако можно реализовывать ресурсы, которые не имеют контракта
+или он отличается от того, что предоставляется стандартно
+C<IMPL::Web::Application::ResourceContract>.
+
+Каждый ресурс является контейнером, тоесть позволяет получить дочерний ресурс
+по идентифифкатору, если таковой имеется, тоесть ресурс, у которого нет дочерних
+ресурсов на самом деле рассматривается как пустой контейнер.
+
+С ресурсом непосредственно взаимодействует котроллер запросов
+C<IMPL::Web::Handler::RestController>, вызывая два метода.
+
+=over
+
+=item * C<FetchChildResource($childId)>
+
+Данный метод возвращает дочерний ресурс, соответствующий C<$childId>.
+Текущая реализация использует метод C<FindChildResourceInfo> контракта текущего
+ресурса, после чего создает дочерний ресурс.
+
+Если дочерний ресурс не найден, вызывается исключение
+C<IMPL::Web::NotFoundException>.
+
+=item * C<InvokeHttpVerb($verb,$action)>
+
+Обрабатывает запрос к ресурсу. Для этого используется контракт ресурса, в
+нем выбирается соответсвующий C<IMPL::Web::Application::OperationContract>.
+Затем найденный контракт для указанной операции используется для обработки
+запроса.
+
+=back
+
+Если объект реализует два вышеуказанных метода, он является веб-ресурсом, а
+детали его реализации, котнракт и прочее уже не важно, поэтому можно реализовать
+собственный класс ресурса, например унаследованный от 
+C<IMPL::Web::Application::CustomResource>.
+
+=cut
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Application/ResourceContract.pm
--- a/Lib/IMPL/Web/Application/ResourceContract.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Web/Application/ResourceContract.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -1,114 +1,92 @@
 package IMPL::Web::Application::ResourceContract;
 use strict;
-use IMPL::lang qw(:declare);
+use IMPL::lang qw(:constants);
 use IMPL::declare {
 	require => {
-		'Exception' => 'IMPL::Exception',
-		'ArgumentException' => '-IMPL::ArgumentException',
+		'Exception'            => 'IMPL::Exception',
+		'ArgumentException'    => '-IMPL::ArgumentException',
 		'KeyNotFoundException' => '-IMPL::KeyNotFoundException',
-		'ResourceClass' => 'IMPL::Web::Application::Resource'
-	},
-	base => [
-	   'IMPL::Object' => undef
-	]
+		'ResourceClass'        => 'IMPL::Web::Application::Resource'
+	  },
+	  base  => [ 'IMPL::Object' => undef ],
+	  props => [
+		resourceFactory  => PROP_ALL,
+		verbs       => PROP_ALL,
+		_namedResources  => PROP_ALL,
+		_regexpResources => PROP_ALL | PROP_LIST,
+	  ]
 };
 
-BEGIN {
-	public property resourceFactory => PROP_ALL;
-	public property operations => PROP_ALL;
-	private property _namedResources => PROP_ALL;
-	private property _regexpResources => PROP_ALL | PROP_LIST; 
-}
-
 sub CTOR {
 	my $this = shift;
 	my %args = @_;
-	
+
 	$this->resourceFactory( $args{resourceFactory} || ResourceClass );
-	
-	my $resources = $args{resources} || [];
-	my $operations = $args{operations} || {};
-	
-	die ArgumentException->new(resources => 'resources parameter must be a reference to an array')
-	   unless ref $resources eq 'ARRAY';
-	   
-	die ArgumentException->new(opearations => 'operations parameter must be a reference to a hash')
-	   unless ref $operations eq 'HASH';
-	   
+
+	my $resources  = $args{resources}  || [];
+	my $verbs = $args{verbs} || {};
+
+	die ArgumentException->new(
+		resources => 'resources parameter must be a reference to an array' )
+	  unless ref $resources eq 'ARRAY';
+
+	die ArgumentException->new(
+		opearations => 'operations parameter must be a reference to a hash' )
+	  unless ref $verbs eq 'HASH';
+
+	$this->verbs(
+		{ map { lc($_), $verbs->{$_} } keys %$verbs } );
+
 	my %nameMap;
-		   
-	foreach my $res (@$resources) {
+
+	foreach my $res (@$verbs) {
 		next unless $res->{contract};
-		if(my $name = $res->{name}) {
+		if ( my $name = $res->{name} ) {
 			$nameMap{$name} = $res;
 		}
-		if($res->{match}) {
+		if ( $res->{match} ) {
 			$this->_regexpResources->Append($res);
 		}
 	}
-	
-	$this->_namedResources(\%nameMap);
+
+	$this->_namedResources( \%nameMap );
+}
+
+sub AddChildResourceContract {
+    my ($this,$res) = @_;
+    
+    die ArgumentException->new(res => "A valid child resource definition")
+        unless ref $res eq 'HASH';
+        
+    $this->_namedResources->{$res->{name}} = $res if $res->{name};
+    $this->_regexpResources->Append($res) if $res->{match};
+    
+    return; 
 }
 
 sub CreateResource {
 	my $this = shift;
 	my %args = @_;
-	
-	return $this->resourceFactory->new (
-	   %args,
-	   contract => $this
-	);
-}
 
-sub FindChildResourceContractInfo {
-	my ($this,$name) = @_;
-	
-	if(my $contract = $this->_namedResources->{$name}) {
-		return $contract;
-	} else {
-		foreach my $info ( $this->_regexpResources ) {
-			my $rx = $info->{match};
-			return $info if $name =~ m/$rx/;
-		}
-	}
-	
-	return undef;
+	return $this->resourceFactory->new( %args, contract => $this );
 }
 
-sub CreateChildResource {
-	my $this = @_;
-	my %args = @_;
-	
-	my $id = $args{id} or die ArgumentException( id => 'id parameter must be specified');
-	my $parent = $args{parent};
-	my $model = $parent->model if $parent;
-	my $binding, $childContract, @bindingVars;
-	
-	if(my $info = $this->_namedResources->{$id}) {
-		@bindingVars = ($id);
-		$childContract = $info->{contract};
-		$binding = $info->{bind};
-    } else {
-        foreach my $info ( $this->_regexpResources ) {
-            my $rx = $info->{match};
-            next unless $rx;
-            if( @bindingVars = ($id =~ m/$rx/) ) {
-            	$childContract = $info->{contract};
-            	$binding = $info->{bind};
-            }
-        }
-    }
-    
-    if ($childContract) {
-    	my $childModel = $binding ? $binding->($parent,$model,@bindingVars) : undef;
-    	
-    	return $childContract->CreateResource(
-    	   %args,
-    	   model => $childModel
-    	);
-    } else {
-    	die KeyNotFoundException->new($id);
-    }
+sub FindChildResourceInfo {
+	my ( $this, $name ) = @_;
+
+	if ( my $info = $this->_namedResources->{$name} ) {
+		return $info, [$name];
+	}
+	else {
+		foreach my $info ( $this->_regexpResources ) {
+			my $rx = $info->{match};
+			if(my @childId = $name =~ m/$rx/) {
+			    return $info, \@childId; 
+			}
+		}
+	}
+
+	return;
 }
 
 1;
@@ -131,26 +109,50 @@
 };
 
 my $contract = ResourceContract->new(
-    operations => {
+    verbs => {
     	get => OperationContract->new(
-            bind => sub {
+            binding => sub {
+            	my ($resource,$action) = @_;
                 return "Hello!";
             }
-        )
+        ),
+        post => OperationContract->new(
+            parameters => [
+                IMPL::Transform::DataToModel->new() # создаем преобразование для формы
+            ],
+            binding => sub {
+            	my ($resource,$action,$data) = @_;
+            	return $resource->model->AddItem($data);
+            },
+            success => sub {
+            	my ($resource,$action,$result) = @_;
+            	return IMPL::Web::HttpResponse->Redirect(
+            	   location => $resource->location->Child($result->id)
+            	)
+            },
+            error => sub {
+            	my ($resource,$action,$error) = @_;
+            	$action->errors->Append($error);
+            	return $resource->model;
+            }
+            
+        ),
     },
     resources => [
         {
         	name => 'info',
-        	bind => sub {
+        	binding => sub {
         		return $_[0]->model->info;
         	},
         	contract => ResourceContract->new(
-        	   get => OperationContract->new(
-        	       bind => sub {
-        	       	   my ($resource,$model) = @_;
-        	       	   return $model; # or the same: $resource->model;
-        	       }
-        	   )
+        	   verbs => {
+	        	   get => OperationContract->new(
+	        	       binding => sub {
+	        	       	   my ($resource,$action) = @_;
+	        	       	   return $resource->model;
+	        	       }
+	        	   )
+        	   }
         	)
         }
     ]
@@ -164,13 +166,163 @@
     id => 'item-something'
 );
 
-my $child = $contract->CreateChildResource(
-    parent => $resource,
-    id => 'info'
-);
+my $child = $contract->FetchChildResource('info');
 
 =end code 
 
 =head1 DESCRIPTION
 
-=cut
\ No newline at end of file
+Контракт описывает структуру Веб-ресурса и отображение операций над ним в методы
+предметной области. Контракты используются инфраструктурой и пользователь
+не использует их напрямую, до тех пор пока не требуется изменить стандартный
+функционал. 
+
+
+Ресурс представляе собой набор контрактов операций, соответствующих методам
+C<HTTP> которые доступны у данного ресурса. Кроме операций ресурс состоит из
+дочерних ресурсов, которые могут соответствовать регулярным выражениям, либо
+иметь фиксированные имена.
+
+Каждая операция над ресурсом C<IMPL::Web::Application::OperationContract>
+описывается преобразованием параметров, привязкой к предметной области,
+дополнительным обработчиком результата выполнения привязки, либо обработчиком
+исключения, если привязку не удалось выполнить.
+
+Основное назначение контракта - создавать объекты ресурсов, над которыми
+контроллер запросов C<HTTP> сможет выполнить операцию. Контракт может создавать
+дочерние ресурсы, на основе указанного родительского ресурса и идетификатора
+нового ресурса. При этом будет найден подходящий контракт для дочернего ресурса
+и с его помощью создан дочерний ресурс.
+
+=head2 Динамический контракт
+
+Основная функция контракта - превращать данные модели предметной области в
+данные ресурсной модели, тоесть в ресурсы, для чего каждый контракт обязан
+реализовывать метод C<CreateResource(%args)>.
+
+Результатом выполнения этого метода должен быть Web-ресурс, см.
+C<IMPL::Web::Application::Resource>. Другими словами не существует жесткого
+требования к реализации самого контракта, как и того, что созданный ресурс
+должен ссылаться именно на этот контракт (да и вообще ссылаться на контракт).
+
+Таким образом можно реализовать контракт, который выполняет роль посредника,
+ниже приведен пример, который выбирает нужный контракт на основе типа модели
+переданной для создания ресурса. 
+
+=begin code
+
+package My::Web::Application::ContractMapper;
+use strict;
+use IMPL::lang qw(:constants);
+use IMPL::declare {
+    require => {
+        ForbiddenException => 'IMPL::Web::Forbidden'  
+    },
+    base => [
+        'IMPL::Object' => undef,
+        'IMPL::Object::Autofill' => '@_'
+    ],
+    props => [
+        map => PROP_GET | PROP_OWNERSET
+    ]
+}
+
+sub CreateResource {
+    my ($this,%args) = @_;
+    
+    my $type = ref $args{model} || '_default';
+    
+    my $contract = $this->map->{$type};
+    
+    die ForbiddenException->new()
+        unless $contract;
+    
+    return $contract->CreateResource(%args);
+} 
+
+=end code
+
+=head1 MEMBERS
+
+=head2 C<CTOR(%args)>
+
+=over
+
+=item * C<resourceFactory>
+
+Фабрика объектов C<IMPL::Object::Factory> которая будет использоваться при
+создании новых ресурсов. По-умолчанию C<IMPL::Web::Application::Resource>.
+
+=item * C<operations>
+
+Хеш с доступными действиями над C<HTTP> ресурсом, ключом является имя ресурса,
+значением C<IMPL::Web::Application::OperationContract>.
+
+=item * C<resources>
+
+Ссылка на массив хешей, каждый хеш описывает правила, как получить дочерний
+ресурс и связать его с контрактом. Ниже преведено описание элементов хеша.
+
+=over
+
+=item * C<name>
+
+Имя дочернегно ресурса.
+
+=item * C<match>
+
+Регулярное выражение, которому должно удовлетворять имя дочернего ресурса. 
+
+=item * C<bind>
+
+Делегат, получающий модель для дочернего ресурса. Первым параметром ему
+передается родительский объект, далее передаются граппы из регулярного
+выражения, если это ресурс с именем удовлетворяющим регулярному выражению из
+элемента C<match>, либо имя ресурса, если это ресурс с именем, указанным в
+элементе C<name>.
+
+=item * C<contract>
+
+Ссылка на C<IMPL::Web::Application::ResourceContract> для дочернего ресурса.
+У данного контракта используется только метод C<CreateContract>.
+
+=back
+
+По крайней мере C<name> или C<match> должны присутсвовать.
+
+=back
+
+=head2 C<CreateResource(%args)>
+
+Создает ресурс, параметры C<%args> будут переданы напрямую констркутору
+ресурса, для создания ресурса используется фабрика C<resourceFactory>.
+При создании, конгструктору ресурса, будет передана ссылка на текущй контракт.
+
+По-сути никакого дополнительного функционала данный метод не несет.
+
+=head2 C<FindChildResourceInfo($childId)>
+
+Используется для поиска информации о дочернем ресурсе, возвращает список из двух
+элементов. C<($info,$childIdParts)>
+
+=over
+
+=item * C<$info>
+
+Информация о контракте дочернего ресурса, как правило это ссылка на хеш, похожий
+по формату на 
+
+=back
+
+=head2 C<[get]verbs>
+
+Хеш с доступными действиями над C<HTTP> ресурсом, все имена операций приведены
+к нижнему регистру.
+
+=begin code
+
+my $result = $contract->verbs->{get}->Invoke($resource,$action);
+
+=end code
+
+=cut
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Application/ResourceInterface.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/Application/ResourceInterface.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -0,0 +1,89 @@
+package IMPL::Web::Application::ResourceInterface;
+use strict;
+
+use IMPL::require {
+    Exception => 'IMPL::Exception',
+    NotImplException => '-IMPL::NotImplementedException'
+};
+
+sub InvokeHttpVerb {
+    die NotImplException->new();
+}
+
+sub FetchChildResource {
+    die NotImplementedException->new();
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Web::Application::ResourceInterface> - Интерфейс для Web-ресурса.
+
+=head1 SYNOPSIS
+
+=begin code
+
+package MyApp::Web::Resource;
+use IMPL::lang qw(:constants);
+use IMPL::declare {
+    require => {
+        NotAllowedException => 'IMPL::Web::NotAllowedException'        
+    },
+    base => [
+        'IMPL::Object' => undef,
+        'IMPL::Web::Application::ResourceInterface' => undef
+    ],
+    props => [
+        model => PROP_ALL
+    ]    
+};
+
+sub InvokeHttpVerb {
+    my ($this,$verb,$action) = @_;
+    
+    if($verb eq 'GET') {
+        return $this->model;
+    } else {
+        die NotAllowedException->new(allow => 'GET');
+    }
+}
+
+sub FetchChildResource {
+    # no child resources
+    return;
+}
+
+=end code
+
+=head1 DESCRIPTION
+
+Данный модуль объявляет только интерфейс, тоесть в нем есть заглушки для функций
+которые необходимо реализовать.
+
+Для создания класса, который может быть использоваться для создания Web-ресурсов
+нужно унаследовать данный интерфейс и реализовать его методы.
+
+=head1 MEMBERS
+
+=head2 C<InvokeHttpVerb($verb,$action)>
+
+Выполняет операцию над ресурсом и возвращает результат ее выполнения.
+Результатом может быть произвольный объект, который будет передан по цепочке
+обработчиков приложения для формирования ответа вервера, либо
+C<IMPL::Web::HttpResponse>, который описывает (не обязательно полностью) ответ.
+В любом случае результат будет передан далее в цепочку обработчиков и может
+быть изменен.  
+
+=head2 C<FetchChildResource($childId)>
+
+Используется для получения дочернего ресурса (который содержится в данном
+контейнере). Метод должен возвращать либо Web-ресурс
+C<IMPL::Web::Application::ResourceInterface>, либо C<undef> если дочерний ресурс
+не найден.
+
+=cut
\ No newline at end of file
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Application/Response.pm
--- a/Lib/IMPL/Web/Application/Response.pm	Thu Sep 13 17:55:01 2012 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,296 +0,0 @@
-package IMPL::Web::Application::Response;
-use strict;
-
-use parent qw(IMPL::Object IMPL::Object::Autofill);
-
-require IMPL::Exception;
-require CGI;
-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 };
-    public property contentType => prop_all, { validator => \&_checkHeaderPrinted }; # String
-    public property charset => { get => \&_charset, set => \&_charset }, { validator => \&_checkHeaderPrinted };
-    public property expires => prop_all, { validator => \&_checkHeaderPrinted };
-    public property cookies => prop_all, { validator => \&_checkHeaderPrinted }; # Hash
-    
-    public property buffered => prop_all, { validator => \&_canChangeBuffer }; # Boolean
-    public property streamOut => prop_get | owner_set; # stream
-    public property streamBody => {get => \&getStreamBody }; # stream
-    public property isHeaderPrinted => prop_get | owner_set; # Boolean 
-    
-    private property _bufferBody => prop_all;
-    private property _streamBody => prop_all;
-}
-
-__PACKAGE__->PassThroughArgs;
-
-our %CTOR = (
-    'IMPL::Object::Autofill' => sub {
-        my %args = @_;
-        
-        $args{query} = CGI->new($args{query} || {});
-        
-        %args;
-    }
-);
-
-sub CTOR {
-    my ($this,%args) = @_;
-    
-    if ($this->streamOut and lc $this->streamOut eq 'memory') {
-        my $dummy = '';
-        open my $hout, '>:encoding(utf8)', \$dummy or die new IMPL::Exception("Failed to create memory stream",$!);
-        $this->streamOut($hout);
-    } elsif (not $this->streamOut) {
-        $this->streamOut(*STDOUT);    
-    } else {
-        die new IMPL::InvalidArgumentException("Invalid parameter value",$this->streamOut);
-    }
-    
-    $this->buffered(1) unless defined $this->buffered;
-    binmode $this->streamOut, ":encoding(".$this->charset.")";
-}
-
-sub _checkHeaderPrinted {
-    my ($this,$value) = @_;
-    
-    die new IMPL::InvalidOperationException() if $this->isHeaderPrinted;
-}
-
-sub _canChangeBuffer {
-    my ($this,$value) = @_;
-    
-    die new IMPL::InvalidOperationException() if $this->isHeaderPrinted or $this->_streamBody;
-}
-
-sub _charset {
-    my $this = shift;
-    
-    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 {
-    my ($this) = @_;
-    
-    unless ($this->isHeaderPrinted) {
-        $this->isHeaderPrinted(1);
-        
-        my %opt;
-        
-        $opt{-type} = $this->contentType if $this->contentType;
-        $opt{-status} = $this->status if $this->status;
-        $opt{-expires} = $this->expires if $this->expires;
-        
-        my $refCookies = $this->cookies;
-        $opt{-cookie} = [map _createCookie($_,$refCookies->{$_}), keys %$refCookies] if $refCookies;
-        
-        my $hOut = $this->streamOut;
-        
-        print $hOut $this->query->header(
-            %opt
-        );
-    }
-}
-
-sub _createCookie {
-    return UNIVERSAL::isa($_[1], 'CGI::Cookie') ? $_[1] : CGI::Cookie->new(-name => $_[0], -value => $_[1] );
-}
-
-sub setCookie {
-    my ($this,$name,$value) = @_;
-    
-    unless ($this->cookies) {
-        $this->cookies({$name,$value});
-    } else {
-        $this->_checkHeaderPrinted(); 
-        $this->cookies->{$name} = $value;
-    }
-    return $value;
-}
-
-sub getStreamBody {
-    my ($this) = @_;
-    
-    return undef unless $this->streamOut;
-    
-    unless ($this->_streamBody) {
-        if ($this->buffered) {
-            my $buffer = "";
-            
-            $this->_bufferBody(\$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 {
-            $this->_PrintHeader();
-            $this->_streamBody($this->streamOut);
-        }
-    }
-        
-    return $this->_streamBody;
-}
-
-sub Complete {
-    my ($this) = @_;
-    
-    return 0 unless $this->streamOut;
-    
-    my $hOut = $this->streamOut;
-    
-    $this->_PrintHeader();
-
-    close $this->_streamBody();
-    
-    if ($this->buffered) {
-        print $hOut ${$this->_bufferBody};    
-    }    
-    
-    $this->_bufferBody(undef);
-    $this->streamOut(undef);
-    
-    return 1;
-}
-
-sub Discard {
-    my ($this) = @_;
-    
-    carp "Discarding sent response" if $this->isHeaderPrinted;
-    
-    $this->_streamBody(undef);
-    $this->_bufferBody(undef);
-    $this->streamOut(undef);
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-C<IMPL::Web::Application::Response> - Ответ веб сервера непосредственно клиенту.
-
-=head1 DESCRIPTION
-
-C<[Infrastructure]>
-
-Позволяет сформировать основные свойства заголовка и тело ответа.
-
-Создается объектом C<IMPL::Web::Application::Action> в процессе обработки запроса.
-
-Может использоваться обработчиками C<IMPL::Web::QueryHandler> в процессе выполнения запроса.
-
-Объект позволяет буфферизировать вывод в тело ответа, что позволяет отменить или изменить
-ответ в последний момент. Свойство C< isHeaderPrinted >  используется для определения факта
-отправлки данных клиенту. 
-
-=head1 PROPERTIES
-
-=head2 HTTP Header
-
-Свойства отвечающие за заголовок HTTP ответа. Эти своства могут быть изменены до тех пор пока
-не будет отправлен заголовок. В противном случае выдается исключение C< IMPL::InvalidOperationException >.
-
-=over
-
-=item C< [get] query >
-
-CGI запрос, который используется для вывода данных, заголовка и пр. Существует всегда.
-
-=item C< [get,set] status >
-
-Код HTTP. Например, '200 OK'. По умолчанию не установлен, при отправке клиенту бедт отправлен '200 ОК'.
-
-=item C< [get,set] contentType >
-
-Тип MIME. По умолчанию не установлен, подразумивается 'text/html'.
-
-=item C< [get,set] charset >
-
-Кодировка, синоним свойства query->charset.
-
-=item C< [get,set] expires >
-
-Определяет время жизни контента, например '+10m'. По умолчанию не задано и не передается.
-
-=item C< [get,set] cookies >
-
-Хеш массив с cookies, например C< { cart => ['foo','bar'], display => 'list' } >.
-
-=back
-
-=head2 Response behaviour
-
-Свойства отвечающие за поведение ответа.
-
-=over
-
-=item C< [get,set] buffered >
-
-C< True > - то тело ответа пишется в буффер и будет отправлено при вызове метода C< Complete >,
-заголовок также будет отправлен после вызова метода C< Complete >. 
-
-C< False > - тело ответа пишется непосредственно в поток к клиенту, при этом заголовок
-будет отправлен при первом обращении к свойству C< streamBody >
-
-Это свойство можно менять до первого обращения к потоку для записи в тело ответа.
-
-=item C< [get] streamOut >
-
-Стандартный вывод CGI приложения.
-
-=item C< [get] streamBody >
-
-Поток для записи в тело ответа.
-
-=item C< [get] isHeaderPrinted >
-
-Признак того, что заголовок уже был отправлен клиенту.
-
-=back
-
-=head1 METHODS
-
-=over
-
-=item C< Complete >
-
-Завершает отправку ответа.
-
-=item C< Discard >
-
-Отменяет отправку ответа, при этом если часть данных (например, заголовок)
-уже была отправлена, выдает предупреждение в STDERR.
-
-=back
-
-=head1 REMARKS
-
-Данный объект является автозаполняемым, т.е. все его свойства можно задать через
-именованные параметры конструктора.
-
-=cut
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Application/RestBaseResource.pm
--- a/Lib/IMPL/Web/Application/RestBaseResource.pm	Thu Sep 13 17:55:01 2012 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,92 +0,0 @@
-package IMPL::Web::Application::RestBaseResource;
-use strict;
-
-use IMPL::lang qw(:declare :constants);
-use IMPL::declare {
-	require => {
-		Exception => 'IMPL::Exception',
-		ArgumentException => '-IMPL::InvalidArgumentException',
-		NotImplException => '-IMPL::NotImplementedException',
-		ForbiddenException => 'IMPL::Web::ForbiddenException',
-		TTransform => '-IMPL::Transform'
-	},
-    base => {
-        'IMPL::Object' => undef,
-        'IMPL::Object::Autofill' => '@_'
-    }
-};
-
-
-BEGIN {
-    public property id => PROP_GET | PROP_OWNERSET;
-    public property parent => PROP_GET | PROP_OWNERSET;
-    public property contract => PROP_GET | PROP_OWNERSET;
-    protected property final => PROP_ALL;
-}
-
-sub target {
-	shift;
-}
-
-sub CTOR {
-    my ($this) = @_;
-    
-    die ArgumentException->new("id","Identifier is required for non-root resources") if $this->id and not length $this->id;
-    die ArgumentException->new("A contract is required") unless $this->contract;
-}
-
-sub GetHttpImpl {
-    my($this,$method) = @_;
-    
-    my %map = (
-        GET => 'GetImpl',
-        PUT => 'PutImpl',
-        POST => 'PostImpl',
-        DELETE => 'DeleteImpl'
-    );
-    
-    return $map{$method};
-}
-
-sub InvokeHttpMethod {
-    my ($this,$method,$action) = @_;
-    
-    my $impl = $this->GetHttpImpl($method) || 'HttpFallbackImpl';
-    
-    return $this->$impl($action);
-}
-
-sub GetImpl {
-	die NotImplException->new();
-}
-
-sub PutImpl {
-    die NotImplException->new();
-}
-
-sub PostImpl {
-    die NotImplException->new();
-}
-
-sub DeleteImpl {
-    die NotImplException->new();
-}
-
-sub HttpFallbackImpl {
-    die ForbiddenException->new();
-}
-
-sub FetchChildResource {
-	return undef;
-}
-
-
-1;
-
-__END__
-
-=pod
-
-
-
-=cut 
\ No newline at end of file
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Application/RestCustomResource.pm
--- a/Lib/IMPL/Web/Application/RestCustomResource.pm	Thu Sep 13 17:55:01 2012 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,63 +0,0 @@
-package IMPL::Web::Application::RestCustomResource;
-use strict;
-
-use IMPL::lang qw(:declare :constants);
-use IMPL::declare {
-	require => {
-		Exception => "IMPL::Exception",
-		ArgumentException => '-IMPL::InvalidArgumentException',
-		ForbiddenException => 'IMPL::Web::ForbiddenException',
-		NotFoundException => 'IMPL::Web::NotFoundException'
-	},
-	base => {
-		'IMPL::Web::Application::RestBaseResource' => '@_'
-	}
-};
-
-BEGIN {
-	public property get => PROP_GET | PROP_OWNERSET;
-	public property put => PROP_GET | PROP_OWNERSET;
-	public property post => PROP_GET | PROP_OWNERSET;
-	public property delete => PROP_GET | PROP_OWNERSET;
-}
-
-sub FetchChildResource {
-	my ($this,$id,$action) = @_;
-	
-	die NotFoundException->new() if $this->final;
-	
-	return $this->contract->Transform( $this->GetImpl($action), { parent => $this, id => $id } )->FetchChildResource($id,$action);
-}
-
-sub GetImpl {
-	my ($this,$action) = @_;
-	
-	my $method = $this->get or die ForbiddenException->new();
-	return $this->InvokeMember($method,$action);
-}
-
-sub PutImpl {
-	my ($this,$action) = @_;
-	my $method = $this->put or die ForbiddenException->new();
-    return $this->InvokeMember($method,$action);
-}
-
-sub PostImpl {
-	my ($this,$action) = @_;
-	my $method = $this->post or die ForbiddenException->new();
-    return $this->InvokeMember($method,$action);
-}
-
-sub DeleteImpl {
-	my ($this,$action) = @_;
-	my $method = $this->delete or die ForbiddenException->new();
-    return $this->InvokeMember($method,$action);
-}
-
-sub InvokeMember {
-	my ($this,$method,$action) = @_;
-	
-	return $this->$method($action);
-}
-
-1;
\ No newline at end of file
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Application/RestResource.pm
--- a/Lib/IMPL/Web/Application/RestResource.pm	Thu Sep 13 17:55:01 2012 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,601 +0,0 @@
-package IMPL::Web::Application::RestResource;
-use strict;
-
-use IMPL::lang qw(:declare :constants is :hash);
-use IMPL::Exception();
-
-use IMPL::declare {
-	require => {
-		ForbiddenException => 'IMPL::Web::ForbiddenException',
-		NotFoundException => 'IMPL::Web::NotFoundException',
-		InvalidOpException => '-IMPL::InvalidOperationException',
-		ArgumentException => '-IMPL::InvalidArgumentException',
-		TTransform => '-IMPL::Transform',
-		TResolve => '-IMPL::Config::Resolve',
-		CustomResource => 'IMPL::Web::Application::RestCustomResource'
-	},
-	base => {
-		'IMPL::Web::Application::RestCustomResource' => '@_'
-	}
-};
-
-BEGIN {
-	# объект, который представляется данным ресурсом
-	public property target => PROP_GET | PROP_OWNERSET;
-	
-	# получение индекса, тоесть обращение по пути '/foo/bar/'
-	public property index => PROP_GET | PROP_OWNERSET;
-	
-	# получение дочернего ресурса по идентификатору, который
-	# удовлетворяет childRegex
-	public property fetch => PROP_GET | PROP_OWNERSET;
-	
-	# публикует ресурсы связанные с методами объекта
-	public property methods => PROP_GET | PROP_OWNERSET;
-	
-	# формат идентификаторов дочерних ресурсов для метода fetch
-	public property childRegex => PROP_GET | PROP_OWNERSET;
-	
-	# поддержка форм браузеров при помощи создания дочерних ресурсов 
-	public property enableForms => PROP_GET | PROP_OWNERSET;
-	
-	# контракты именованных дочерних ресурсов
-	public property nestedResources => PROP_GET | PROP_OWNERSET;
-}
-
-sub CTOR {
-	my ($this,%args) = @_;
-	
-	die ArgumentException->new("target") unless $this->target;
-	
-	$this->final($this->childRegex ? 0 : 1);
-	$this->methods({}) unless $this->methods;
-	
-	$this->index($this->get) unless defined $this->index;
-	
-	if ($this->enableForms) {
-        $this->methods->{create} = {
-        	get => $this->get,
-        	post => $this->post,
-        	final => 1 # this resource doesn't have any children
-        } if $this->post;
-        
-        $this->methods->{edit} = {
-        	get => $this->get,
-        	post => $this->put,
-        	final => 1 # this resource doesn't have any children
-        } if $this->put;
-        
-        $this->methods->{delete} {
-        	get => $this->get,
-        	post => $this->delete,
-        	final => 1 # this resource doesn't have any children
-        } if $this->delete;
-	}
-}
-
-# создает дочерний ресурс из описания, однако все методы созданного
-# ресурса переадресуются к его родителю, это нужно, чтобы публиковать
-# методы и свойства объекта
-sub _CreateSubResource {
-	my ($this,$resource,$id) = @_;
-	
-	my %methods = map {
-        my $method = $resource->{$_};
-        $_ => sub {
-            my ($this,$action) = @_;
-            return $this->parent->InvokeMember($method,$action);
-        };           
-    } grep $resource->{$_}, qw(get post put delete);
-        
-    return CustomResource->new(
-        %methods,
-        final => $resource->{final},
-        parent => $this,
-        id => $id,
-        contract => $this->contract
-    );
-}
-
-sub FetchChildResource {
-	my ($this,$id,$action) = @_;
-	
-	my $rx = $this->childRegex;
-	
-	my $res;
-	
-	if (length $id == 0) {
-		
-		my $method = $this->index;
-		die ForbiddenException->new() unless $method;
-		
-		$res = $this->InvokeMember($method,$action);
-		
-	} elsif ($this->methods and my $resource = $this->methods->{$id}) {
-		
-		return $this->_CreateSubResource($resource,$id);
-		
-	} elsif ($rx and $id =~ m/^$rx$/ and my $method = $this->fetch) {
-		
-		$method = {
-			method => $method,
-			parameters => 'id'
-		} unless ref $method;
-		
-		$res = $this->InvokeMember($method,$action, { id => $id } );
-		
-	}
-	
-    die NotFoundException->new() unless defined $res;
-        
-    return $this->contract->Transform($res, {parent => $this, id => $id} );
-}
-
-sub InvokeMember {
-    my ($this,$method,$action,$predefined) = @_;
-    
-    die ArgumentException->new("method","No method information provided") unless $method;
-    
-    #normalize method info
-    if (not ref $method) {
-        $method = {
-            method => $method
-        };
-    }
-    
-    if (ref $method eq 'HASH') {
-        my $member = $method->{method} or die InvalidOpException->new("A member name isn't specified");
-        
-        $member = $member->Invoke($this) if eval { $member->isa(TResolve) };
-        
-        my @args;
-    
-        if (my $params = $method->{parameters}) {
-            if (ref $params eq 'HASH') {
-                @args = map {
-                    $_,
-                    $this->MakeParameter($params->{$_},$action,$predefined)
-                } keys %$params;                
-            } elsif (ref $params eq 'ARRAY') {
-                @args = map $this->MakeParameter($_,$action,$predefined), @$params;
-            } else {
-                @args = ($this->MakeParameter($params,$action,$predefined)); 
-            }
-        }
-        return $this->target->$member(@args);
-    } elsif (ref $method eq TResolve) {
-        return $method->Invoke($this);
-    } elsif (ref $method eq 'CODE') {
-        return $method->($this,$action);
-    } else {
-        die InvalidOpException->new("Unsupported type of the method information", ref $method);
-    }
-}
-
-sub MakeParameter {
-    my ($this,$param,$action,$predefined) = @_;
-    
-    my $params = hashApply(
-	    {
-	    	id => $this->id,
-	    	action => $action,
-	    	query => $action->query
-	    },
-	    $predefined || {}
-	);
-    
-    
-    
-    if ($param) {
-        if (is $param, TTransform ) {
-            return $param->Transform($action->query);
-        } elsif ($param and not ref $param) {
-            return $params->{$param} || $action->query->param($param);
-        } else {
-            die InvalidOpException->new("Unsupported parameter mapping", $param);
-        }
-    } else {
-        return undef;
-    }
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-C<IMPL::Web::Application::RestResource> - ресурс Rest вебсервиса.
-
-=head1 SYNOPSIS
-
-=begin text
-
-[REQUEST]
-GET /artists
-
-[RESPONSE]
-<artists>
-    <artist id="1">
-        <name>The Beatles <name/>
-    </atrist>
-    <artist id="2">
-        <name>Bonobo</name>
-    </artist>
-</artists>
-
-[REQUEST]
-GET /artists/1/cds?title='Live at BBC'
-
-[RESPONSE]
-<cds>
-    <cd id="14">
-        <title>Live at BBC 1</title>
-    </cd>
-    <cd id="15">
-        <title>Live at BBC 2</title>
-    </cd>
-</cds>
-
-[REQUEST]
-GET /cds/15
-
-[RESPONSE]
-<cd id="15">
-    <title>Live at BBC 2</title>
-</cd>
-
-=end text
-
-=begin code
-
-use IMPL::require {
-	TRes => 'IMPL::Web:Application::RestResource',
-	DataContext => 'My::App::DataContext'
-};
-
-my $cds = TRes->new(
-    DataContext->Default,
-    {
-    	methods => {
-    		history => {
-    			get => {
-	    			method => 'GetHistory',
-	    			parameters => [qw(from to)]
-    			}, 
-    		},
-    		rating => {
-    			get => {
-    				method => 'GetRating'
-    			}
-    			post => {
-    				method => 'Vote',
-    				parameters => [qw(id rating comment)]
-    			}
-    		}
-    	}
-    	index => {
-    		method => 'search',
-    		paremeters => [qw(filter page limit)]
-    	},
-    	fetch => 'GetItemById'
-    }   
-);
-
-=end code
-
-=head1 DESCRIPTION
-
-Каждый ресурс представляет собой коллекцию и реализует методы C<HTTP> C<GET,POST,PUT,DELETE>.
-
-Вызов каждого из этих методов позволяет выполнить одну из операций над ресурсом, однако
-операций может быть больше, для этого создаются дочерние ресурсы (каждый из которых также
-может иметь четыре метода C<GET,POST,PUT,DELETE>), однако обращения к методам у дочерних
-ресурсов отображаются в вызовы методов у родительского ресурса.
-
-Такой подход позволяет расширить функциональность не изменяя стандарт C<HTTP>, а также обойти
-ограничения браузеров на методы C<PUT,DELETE>.
-
-Данный тип ресутсов расчитан на использование с конфигурацией, которую можно будет
-сохранить или прочитать, например, из файла. Для этого у ресурса есть ряд настроек,
-которые позволяют в простой форме задать отображения между C<HTTP> методами и методами
-объекта представленного данным ресурсом.
-
-Следует отметить, что свойство C<final> вычисляется автоматически.
-
-
-=head2 HTTP METHODS
-
-=head3 C<GET>
-
-Возвращает данные из текущего ресурса. Обращение к данному методу не должно вносить
-изменений в ресурсы. 
-
-=head3 C<PUT>
-
-Обновляет ресурс. Повторное обращение к данному методу должно приводить к одному и
-томуже результату.
-
-=head3 C<DELETE>
-
-Удаляет ресурс.
-
-=head3 C<POST>
-
-Данный метод может вести себя как угодно, однако обычно он используется для добавления
-нового дочернего ресурса в коллекцию,также может использоваться для вызова метода, в случае
-если происходит публикация методов в качестве дочерних ресурсов.
-
-=head1 BROWSER COMPATIBILITY
-
-Однако существует проблема с браузерами, поскольку тег C<< <form> >> реализет только методы
-C<GET,POST>. Для решения данной проблемы используется режим совместимости C<enableForms>. В
-случае когда данный режим активен, автоматически публикуются дочерние ресурсы C<create,edit,delete>.
-
-Данные ресуры пбликуются как методы, что означает то, что обращения к ним будут превращены в
-выполнения соответсвующих методов на родительском объекте.
-
-=head2 C<create>
-
-По сути данные ресурсы не является необходимостью, однако создается для целостности модели.
-
-=head3 C<GET>
-
-Передает управление методу C<get>
-
-=head3 C<POST>
-
-Передает управление методу C<post>
-
-=head2 C<edit>
-
-=head3 C<GET>
-
-Передает управление методу C<get>
-
-=head3 C<POST>
-
-Передает управление методу C<put>, как если бы он был выполнен непосредственно у
-родительского ресурса.
-
-=head2 C<delete>
-
-=head3 C<GET>
-
-Передает управление методу C<get>
-
-=head3 C<POST>
-
-Передает управление методу C<delete>, , как если бы он был выполнен непосредственно у
-родительского ресурса.
-
-=head1 METHOD DEFINITIONS
-
-Все методы ресурсов данного типа задаются описаниями, хранящимися в соответствующих
-свойствах. Когда наступает необходимость вызова соответствующего метода, его описание
-бедется из свойства и передается методу C<InvokeMember>, который и производит вызов.
-
-=head2 C<HASH>
-
-Содержит в себе описание метода, который нужно вызвать, а также его параметры.
-
-=over
-
-=item C<method>
-
-Имя метода который будет вызван.
-
-=item C<paremeters>
-
-Описание параметров метода, может быть либо массивом, либо хешем, либо простым
-значением.
-
-=over
-
-=item C<ARRAY>
-
-Метод получает список параметров, каждый элемент данного массива будет превращен
-в параметр при помощи метода C<MakeParameter>
-
-=item C<HASH>
-
-Метод получает список параметров, который состоит пар ключ-значение, каждое значение 
-данного хеша будет превращено в зачение параметра метода при помощи метода C<MakeParameter>.
-Ключи хеша изменениям не подвергаются.
-
-=item Простое значение
-
-Метод получает одно значение, которое будет получено из текущего при помощи C<MakeParameter>.
-
-=back
-
-=back
-
-=head2 C<CODE>
-
-Если в описании метода находится ссылка на функцию, то эта функция будет вызвана с параметрами.
-Данный вариант полезен когда ресурсы создаются програмно обычного механизма описаний не достаточно
-для реализации требуемого функционала.
-
-=over
-
-=item C<$resource>
-
-Текущий ресурс у которого производится вызов метода.
-
-=item C<$action>
-
-Текущий запрос C<IMPL::Web::Application::Action>.
-
-=back
-
-=head2 Простое значение
-
-Интерпретируется как имя метода у объекта данных текущего ресурса.
-
-=head1 MEMBERS
-
-=head2 C<[get]id>
-
-Идентификатор текущего ресурса.
-
-=head2 C<[get]target>
-
-Объект данных (может быть и класс, поскольку у него будут только вызываться
-методы), обеспечивающий функционал ресурса.
-
-=head2 C<[get]parent>
-
-Родительский ресурс, в котором находится текущий ресурс. Может быть C<undef>,
-если текущий ресурс является корнем.
-
-=head2 C<[get]methods>
-
-Содержит описания методов, которые будут публиковаться как дочерние ресурсы.
-
-=head2 C<[get]childRegex>
-
-Содержит регулярное выражение для идентификаторов дочерних объектов. Если оно
-не задано, то данный ресурс не является коллекцией.
-
-=head2 C<[get]fetch>
-
-Содержит описание метода для получения дочернего объекта. Если данный метод
-отсутствует, то дочерние ресурсы не получится адресовать относительно данного.
-По умолчанию получает идентификатор дочернего ресурса первым параметром.  
-
-=head2 C<[get]index>
-
-Описание метода для получения списка дочерних объектов. По умолчанию не
-получает параметров.
-
-=head2 C<[get]post>
-
-Описание метода для добавление дочернего ресурса. По умолчанию получает
-объект C<CGI> описывабщий текущий запрос первым параметром.
-
-=head2 C<[get]put>
-
-Описание метода для обновления дочернего ресурса. По умолчанию получает
-объект C<CGI> текущего запроса.
-
-=head2 C<[get]delete>
-
-Описание метода для удаления дочернего ресурса. По умолчанию не получает
-параметров.
-
-=head2 C<GetImpl($action)>
-
-=over
-
-=item C<$action>
-
-Текущий запрос C<IMPL::Web::Application::Action>.
-
-=back
-
-Переадресует запрос нужному методу внутреннего объекта C<target> при
-помощи C<InvokeMember>.
-
-=head2 C<PutImpl($action)>
-
-=over
-
-=item C<$action>
-
-Текущий запрос C<IMPL::Web::Application::Action>.
-
-=back
-
-Переадресует запрос нужному методу внутреннего объекта C<target> при
-помощи C<InvokeMember>.
-
-=head2 C<PostImpl($action)>
-
-=over
-
-=item C<$action>
-
-Текущий запрос C<IMPL::Web::Application::Action>.
-
-=back
-
-Переадресует запрос нужному методу внутреннего объекта C<target> при
-помощи C<InvokeMember>.
-
-=head2 C<DeleteImpl($action)>
-
-=over
-
-=item C<$action>
-
-Текущий запрос C<IMPL::Web::Application::Action>.
-
-=back
-
-Переадресует запрос нужному методу внутреннего объекта C<target> при
-помощи C<InvokeMember>.
-
-=head2 C<InvokeMember($memberInfo,$action,$params)>
-
-=over
-
-=item C<$memberInfo>
-
-Описание члена внутреннего объекта C<target>, который нужно вызвать.
-
-=item C<$action>
-
-Текущий запрос C<IMPL::Web::Application::Action>.
-
-=item C<$params>
-
-Ссылка на хеш с предопределенными параметрами.
-
-=back
-
-Вызывает метод внутреннего объекта C<target>, предварительно подготовив
-параметры на основе описания C<$memberInfo> и при помощи С<MakeParameter()>.
-
-=head2 C<MakeParameter($paramDef,$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) >>.
-
-=item C<$action>
-
-Текущий запрос
-
-=back
-
-=cut
\ No newline at end of file
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Application/ViewResult.pm
--- a/Lib/IMPL/Web/Application/ViewResult.pm	Thu Sep 13 17:55:01 2012 +0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,67 +0,0 @@
-package IMPL::Web::Application::ViewResult;
-use strict;
-
-use IMPL::lang qw(:declare);
-use IMPL::declare {
-	base => [
-	   'IMPL::Web::Application::ActionResult' => '@_'
-	]
-};
-
-BEGIN {
-	public property model => PROP_ALL;
-}
-
-sub CTOR {
-	my $this = shift;
-	$this->status('200 OK') unless $this->status;
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-C<IMPL::Web::Application::ViewResult> - Результат для которого требуется создать
-представление.
-
-=head1 SYNOPSIS
-
-=begin code
-
-use IMPL::require {
-	View => 'IMPL::Web::Application::ViewResult'
-};
-
-sub ViewItem {
-	my ($this,$id) = @_;
-	
-	my $view = View->new(model => $this->items->find($id));
-	$view->cookies->{'Some cookie'} = 'some value';
-	return $view;
-}
-
-=end code
-
-=head1 DESCRIPTION
-
-Наследует C<IMPL::Web::Application::ActionResult>.
-
-Позволяет сформировать C<HTTP> ответ с указанием расширенных свойств и данных.
-Как правило данный класс не требуется использовать на прямую, он создается
-системой по-умолчанию для представления результатов методов предметной области.
-
-Следует избегать использование данного класса непосредственно при реализации
-предметной области, поскольку она должна быть отделена от контроллеров и
-представления.
-
-=head1 MEMBERS
-
-=head2 C<[get,set]model>
-
-Объект для которого необходимо построить представление.
-
-=cut
\ No newline at end of file
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/AutoLocator.pm
--- a/Lib/IMPL/Web/AutoLocator.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Web/AutoLocator.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -1,7 +1,7 @@
 package IMPL::Web::AutoLocator;
 use strict;
 
-use IMPL::lang qw(:declare :constants :hash);
+use IMPL::lang qw(:constants :hash);
 use URI;
 use URI::Escape;
 use IMPL::declare {
@@ -13,17 +13,16 @@
         'IMPL::Object' => undef,
         'IMPL::Object::Autofill' => '@_',
         'IMPL::Object::Serializable' => '@_'
+	],
+	props => [
+	   base => PROP_GET | PROP_OWNERSET,
+	   view => PROP_ALL,
+	   query => PROP_ALL,
+	   hash => PROP_ALL
 	]
 };
 
-BEGIN {
-	public property base => PROP_GET | PROP_OWNERSET;
-	public property view => PROP_ALL;
-	public property query => PROP_ALL;
-	public property hash => PROP_ALL;
-}
-
-sub Fetch {
+sub Child {
 	my $this = shift;
 	my $child = shift or die ArgumentException->new("a child resource identifier is required");
 	die ArgumentException->new("a child resource can't be a reference") if ref $child;
@@ -72,7 +71,7 @@
 	return if $method eq 'DESTROY';
 	
 	my $this = shift;
-	return $this->Fetch($method,@_);
+	return $this->Child($method,@_);
 }
 
 
@@ -83,14 +82,14 @@
 
 =head1 NAME
 
-=head1 SYNOPSIS
+C<IMPL::Web::AutoLocator> - Обертка вокруг адреса ресурса.
 
-C<IMPL::Web::AutoLocator> - Обертка вокруг адреса ресурса.
+=head1 SYNOPSIS
 
 =begin code
 
 use IMPL::require {
-	Locator => 'IMPL::Web::Locator'
+	Locator => 'IMPL::Web::AutoLocator'
 };
 
 my $bugTracker = Locator->new(base => "http://myhost.org/bugzilla")->SetView("cgi");
@@ -101,27 +100,80 @@
 
 my $page = $wiki->Main->HowTo;
 
+my $images = Locator->new(base => "http://static.myhost.org/images", view => "png");
+
+my $editIco = $images->icons->small->edit;
+
 =end code
 
 =head1 DESCRIPTION
 
-Для удобстав навигации по ресурсам, полностью отражает классическую структуру иерархически
-организованных ресурсов. позволяет гибко работать с параметрами запроса и хешем. Для постоты
-чтения реализует метод C<AUTOLOAD> для доступа к дочерним ресурсам.
+Для удобстав навигации по ресурсам, полностью отражает классическую структуру
+иерархически организованных ресурсов. позволяет гибко работать с параметрами
+запроса и хешем. Для постоты чтения реализует метод C<AUTOLOAD> для доступа
+к дочерним ресурсам.
 
 =head1 MEMBERS
 
-=head2 C<CTOR(base => $url,view => $extension, query => $hashQuery, hash => $fragment)>
+=head2 C<CTOR(%args)>
+
+Создает новый объект расположение. Позволяет задать путь, расширение, параметры
+запроса и фрагмент ресурса.
+
+=over
+
+=item * C<base>
+
+Строка с базовым адресом для дочерних ресурсов.
+
+=item * C<view>
 
-Создает новый объект расположение. Позволяет задать путь, расширение, параметры запроса и фрагмент ресурса.
+Задает суфикс, обозначающий представление ресурса, аналогично расширению у
+файлов. Данный суффикс может использоваться контроллером для выбора
+представления ресурса.
+
+=item * C<query>
+
+Ссылка на хеш с параметрами запроса
+
+=item * C<hash>
+
+Часть C<uri> обозначающая фрагмент документа (все, что идет после символа C<#>).
+
+=back
 
-=head2 C<Fetch($child[,$query])>
+=head2 C<Child($child[,$query])>
+
+Получает расположение дочернего ресурса. При этом cоздается новый объект адреса ресурса.
+
+=head2 C<SetView($view)>
+
+Позволяет указать представление (расширение) у текущего адреса ресурса. Изменяет
+представление и возвращает измененный адрес ресурса.
+
+=head2 C<[get]base>
+
+Базовый адрес, относительно которого будут получены дочерние ресурсы.
 
-Получает расположение дочернего ресурса. При этом моздается новый объект адреса ресурса.
+=head2 C<[get,set]view>
+
+Представление для ресурсов, аналогично расширению у файлов.
+
+=head2 C<[get,set]query>
+
+Ссылка на хеш с параметрами для C<GET> запроса.
+
+=head2 C<[get,set]hash>
+
+Часть адреса ресурса, отвечающая за фрагмент. 
+
+=head2 C<[get]url>
+
+Объект C<URI> для текущего адреса.
 
 =head2 C<AUTLOAD>
 
-Перенаправляет вызовы методов в метод C<Fetch> передавая первым параметром имя метода.
+Перенаправляет вызовы методов в метод C<Child> передавая первым параметром имя метода.
 
 =cut
 
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Exception.pm
--- a/Lib/IMPL/Web/Exception.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Web/Exception.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -2,12 +2,18 @@
 use strict;
 use warnings;
 
-use parent qw(IMPL::Exception);
+use IMPL::lang qw(:constants);
+use IMPL::declare {
+	base => [
+	   'IMPL::Exception' => '@_'
+	],
+	props => [
+	   headers => PROP_ALL
+	]
+};
 
-__PACKAGE__->PassThroughArgs;
-
-sub code {
-	400;
+sub status {
+	"500 Internal error";
 }
 
 1;
@@ -43,8 +49,12 @@
 
 =head1 MEMBERS
 
-=head2 C<code()>
+=head2 C<status()>
 
 Возвращает C<HTTP> код ошибки. Каждый класс иключений должен переопределить данный метод.
 
+=head2 C<[get,set]headers>
+
+Ссылка на хеш с параметрами заголовка.
+
 =cut
\ No newline at end of file
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/ForbiddenException.pm
--- a/Lib/IMPL/Web/ForbiddenException.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Web/ForbiddenException.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -7,8 +7,8 @@
 	}
 };
 
-sub code {
-	403
+sub status {
+	"403 Forbidden"
 }
 
 1;
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Handler/ErrorHandler.pm
--- a/Lib/IMPL/Web/Handler/ErrorHandler.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Web/Handler/ErrorHandler.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -7,6 +7,8 @@
 	require => {
 		WebException => 'IMPL::Web::Exception',
 		ArgumentException => '-IMPL::InvalidArgumentException',
+		IOException => '-IMPL::IOException',
+		HttpResponse => 'IMPL::Web::HttpResponse'
 	},
 	base => {
 		'IMPL::Object' => undef,
@@ -42,9 +44,6 @@
 	};
 	
 	if (my $err = $@) {
-		$action->ReinitResponse();
-		$action->response->charset('utf-8');
-		$action->response->contentType($this->contentType);
 		
 		my $vars = {
 			error => $err
@@ -52,17 +51,24 @@
 		
 		my $code = 500;
 		
-		$code =  $err->code if eval { $err->isa(WebException) };
+		if (eval { $err->isa(WebException) }) {
+			($code) = ($err->status =~ m/^(\d+)/);
+		}
 		
-		$action->response->status("$code");
-	
 		my $doc = $this->loader->document(
             $this->errors->{$code} || $this->fallback,
             $vars
         );
         
-        my $hout = $action->response->streamBody;
-        print $hout $doc->Render($vars);
+        my $text = $doc->Render($vars);
+        
+        $result = HttpResponse->new(
+            status => $err->status,
+            type => $this->contentType,
+            charset => 'utf-8',
+            headers => $err->headers,
+            body => $text
+        );
 	}
 	
 	return $result;
@@ -76,8 +82,36 @@
 
 =head1 NAME
 
+C<IMPL::Web::Handler::ErrorHandler> - обертка для обработки исключений.
+
 =head1 SYNOPSIS
 
+Используется в цеопчке обработчиков приложения.
+
+=begin code xml
+
+    <handlers type="ARRAY">
+        <item type="IMPL::Web::Handler::ErrorHandler">
+            <contentType>text/html</contentType>
+            <loader refid="tt-loader"/>
+            <errors type="HASH">
+                <error extname="500">errors/500</error>
+                <error extname="404">errors/404</error>
+                <error extname="403">errors/403</error>
+            </errors>
+            <fallback>errors/500</fallback>
+        </item>
+    </handlers>
+
+=end code xml
+
 =head1 DESCRIPTION
 
+Позволяет создать представление для ресурса в случае ошибки, для этого
+используется соответствие представлений и кодов ошибок.
+
+В результате обработчик либо прозрачно передает результат вышестоящего
+обработчика нижестоящему, либо создает C<IMPL::Web::HttpResponse> с
+соответствующим статусом и содержанием. 
+
 =cut
\ No newline at end of file
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Handler/RestController.pm
--- a/Lib/IMPL/Web/Handler/RestController.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Web/Handler/RestController.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -2,69 +2,72 @@
 use strict;
 
 use IMPL::lang qw(:declare :constants);
-
-
 use IMPL::declare {
 	require => {
+	    ResourceInterface => 'IMPL::Web::Application::ResourceInterface', 
 		Exception => 'IMPL::Exception',
 		ArgumentExecption => '-IMPL::InvalidArgumentException',
-		HttpException => 'IMPL::Web::Exception',
-        NotFoundException => 'IMPL::Web::NotFoundException'
+		NotFoundException => 'IMPL::Web::NotFoundException'
 	},
 	base => {
 		'IMPL::Object' => undef,
 		'IMPL::Object::Autofill' => '@_',
 		'IMPL::Object::Serializable' => undef
-	}	
+	},
+	props => [
+	   rootResource => PROP_GET | PROP_OWNERSET,
+	   trailingSlash => PROP_GET | PROP_OWNERSET
+	]	
 };
 
-BEGIN {
-	public property root => PROP_GET | PROP_OWNERSET;
-	public property contract => PROP_GET | PROP_OWNERSET;
-}
-
 sub CTOR {
 	my ($this) = @_;
 	
-	die ArgumentException->new("root") unless $this->root;
-	die ArgumentException->new("contract") unless $this->contract;
+	die ArgumentException->new(rootResource => "A web-resource is required")
+	   unless eval { $this->rootResource->isa(ResourceInterface) };
+	 
 }
 
+sub GetResourcePath {
+    my ($this,$action) = @_;
+    
+    my $pathInfo = $action->pathInfo;
+    my @segments;
+    
+    if (length $pathInfo) {
+    
+        @segments = split(/\//, $pathInfo, $this->trailingSlash ? -1 : 0);
+        
+        # remove first segment since it's always empty
+        shift @segments;
+        
+        my ($obj,$view) = (pop(@segments) =~ m/(.*?)(?:\.(\w+))?$/);
+        push @segments, $obj;
+    
+    }
+    
+    return @segments;    
+}
+
+
 sub Invoke {
 	my ($this,$action) = @_;
 	
-	my $query = $action->query;
-	
-	my $method = $query->request_method;
-	
-	#TODO: path_info is broken for IIS
-	my $pathInfo = $query->path_info;
-	my @segments;
-	
-	if (length $pathInfo) {
+	my $method = $action->requestMethod;
 	
-		@segments = split /\//, $pathInfo, -1; # keep trailing empty string if present
-		
-		# remove first segment since it's always empty
-		shift @segments;
-		
-		my ($obj,$view) = (pop(@segments) =~ m/(.*?)(?:\.(\w+))?$/);
-		push @segments, $obj;
+	my @segments = $this->GetResourcePath($action);
 	
-	}
-	
-	
-	my $res = $this->contract->Transform($this->root, { id => '' } );
+	my $res = $this->rootResource;
 	
 	while(@segments) {
 		my $id = shift @segments;
 		
-		$res = $res->FetchChildResource($id,$action);
+		$res = $res->FetchChildResource($id);
 		
 		die NotFoundException->new($pathInfo,$id) unless $res;
 	}
 	
-	$res = $res->InvokeHttpMethod($method,$action);
+	$res = $res->InvokeHttpVerb($method,$action);
 }
 
 1;
@@ -75,32 +78,50 @@
 
 =head1 NAME
 
-C<IMPL::Web::Handler::RestController> - Транслирует запросы к ресурсам в вызовы методов.
+C<IMPL::Web::Handler::RestController> - Обрабатывает C<HTTP> запрос передавая
+его соответствующему ресурсу.
 
 =head1 SYNOPSIS
 
-Использует контракты для преобразования стандартных C<REST> запросов в вызовы методов объектов.
-C<$ENV{PATH_INFO}> используется как путь к нужному ресурсу у которого будет вызван метод указанный в запросе.
+Используется в конфигурации приложения как элемент цепочки обработчиков.
+Как правило располагается на самом верхнем уровне.
+
+=begin code xml
+
+    <handlers type="ARRAY">
+        <item type="IMPL::Web::Handler::RestController">
+            <rootResource type="My::App::Web::RootResource"/>
+        </item>
+        <item type="IMPL::Web::Handler::JSONView" />
+        <item type="IMPL::Web::Handler::SecureCookie" />
+        <item type="IMPL::Web::Handler::ErrorHandler" />
+    </handlers>
+
+=end code xml
+
 
 =head1 DESCRIPTION
 
-=head2 Resource model
+Использует C<PATH_INFO> для определения нужного ресурса, затем предает
+найденному ресурсу управление для обработки запроса.
+
+Если ресурс не найден, то возникает исключение C<IMPL::Web::NotFoundException>.
 
-Ресурсы имеют иерархическую структуру, аналогичную файлам и каталогам, которая описывается контрактом, также
-контрак описывает то, как должны обрабатываться методы C<HTTP> запроса, такие как C<GET> и C<POST>.
-
-За корректность реализации данных методов отвечает разработчик.
+Для определения нужного ресурса контроллер разбивает C<PATH_INFO> на фрагменты
+и использует каждый фрагмент для получения дочернего ресурса начиная с корневого.
+Для чего используется метод
+C<< IMPL::Web::Application::ResourceInterface->FetchChildResource($childId) >>.
 
-Каждый ресурс представляет собой коллкецию вложенных ресурсов, путь указанный в C<HTTP> запросе разбивается на
-части, затем каждый сегмент последовательно используется для поиска дочернего ресурса. При обработки
-первого сегмента используется корневой ресурс. Корневой ресурс должен существовать всегда.
+=head1 MEMEBERS
 
-=head2 Contract
+=head2 C<[get]rootResource>
 
-Контрактом может быть любое преобразование которое определяет соответсвие между объектами приложения и
-ресурсами, доступными через протокол C<HTTP>.
+Корневой ресурс приложения, должен быть всегда и реализовывать интерфес ресурса
+C<IMPL::Web::Application::ResourceInterface>.
 
+=head2 C<[get]trailingSlash>
 
-
+Если данная переменная имеет значение C<true>, то слеш в конце пути к ресурсу
+будет интерпретироваться, как дочерний ресурс с пустым идентификатором.
 
 =cut
\ No newline at end of file
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Handler/TTView.pm
--- a/Lib/IMPL/Web/Handler/TTView.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Web/Handler/TTView.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -4,195 +4,211 @@
 use List::Util qw(first);
 use IMPL::lang qw(:declare :constants);
 use IMPL::declare {
-	require => {
-		Factory => 'IMPL::Object::Factory'
-	},
-	base => {
-		'IMPL::Object' => undef,
-		'IMPL::Object::Autofill' => '@_',
-		'IMPL::Object::Serializable' => undef
-	}
+    require => {
+        Factory      => 'IMPL::Object::Factory',
+        HttpResponse => 'IMPL::Web::HttpResponse'
+      },
+      base => [
+        'IMPL::Object'               => undef,
+        'IMPL::Object::Autofill'     => '@_',
+        'IMPL::Object::Serializable' => undef
+      ],
+
+      props => [
+        contentType     => PROP_GET | PROP_OWNERSET,
+        contentCharset  => PROP_GET | PROP_OWNERSET,
+        loader          => PROP_GET | PROP_OWNERSET,
+        selectors       => PROP_GET | PROP_LIST | PROP_OWNERSET,
+        defaultDocument => PROP_ALL,
+        indexResource   => PROP_ALL,
+        _selectorsCache => PROP_ALL,
+        _classTemplates => PROP_ALL
+      ]
 };
 
-BEGIN {
-	public property contentType => PROP_GET | PROP_OWNERSET;
-	public property loader => PROP_GET | PROP_OWNERSET;
-	public property selectors => PROP_GET | PROP_LIST | PROP_OWNERSET;
-	public property defaultDocument => PROP_ALL;
-	public property indexResource => PROP_ALL;
-	private property _selectorsCache => PROP_ALL;
-	private property _classTemplates => PROP_ALL;
-}
+sub CTOR {
+    my ($this) = @_;
 
-sub CTOR {
-	my ($this) = @_;
-	
-	$this->indexResource('index') unless $this->indexResource;
+    $this->indexResource('index') unless $this->indexResource;
 }
 
 sub Invoke {
-	my ($this,$action,$next) = @_;
-	
-	my $result = $next ? $next->($action) : undef;
-	
-	my $vars = {
-        data => $result,
-        action => $action,
-        app => $action->application,
+    my ( $this, $action, $next ) = @_;
+
+    my $result = $next ? $next->($action) : undef;
+
+    my $vars = {
+        data        => $result,
+        action      => $action,
+        app         => $action->application,
         LoadFactory => sub {
-        	my $class = shift;
-        	
-        	my $module = $class;
-        	
-        	$module =~ s/::/\//g;
-        	$module .= ".pm";
-        	
-        	require $module;
-        	return Factory->new($class);
+            my $class = shift;
+
+            my $module = $class;
+
+            $module =~ s/::/\//g;
+            $module .= ".pm";
+
+            require $module;
+            return Factory->new($class);
         }
-    }; 
-	
-	my $doc = $this->loader->document(
-        $this->SelectView($action,ref $result),
-        $vars
+    };
+
+    my $doc =
+      $this->loader->document( $this->SelectView( $action, ref $result ),
+        $vars );
+
+    return HttpResponse->new(
+        type => $this->contentType,
+        charset => $this->contentCharset,
+        body => $doc->Render($vars)
     );
-    
-    $action->response->contentType($this->contentType);
-	
-	my $hout = $action->response->streamBody;
-    
-    print $hout $doc->Render($vars);
 }
 
 sub SelectView {
-	my ($this,$action,$class) = @_;
-	
-	my @path = split /\//, $action->query->path_info(), -1;
-	
-	shift @path; # remove always empty leading segment
-	
-	my $last = pop @path;
-	$last =~ s/\.\w+$//;
-	$last ||= $this->indexResource;
-	push @path,$last;
-	
-	$this->BuildCache unless $this->_selectorsCache;
-	my $cache = $this->_selectorsCache;
-	
-	@path = reverse @path;
-	
-	foreach my $subclass ( $class ? (_GetHierarchy($class), '-default') : '-plain') {
-		my @results;
-		push @results, { result => $this->_classTemplates->{$subclass}, level => 0 } if $this->_classTemplates->{$subclass};
-		if ($cache->{$subclass}) { 
-            my $alternatives = [ { selector => $cache->{$subclass}, immediate => 1 } ];
-            $alternatives = $this->MatchAlternatives($_,$alternatives,\@results) foreach @path;
-		}
-		
-		if (@results) {
-			@results = sort { $b->{level} <=> $a->{level} } @results;
-			return (shift @results)->{result};
-		}
-	}
-		
-	return $this->defaultDocument;
+    my ( $this, $action, $class ) = @_;
+
+    my @path = split /\//, $action->query->path_info(), -1;
+
+    shift @path;    # remove always empty leading segment
+
+    my $last = pop @path;
+    $last =~ s/\.\w+$//;
+    $last ||= $this->indexResource;
+    push @path, $last;
+
+    $this->BuildCache unless $this->_selectorsCache;
+    my $cache = $this->_selectorsCache;
+
+    @path = reverse @path;
+
+    foreach
+      my $subclass ( $class ? ( _GetHierarchy($class), '-default' ) : '-plain' )
+    {
+        my @results;
+        push @results,
+          { result => $this->_classTemplates->{$subclass}, level => 0 }
+          if $this->_classTemplates->{$subclass};
+        if ( $cache->{$subclass} ) {
+            my $alternatives =
+              [ { selector => $cache->{$subclass}, immediate => 1 } ];
+            $alternatives =
+              $this->MatchAlternatives( $_, $alternatives, \@results )
+              foreach @path;
+        }
+
+        if (@results) {
+            @results = sort { $b->{level} <=> $a->{level} } @results;
+            return ( shift @results )->{result};
+        }
+    }
+
+    return $this->defaultDocument;
 }
 
 sub _GetHierarchy {
-	my ($class) = @_;
-	return unless $class;
-	
-	no strict 'refs';
-	
-	return $class, map { _GetHierarchy($_) } @{"${class}::ISA"};
+    my ($class) = @_;
+    return unless $class;
+
+    no strict 'refs';
+
+    return $class, map { _GetHierarchy($_) } @{"${class}::ISA"};
 }
 
 sub BuildCache {
-	my ($this) = @_;
-	
-	my @selectors;
-	
-	my $cache = $this->_selectorsCache({});
-	$this->_classTemplates({});
-	
-	foreach my $selector ($this->selectors) {
-		if (not ref $selector) {
-			
-			my ($path,$data) = split(/\s*=>\s*/, $selector);
-			
-			my @path = split(/\s+/,$path);
-			
-			my $class;
-			
-			# if this selector has a class part
-			if ($path[$#path] =~ m/^\@(.*)/) {
-				$class = $1;
-				pop @path;
-			} else {
-				$class = '-default';
-			}
-			
-			#if this selector has a path
-			if (@path) {
-				@path = reverse @path;
-				my $last = pop @path;
-				my $t = ( $cache->{$class} ||= {} );
-				my $level = 1;
-		        foreach my $prim (@path ) {
-		            $t = ($t->{$prim}->{next} ||= {});
-		            $level ++;
+    my ($this) = @_;
+
+    my @selectors;
+
+    my $cache = $this->_selectorsCache( {} );
+    $this->_classTemplates( {} );
+
+    foreach my $selector ( $this->selectors ) {
+        if ( not ref $selector ) {
+
+            my ( $path, $data ) = split( /\s*=>\s*/, $selector );
+
+            my @path = split( /\s+/, $path );
+
+            my $class;
+
+            # if this selector has a class part
+            if ( $path[$#path] =~ m/^\@(.*)/ ) {
+                $class = $1;
+                pop @path;
+            }
+            else {
+                $class = '-default';
+            }
+
+            #if this selector has a path
+            if (@path) {
+                @path = reverse @path;
+                my $last  = pop @path;
+                my $t     = ( $cache->{$class} ||= {} );
+                my $level = 1;
+                foreach my $prim (@path) {
+                    $t = ( $t->{$prim}->{next} ||= {} );
+                    $level++;
                 }
                 $t->{$last}->{level} = $level;
-                $t->{$last}->{data} = $data;
-			
-			} else {
-				# we dont have a selector, only class
-				
-				$this->_classTemplates->{$class} = $data;
-			}
-			
-		}
-	}
+                $t->{$last}->{data}  = $data;
+
+            }
+            else {
+
+                # we dont have a selector, only class
+
+                $this->_classTemplates->{$class} = $data;
+            }
+
+        }
+    }
 }
 
 sub MatchAlternatives {
-    my ($this,$segment,$alternatives,$results) = @_;
-    
+    my ( $this, $segment, $alternatives, $results ) = @_;
+
     my @next;
-    
+
     foreach my $alt (@$alternatives) {
-        while (my ($selector,$match) = each %{$alt->{selector}} ) {
-            
-            
+        while ( my ( $selector, $match ) = each %{ $alt->{selector} } ) {
+
             my $context = {
                 vars => \%{ $alt->{vars} || {} },
                 selector => $match->{next}
             };
-            
-            if ($selector =~ s/^>//) {
+
+            if ( $selector =~ s/^>// ) {
                 $context->{immediate} = 1;
             }
-                
-            if (my ($name,$rx) = ($selector =~ m/^\{(?:(\w+)\:)?(.*)\}$/) ) {
+
+            if ( my ( $name, $rx ) =
+                ( $selector =~ m/^\{(?:(\w+)\:)?(.*)\}$/ ) )
+            {
+
                 #this is a regexp
-                
-                if ( my @captures = ($segment =~ m/($rx)/) ) {
+
+                if ( my @captures = ( $segment =~ m/($rx)/ ) ) {
                     $context->{success} = 1;
-                    
+
                     if ($name) {
                         $context->{vars}->{$name} = \@captures;
                     }
                 }
-            } else {
+            }
+            else {
+
                 #this is a segment name
-                if ($segment eq $selector) {
+                if ( $segment eq $selector ) {
                     $context->{success} = 1;
                 }
             }
-            
+
             # test if there were a match
-            if (delete $context->{success}) {
-                if (my $data = $match->{data}) {
+            if ( delete $context->{success} ) {
+                if ( my $data = $match->{data} ) {
+
                     # interpolate data
                     $data =~ s/{(\w+)(?:\:(\d+))?}/
                         my ($name,$index) = ($1,$2 || 0);
@@ -203,20 +219,25 @@
                             "";
                         }
                     /gex;
-                    
-                    push @$results, { level => $match->{level}, result => $data };
+
+                    push @$results,
+                      { level => $match->{level}, result => $data };
                 }
                 push @next, $context if $context->{selector};
-            } else {
+            }
+            else {
+
                 #repeat current alternative if it's not required to be immediate
-                push @next, {
+                push @next,
+                  {
                     selector => { $selector, $match },
-                    vars => $alt->{vars}
-                } unless $alt->{immediate};
+                    vars     => $alt->{vars}
+                  }
+                  unless $alt->{immediate};
             }
         }
     }
-    
+
     return \@next;
 }
 
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/Handler/ViewSelector.pm
--- a/Lib/IMPL/Web/Handler/ViewSelector.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Web/Handler/ViewSelector.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -4,67 +4,68 @@
 use IMPL::lang qw(:declare :constants);
 
 use IMPL::declare {
-	require => {
-		NotAcceptable => 'IMPL::Web::NotAcceptableException',
-		ViewResult => 'IMPL::Web::Application::ViewResult'
-	},
-	base => {
-		'IMPL::Object' => undef,
-		'IMPL::Object::Autofill' => '@_',
-		'IMPL::Object::Serializable' => undef
-	}
+    require => {
+        NotAcceptable => 'IMPL::Web::NotAcceptableException',
+        HttpResponse  => 'IMPL::Web::HttpResponse'
+      },
+      base => [
+        'IMPL::Object'               => undef,
+        'IMPL::Object::Autofill'     => '@_',
+        'IMPL::Object::Serializable' => undef
+      ],
+      props => [
+        views    => PROP_ALL | PROP_LIST,
+        fallback => PROP_ALL,
+        types    => PROP_ALL
+      ]
 };
 
-BEGIN {
-	public property views => PROP_ALL | PROP_LIST;
-	public property fallback => PROP_ALL;
-	public property types => PROP_ALL;
-}
-
 sub Invoke {
-	my ($this,$action,$next) = @_;
-	
-	my $result = $next ? $next->($action) : undef;
-	
-	my $model;
-	
-	if( eval { $result->isa(ViewResult) } ) {
-	
-		my $handler;
-		my $path = $action->query->path_info;
-		
-		if ($this->types and $path =~ m/\.(\w+)$/) {
-			my $forced;	
-			if ($forced = $this->types->{$1} and $action->query->Accept($forced) ) {
-				($handler) = grep eval { $_->can('contentType') } && $_->contentType eq $forced, $this->views;
-			}
-		}
-		
-		if (not $handler) {
-		
-			my @handlers =
-		        sort {
-		            $b->{preference} <=> $a->{preference}
-		        } map {
-		            {
-		            	handler => $_,
-		                preference =>
-		                    eval { $_->can('contentType') } ? $action->query->Accept($_->contentType) : 0
-		            }
-				} $this->views;
-		
-		    my $info = shift @handlers;
-		    $handler = $info ? $info->{handler} : undef;
-	    
-		}
-	    
-	    die NotAcceptable->new(map { eval {$_->can('contentType') } ? $_->contentType : () } $this->views )
-	        unless $handler;
-	        
-	    return $handler->Invoke($action,sub { $result });
-	} else {
-		return $result;
-	}
+    my ( $this, $action, $next ) = @_;
+
+    my $result = $next ? $next->($action) : undef;
+
+    my $model;
+
+    return $result if eval { $result->isa(HttpResponse) };
+
+    my $handler;
+    my $path = $action->pathInfo;
+
+    if ( $this->types and $path =~ m/\.(\w+)$/ ) {
+        my $forced;
+        if ( $forced = $this->types->{$1} and $action->query->Accept($forced) )
+        {
+            ($handler) =
+              grep eval { $_->can('contentType') }
+              && $_->contentType eq $forced, $this->views;
+        }
+    }
+
+    if ( not $handler ) {
+
+        my @handlers =
+          sort { $b->{preference} <=> $a->{preference} } map {
+            {
+                handler    => $_,
+                preference => eval { $_->can('contentType') }
+                ? $action->query->Accept( $_->contentType )
+                : 0
+            }
+          } $this->views;
+
+        my $info = shift @handlers;
+        $handler = $info ? $info->{handler} : undef;
+
+    }
+
+    die NotAcceptable->new(
+        map {
+            eval { $_->can('contentType') } ? $_->contentType : ()
+        } $this->views
+    ) unless $handler;
+
+    return $handler->Invoke( $action, sub { $result } );
 }
 
 1;
@@ -96,4 +97,4 @@
 
 Хеш с соотвествием между расширением и типом содержимого, для подсказки при выборе представления.
 
-=cut
\ No newline at end of file
+=cut
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/HttpResponse.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/HttpResponse.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -0,0 +1,139 @@
+use strict;
+package IMPL::Web::HttpResponse;
+
+use CGI();
+use IMPL::lang qw(:declare);
+use IMPL::declare {
+	require => {
+		Exception => 'IMPL::Exception',
+		ArgumentException => '-IMPL::InvalidArgumentException' 
+	},
+	base => [
+		'IMPL::Object' => undef,
+		'IMPL::Object::Autofill' => '@_'
+	],
+	props => [
+	   status => PROP_ALL,
+	   type => PROP_ALL,
+	   charset => PROP_ALL,
+	   cookies => PROP_ALL,
+	   headers => PROP_ALL,
+	   body => PROP_ALL
+	]
+};
+
+sub CTOR {
+	my ($this) = @_;
+	
+	$this->headers({}) unless $this->headers();
+	$this->cookies({}) unless $this->cookies();
+}
+
+sub PrintResponse {
+	my ($this,$out) = @_;
+	
+	my $q = CGI->new({});
+	
+	my %headers = %{$this->headers};
+	
+	if(my $cookies = $this->cookies) {
+		$headers{-cookie} = [map _createCookie($_,$cookies->{$_}), keys %$cookies] if $cookies;
+	}
+	
+	$headers{'-status'} = $this->status || '200 OK';
+	$headers{'-type'} = $this->type || 'text/html';
+	
+	if(my $charset = $this->charset) {
+	   $q->charset($charset);
+	   binmode $out, ":encoding($charset)";
+	}
+	
+	$q->header(\%headers);
+	
+	if(my $body = $this->body) {
+		if(ref $body eq 'CODE') {
+			$body->($out);
+		} else {
+			print $out $body;
+		}
+	}
+}
+
+#used to map a pair name valie to a valid cookie object
+sub _createCookie {
+    return UNIVERSAL::isa($_[1], 'CGI::Cookie') ? $_[1] : CGI::Cookie->new(-name => $_[0], -value => $_[1] );
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Web::HttpResponse> - Результат обработки C<HTTP> запроса.
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+Базовый класс для ответов приложения на C<HTTP> запрос. Каждый вид ответа,
+например 
+
+Данный объект используется для формирования и передачи данных C<HTTP> ответа
+напрямую. Основными полями являются C<body> и C<status>.
+
+Кроме свойств относящихся непосредственно к самому C<HTTP> ответу, данный объект
+может содержать свойства относящиеся к процессу обработки запроса, например
+механизму формирования представления.
+
+=head1 MEMBERS
+
+=head2 C<[get,set]status>
+
+Статус который будет отправлен сервером клиенту, например, C<200 OK> или
+C<204 No response>. Если не указан, то будет C<200 OK>.
+
+=head2 C<[get,set]type>
+
+Тип содержимого, которое будет передано клиенту, если не указано, будет
+C<text/html>.
+
+=head2 C<[get,set]charset>
+
+Кодировка в которой будут переданны данные. Следует задавать если и только, если
+передается текстовая информация. Если указана кодировка, то она будет
+автоматически применена к потоку, который будет передан методу C<PrintResponse>. 
+
+=head2 C<[get,set]cookies>
+
+Опционально. Ссылка на хеш с печеньками.
+
+=head2 C<[get,set]headers>
+
+Опционально. Ссылка на хеш с дополнительными полями заголовка ответа. Формат
+имен полей как у модуля C<CGI>.
+
+=begin code
+
+$response->header->{custom_header} = "my value";
+
+#will produce the following header
+
+Custom-header: my value
+
+=end code
+
+=head2 C<[get,set]body>
+
+Тело ответа. Может быть как простой скаляр, который будет приведен к строке и
+выдан в поток вывода метода C<PrintResponse>. Также может быть ссылкой на
+процедуру, в таком случае будет вызвана эта процедура и ей будет передан
+первым параметром поток для вывода тела ответа.
+
+=head2 C<PrintResponse($outStream)>
+
+Формирует заголовок и выводит ответ сервера в указанный параметром поток. 
+
+=cut
\ No newline at end of file
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/NotAcceptableException.pm
--- a/Lib/IMPL/Web/NotAcceptableException.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Web/NotAcceptableException.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -7,8 +7,8 @@
     }
 };
 
-sub code {
-    406;
+sub status {
+    "406 Not acceptable"
 }
 
 1;
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/NotAllowedException.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/NotAllowedException.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -0,0 +1,28 @@
+package IMPL::Web::NotAllowedException;
+use strict;
+
+use IMPL::lang qw(:constants);
+use IMPL::declare {
+    base => [
+        'IMPL::Web::Exception' => sub {
+            my %args = @_;
+            $args{Message};
+        }
+    ]
+};
+
+sub CTOR {
+    my %args = @_;
+    
+    $this->headers({
+       allow => $args{allow} 
+    });
+}
+
+sub status {
+    "405 Method Not Allowed"
+}
+
+1;
+
+__END__
\ No newline at end of file
diff -r 431db7034a88 -r 47f77e6409f7 Lib/IMPL/Web/NotFoundException.pm
--- a/Lib/IMPL/Web/NotFoundException.pm	Thu Sep 13 17:55:01 2012 +0400
+++ b/Lib/IMPL/Web/NotFoundException.pm	Sat Sep 29 02:34:47 2012 +0400
@@ -7,8 +7,8 @@
     }
 };
 
-sub code {
-	404;
+sub status {
+	"404 Not found"
 }
 
 1;