1 |
3 |
ahitrov@rambler.ru |
package Contenido::PreambleHandler; |
2 |
|
|
|
3 |
|
|
use strict; |
4 |
|
|
|
5 |
|
|
use Contenido::Globals; |
6 |
|
|
use Scalar::Util qw|blessed reftype|; |
7 |
|
|
use Data::Dumper; |
8 |
|
|
|
9 |
|
|
sub comps {return{}} # dummy |
10 |
|
|
|
11 |
|
|
# ->new( load_modules => 'My_preambles') |
12 |
|
|
# |
13 |
|
|
sub new { |
14 |
|
|
my $proto = shift; |
15 |
|
|
my %args = @_; |
16 |
|
|
my $class = ref $proto || $proto; |
17 |
|
|
my $self = {}; |
18 |
|
|
bless $self, $class; |
19 |
|
|
|
20 |
|
|
$self->_init; |
21 |
|
|
$self->_load_modules( $args{'load_modules'} ) if $args{'load_modules'}; |
22 |
|
|
|
23 |
|
|
return $self; |
24 |
|
|
} |
25 |
|
|
|
26 |
|
|
sub _init { |
27 |
|
|
my $self = shift; |
28 |
|
|
my $comps = $self->comps || {}; |
29 |
|
|
$self->{comps}{$_} = $comps->{$_} for keys %$comps; |
30 |
|
|
} |
31 |
|
|
|
32 |
|
|
sub _load_modules { |
33 |
|
|
my $self = shift; |
34 |
|
|
my $class = ref $self || $self; |
35 |
|
|
my $path = shift || return; |
36 |
|
|
|
37 |
|
|
# (c) Init.pm |
38 |
|
|
my $root_path = __FILE__; |
39 |
|
|
$root_path =~ s|/[^/]*$||; |
40 |
|
|
$root_path =~ s|/Contenido$||; |
41 |
|
|
|
42 |
|
|
my $modules = Utils::find_modules(relative_dir => $state->project.'/'.$path, absolute_dir => $root_path.'/', recursive => 1); |
43 |
|
|
return unless ref $modules eq 'ARRAY'; |
44 |
|
|
|
45 |
|
|
$log->info("Loading Preabmle modules"); |
46 |
|
|
|
47 |
|
|
my %modules; map { $modules{$_}++ } @$modules; |
48 |
|
|
for my $module ( keys %modules ) { |
49 |
|
|
|
50 |
|
|
eval "use $module"; $log->error("Cannot load module $module because of '$@'") if $@; |
51 |
|
|
|
52 |
|
|
unless ( $module->isa( $class ) ) { |
53 |
|
|
$log->warning("Class $module is not child of $class - skiped"); |
54 |
|
|
next; |
55 |
|
|
} |
56 |
|
|
|
57 |
|
|
my $obj = $module->new; next unless ref $obj eq $module; |
58 |
|
|
my $comps = $obj->comps; |
59 |
|
|
for ( keys %$comps ) { |
60 |
|
|
$comps->{$_}{obj} = $obj; |
61 |
|
|
$self->{comps}{$_} = $comps->{$_}; |
62 |
|
|
} |
63 |
|
|
$log->info("$module loaded"); |
64 |
|
|
} |
65 |
|
|
} |
66 |
|
|
|
67 |
|
|
# !!! This code will be executed in every Mason component's preamble. |
68 |
|
|
# Don't make it fat. |
69 |
|
|
# |
70 |
|
|
sub handle { |
71 |
|
|
my $self = shift; |
72 |
|
|
my $context = shift; |
73 |
|
|
my $req_args = shift; |
74 |
|
|
|
75 |
|
|
my $req_args_h = $req_args && reftype $req_args eq 'ARRAY' ? { @$req_args } : {}; |
76 |
|
|
my $comp = $context->current_comp; |
77 |
|
|
my $action = $self->{comps}{ $comp->path }; |
78 |
|
|
|
79 |
|
|
return unless $action; |
80 |
|
|
|
81 |
|
|
# 1. Action is self cached |
82 |
|
|
# |
83 |
|
|
if ( ref $action->{cache} && !$state->development ) { |
84 |
|
|
|
85 |
|
|
# create complex cache key - based on component args |
86 |
|
|
my $key = $action->{cache}{'key'}; |
87 |
|
|
if ( defined $action->{cache}{'key_args'} && reftype $action->{cache}{'key_args'} eq 'ARRAY' ) { |
88 |
|
|
my $key_args = $action->{cache}{'key_args'}; |
89 |
|
|
$key = join '_', $key || (), map { $_.':'.$req_args_h->{$_} } @$key_args; |
90 |
|
|
} |
91 |
|
|
|
92 |
|
|
return { _cached => 1 } if $context->cache_self( %{$action->{cache}}, key => $key ); |
93 |
|
|
} |
94 |
|
|
|
95 |
|
|
if ( $action->{'sub'} ) { |
96 |
|
|
my $ret; |
97 |
|
|
my $sub = $action->{'sub'}; |
98 |
|
|
|
99 |
|
|
# 2. Action located in extra module |
100 |
|
|
# |
101 |
|
|
if ( ref $action->{obj} ) { |
102 |
|
|
$ret = $action->{obj}->$sub( $context, $req_args_h ); |
103 |
|
|
|
104 |
|
|
# 3. Action present in current module |
105 |
|
|
# |
106 |
|
|
} else { |
107 |
|
|
$ret = $self->$sub( $context, $req_args_h ); |
108 |
|
|
} |
109 |
|
|
|
110 |
|
|
push @$req_args, (%$ret) if reftype $ret eq 'HASH'; # add data to %ARGS |
111 |
|
|
|
112 |
|
|
return $ret; |
113 |
|
|
} |
114 |
|
|
|
115 |
|
|
return 0; |
116 |
|
|
} |
117 |
|
|
|
118 |
|
|
|
119 |
|
|
1; |
120 |
|
|
|