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