Mercurial > pub > Impl
changeset 206:c8fe3f84feba
+IMPL::Web::Handlers::ViewSelector
+IMPL::Web::Handlers::ErrorHandler
*IMPL::Web::Handlers::RestController moved types mappings to ViewSelector
author | sergey |
---|---|
date | Thu, 03 May 2012 16:48:39 +0400 |
parents | 891c04080658 |
children | f534a60d5b01 |
files | Lib/IMPL/Config/Activator.pm Lib/IMPL/Config/Resolve.pm Lib/IMPL/DOM/Navigator/Builder.pm Lib/IMPL/DOM/Navigator/SimpleBuilder.pm Lib/IMPL/Exception.pm Lib/IMPL/Object/Autofill.pm Lib/IMPL/Object/Serializable.pm Lib/IMPL/Profiler.pm Lib/IMPL/SQL/Schema/Traits/mysql.pm Lib/IMPL/Web/Application/Action.pm Lib/IMPL/Web/Application/RestBaseResource.pm Lib/IMPL/Web/Exception.pm Lib/IMPL/Web/Handler/ErrorHandler.pm Lib/IMPL/Web/Handler/JSONView.pm Lib/IMPL/Web/Handler/RestController.pm Lib/IMPL/Web/Handler/TTView.pm Lib/IMPL/Web/Handler/ViewSelector.pm Lib/IMPL/Web/NotAcceptableException.pm Lib/IMPL/Web/View/TTLoader.pm |
diffstat | 19 files changed, 227 insertions(+), 176 deletions(-) [+] |
line wrap: on
line diff
--- a/Lib/IMPL/Config/Activator.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/Config/Activator.pm Thu May 03 16:48:39 2012 +0400 @@ -15,7 +15,7 @@ sub CTOR { my $this = shift; - die new IMPL::Exception("A Type parameter is required") unless $this->factory; + die new IMPL::Exception("A factory parameter is required") unless $this->factory; }
--- a/Lib/IMPL/Config/Resolve.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/Config/Resolve.pm Thu May 03 16:48:39 2012 +0400 @@ -4,9 +4,11 @@ use IMPL::Class::Property; use IMPL::Exception; +use Carp qw(carp); BEGIN { public property path => prop_all|prop_list; + carp "deprecated"; } __PACKAGE__->PassThroughArgs;
--- a/Lib/IMPL/DOM/Navigator/Builder.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/DOM/Navigator/Builder.pm Thu May 03 16:48:39 2012 +0400 @@ -44,7 +44,7 @@ $node = $this->{$Document} = $this->{$_docClass}->new(nodeName => $nodeName,%props); $this->_initNavigator($node); } else { - die new IMPL::InvalidOperationException('Can\t create a second top level element') unless $this->Current; + die new IMPL::InvalidOperationException('Can create a second top level element') unless $this->Current; $node = $this->{$Document}->Create($nodeName,$class,\%props); $this->Current->appendChild($node); $this->internalNavigateNodeSet($node);
--- a/Lib/IMPL/DOM/Navigator/SimpleBuilder.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/DOM/Navigator/SimpleBuilder.pm Thu May 03 16:48:39 2012 +0400 @@ -26,7 +26,7 @@ $node = $this->{$Document} = IMPL::DOM::Document->new(nodeName => $nodeName,%props); $this->_initNavigator($node); } else { - die new IMPL::InvalidOperationException('Can\t create a second top level element') unless $this->Current; + die new IMPL::InvalidOperationException('Can create a second top level element') unless $this->Current; $node = $this->{$Document}->Create($nodeName,'IMPL::DOM::Node',\%props); $this->Current->appendChild($node); $this->internalNavigateNodeSet($node);
--- a/Lib/IMPL/Exception.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/Exception.pm Thu May 03 16:48:39 2012 +0400 @@ -20,7 +20,7 @@ my ($str,$level) = @_; $level ||= 0; $str = '' unless defined $str; - join ("\n", map( "\t"x$level.$_ , split(/\n/,$str) ) ); + join ("\n", map( " "x$level.$_ , split(/\n/,$str) ) ); } sub new {
--- a/Lib/IMPL/Object/Autofill.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/Object/Autofill.pm Thu May 03 16:48:39 2012 +0400 @@ -58,19 +58,19 @@ } $class->get_meta('IMPL::Class::PropertyInfo')) { my $name = $prop_info->Name; if (ref $prop_info->Mutators || !$prop_info->Implementor->isa('IMPL::Class::Property::Direct')) { - $text .= "\t\$this->$name(\$fields->{$name}) if exists \$fields->{$name};\n"; + $text .= " \$this->$name(\$fields->{$name}) if exists \$fields->{$name};\n"; } else { my $fld = $prop_info->Implementor->FieldName($prop_info); if ($prop_info->Mutators & prop_list) { - $text .= "\t\$this->{$fld} = IMPL::Object::List->new ( ref \$fields->{$name} ? \$fields->{$name} : [\$fields->{$name}] ) if exists \$fields->{$name};\n"; + $text .= " \$this->{$fld} = IMPL::Object::List->new ( ref \$fields->{$name} ? \$fields->{$name} : [\$fields->{$name}] ) if exists \$fields->{$name};\n"; } else { - $text .= "\t\$this->{$fld} = \$fields->{$name} if exists \$fields->{$name};\n"; + $text .= " \$this->{$fld} = \$fields->{$name} if exists \$fields->{$name};\n"; } } } } else { # meta not supported - #$text .= "\t".'$this->$_($fields->{$_}) foreach keys %$fields;'."\n"; + #$text .= " ".'$this->$_($fields->{$_}) foreach keys %$fields;'."\n"; } $text .= "}\n\\&_impl_object_autofill;"; return eval $text;
--- a/Lib/IMPL/Object/Serializable.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/Object/Serializable.pm Thu May 03 16:48:39 2012 +0400 @@ -38,7 +38,7 @@ SAVE_METHOD $code .= - join "\n", map "\t".'$ctx->AddVar('.$_->Name.' => ' . + join "\n", map " ".'$ctx->AddVar('.$_->Name.' => ' . ((not ref $_->Mutators and $_->Mutators & prop_list) ? ('[$this->'.$_->Class.'::'.$_->Name.'()]') : ('$this->'.$_->Class.'::'.$_->Name.'()')) . ') if defined ' . '$this->'.$_->Class.'::'.$_->Name.'()' . ';', grep $_->canGet, $class->get_meta('IMPL::Class::PropertyInfo',undef,1); $code .= <<SAVE_METHOD;
--- a/Lib/IMPL/Profiler.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/Profiler.pm Thu May 03 16:48:39 2012 +0400 @@ -76,7 +76,7 @@ @frame[0..2] = @next[0..2]; } - #warn "\t"x$level,"$frame[0] - $frame[3]"; + #warn " "x$level,"$frame[0] - $frame[3]"; return wantarray ? @frame : $frame[0]; }; } @@ -124,7 +124,7 @@ my $context = wantarray; { local $InvokeTime = 0; - #warn "\t"x$level,"enter ${class}::$method"; + #warn " "x$level,"enter ${class}::$method"; $level ++; if ($context) { @arr = &$entry(@_); @@ -143,7 +143,7 @@ $InvokeInfo{"${class}::${method}"}{Own} += $timeOwn; $InvokeTime += $timeTotal; $level --; - #warn "\t"x$level,"leave ${class}::$method"; + #warn " "x$level,"leave ${class}::$method"; return $context ? @arr : $scalar; }; if ($proto) {
--- a/Lib/IMPL/SQL/Schema/Traits/mysql.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/SQL/Schema/Traits/mysql.pm Thu May 03 16:48:39 2012 +0400 @@ -256,24 +256,24 @@ push @sql, ');'; } - return map { ("\t" x $level) . $_ } @sql; + return map { (" " x $level) . $_ } @sql; } sub formatDropTable { my ($tableName,$level) = @_; - return "\t"x$level."DROP TABLE ".quote_names($tableName).";"; + return " "x$level."DROP TABLE ".quote_names($tableName).";"; } sub formatTableTag { my ($tag,$level) = @_; - return map { "\t"x$level . "$_ = ".$tag->{$_} } grep {/^(ENGINE)$/i} keys %{$tag}; + return map { " "x$level . "$_ = ".$tag->{$_} } grep {/^(ENGINE)$/i} keys %{$tag}; } sub formatColumn { my ($column,$level) = @_; $level ||= 0; - return "\t"x$level.quote_names($column->Name)." ".formatType($column->Type)." ".($column->CanBeNull ? 'NULL' : 'NOT NULL').($column->DefaultValue ? formatValueToType($column->DefaultValue,$column->Type) : '' ).($column->Tag ? ' '.join(' ',$column->Tag) : ''); + return " "x$level.quote_names($column->Name)." ".formatType($column->Type)." ".($column->CanBeNull ? 'NULL' : 'NOT NULL').($column->DefaultValue ? formatValueToType($column->DefaultValue,$column->Type) : '' ).($column->Tag ? ' '.join(' ',$column->Tag) : ''); } sub formatType { @@ -306,11 +306,11 @@ my $columns = join(',',map quote_names($_->Name),@{$constraint->Columns}); if (ref $constraint eq 'IMPL::SQL::Schema::Constraint::PrimaryKey') { - return "\t"x$level."PRIMARY KEY ($columns)"; + return " "x$level."PRIMARY KEY ($columns)"; } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Unique') { - return "\t"x$level."UNIQUE $name ($columns)"; + return " "x$level."UNIQUE $name ($columns)"; } elsif ($constraint eq 'IMPL::SQL::Schema::Constraint::Index') { - return "\t"x$level."INDEX $name ($columns)"; + return " "x$level."INDEX $name ($columns)"; } else { die new IMPL::InvalidArgumentException('The unknown constraint', ref $constraint); } @@ -329,7 +329,7 @@ my $refname = quote_names($constraint->ReferencedPrimaryKey->Table->Name); my $refcolumns = join(',',map quote_names($_->Name),@{$constraint->ReferencedPrimaryKey->Columns}); return ( - "\t"x$level. + " "x$level. "CONSTRAINT $name FOREIGN KEY $name ($columns) REFERENCES $refname ($refcolumns)". ($constraint->OnUpdate ? 'ON UPDATE'.$constraint->OnUpdate : ''). ($constraint->OnDelete ? 'ON DELETE'.$constraint->OnDelete : '') @@ -339,13 +339,13 @@ sub formatAlterTableRename { my ($oldName,$newName,$level) = @_; - return "\t"x$level."ALTER TABLE ".quote_names($oldName)." RENAME TO ".quote_names($newName).";"; + return " "x$level."ALTER TABLE ".quote_names($oldName)." RENAME TO ".quote_names($newName).";"; } sub formatAlterTableDropColumn { my ($tableName, $columnName,$level) = @_; - return "\t"x$level."ALTER TABLE ".quote_names($tableName)." DROP COLUMN ".quote_names($columnName).";"; + return " "x$level."ALTER TABLE ".quote_names($tableName)." DROP COLUMN ".quote_names($columnName).";"; } =pod @@ -356,7 +356,7 @@ my $posSpec = $pos == 0 ? 'FIRST' : 'AFTER '.quote_names($table->ColumnAt($pos-1)->Name); - return "\t"x$level."ALTER TABLE ".quote_names($tableName)." ADD COLUMN ".formatColumn($column) .' '. $posSpec.";"; + return " "x$level."ALTER TABLE ".quote_names($tableName)." ADD COLUMN ".formatColumn($column) .' '. $posSpec.";"; } =pod @@ -365,7 +365,7 @@ sub formatAlterTableChangeColumn { my ($tableName,$column,$table,$pos,$level) = @_; my $posSpec = $pos == 0 ? 'FIRST' : 'AFTER '.quote_names($table->ColumnAt($pos-1)->Name); - return "\t"x$level."ALTER TABLE ".quote_names($tableName)." MODIFY COLUMN ".formatColumn($column).' '. $posSpec.";"; + return " "x$level."ALTER TABLE ".quote_names($tableName)." MODIFY COLUMN ".formatColumn($column).' '. $posSpec.";"; } =pod @@ -383,7 +383,7 @@ } else { die new IMPL::Exception("The unknow type of the constraint",ref $constraint); } - return "\t"x$level."ALTER TABLE ".quote_names($tableName)." DROP $constraintName;"; + return " "x$level."ALTER TABLE ".quote_names($tableName)." DROP $constraintName;"; } =pod @@ -392,7 +392,7 @@ sub formatAlterTableAddConstraint { my ($tableName,$constraint,$level) = @_; - return "\t"x$level."ALTER TABLE ".quote_names($tableName)." ADD ".formatConstraint($constraint,0).';'; + return " "x$level."ALTER TABLE ".quote_names($tableName)." ADD ".formatConstraint($constraint,0).';'; } sub CreateTable {
--- a/Lib/IMPL/Web/Application/Action.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/Web/Application/Action.pm Thu May 03 16:48:39 2012 +0400 @@ -6,6 +6,7 @@ __PACKAGE__->PassThroughArgs; use IMPL::Class::Property; +use Carp qw(carp); BEGIN { public property application => prop_get | owner_set; @@ -46,6 +47,8 @@ sub ChainHandler { my ($this,$handler) = @_; + carp "deprecated, use Application->handlers instead"; + my $delegateNext = $this->_entryPoint(); if (ref $handler eq 'CODE') { @@ -125,103 +128,7 @@ =head1 DESCRIPTION C<[Infrastructure]> - -Определяет порядок выполнения запроса. Запрос выполняется последовательным вызовом -цепочки обработчиков, при этом обработчики сами вызывают следующие. -Обработчики выполняются в порядке, обратном их добавлению. - -Типичная цепочка может быть такой, в порядке добавления - -=begin code - -IMPL::Web::QueryHandler::SecCallToMethod -IMPL::Web::QueryHandler::AuthenticateCookie -IMPL::Web::QueryHandler::PageFormat - -=end code - -что приведет к следующей последовательности - -=begin code - -# the application creates a new Action object - -my $action = $application->actionFactory->new( - action => $application, # the application passes self - query => $query # current CGI query -); - -# forms query handlers stack - -$action->ChainHandler($_) foreach qw ( - IMPL::Web::QueryHandler::SecCallToMethod - IMPL::Web::QueryHandler::AuthenticateCookie - IMPL::Web::QueryHandler::PageFormat -); - -# and finally invokes the action - -$action->Invoke() { - - # some internals - - IMPL::Web::QueryHandler::PageFormat->Invoke($action,$nextHandlerIsAuthHandler) { - - #some internals - - my $result = $nextHandlerIsAuthHandler() { - - # some internals - - IMPL::Web::QueryHandler::AuthenticateCookie->Invoke($action,$nextHandlerIsSecCall) { - - # some internals - # do auth and generate security $context - - # impersonate $context and call the next handler - return $context->Impersonate($nextHandlerIsSecCall) { - - # some internals - - IMPL::Web::QueryHandler::SecCallToMethod->Invoke($action,undef) { - - # next handler isn't present as it is the last hanler - - # some internals - # calculate the $method and the $target from CGI request - - IMPL::Security->AccessCheck($target,$method); - return $target->$method(); - - } - - } - - } - } - - # some intenals - # formatted output to $action->response->streamBody - } -} - -=end code - -или как альтернатива может быть еще - -=begin code - -IMPL::Web::QueryHandler::SecCallToMethod -IMPL::Web::QueryHandler::AuthenticateCookie -IMPL::Web::QueryHandler::Filter->new( target => IMPL::Transform::ObjectToJSON->new() , method => 'Transform') -IMLP::Web::QueryHandler::JSONFormat - - -=end code - -В данной цепочке также происходит вызов метода, но его результат потом преобразуется -в простые структуры и передается JSON преобразователю. Таким образом модулю логики -не требуется знать о выходном формате, всю работу проделают дополнительные фильтры. +Свзяывет CGI запрос, приложение, орабатывающее его и ответ, который будет отправлен клиенту. =head1 MEMBERS @@ -264,37 +171,4 @@ что эта операция не возможна, если ответ частично или полностью отправлен клиенту. Тогда возникает исключение C<IMPL::InvalidOperationException>. -=item C< ChainHandler($handler) > - -Добавляет новый обработчик в цепочку. Выполнение цепочки начинается с конца, -тоесть последний добавленный будет выполнен первым. - -=back - -=head1 HANDLERS - -=head2 subroutines - -=over - -=item CODE ref - -Ссылка на процедуру может являться обработчиком, при этом функция будет вызвана с -двумя параметрами: ссылкой на action объект, и точкой входа следующего обработчика. - -=item Method Name - -Имя метода, передается в виде строки. У текущего объекта action ищется метод с -указанным именем, после чего используется ссылка на этот метод для вызова с двумя -параметрами: ссылкой на action объект, и точкой входа следующего обработчика. - -Получается вызов идентичный следующему C<< $action->MethodName($nextHandler) >>; - -=back - -=head2 C< IMPL::Web::QueryHandler > - -Любой объект наследованный от C< IMPL::Web::QueryHandler > может быть -использован в качестве обработчика запроса - =cut
--- a/Lib/IMPL/Web/Application/RestBaseResource.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/Web/Application/RestBaseResource.pm Thu May 03 16:48:39 2012 +0400 @@ -8,8 +8,7 @@ ArgumentException => '-IMPL::InvalidArgumentException', NotImplException => '-IMPL::NotImplementedException', ForbiddenException => 'IMPL::Web::ForbiddenException', - TTransform => '-IMPL::Transform', - TResolve => '-IMPL::Config::Resolve' + TTransform => '-IMPL::Transform' }, base => { 'IMPL::Object' => undef,
--- a/Lib/IMPL/Web/Exception.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/Web/Exception.pm Thu May 03 16:48:39 2012 +0400 @@ -18,7 +18,8 @@ =head1 NAME -C<IMPL::Web::Exception> - Базовый класс для всех web-исключенийю +C<IMPL::Web::Exception> - Базовый класс для всех web-исключений, для ошибок вызванных +по вине клиента. =head1 SYNOPSIS @@ -44,6 +45,6 @@ =head2 C<code()> -Возвращает C<HTTP> код ошибки. +Возвращает C<HTTP> код ошибки. Каждый класс иключений должен переопределить данный метод. =cut \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Web/Handler/ErrorHandler.pm Thu May 03 16:48:39 2012 +0400 @@ -0,0 +1,70 @@ +package IMPL::Web::Handler::ErrorHandler; +use strict; + +use IMPL::lang qw(:declare :constants is); +use IMPL::Exception(); +use IMPL::declare { + require => { + WebException => 'IMPL::Web::Exception', + ArgumentException => '-IMPL::InvalidArgumentException', + }, + base => { + 'IMPL::Object' => undef, + 'IMPL::Object::Autofill' => '@_', + 'IMPL::Object::Serializable' => undef + } +}; + +BEGIN { + public property errors => PROP_ALL; + public property loader => PROP_ALL; + public property fallback => PROP_ALL; + public property contentType => PROP_ALL; +} + +sub CTOR { + my ($this) = @_; + + die ArgumentException->new("loader") unless $this->loader; + die ArgumentException->new("fallback") unless $this->fallback; + + $this->errors({}) unless $this->errors; + +} + +sub Invoke { + my ($this,$action,$next) = @_; + + undef $@; + my $result; + eval { + $result = $next ? $next->($action) : undef; + }; + + if (my $err = $@) { + $action->ReinitResponse(); + $action->response->contentType($this->contentType); + + my $vars = { + error => $err + }; + + my $code = 500; + + $code = $err->code if eval { $err->isa(WebException) }; + + $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); + } + + return $result; +} + +1; \ No newline at end of file
--- a/Lib/IMPL/Web/Handler/JSONView.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/Web/Handler/JSONView.pm Thu May 03 16:48:39 2012 +0400 @@ -11,13 +11,17 @@ } }; +sub contentType { + 'application/json' +} + sub Invoke { my ($this,$action,$next) = @_; - my $result = $next->($action); + my $result = $next ? $next->($action) : undef; $result = [$result] unless ref $result; - #$action->response->contentType('text/javascript'); + $action->response->contentType($this->contentType); my $hout = $action->response->streamBody;
--- a/Lib/IMPL/Web/Handler/RestController.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/Web/Handler/RestController.pm Thu May 03 16:48:39 2012 +0400 @@ -21,14 +21,13 @@ BEGIN { public property root => PROP_GET | PROP_OWNERSET; public property contract => PROP_GET | PROP_OWNERSET; - public property types => PROP_GET | PROP_OWNERSET; } sub CTOR { my ($this) = @_; - die ArgimentException->new("types") - if $this->types and ref $this->types ne 'HASH'; + die ArgumentException->new("root") unless $this->root; + die ArgumentException->new("contract") unless $this->contract; } sub Invoke { @@ -49,10 +48,6 @@ my ($obj,$view) = (pop(@segments) =~ m/(.*?)(?:\.(\w+))?$/); push @segments, $obj; - if ($this->types and my $type = $this->types->{$view}) { - $action->response->contentType($type); - } - my $res = $this->contract->Transform($this->root, { id => '' } ); while(@segments) {
--- a/Lib/IMPL/Web/Handler/TTView.pm Thu May 03 01:00:02 2012 +0400 +++ b/Lib/IMPL/Web/Handler/TTView.pm Thu May 03 16:48:39 2012 +0400 @@ -56,6 +56,8 @@ $this->SelectView($action,ref $result), $vars ); + + $action->response->contentType($this->contentType); my $hout = $action->response->streamBody; @@ -232,11 +234,29 @@ =begin code xml -<view type="HASH"> - <item extname="@My::Data::Product">product/info</item> - <catalog> - <catalog> -</view> +<item id="html-view" type="IMPL::Web::Handler::TTView"> + <contentType>text/html</contentType> + <loader id="tt-loader" type="IMPL::Web::View::TTLoader"> + <options type="HASH"> + <INCLUDE_PATH type="IMPL::Config::Reference"> + <target>IMPL::Config</target> + <AppBase>view</AppBase> + </INCLUDE_PATH> + <INTERPOLATE>1</INTERPOLATE> + <POST_CHOMP>1</POST_CHOMP> + <ENCODING>utf-8</ENCODING> + </options> + <ext>.tt</ext> + <initializer>global.tt</initializer> + <layoutBase>layouts</layoutBase> + </loader> + <defaultDocument>default</defaultDocument> + <selectors type="ARRAY"> + <item>@HASH => dump</item> + <item>@My::Data::Product => product/info</item> + <item>{action:.*} @My::Data::Product => product/{action}</item> + </selectors> +</item> =end code xml @@ -252,10 +272,10 @@ [url-template] [class] => template -shoes * => product/list +shoes => product/list {action:*.} @My::Data::Product => product/{action} -stuff list => product/list +stuff >list => product/list details => product/details =end text
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Web/Handler/ViewSelector.pm Thu May 03 16:48:39 2012 +0400 @@ -0,0 +1,60 @@ +package IMPL::Web::Handler::ViewSelector; +use strict; + +use IMPL::lang qw(:declare :constants); + +use IMPL::declare { + require => { + NotAcceptable => 'IMPL::Web::NotAcceptableException' + }, + base => { + 'IMPL::Object' => undef, + 'IMPL::Object::Autofill' => '@_', + 'IMPL::Object::Serializable' => undef + } +}; + +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 $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,$next); +} + +1; \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Web/NotAcceptableException.pm Thu May 03 16:48:39 2012 +0400 @@ -0,0 +1,25 @@ +package IMPL::Web::NotAcceptableException; +use strict; + +use IMPL::declare { + base => { + 'IMPL::Web::Exception' => '@_' + } +}; + +sub code { + 406; +} + +1; + +__END__ + +=pod + +=head1 NAME + +C<IMPL::Web::NotAcceptableException> Исключение в случае, если запрошенный ресурс не может +быть выдан в указанном виде. + +=cut \ No newline at end of file