# HG changeset patch # User wizard # Date 1267809285 -10800 # Node ID a35b60b16a99c6bd2033f7baacd1636a97eec61e # Parent bf59ee1cd506a8320734ddb7c64ef60a68a0bc7f Configuration, late activation diff -r bf59ee1cd506 -r a35b60b16a99 Lib/IMPL/Config.pm --- a/Lib/IMPL/Config.pm Fri Mar 05 13:59:29 2010 +0300 +++ b/Lib/IMPL/Config.pm Fri Mar 05 20:14:45 2010 +0300 @@ -83,6 +83,10 @@ } } +sub spawn { + goto &LoadXMLFile; +} + 1; __END__ @@ -99,6 +103,7 @@ BEGIN { public property SimpleString => prop_all; public property MyClass => prop_all; + public lazy property DataSource => prop_all, {type => 'App::DataSource', factory => sub {}}; } sub CTOR { @@ -108,6 +113,12 @@ $this->MyClass(new IMPL::Config::Class(Type => MyClass)) unless $this->MyClass; } +# in some script + +my $app = spawn App::Config('default.xml'); + +$app->Run(); + =head1 DESCRIPTION Позволяет сохранить/загрузить конфигурацию. Также все классы конфигурации diff -r bf59ee1cd506 -r a35b60b16a99 Lib/IMPL/Config/Link.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Config/Link.pm Fri Mar 05 20:14:45 2010 +0300 @@ -0,0 +1,22 @@ +package IMPL::Config::Link; + +use strict; + +require IMPL::Exception; + +require Tie::Scalar; +our @ISA = qw(Tie::StdScalar); + +sub FETCH { + return ${$_[0]} = ${$_[0]}->instance() if UNIVERSAL::isa(${$_[0]},'IMPL::Config::Activator'); +} + +sub restore { + my ($self,$data,$surrogate) = @_; + + my %args = @$data; + + die new IMPL::Exception('A target is required for the link') unless exists $args{target}; + + return $self->new($args{target}); +} \ No newline at end of file diff -r bf59ee1cd506 -r a35b60b16a99 Lib/IMPL/Web/Application.pm --- a/Lib/IMPL/Web/Application.pm Fri Mar 05 13:59:29 2010 +0300 +++ b/Lib/IMPL/Web/Application.pm Fri Mar 05 20:14:45 2010 +0300 @@ -3,12 +3,17 @@ use warnings; use base qw(IMPL::Object IMPL::Object::Singleton); + +require IMPL::Web::Application::Action; +require IMPL::Web::Application::Response; + use IMPL::Class::Property; use CGI; BEGIN { public property handlerError => prop_all; public property factoryAction => prop_all; + public property handlersQuery => prop_all; } # custom factory @@ -21,8 +26,18 @@ sub Run { my ($this) = @_; - while (my $request = $this->fetch_request()) { - my $response = new IMPL::Web::Application::Response(request => $request); + while (my $query = $this->FetchRequest()) { + my $response = new IMPL::Web::Application::Response(request => $query); + + my $action = new IMPL::Web::Application::Action( + request => $query, + response => $response, + application => $this, + ); + + $action->ChainHandler($_) foreach $this->handlersQuery; + + $action->Invoke(); } } diff -r bf59ee1cd506 -r a35b60b16a99 Lib/IMPL/Web/Response.pm --- a/Lib/IMPL/Web/Response.pm Fri Mar 05 13:59:29 2010 +0300 +++ b/Lib/IMPL/Web/Response.pm Fri Mar 05 20:14:45 2010 +0300 @@ -7,22 +7,21 @@ require CGI; require CGI::Cookie; +use Carp; use IMPL::Class::Property; -use HTTP::Response; - 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 => prop_all, { validator => \&_checkHeaderPrinted }; + 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_get | owner_set; # Boolean + 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_all; # Boolean + public property isHeaderPrinted => prop_get | owner_set; # Boolean private property _bufferBody => prop_all; private property _streamBody => prop_all; @@ -33,18 +32,10 @@ sub CTOR { my ($this,%args) = @_; - $this->query(CGI->new({})) unless $this->query; + $this->query(CGI->new($this->query() | {})) unless $this->query; + $this->charset($this->query->charset) unless $this->charset; - if ($this->buffered) { - my $buffer = ""; - $this->_bufferBody(\$buffer); - - open my $hBody, ">", \$buffer or die new IMPL::Exception("Failed to create buffer",$!); - - $this->_streamBody($hBody); - } else { - $this->_streamBody($this->streamOut); - } + $this->streamOut(*STDOUT) unless $this->streamOut; } sub _checkHeaderPrinted { @@ -53,6 +44,18 @@ 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; + + return $this->query->charset(@_); +} + sub _PrintHeader { my ($this) = @_; @@ -62,7 +65,6 @@ my %opt; $opt{-type} = $this->contentType if $this->contentType; - $opt{-charset} = $this->charset if $this->charset; $opt{-status} = $this->status if $this->status; $opt{-expires} = $this->expires if $this->expires; @@ -80,14 +82,23 @@ sub getStreamBody { my ($this) = @_; - return undef unless $this->_bodyStream; + return undef unless $this->streamOut; - if ($this->buffered) { - return $this->_bodyStream; - } else { - $this->_PrintHeader(); - return $this->_bodyStream; + unless ($this->_streamBody) { + if ($this->buffered) { + my $buffer = ""; + $this->_bufferBody(\$buffer); + + open my $hBody, ">", \$buffer or die new IMPL::Exception("Failed to create buffer",$!); + + $this->_streamBody($hBody); + } else { + $this->_PrintHeader(); + $this->_streamBody($this->streamOut); + } } + + return $this->_streamBody; } sub Complete { @@ -113,6 +124,8 @@ sub Discard { my ($this) = @_; + carp "Discarding sent response" if $this->isHeaderPrinted; + $this->_streamBody(undef); $this->_bufferBody(undef); $this->streamOut(undef); @@ -124,6 +137,94 @@ =pod +=head1 DESCRIPTION +Ответ сервера на CGI запрос, позволяет сформировать основные свойства заголовка и тело запроса. + +Объект позволяет буфферизировать вывод в тело ответа, что позволяет отменить или изменить +ответ в последний момент. + +Свойство C< isHeaderPrinted > можно использовать для определения были ли отправлены какие-нибудь +данные клиенту. + +=head1 PROPERTIES + +=head2 HTTP Header + +Свойства отвечающие за заголовок HTTP ответа. Эти своства могут быть изменены до тех пор пока +не будет отправлен заголовок. В противном случае выдается исключение C< IMPL::InvalidOperationException >. + +=over + +=item C< query > + +CGI запрос, который используется для вывода данных, заголовка и пр. Существует всегда. + +=item C< status > + +Код ошибки HTTP. Например, '200 OK'. По умолчанию не установлен, при отправке клиенту бедт отправлен '200 ОК'. + +=item C< contentType > + +Тип MIME. По умолчанию не установлен, подразумивается 'text/html'. + +=item C< charset > + +Кодировка, синоним свойства query->charset. + +=item C< expires > + +Определяет время жизни контента, например '+10m'. По умолчанию не задано и не передается. + +=item C< cookies > + +Хеш массив с cookies, например C< { cart => ['foo','bar'], display => 'list' } >. + +=back + +=head2 Response behaviour + +Свойства отвечающие за поведение ответа. + +=over + +=item C< buffered > + +C< True > - то тело ответа пишется в буффер и будет отправлено при вызове метода C< Complete >, +заголовок также будет отправлен после вызова метода C< Complete >. + +C< False > - тело ответа пишется непосредственно в поток к клиенту, при этом заголовок +будет отправлен при первом обращении к свойству C< streamBody > + +Это свойство можно менять до первого обращения к потоку для записи в тело ответа. + +=item C< streamOut > + +Стандартный вывод CGI приложения. + +=item C< streamBody > + +Поток для записи в тело ответа. + +=item C< isHeadPrinted > + +Признак того, что заголовок уже был отправлен клиенту. + +=back + +=head1 METHODS + +=over + +=item C< Complete > + +Завершает отправку ответа. + +=item C< Discard > + +Отменяет отправку ответа, при этом если часть данных (например, заголовок) +уже была отправлена, выдает предупреждение в STDERR. + +=back =cut \ No newline at end of file diff -r bf59ee1cd506 -r a35b60b16a99 _test/Resources/app.xml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/_test/Resources/app.xml Fri Mar 05 20:14:45 2010 +0300 @@ -0,0 +1,23 @@ + + + Sample application + + value one + value two + + + Test::Config::DataSource + + data + nobody + + + + Test::Config::Security + + + + + + + \ No newline at end of file