Line # Revision Author
1 760 ahitrov #!/usr/bin/env perl
2 8 ahitrov@rambler.ru
3 use strict;
4
5 use Apache;
6 use Apache::Constants;
7 use Time::HiRes;
8
9 use Contenido::Globals;
10 use Contenido::Apache;
11 use Contenido::Init;
12
13 $Contenido::Globals::PROJECT_NAME = '@PROJECT@';
14 $store_method = lc('@STORE_METHOD@');
15 $DEBUG = lc('@DEBUG@') eq 'yes';
16 $DEBUG_SQL = lc('@DEBUG_SQL@') eq 'yes';
17 $DEBUG_CORE = lc('@DEBUG_CORE@') eq 'yes';
18
19 #базовая инициализация Contenido
20 Contenido::Init->init();
21
22 #импортим все что нужно в пакет в котором работают компоненты
23 package HTML::Mason::Commands;
24
25 use Data::Dumper;
26 use Convert::Cyrillic;
27 use Image::Size;
28 use Time::HiRes qw(gettimeofday);
29 use POSIX qw(strftime);
30 use Contenido::File;
31 use Contenido::DateTime;
32
33 use Utils;
34 use Contenido::Globals;
35 use Contenido::Init;
36
37 use vars qw(%_comments);
38
39 %_comments = (
40 'text/css' => ['/*', '*/' ],
41 'text/html' => ['<!--', '-->'],
42 );
43
44 require "@CONF@/mason/handler_project.pl";
45
46 1;
47
48 #обьявление package в котором работает основной handler
49 package @PROJECT@::Mason;
50
51 use Contenido::Globals;
52 use HTML::Mason::ApacheHandler;
53 use HTML::Entities;
54 use Utils;
55
56 my %ah_args = (
57 data_dir => '@PROJECT_VAR@/mason',
58 comp_root => [['project'=>'@MASON_COMP@'], ['core'=>'@CORE_COMP@']],
59 );
60
61 if ( '@PLUGINS@' ) {
62 my @plcomps = map { [$_=>'@PLUGIN_COMP@'.'/'.$_.'/comps'] } grep { $_ } split(/\ +/, '@PLUGINS@');
63 if ( @plcomps ) {
64 @{$ah_args{comp_root}} = ($ah_args{comp_root}->[0], @plcomps, $ah_args{comp_root}->[1]);
65 }
66 }
67
68 if (lc('@DEVELOPMENT@') eq 'yes') {
69 $ah_args{error_mode} = 'output';
70
71 if (lc '@COMP_TIMINGS_DISABLE@' ne 'yes') {
72 $ah_args{preamble} = q|
73 use locale;
74 my $_comm = $_comments{$r->content_type};
75 my $s_time_ = [Time::HiRes::gettimeofday];
76 597 ahitrov warn "Start: ".$m->current_comp->path."\n";
77 8 ahitrov@rambler.ru if ($_comm) {
78 $m->out("\n".$$_comm[0]." ".$m->current_comp->path.":\tStart t: ".Time::HiRes::time." ".$$_comm[1]."\n");
79 }|;
80 $ah_args{postamble} = q|
81 597 ahitrov warn "Timing: ".$m->current_comp->path.":\t".sprintf('%.1f ms', Time::HiRes::tv_interval($s_time_) * 1000)."\n";
82 8 ahitrov@rambler.ru if ($_comm) {
83 $m->out("\n".$$_comm[0]." ".$m->current_comp->path.":\tFinish t: ".Time::HiRes::time.", w: ".sprintf('%.4f', Time::HiRes::tv_interval($s_time_))." ".$$_comm[1]."\n");
84 }|;
85 } else {
86 $ah_args{preamble} = q|
87 use locale;
88 |;
89 }
90 } else {
91 597 ahitrov if (lc '@COMP_TIMINGS_DISABLE@' ne 'yes') {
92 $ah_args{preamble} = q|
93 8 ahitrov@rambler.ru use locale;
94 597 ahitrov my $s_time_ = [Time::HiRes::gettimeofday];
95 |;
96 $ah_args{postamble} = q|
97 warn "Timing: ".$m->current_comp->path.":\t".sprintf('%.1f ms', Time::HiRes::tv_interval($s_time_) * 1000)."\n";
98 |;
99 } else {
100 $ah_args{preamble} = q|
101 use locale;
102 |;
103 }
104 8 ahitrov@rambler.ru $ah_args{error_mode} = lc('@ERROR_MODE@') eq 'output' ? 'output':'fatal';
105 $ah_args{preloads} = [qw(@PRELOADS@)];
106 if (lc('@STATIC_SOURCE_ENABLE@') eq 'yes') {
107 $ah_args{static_source} = 1;
108 }
109 }
110
111 if ( lc '@PREAMBLE_HANDLER@' and ref $state->{preamble_handler_obj} ) {
112 $ah_args{preamble} .= q|
113 {
114 my $ret = $state->{preamble_handler_obj}->handle( $m, \@_ );
115 if ( ref $ret eq 'HASH' ) {
116 return if ($ret->{_cached} or $ret->{_return}); # component is self cached or wanna return
117 &http_abort( $ret->{http_abort} ) if $ret->{http_abort};
118 }
119 }
120 |;
121 }
122
123 #Только для нового perl к сожалению :(
124 if (@PERL_LEVEL@ >= 500600) {
125 $ah_args{buffer_preallocate_size} = 256000;
126 $ah_args{enable_autoflush} = 0;
127 }
128
129 # Кеширование Mason (в принципе)
130 if (lc '@MASON_CACHE_ENABLED@' eq 'yes') {
131 # Кеширование Mason посредством Memcached
132 if (lc '@MASON_MEMCACHED_ENABLED@' eq 'yes') {
133 $ah_args{data_cache_defaults} = {
134 cache_class => 'Contenido::Cache::Memcached',
135 mc_backend => '@MASON_MEMCACHED_BACKEND@',
136 mc_servers => [qw(@MASON_MEMCACHED_SERVERS@)],
137 mc_debug => lc '@MASON_MEMCACHED_DEBUG@' eq 'yes',
138 mc_namespace => '@MASON_MEMCACHED_NAMESPACE@',
139 };
140 }
141 } else {
142 $ah_args{data_cache_defaults} = {
143 cache_class => 'Cache::NullCache',
144 };
145 }
146
147 $ah_args{escape_flags} = {
148 h => sub { HTML::Entities::encode_entities(${ $_[0] }, '\'<>&"') },
149 js => sub { Utils::js_escape( ${ $_[0] } ) },
150 strip_crlf => sub { ${$_[0]} =~ s/\r?\n\s*/ /g },
151 };
152
153 $ah_args{default_escape_flags} = '@DEFAULT_ESCAPE_FLAGS@' unless '@DEFAULT_ESCAPE_FLAGS@' eq '';
154
155 # Кеширование скомпиленных компонент
156 if (lc '@COMP_CACHE_ENABLED@' eq 'no') {
157 $ah_args{use_object_files} = 0;
158 $ah_args{code_cache_max_size} = 0;
159 }
160
161 my $ah =new @DEFAULT_HANDLER@(%ah_args);
162
163 sub handler {
164 my $r = shift;
165
166 # Mason НЕ обрабатывает всякое г!!!! /i/ /images/ /binary/
167 return Apache::Constants::DECLINED unless Contenido::Apache::is_valid_request($r);
168
169 my $status;
170
171 # устанавливаем соединение с базой для проекта и всех используемых плагинов,
172 # если их нет или они были потеряны
173 # и пытаемся обработать запрос
174 eval {
175 Contenido::Apache::request_init($r);
176 $status = $ah->handle_request($r)
177 };
178
179 if ($@) {
180 warn '['.scalar(localtime())."] got error $@\n";
181 return Apache::Constants::SERVER_ERROR;
182 } else {
183 return $status;
184 }
185 }
186
187
188 1;
189