1 |
8 |
ahitrov@rambler.ru |
|
2 |
|
|
package Contenido::Keeper; |
3 |
|
|
|
4 |
|
|
# ---------------------------------------------------------------------------- |
5 |
|
|
# Класс базы данных |
6 |
|
|
# ---------------------------------------------------------------------------- |
7 |
|
|
use strict; |
8 |
|
|
use warnings; |
9 |
|
|
use locale; |
10 |
|
|
|
11 |
|
|
use vars qw($VERSION $AUTOLOAD); |
12 |
|
|
$VERSION = '5.0'; |
13 |
|
|
|
14 |
|
|
use base qw(Contenido::DB::PostgreSQL); |
15 |
|
|
|
16 |
|
|
use Data::Dumper; |
17 |
|
|
use Time::HiRes; |
18 |
|
|
|
19 |
|
|
use Contenido::Globals; |
20 |
|
|
use Contenido::Msg; |
21 |
|
|
|
22 |
|
|
# TODO |
23 |
|
|
# побить на 2-4 модуля вменяемого размера....! |
24 |
|
|
|
25 |
|
|
use constant DATA_SOURCE_LOCAL => 10; |
26 |
|
|
use constant DATA_SOURCE_MEMCACHED => 20; |
27 |
|
|
use constant DATA_SOURCE_DATABASE => 30; |
28 |
|
|
|
29 |
|
|
# # ------------------------------------------------------------------------------------------------ |
30 |
|
|
# Конструктор объекта базы данных. |
31 |
|
|
# Обязательный параметр - объект класса Contenido::State из которого |
32 |
|
|
# конструктор возьмет необходимые параметры для доступа к БД и т.д. |
33 |
|
|
# |
34 |
|
|
# Формат вызова: |
35 |
|
|
# Contenido::Keeper->new($state) |
36 |
|
|
# ------------------------------------------------------------------------------------------------ |
37 |
|
|
sub new { |
38 |
|
|
my ($proto, $local_state) = @_; |
39 |
|
|
|
40 |
|
|
unless ( ref $local_state ) { |
41 |
|
|
$log->error("Неправильный вызов конструктора объекта базы данных. В параметрах нет объекта класса Contenido::State"); |
42 |
|
|
die; |
43 |
|
|
} |
44 |
|
|
|
45 |
|
|
my $class = ref($proto) || $proto; |
46 |
|
|
my $self = {}; |
47 |
|
|
bless($self, $class); |
48 |
|
|
|
49 |
|
|
|
50 |
|
|
# Заполним собственные свойства конкретными данными... |
51 |
|
|
$self->{db_host} = $local_state->db_host(); |
52 |
|
|
$self->{db_name} = $local_state->db_name(); |
53 |
|
|
$self->{db_user} = $local_state->db_user(); |
54 |
|
|
$self->{db_password} = $local_state->db_password(); |
55 |
|
|
$self->{db_port} = $local_state->db_port(); |
56 |
|
|
# AUTOLOAD method, can не работает |
57 |
|
|
$self->{db_client_encoding} = $local_state->{attributes}{db_client_encoding} ? $local_state->db_client_encoding() : ''; |
58 |
|
|
$self->{db_enable_utf8} = $local_state->{attributes}{db_enable_utf8} ? $local_state->db_enable_utf8() : 0; |
59 |
|
|
|
60 |
217 |
ahitrov |
$self->{serialize_with} = $local_state->{serialize_with}; |
61 |
|
|
|
62 |
8 |
ahitrov@rambler.ru |
$self->{data_dir} = $self->{data_directory} = $local_state->data_directory(); |
63 |
|
|
$self->{images_dir} = $self->{images_directory} = $local_state->images_directory(); |
64 |
|
|
$self->{binary_dir} = $self->{binary_directory} = $local_state->binary_directory(); |
65 |
|
|
$self->{preview} = $local_state->preview(); |
66 |
|
|
$self->{convert_binary} = $local_state->can('convert_binary') ? $local_state->convert_binary : undef; |
67 |
|
|
|
68 |
|
|
$self->{debug} = $local_state->debug(); |
69 |
|
|
$self->{store_method} = $local_state->store_method(); |
70 |
|
|
$self->{cascade} = $local_state->cascade(); |
71 |
|
|
|
72 |
|
|
$self->{default_status} = [ |
73 |
|
|
[0, 'Скрытый'], |
74 |
|
|
[1, 'Активный'], |
75 |
|
|
[2, 'Принято'], |
76 |
|
|
[3, 'Отложено'], |
77 |
|
|
]; |
78 |
|
|
|
79 |
|
|
$self->{state} = $local_state; |
80 |
|
|
$self->_init_(); |
81 |
|
|
|
82 |
|
|
# соединяемся с базой если используется постоянное соединение |
83 |
|
|
$self->db_connect() if $local_state->db_type ne 'none' && $local_state->db_keepalive(); |
84 |
|
|
# соединяемся с memcached |
85 |
|
|
$self->MEMD() if $local_state->memcached_enable(); |
86 |
|
|
|
87 |
|
|
return $self; |
88 |
|
|
} |
89 |
|
|
|
90 |
|
|
# ---------------------------------------------------------------------------- |
91 |
|
|
# Инициализация. |
92 |
|
|
# - Создает внутри объекта хэш с типами полей - это нужно для быстрой |
93 |
|
|
# работы метода AUTOLOAD... |
94 |
|
|
# ---------------------------------------------------------------------------- |
95 |
|
|
sub _init_ { |
96 |
|
|
my $self = shift; |
97 |
|
|
|
98 |
|
|
foreach my $attribute ( qw( |
99 |
|
|
db_host db_name db_user db_password db_port |
100 |
217 |
ahitrov |
serialize_with |
101 |
8 |
ahitrov@rambler.ru |
|
102 |
|
|
data_directory data_dir |
103 |
|
|
images_directory images_dir |
104 |
|
|
binary_directory binary_dir |
105 |
|
|
|
106 |
|
|
store_method cascade |
107 |
|
|
|
108 |
|
|
default_status |
109 |
|
|
|
110 |
|
|
debug |
111 |
|
|
state |
112 |
|
|
) ) |
113 |
|
|
{ |
114 |
|
|
$self->{attributes}->{ $attribute } = 'SCALAR'; |
115 |
|
|
} |
116 |
|
|
} |
117 |
|
|
|
118 |
|
|
sub get_items { |
119 |
|
|
my ($self, $proto, %opts) = @_; |
120 |
|
|
|
121 |
|
|
$log->info("get_items($proto) called with opts: ".Data::Dumper::Dumper(\%opts)) if $DEBUG; |
122 |
|
|
|
123 |
|
|
#установка доп опций |
124 |
|
|
$opts{all_childs} = $self->_all_childs($opts{s}) if ($opts{dive} and $opts{s}); |
125 |
|
|
|
126 |
|
|
# ------------------------------------------------------------------------------------------- |
127 |
|
|
# выставляем режим возвращаемых данных (array|array_ref|hash|hash_ref|count) |
128 |
|
|
# default array for compatibility reasons |
129 |
|
|
# hash/hash_ref хешируют по умолчанию по полю id... |
130 |
|
|
# hash_by параметр может установить произвольное поле обьекта для построения хеша |
131 |
|
|
# return_mode => 'count' эквивалентно count=>1 |
132 |
|
|
# return_mode имеет более высокий приоритет чем count |
133 |
|
|
|
134 |
|
|
if ($opts{count} and $opts{return_mode} and ($opts{return_mode} ne 'count')) { |
135 |
|
|
$log->warning("get_items($proto) have count=>1 and return_mode=>$opts{return_mode} set... using $opts{return_mode} mode"); delete $opts{count}; |
136 |
|
|
} elsif ($opts{count}) { |
137 |
|
|
$opts{return_mode} = 'count'; |
138 |
|
|
} elsif (defined($opts{return_mode}) and $opts{return_mode} eq 'count') { |
139 |
|
|
$opts{count} = 1; |
140 |
|
|
} |
141 |
|
|
|
142 |
|
|
# выставляем совместимое значение return_mode если не указанно обратного |
143 |
|
|
my $mode = $opts{return_mode} || 'array'; |
144 |
|
|
# ---------------------------------------------------------------------------------------- |
145 |
|
|
|
146 |
|
|
#----------------------------------------------------------------------------------------- |
147 |
|
|
# убираем возможную сортировку если указано in_id_sort |
148 |
|
|
# и проставляем sort_list если он не стоит |
149 |
|
|
#----------------------------------------------------------------------------------------- |
150 |
|
|
if ($opts{in_id_sort} && $opts{in_id}) { |
151 |
|
|
$opts{sort_list} = $opts{in_id}; |
152 |
|
|
} |
153 |
|
|
|
154 |
|
|
#----------------------------------------------------------------------------------------- |
155 |
|
|
# если есть sort_list и return_mode не array или array_ref ругаемся и сбрасываем sort_list |
156 |
|
|
#----------------------------------------------------------------------------------------- |
157 |
|
|
if ($opts{sort_list} and ($mode ne 'array') and ($mode ne 'array_ref')) { |
158 |
|
|
delete $opts{sort_list}; |
159 |
|
|
$log->warning("sort_list set with incompatible return_mode: '$mode'"); |
160 |
|
|
} |
161 |
|
|
|
162 |
|
|
# ----------------------------------------------------------------------------------------- |
163 |
|
|
# убираем все order_by если у нас hash или hash_ref return_mode или стоит in_id_sort |
164 |
|
|
# тоесть режим возвращаемых данных не предполагает сортировки базой чего либо |
165 |
|
|
# можно руками выставить если очень хочется в opts |
166 |
|
|
# todo добавить некий warns если при этот order или order_by в параметрах есть |
167 |
|
|
# ---------------------------------------------------------------------------------------- |
168 |
|
|
if ( (($mode eq 'hash' or $mode eq 'hash_ref') && !(exists $opts{limit} || exists $opts{offset})) or ($mode eq 'count') or $opts{sort_list}) { |
169 |
|
|
$opts{no_order} = 1; |
170 |
|
|
if ($opts{order} or $opts{order_by}) { |
171 |
|
|
my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef; |
172 |
|
|
my $mason_file = ref($mason_comp) ? $mason_comp->path : undef; |
173 |
|
|
$log->warning("Указание сортировки проигнорировано так как указан несовместимый режим. ".($mason_file ? "called from $mason_file" : '')); |
174 |
|
|
delete $opts{order}; |
175 |
|
|
delete $opts{order_by}; |
176 |
|
|
} |
177 |
|
|
} |
178 |
|
|
|
179 |
|
|
# ---------------------------------------------------------------------------------------- |
180 |
|
|
# Формируем запрос |
181 |
|
|
# ToDo: добавить механизм кеширования полученных запросов |
182 |
|
|
#----------------------------------------------------------------------------------------- |
183 |
|
|
my ($query, $binds) = $proto->_get_sql(%opts); |
184 |
|
|
return unless ($query); |
185 |
|
|
|
186 |
|
|
|
187 |
|
|
my $start = Time::HiRes::time() if ($DEBUG); |
188 |
|
|
# --------------------------------------------------------------------------------------- |
189 |
|
|
# Подготавливаем запрос и кешируем полученные prepared запросы (см докуметацию DBI на счет prepare_cached) |
190 |
|
|
# действительно работает на pgsql 8.0+ и новых версиях DBD (и помогает!) |
191 |
|
|
# ---------------------------------------------------------------------------------------- |
192 |
|
|
my $sth; |
193 |
|
|
if ($opts{no_prepare_cached}) { |
194 |
|
|
unless ($sth = $self->SQL->prepare($$query)) { |
195 |
|
|
$self->error; |
196 |
|
|
$log->error("DBI prepare error on $$query\ncalled with opts: ".Data::Dumper::Dumper(\%opts)); |
197 |
|
|
return; |
198 |
|
|
} |
199 |
|
|
} else { |
200 |
|
|
unless ($sth = $self->SQL->prepare_cached($$query, {}, 1)) { |
201 |
|
|
$self->error; |
202 |
|
|
$log->error("DBI prepare error on $$query\ncalled with opts: ".Data::Dumper::Dumper(\%opts)); |
203 |
|
|
return; |
204 |
|
|
} |
205 |
|
|
} |
206 |
|
|
|
207 |
|
|
# ---------------------------------------------------------------------------------------- |
208 |
|
|
# Выполняем |
209 |
|
|
# ---------------------------------------------------------------------------------------- |
210 |
|
|
unless ($sth->execute(@$binds)) { |
211 |
|
|
$self->error; |
212 |
|
|
$log->error("DBI execute error on $$query\n".Data::Dumper::Dumper($binds)."\ncalled with opts:\n".Data::Dumper::Dumper(\%opts)); |
213 |
|
|
return; |
214 |
|
|
} |
215 |
|
|
my $finish1 = Time::HiRes::time() if ($DEBUG); |
216 |
|
|
|
217 |
|
|
#----------------------------------------------------------------------------------------- |
218 |
|
|
# подготавливаем результаты в нужном формате |
219 |
|
|
#----------------------------------------------------------------------------------------- |
220 |
|
|
my ($res, $total); |
221 |
|
|
($res, $total) = $self->_prepare_array_results($sth, \%opts) if ($mode eq 'array' or $mode eq 'array_ref'); |
222 |
|
|
($res, $total) = $self->_prepare_hash_results($sth, \%opts) if ($mode eq 'hash' or $mode eq 'hash_ref'); |
223 |
|
|
($res, $total) = $self->_prepare_count_results($sth, \%opts) if ($mode eq 'count'); |
224 |
|
|
$sth->finish(); |
225 |
|
|
my $finish2 = Time::HiRes::time() if ($DEBUG); |
226 |
|
|
|
227 |
|
|
if ($DEBUG) { |
228 |
|
|
my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef; |
229 |
|
|
my $mason_file = ref($mason_comp) ? $mason_comp->path : undef; |
230 |
|
|
my $db_time = int(10000*($finish1-$start))/10; |
231 |
|
|
my $core_time = int(10000*($finish2-$finish1))/10; |
232 |
|
|
my $total_time = int(10000*($finish2-$start))/10; |
233 |
|
|
|
234 |
|
|
$Contenido::Globals::DB_TIME += $finish1-$start; |
235 |
|
|
$Contenido::Globals::CORE_TIME += $finish2-$finish1; |
236 |
|
|
$Contenido::Globals::DB_COUNT++; |
237 |
|
|
|
238 |
|
|
$log->info("get_items($proto) ".($mason_file ? "called from $mason_file" : '')." SQL: '$$query' with binds: '".join("', '", @$binds)."' fetched: $total records (total work time: $total_time ms, database time $db_time ms, core time $core_time ms)"); |
239 |
|
|
} |
240 |
|
|
|
241 |
|
|
#выдает предупреждение если полученно более 500 обьектов но не выставлен no_limit |
242 |
|
|
if ($total>999 and !($opts{no_limit} or $opts{limit})) { |
243 |
|
|
my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef; |
244 |
|
|
my $mason_file = ref($mason_comp) ? $mason_comp->path : undef; |
245 |
|
|
$log->error("get_items($proto) ".($mason_file ? "called from $mason_file" : '')." SQL: '$$query' with binds: '".join("', '", @$binds)."' fetched 1000 records... гарантированно часть записей не получена из базы... или добавьте no_limit=>1 или разберитесь почему так много данных получаете"); |
246 |
|
|
} elsif ($total>500 and !($opts{no_limit} or $opts{limit})) { |
247 |
|
|
my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef; |
248 |
|
|
my $mason_file = ref($mason_comp) ? $mason_comp->path : undef; |
249 |
|
|
$log->warning("get_items($proto) ".($mason_file ? "called from $mason_file" : '')." SQL: '$$query' with binds: '".join("', '", @$binds)."' fetched over 500 ($total) records... или добавьте no_limit=>1 или разберитесь почему так много данных получаете"); |
250 |
|
|
} |
251 |
|
|
|
252 |
|
|
# ----------------------------------------------------------------------------------------- |
253 |
|
|
# возвращаем разные результаты в зависимости от того какой return_mode просят |
254 |
|
|
# ----------------------------------------------------------------------------------------- |
255 |
|
|
if ($mode eq 'array') { |
256 |
|
|
return @$res; |
257 |
|
|
} elsif ($mode eq 'array_ref') { |
258 |
|
|
return $res; |
259 |
|
|
} elsif ($mode eq 'hash') { |
260 |
|
|
return %$res; |
261 |
|
|
} elsif ($mode eq 'hash_ref') { |
262 |
|
|
return $res; |
263 |
|
|
} elsif ($mode eq 'count') { |
264 |
|
|
return $res; |
265 |
|
|
} else { |
266 |
|
|
$log->error("get_items($proto) unsupported return_mode called with opts: ".Data::Dumper::Dumper(\%opts)); |
267 |
|
|
return; |
268 |
|
|
} |
269 |
|
|
} |
270 |
|
|
|
271 |
|
|
#internal only method |
272 |
|
|
sub _prepare_count_results { |
273 |
|
|
my ($self, $sth, $opts) = @_; |
274 |
|
|
my ($count) = $sth->fetchrow_array(); |
275 |
|
|
return ($count, 1); |
276 |
|
|
} |
277 |
|
|
|
278 |
|
|
#internal only method |
279 |
|
|
sub _prepare_hash_results { |
280 |
|
|
my ($self, $sth, $opts) = @_; |
281 |
|
|
|
282 |
|
|
#To Do вывод warnings при использование ключей несовместимых с hash режимами... как то: in_id_sort |
283 |
|
|
#To Do доделать hash mode для $opts{names} и для $opts{ids} |
284 |
|
|
|
285 |
|
|
# выставляем умолчательное значение hash_by |
286 |
|
|
my $hash_by = $opts->{hash_by} || 'id'; |
287 |
|
|
# выставляем умолчательное значение hash_index |
288 |
|
|
my $hash_index = $opts->{hash_index} || 0; |
289 |
|
|
|
290 |
|
|
my %items; |
291 |
|
|
my $total = 0; |
292 |
|
|
|
293 |
|
|
if ($opts->{names}) { |
294 |
|
|
while (my $row = $sth->fetch) { |
295 |
|
|
$items{$row->[0]} = $row->[1]; |
296 |
|
|
} |
297 |
|
|
} elsif ($opts->{ids} || $opts->{field}) { |
298 |
|
|
if (ref($opts->{field})) { |
299 |
|
|
#hashing by first field by default |
300 |
|
|
while (my $row = $sth->fetch) { |
301 |
|
|
$items{$row->[$hash_index]} = [@$row]; |
302 |
|
|
} |
303 |
|
|
} else { |
304 |
|
|
while (my $row = $sth->fetch) { |
305 |
|
|
$items{$row->[0]} = 1; |
306 |
|
|
} |
307 |
|
|
} |
308 |
|
|
} else { |
309 |
|
|
my $item; |
310 |
|
|
while (my $row = $sth->fetch) { |
311 |
|
|
eval { $item=$row->[0]->init_from_db($row, $self, $opts->{light}); }; |
312 |
|
|
if ($@) { |
313 |
|
|
$log->error("Сannot init item from database for $row->[0] because '$@'"); |
314 |
|
|
} else { |
315 |
|
|
$item->post_init($opts); |
316 |
|
|
$self->set_object_to_cache($item, 30, $opts) if ($opts->{with_cache}); |
317 |
|
|
$total++; |
318 |
139 |
ahitrov |
if ( exists $item->{$hash_by} && defined $item->{$hash_by} ) { |
319 |
217 |
ahitrov |
$items{$item->{$hash_by}} = $item; |
320 |
8 |
ahitrov@rambler.ru |
} else { |
321 |
217 |
ahitrov |
$log->warning( "Can not HASH BY parameter [$hash_by]. It doesn't exists in row or the field is empty"); |
322 |
8 |
ahitrov@rambler.ru |
} |
323 |
|
|
} |
324 |
|
|
} |
325 |
|
|
} |
326 |
|
|
return (\%items, $total); |
327 |
|
|
} |
328 |
|
|
|
329 |
|
|
#internal only method |
330 |
|
|
sub _prepare_array_results { |
331 |
|
|
my ($self, $sth, $opts) = @_; |
332 |
|
|
|
333 |
|
|
my @items; |
334 |
|
|
|
335 |
|
|
if ($opts->{names} || (ref($opts->{field}) eq 'ARRAY')) { |
336 |
|
|
@items = @{$sth->fetchall_arrayref()}; |
337 |
|
|
} elsif ($opts->{ids} || $opts->{field}) { |
338 |
|
|
while (my $row = $sth->fetch) { |
339 |
|
|
push @items, $row->[0]; |
340 |
|
|
} |
341 |
|
|
} else { |
342 |
|
|
my $item; |
343 |
|
|
while (my $row = $sth->fetch) { |
344 |
|
|
eval { $item=$row->[0]->init_from_db($row, $self, $opts->{light}); }; |
345 |
|
|
if ($@) { |
346 |
|
|
$log->error("Cannot init item from database for $row->[0] because '$@'"); |
347 |
|
|
} else { |
348 |
|
|
$item->post_init($opts); |
349 |
|
|
$self->set_object_to_cache($item, 30, $opts) if ($opts->{with_cache}); |
350 |
|
|
push @items, $item; |
351 |
|
|
} |
352 |
|
|
} |
353 |
|
|
} |
354 |
|
|
|
355 |
|
|
return (\@items, scalar(@items)); |
356 |
|
|
} |
357 |
|
|
|
358 |
|
|
#понять бы зачем этот метод нужен |
359 |
|
|
sub get_objects { |
360 |
|
|
return shift->get_items('Contenido::Object', @_); |
361 |
|
|
} |
362 |
|
|
|
363 |
|
|
# ------------------------------------------------------------------------------------------------ |
364 |
|
|
# Получение документов, подходящих под условия отбора: |
365 |
|
|
# @documents = $keeper->get_documents( %search_options ) |
366 |
|
|
# |
367 |
|
|
# Параметры отбора: |
368 |
|
|
# s - номер секции (если задан параметр dive, то s может содержать только один номер секции, в противном случае s |
369 |
|
|
# может содержать ссылку на массив номеров секций); |
370 |
|
|
# sfilter - секция-фильтр. В конечную выборку включаются только документы, попадающие в sfilter (если та задана). |
371 |
|
|
# Может быть задан массив секций (с помощью ссылки на массив); |
372 |
|
|
# dive - если установлен в истину, то отбор будет производиться по все ее детям; |
373 |
|
|
# intersect - флаг "пересечение секций". Если установлен, то будут отобраны документы, привязанные ко всем |
374 |
|
|
# перечисленным в s секциям, если не установлен - к любой из перечисленных секций. |
375 |
|
|
# include_parent - если этот параметр задан, то отбор будет происходить и из самой секции. По умолчанию - задан; |
376 |
|
|
# date_equal - точное соответствие даты (YYYY-MM-DD); |
377 |
|
|
# date - ссылка на массив с двумя датами (началом и концом интервала); |
378 |
|
|
# previous_days - запрос за ... последних дней; |
379 |
|
|
# datetime - custom dtime filters допустимые значения 'future','past','today' |
380 |
|
|
# |
381 |
|
|
# use_mtime - использовать во всех выборках по времени mtime вместо dtime (!) |
382 |
|
|
# use_ctime - использовать во всех выборках по времени ctime вместо dtime (!) |
383 |
|
|
# |
384 |
|
|
# status - заданный идентификатор статуса (или ссылка на массив со статусами); |
385 |
|
|
# class - заданный класс объекта (--"--); |
386 |
|
|
# order - порядок выборки: |
387 |
|
|
# ['date','direct'] - по дате в прямом порядке; |
388 |
|
|
# ['date','reverse'] - по дате в обратном порядке; |
389 |
|
|
# ['name','direct'/'reverse'] - по имени в прямом или обратном порядке; |
390 |
|
|
# [] - без сортировки |
391 |
|
|
# |
392 |
|
|
# in_id [id,id,id,...] - выборка по идентификаторам (по целой пачке - ссылка на массив идентификаторов) |
393 |
|
|
# name - поиск по названию; |
394 |
|
|
# excludes - ссылка на массив всех идентификаторов, которые надо исключить из отбора |
395 |
|
|
# class_excludes - ссылка на массив классов, исключенных для выборки |
396 |
|
|
# count - если задан в единицу, то вернет число - количество элементов |
397 |
|
|
# ids - если задан в единицу, то вернет только идентификаторы объектов... |
398 |
|
|
# names - если задан в единицу, то вернет набор пар [идентификатор, имя] |
399 |
|
|
# offset - возможность задать оффсет для выборки документов... |
400 |
|
|
# |
401 |
|
|
# like - выборка с помощью like (должно быть задано name) |
402 |
|
|
# ilike - выборка с помощью ilike (должно быть задано name) |
403 |
|
|
# |
404 |
|
|
# light - если установить в 1, то вернет объекты без выполнения restore() |
405 |
|
|
# limit - ограничение на количество возвращаемых элементов |
406 |
|
|
# |
407 |
|
|
# Три параметра, которые требуются для построения join-запросов. Рекомендуется использовать их |
408 |
|
|
# для выборок документов связанных с каким-то конкретным документом какой-то конкретной связью: |
409 |
|
|
# lclass - класс связи |
410 |
|
|
# ldest - идентификатор dest_id |
411 |
|
|
# lsource - идентификатор source_id |
412 |
|
|
# lstatus - статус в таблице связей |
413 |
|
|
# id - выборка 1 документа по id |
414 |
|
|
# ------------------------------------------------------------------------------------------------ |
415 |
|
|
sub get_documents { |
416 |
|
|
return shift->get_items('Contenido::Document', @_); |
417 |
|
|
} |
418 |
|
|
|
419 |
|
|
|
420 |
|
|
|
421 |
|
|
# ------------------------------------------------------------------------------------------------ |
422 |
|
|
# Получение связей, подходящих под условия отбора: |
423 |
|
|
# @links = $keeper->get_links( %search_options ) |
424 |
|
|
# |
425 |
|
|
# Параметры отбора: |
426 |
|
|
# status - заданный идентификатор статуса (или ссылка на массив идентификаторов); |
427 |
|
|
# class - заданный класс объекта (--"--); |
428 |
|
|
# |
429 |
|
|
# dest_id - идентификатор (или ссылка на массив идентификаторов) |
430 |
|
|
# source_id - идентификатор (или ссылка на массив идентификаторов) |
431 |
|
|
# |
432 |
|
|
# excludes - ссылка на массив всех идентификаторов, которые надо исключить из отбора |
433 |
|
|
# class_excludes - ссылка на массив классов, исключенных для выборки |
434 |
|
|
# |
435 |
|
|
# count - если задан в единицу, то вернет число - количество элементов |
436 |
|
|
# ids - если задан в единицу, то вернет только идентификаторы связей... |
437 |
|
|
# |
438 |
|
|
# offset - возможность задать оффсет для выборки документов... |
439 |
|
|
# |
440 |
|
|
# light - если установить в 1, то вернет объекты без выполнения restore() |
441 |
|
|
# limit - ограничение на количество возвращаемых элементов |
442 |
|
|
# ------------------------------------------------------------------------------------------------ |
443 |
|
|
sub get_links { |
444 |
|
|
return shift->get_items('Contenido::Link', @_); |
445 |
|
|
} |
446 |
|
|
|
447 |
|
|
|
448 |
|
|
|
449 |
|
|
# ------------------------------------------------------------------------------------------------ |
450 |
|
|
# Получение секций, подходящих под условия отбора: |
451 |
|
|
# @sections = $keeper->get_sections( %search_options ) |
452 |
|
|
# |
453 |
|
|
# Параметры отбора: |
454 |
|
|
# s - номер родительской; |
455 |
|
|
# |
456 |
|
|
# status - заданный идентификатор статуса (или ссылка на массив); |
457 |
|
|
# class - заданный класс секции (--"--); |
458 |
|
|
# order - порядок выборки: |
459 |
|
|
# ['name','direct'/'reverse'] - по имени в прямом или обратном порядке; |
460 |
|
|
# [] - без сортировки |
461 |
|
|
# name - поиск по названию; |
462 |
|
|
# |
463 |
|
|
# in_id [id,id,id,...] - выборка по идентификаторам (по целой пачке) |
464 |
|
|
# ids - если задан в единицу, то вернет только идентификаторы секций... |
465 |
|
|
# names - если задан в единицу, то вернет набор пар [идентификатор, имя] |
466 |
|
|
# |
467 |
|
|
# light - если установить в 1, то вернет объекты без выполнения restore() |
468 |
|
|
# limit - ограничение на размер выборки |
469 |
|
|
# ------------------------------------------------------------------------------------------------ |
470 |
|
|
sub get_sections { |
471 |
|
|
return shift->get_items('Contenido::Section', @_); |
472 |
|
|
} |
473 |
|
|
|
474 |
|
|
# ---------------------------------------------------------------------------- |
475 |
|
|
# Метод для получения списка пользователей системы |
476 |
|
|
# @users = $keeper->_get_users( %search_options ) |
477 |
|
|
# |
478 |
|
|
# Параметры отбора: |
479 |
|
|
# s - номер секции (s может содержать ссылку на массив номеров секций); |
480 |
|
|
# intersect - флаг "пересечение секций". Если установлен, то будут отобраны документы, привязанные ко всем |
481 |
|
|
# перечисленным в s секциям, если не установлен - к любой из перечисленных секций. |
482 |
|
|
# class - заданный класс объекта (--"--); |
483 |
|
|
# ---------------------------------------------------------------------------- |
484 |
|
|
sub _get_users { |
485 |
|
|
return shift->get_items('Contenido::User', @_); |
486 |
|
|
} |
487 |
|
|
# XXX Не использовать - будет удалена в следующих версиях. Использовать _get_users() |
488 |
|
|
sub get_users { |
489 |
|
|
return shift->_get_users(@_); |
490 |
|
|
} |
491 |
|
|
|
492 |
|
|
|
493 |
|
|
# ------------------------------------------------------------------------------------------------- |
494 |
|
|
# Получение деревца... |
495 |
|
|
# Параметры: |
496 |
|
|
# light => облегченная версия |
497 |
|
|
# root => корень дерева (по умолчанию - 1) |
498 |
|
|
# ------------------------------------------------------------------------------------------------- |
499 |
|
|
sub get_tree { |
500 |
|
|
my $self = shift; |
501 |
|
|
return Contenido::Section->new($self)->get_tree(@_); |
502 |
|
|
} |
503 |
|
|
|
504 |
|
|
sub get_section_tree { |
505 |
|
|
my $self = shift; |
506 |
|
|
my ( %opts ) = @_; |
507 |
|
|
|
508 |
|
|
delete $opts{return_mode} if exists $opts{return_mode}; |
509 |
|
|
delete $opts{order_by} if exists $opts{order_by}; |
510 |
|
|
delete $opts{no_limit} if exists $opts{no_limit}; |
511 |
|
|
my $root_id = delete $opts{root_id}; |
512 |
|
|
my $sections = $self->get_sections ( |
513 |
|
|
%opts, |
514 |
|
|
return_mode => 'array_ref', |
515 |
|
|
order_by => 'sorder', |
516 |
|
|
no_limit => 1, |
517 |
|
|
light => exists $opts{light} ? $opts{light} : 1, |
518 |
|
|
); |
519 |
|
|
my %section_hash = map { $_->id => $_ } @$sections if ref $sections eq 'ARRAY'; |
520 |
|
|
my %tree; |
521 |
|
|
if ( ref $sections eq 'ARRAY' ) { |
522 |
|
|
foreach my $sect ( @$sections ) { |
523 |
|
|
if ( !$sect->pid || $sect->id == 1 ) { |
524 |
|
|
$tree{0} = $sect; |
525 |
|
|
} else { |
526 |
|
|
if ( exists $tree{$sect->pid} ) { |
527 |
|
|
if ( exists $tree{$sect->pid}{children} ) { |
528 |
|
|
push @{ $tree{$sect->pid}{children} }, $sect; |
529 |
|
|
} else { |
530 |
|
|
$tree{$sect->pid}{children} = [$sect]; |
531 |
|
|
} |
532 |
|
|
} elsif ( exists $section_hash{$sect->pid} ) { |
533 |
|
|
$tree{$sect->pid} = $section_hash{$sect->pid}; |
534 |
|
|
$tree{$sect->pid}{children} = [$sect]; |
535 |
|
|
} |
536 |
|
|
if ( $root_id && $sect->id == $root_id ) { |
537 |
|
|
$tree{root} = $sect; |
538 |
|
|
} |
539 |
|
|
} |
540 |
|
|
} |
541 |
|
|
if ( (!$root_id || !exists $tree{root}) && exists $tree{0} ) { |
542 |
|
|
$tree{root} = $tree{0}; |
543 |
|
|
} |
544 |
|
|
} |
545 |
|
|
return \%tree; |
546 |
|
|
} |
547 |
|
|
|
548 |
|
|
# ------------------------------------------------------------------------------------------------- |
549 |
|
|
# Получаем объект по идентификатору. А зачем вообще нужен этот метод? А! Потому что мы |
550 |
|
|
# еще не знаем имени класса. |
551 |
|
|
# |
552 |
|
|
# Этот метод получает тип того, что мы извлекаем (секция, документ, связь) |
553 |
|
|
# ------------------------------------------------------------------------------------------------- |
554 |
|
|
sub __get_by_id__ { |
555 |
|
|
my ($self, $proto, %opts) = @_; |
556 |
|
|
return unless ($opts{id}); |
557 |
|
|
#на всякий случай устанавливаем возврат только 1 значения из базы |
558 |
|
|
$opts{limit} = 1; |
559 |
|
|
#отключаем сортировку как бессмысленную |
560 |
|
|
$opts{no_order} = 1; |
561 |
|
|
my ($item)=$self->get_items($proto, %opts); |
562 |
|
|
return $item; |
563 |
|
|
} |
564 |
|
|
|
565 |
|
|
sub get_document_by_id { |
566 |
|
|
my ($self, $id, %opts) = @_; |
567 |
|
|
return unless $id; |
568 |
|
|
$opts{id} = $id; |
569 |
|
|
return $self->__get_by_id__('Contenido::Document', %opts); |
570 |
|
|
} |
571 |
|
|
|
572 |
|
|
sub get_section_by_id { |
573 |
|
|
my ($self, $id, %opts) = @_; |
574 |
|
|
return unless $id; |
575 |
|
|
$opts{id} = $id; |
576 |
|
|
return $self->__get_by_id__('Contenido::Section', %opts); |
577 |
|
|
} |
578 |
|
|
|
579 |
|
|
sub get_link_by_id { |
580 |
|
|
my ($self, $id, %opts) = @_; |
581 |
|
|
return unless $id; |
582 |
|
|
$opts{id}=$id; |
583 |
|
|
return $self->__get_by_id__('Contenido::Link', %opts); |
584 |
|
|
} |
585 |
|
|
|
586 |
|
|
sub get_user_by_id { |
587 |
|
|
my ($self, $id, %opts) = @_; |
588 |
|
|
return unless $id; |
589 |
|
|
$opts{id}=$id; |
590 |
|
|
return $self->__get_by_id__('Contenido::User', %opts); |
591 |
|
|
} |
592 |
|
|
|
593 |
|
|
|
594 |
|
|
# ------------------------------------------------------------------- |
595 |
|
|
# Умный метод. Сначала ищет объект в $request->{_cache_}, |
596 |
|
|
# потом в memcached (если включена поддержка, конечно), и только потом уже идёт в базу. |
597 |
|
|
# Полученные из базы данные складывает в $request и в memcached. |
598 |
|
|
# $level это с кеша какого уровня мы все это достали (10 уровень локальный кеш, 20 уровень memcached, 30 база) |
599 |
|
|
sub get_object_by_id { |
600 |
|
|
my ($self, $id, %opts) = @_; |
601 |
|
|
|
602 |
|
|
my ($object, $level) = $self->get_object_from_cache($id, \%opts) unless ($opts{expire}); |
603 |
|
|
|
604 |
|
|
#не нашли в кешах идем в базу |
605 |
|
|
unless ($object) { |
606 |
|
|
$object = $self->__get_by_id__($opts{proto}||'Contenido::Document', %opts, id=>$id); |
607 |
|
|
$level = DATA_SOURCE_DATABASE; |
608 |
|
|
} |
609 |
|
|
|
610 |
|
|
#ну не шмогла я нешмогла... aka нет такого на белом свете объекта |
611 |
|
|
unless ($object) { |
612 |
|
|
return; |
613 |
|
|
} |
614 |
|
|
|
615 |
|
|
#если с 10 уровня достали то ничего более кешировать всеравно нет смысла |
616 |
|
|
$self->set_object_to_cache($object, $level, \%opts, $state->{memcached_set_mode}) |
617 |
|
|
if $level > DATA_SOURCE_LOCAL; |
618 |
|
|
|
619 |
|
|
return $object; |
620 |
|
|
} |
621 |
|
|
|
622 |
|
|
# ------------------------------------------------------------------- |
623 |
|
|
# Тоже умный метод. Зачастую в таблицах id является суррогатным ключом, |
624 |
|
|
# а некоторое символическое имя - настоящим, например, login в таблицах |
625 |
|
|
# users. Данная функция кеширует соответствие уникального символического |
626 |
|
|
# имени объекта и его id, позволяя не обращаться к базе всякий раз при |
627 |
|
|
# получении данных таким образом. |
628 |
|
|
# ------------------------------------------------------------------- |
629 |
|
|
sub get_object_by_unique_key { |
630 |
|
|
my ($self, $unique, %opts) = @_; |
631 |
|
|
|
632 |
|
|
return undef unless defined $unique; |
633 |
|
|
|
634 |
|
|
my ($id, $level) = (undef, DATA_SOURCE_DATABASE); |
635 |
|
|
my %key_list = (); |
636 |
|
|
|
637 |
|
|
my $class = $opts{class}; |
638 |
|
|
return undef unless defined $class; |
639 |
|
|
|
640 |
|
|
my $key = $class->get_object_unique_key($unique); |
641 |
|
|
return undef unless $key; |
642 |
|
|
|
643 |
|
|
my $object = undef; |
644 |
|
|
|
645 |
|
|
unless ($opts{expire}) { |
646 |
|
|
if (exists $request->{_cache_}->{$key}) { |
647 |
|
|
($id, $level) = $request->{_cache_}->{$key}; |
648 |
|
|
$level = DATA_SOURCE_LOCAL; |
649 |
|
|
} elsif (($self->{state}->{memcached_enable}) && |
650 |
|
|
(defined ($id = $self->MEMD->get($key)))) { |
651 |
|
|
$level = DATA_SOURCE_MEMCACHED; |
652 |
|
|
} |
653 |
|
|
|
654 |
|
|
# Соответствие в кеше имеется, ищем объект по id |
655 |
|
|
if (defined $id) { |
656 |
|
|
$object = $self->get_object_by_id($id, %opts); |
657 |
|
|
# Если какая-то скотина умудрилась грохнуть объект в обход зависимостей |
658 |
|
|
unless (defined $object) { |
659 |
|
|
$self->MEMD->delete($key); |
660 |
|
|
} |
661 |
|
|
} |
662 |
|
|
} |
663 |
|
|
|
664 |
|
|
# Соответствие не найдено или найдено неверное. |
665 |
|
|
unless (defined $object) { |
666 |
|
|
my $attr = $class->class_table->unique_attr; |
667 |
|
|
($object) = |
668 |
|
|
$self->get_items( |
669 |
|
|
$class, |
670 |
|
|
'limit' => 1, |
671 |
|
|
'no_order' => 1, |
672 |
|
|
$attr => $unique, |
673 |
|
|
'class' => $class |
674 |
|
|
); |
675 |
|
|
} |
676 |
|
|
|
677 |
|
|
# Объект с таким уникальным ключем не найден. |
678 |
|
|
return undef unless defined $object; |
679 |
|
|
|
680 |
|
|
$self->set_object_unique_key_to_cache($object, $level, \%opts) |
681 |
|
|
if $level > DATA_SOURCE_LOCAL; |
682 |
|
|
|
683 |
|
|
return $object; |
684 |
|
|
} |
685 |
|
|
|
686 |
|
|
sub set_object_unique_key_to_cache { |
687 |
|
|
my ($self, $object, $level, $opts) = @_; |
688 |
|
|
|
689 |
|
|
my $key = $object->get_object_unique_key; |
690 |
|
|
|
691 |
|
|
if (defined $key) { |
692 |
|
|
if ($level > DATA_SOURCE_LOCAL) { |
693 |
|
|
$request->{_cache_}->{$key} = $object->id; |
694 |
|
|
} |
695 |
|
|
if (($level > DATA_SOURCE_MEMCACHED) and ($self->state->{memcached_enable})) { |
696 |
|
|
my $expire = |
697 |
|
|
exists $opts->{'expire_in'} |
698 |
|
|
? $opts->{'expire_in'} |
699 |
|
|
: $object->memcached_expire; |
700 |
|
|
if ($self->state->{memcached_delayed}) { |
701 |
|
|
$request->{_to_memcache}{$key} = [$object->id, $expire, 'set']; |
702 |
|
|
} else { |
703 |
|
|
$self->MEMD->set($key, $object->id, $expire); |
704 |
|
|
} |
705 |
|
|
} |
706 |
|
|
} |
707 |
|
|
|
708 |
|
|
return $object; |
709 |
|
|
} |
710 |
|
|
|
711 |
|
|
#достает обьект из кеша по его id |
712 |
|
|
sub get_object_from_cache { |
713 |
|
|
my ($self, $id, $opts) = @_; |
714 |
|
|
|
715 |
|
|
my $object; |
716 |
|
|
my %key_list = (); |
717 |
|
|
|
718 |
|
|
#определяем по какому классу работаем (надо для определения ключа кеширования) |
719 |
|
|
my @classes; |
720 |
|
|
if (ref($opts->{class}) eq 'ARRAY') { |
721 |
|
|
foreach my $class (@{$opts->{class}}) { |
722 |
|
|
$key_list{$class->get_object_key($id, $opts)} = $class; |
723 |
|
|
} |
724 |
|
|
} elsif ($opts->{class}) { |
725 |
|
|
$key_list{$opts->{class}->get_object_key($id, $opts)} = $opts->{class}; |
726 |
|
|
} elsif ($opts->{table}) { |
727 |
|
|
$key_list{$opts->{table}->_get_object_key(undef, $id, $opts)} = $opts->{table}; |
728 |
|
|
} else { |
729 |
|
|
my $class = $opts->{proto} || 'Contenido::Document'; |
730 |
|
|
$key_list{$class->get_object_key($id, $opts)} = $class; |
731 |
|
|
} |
732 |
|
|
|
733 |
|
|
while (my ($object_key, $class) = each(%key_list)) { |
734 |
|
|
if (defined($request->{_cache_}->{$object_key})) { |
735 |
|
|
return ($request->{_cache_}->{$object_key}, DATA_SOURCE_LOCAL); |
736 |
|
|
} elsif ($self->MEMD) { |
737 |
|
|
if ($object = $self->MEMD->get($object_key)) { |
738 |
|
|
$object->recover_from_cache($self, $opts) if $object->can('recover_from_cache'); |
739 |
|
|
return ($object, DATA_SOURCE_MEMCACHED); |
740 |
|
|
} else { |
741 |
|
|
return; |
742 |
|
|
} |
743 |
|
|
} |
744 |
|
|
} |
745 |
|
|
return; |
746 |
|
|
} |
747 |
|
|
|
748 |
|
|
#может кешировать любой обьект поддерживающий метод set_to_cache (не обязательно производное Contenido::Object) |
749 |
|
|
#$level это с кеша какого уровня мы все это достали (10 уровень локальный кеш, 20 уровень memcached, 30 база) |
750 |
|
|
#$mode => set|add (default set) |
751 |
|
|
sub set_object_to_cache { |
752 |
|
|
my ($self, $object, $level, $opts, $mode) = @_; |
753 |
|
|
|
754 |
|
|
#выставляем ключ по обьекту |
755 |
|
|
my $object_key = $object->can('get_object_key') ? $object->get_object_key($opts) : ref($object).'|'.$object->id(); |
756 |
|
|
|
757 |
|
|
if ($level > DATA_SOURCE_LOCAL) { |
758 |
|
|
$request->{_cache_}->{$object_key} = $object; |
759 |
|
|
} |
760 |
|
|
if ($level > DATA_SOURCE_MEMCACHED and $self->state->{memcached_enable}) { |
761 |
|
|
my $value = $object->can('prepare_for_cache') ? $object->prepare_for_cache($opts) : $object; |
762 |
|
|
my $expire = exists $opts->{'expire_in'} ? $opts->{'expire_in'} : $object->memcached_expire; |
763 |
|
|
if ($self->state->{memcached_delayed}) { |
764 |
|
|
$request->{_to_memcache}{$object_key} = [$value, $expire, $mode]; |
765 |
|
|
} else { |
766 |
|
|
if ($mode && $mode eq 'add') { |
767 |
|
|
$self->MEMD->add($object_key, $value, $expire); |
768 |
|
|
} else { |
769 |
|
|
$self->MEMD->set($object_key, $value, $expire); |
770 |
|
|
} |
771 |
|
|
} |
772 |
|
|
} |
773 |
|
|
return $object; |
774 |
|
|
} |
775 |
|
|
|
776 |
|
|
sub get_user_by_login { |
777 |
|
|
my ($self, $login, %opts) = @_; |
778 |
|
|
return unless $login; |
779 |
|
|
$opts{login}=$login; |
780 |
|
|
my ($item)=$self->get_items('Contenido::User', %opts); |
781 |
|
|
return $item; |
782 |
|
|
} |
783 |
|
|
|
784 |
|
|
############################## DIFFERENT TRASH CODE ####################################################################### |
785 |
|
|
# ---------------------------------------------------------------------------- |
786 |
|
|
# Обработчик ошибки. Очень важная функция, именно в ней мы будем |
787 |
|
|
# хранить все возможные коды ошибок и так далее... |
788 |
|
|
# надо ли это вообще вот в чем вопрос |
789 |
|
|
# ---------------------------------------------------------------------------- |
790 |
|
|
sub error { |
791 |
|
|
my $self = shift; |
792 |
|
|
|
793 |
|
|
$self->{last_error} = shift || $self->SQL->errstr(); |
794 |
|
|
chomp($self->{last_error}); |
795 |
|
|
|
796 |
|
|
my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef; |
797 |
|
|
my $mason_file = ref($mason_comp) ? $mason_comp->path : undef; |
798 |
|
|
|
799 |
|
|
$log->error(($mason_file ? "Called from $mason_file" : '')."$self->{last_error}"); |
800 |
|
|
} |
801 |
|
|
|
802 |
|
|
|
803 |
|
|
sub minimize_image { |
804 |
|
|
my $self = shift; |
805 |
|
|
my $IMAGE = shift; |
806 |
|
|
my $PREVIEW = shift; |
807 |
|
|
|
808 |
|
|
my $SLINE = $self->{convert_binary}; |
809 |
|
|
my $PREVIEWLINE = " -geometry '".($PREVIEW || $self->{preview})."' -quality 80"; |
810 |
|
|
my $SFILE = $IMAGE->{filename}; |
811 |
|
|
my $DFILE = $SFILE; |
812 |
|
|
$DFILE =~ s/\.([^\.]*)$/\.mini\.$1/; |
813 |
|
|
$SLINE = $SLINE.' '.$PREVIEWLINE.' '.$self->{state}->{images_directory}.'/'.$SFILE.' '.$self->{state}->{images_directory}.'/'.$DFILE; |
814 |
|
|
|
815 |
|
|
my $RESULT = `$SLINE`; |
816 |
|
|
if (length($RESULT) > 0) |
817 |
|
|
{ |
818 |
|
|
$log->error("При вызове '$SLINE' произошла ошибка '$RESULT' ($@)"); |
819 |
|
|
return undef; |
820 |
|
|
} |
821 |
|
|
|
822 |
|
|
$IMAGE->{mini}->{filename} = $DFILE; |
823 |
|
|
($IMAGE->{mini}->{width}, $IMAGE->{mini}->{height}) = Image::Size::imgsize($self->{state}->{images_directory}.'/'.$DFILE); |
824 |
|
|
|
825 |
|
|
return $IMAGE; |
826 |
|
|
} |
827 |
|
|
|
828 |
|
|
sub get_sorted_documents { |
829 |
|
|
my ($self, %opts) = @_; |
830 |
|
|
unless ($opts{s}) { |
831 |
|
|
my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef; |
832 |
|
|
my $mason_file = ref($mason_comp) ? $mason_comp->path : undef; |
833 |
|
|
$log->warning("Method $keeper->get_sorted_documents(...) called without required param s=>".($mason_file ? "called from $mason_file":"")."\ncalled with opts:\n".Data::Dumper::Dumper(\%opts)); |
834 |
|
|
return; |
835 |
|
|
} |
836 |
|
|
my $section = $self->get_section_by_id($opts{s}); |
837 |
|
|
if ($section->{_sorted}) { |
838 |
|
|
$opts{sort_list} = [split(',', $section->_sorted_order())]; |
839 |
|
|
} else { |
840 |
|
|
$log->warning("Method $keeper->get_sorted_documents(...) called with s=>$opts{s} but section have _sorted disabled\n"); |
841 |
|
|
} |
842 |
|
|
return $self->get_documents(%opts); |
843 |
|
|
} |
844 |
|
|
|
845 |
|
|
sub _all_childs { |
846 |
|
|
my ($self, $s)=@_; |
847 |
|
|
return [] unless $s; |
848 |
|
|
# Получаем всех детишек от данной секции и вглубь... |
849 |
|
|
my $section = $self->get_section_by_id($s, light=>1); |
850 |
|
|
return [] unless (ref($section)); |
851 |
|
|
my @all_childs = $section->childs(100); |
852 |
|
|
return \@all_childs; |
853 |
|
|
} |
854 |
|
|
|
855 |
|
|
# ------------------------------------------------------------------- |
856 |
|
|
# Инициализирует $keeper->{MEMD} |
857 |
|
|
#-------------------------------------------------------------------- |
858 |
|
|
sub MEMD { |
859 |
|
|
my $self = shift; |
860 |
|
|
|
861 |
|
|
return undef unless $self->{state}->{memcached_enable}; |
862 |
|
|
|
863 |
459 |
ahitrov |
unless ( $self->{MEMD} && ref $self->{MEMD} && ref $self->{MEMD}->server_versions eq 'HASH' && keys %{$self->{MEMD}->server_versions} ) { |
864 |
8 |
ahitrov@rambler.ru |
my $implementation = $self->state()->memcached_backend(); |
865 |
|
|
$self->{MEMD} = $implementation->new({ |
866 |
|
|
servers => $self->state()->memcached_servers(), |
867 |
|
|
compress_threshold => 10_000, |
868 |
|
|
namespace => $self->state()->memcached_namespace, |
869 |
|
|
enable_compress => $self->state()->memcached_enable_compress(), |
870 |
|
|
connect_timeout => 0.1, |
871 |
459 |
ahitrov |
io_timeout => $self->state()->memcached_select_timeout(), |
872 |
8 |
ahitrov@rambler.ru |
check_args => 'skip' |
873 |
|
|
}); |
874 |
459 |
ahitrov |
$self->{MEMD}->enable_compress( $self->state()->memcached_enable_compress() ); |
875 |
8 |
ahitrov@rambler.ru |
} |
876 |
|
|
return $self->{MEMD}; |
877 |
|
|
} |
878 |
|
|
|
879 |
|
|
# ---------------------------------------------------------------------------- |
880 |
|
|
# Это умный AUTOLOAD. Ловит методов для установки/чтения полей... |
881 |
|
|
# Версия 0.2 |
882 |
|
|
# ---------------------------------------------------------------------------- |
883 |
|
|
sub AUTOLOAD { |
884 |
|
|
my $self = shift; |
885 |
|
|
my $attribute = $AUTOLOAD; |
886 |
|
|
|
887 |
|
|
$attribute =~ s/.*:://; |
888 |
|
|
return undef unless $attribute =~ /[^A-Z]/; # Отключаем методы типа DESTROY |
889 |
|
|
|
890 |
|
|
unless (ref $self) { |
891 |
|
|
$log->error("Прямой вызов неизвестной функции $AUTOLOAD()"); |
892 |
|
|
return undef; |
893 |
|
|
} elsif (! exists($self->{attributes}->{$attribute})) { |
894 |
|
|
$log->error("Вызов метода, для которого не существует обрабатываемого свойства: ->$attribute()"); |
895 |
|
|
return undef; |
896 |
|
|
} |
897 |
|
|
|
898 |
|
|
$self->{ $attribute } = shift @_ if scalar @_ > 0; |
899 |
|
|
return $self->{ $attribute }; |
900 |
|
|
} |
901 |
|
|
|
902 |
|
|
|
903 |
|
|
1; |
904 |
|
|
|