Line # Revision Author
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