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