49
|
1 package Engine::Action::URICall;
|
|
2 use strict;
|
|
3 use Common;
|
|
4 use Engine::Action;
|
|
5
|
|
6 our $Namespace;
|
|
7
|
|
8 our %MapOutput;
|
|
9 our $DefaultMethod;
|
|
10
|
|
11 %MapOutput = ( page => 'Engine::Output::Page' , xml => 'Engine::Output::Xml' ) if not %MapOutput;
|
|
12
|
|
13 =pod
|
|
14 /module/submodule/method.format
|
|
15 =cut
|
|
16
|
|
17 sub ConstructAction {
|
|
18 my ($class,$uriRequest) = @_;
|
|
19
|
|
20 my @module = $uriRequest->path_segments;
|
|
21
|
|
22 my ($function,$format) = (((pop @module) or $DefaultMethod) =~ m/^(.*?)(?:\.(\w+))?$/);
|
|
23 @module = grep $_, @module;
|
|
24 my $module = @module ? ($Namespace ? $Namespace . '::' : '').join('::',@module) : $Namespace;
|
|
25
|
|
26 return new Engine::Action( Package => $module, Method => $function, Output => $class->MapOutput($format), RequestURI => $uriRequest);
|
|
27 }
|
|
28
|
|
29 sub MapOutput {
|
|
30 my ($class,$format) = @_;
|
|
31 my $module = $MapOutput{$format} or return undef;
|
|
32
|
|
33 eval "require $module;" or die new Exception('Failed to load output module',$module,$@);
|
|
34
|
|
35 if ($module->can('construct')) {
|
|
36 return $module->construct($format);
|
|
37 } else {
|
|
38 return $module;
|
|
39 }
|
|
40 }
|
|
41
|
|
42 1;
|