annotate Lib/Engine/Action/URICall.pm @ 19:1ca530e5c9c5

DOM схема, требует переработки в части схемы для описания схем. Автоверификация не проходит
author Sergey
date Fri, 11 Sep 2009 16:30:39 +0400
parents 03e58a454b20
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package Engine::Action::URICall;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3 use Common;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4 use Engine::Action;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6 our $Namespace;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 our %MapOutput;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9 our $DefaultMethod;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 %MapOutput = ( page => 'Engine::Output::Page' , xml => 'Engine::Output::Xml' ) if not %MapOutput;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13 =pod
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 /module/submodule/method.format
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15 =cut
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17 sub ConstructAction {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18 my ($class,$uriRequest) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 my @module = $uriRequest->path_segments;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22 my ($function,$format) = (((pop @module) or $DefaultMethod) =~ m/^(.*?)(?:\.(\w+))?$/);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23 @module = grep $_, @module;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24 my $module = @module ? ($Namespace ? $Namespace . '::' : '').join('::',@module) : $Namespace;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 return new Engine::Action( Package => $module, Method => $function, Output => $class->MapOutput($format), RequestURI => $uriRequest);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29 sub MapOutput {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30 my ($class,$format) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 my $module = $MapOutput{$format} or return undef;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33 eval "require $module;" or die new Exception('Failed to load output module',$module,$@);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 if ($module->can('construct')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36 return $module->construct($format);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38 return $module;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42 1;