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