Line # Revision Author
1 3 ahitrov@rambler.ru package Contenido::Object;
2
3 # ----------------------------------------------------------------------------
4 # ����� ������.
5 # ������������ ����� ��� ���� �����. ��� �� �� ���������� ���, �� �������
6 # ������������� ��� ������������.
7 #
8 # �� ���� �� ����� ����������� ��������� ������ � ����������� ������,
9 # ��������� ������ � ��������� ������� � ��� �����...
10 # ----------------------------------------------------------------------------
11
12 use strict;
13 use warnings;
14 use locale;
15
16 use vars qw($VERSION $AUTOLOAD);
17 $VERSION = '4.1';
18
19 use Utils;
20 use Contenido::Globals;
21 use Data::Dumper;
22
23 use DBD::Pg;
24 use Encode;
25
26 use SQL::ProtoTable;
27
28 # required properties ������ ������� �� ������� �������
29 sub required_properties {
30 my $self=shift;
31 my $class = ref($self) || $self;
32 if ($class->can('class_table')) {
33 return $self->class_table->required_properties();
34 } else {
35 $log->error("$class cannot method class_table");
36 return ();
37 }
38 }
39
40 sub extra_properties {
41 return ();
42 }
43
44 sub post_init {
45 return;
46 }
47
48 sub pre_store {
49 return 1;
50 }
51
52 sub post_store {
53 return 1;
54 }
55
56 sub post_finish_store {
57 return 1;
58 }
59
60 sub pre_delete {
61 return 1;
62 }
63
64 sub post_delete {
65 return 1;
66 }
67
68 sub pre_abort {
69 return 1;
70 }
71
72 sub t_abort {
73 my $self = shift;
74 $self->pre_abort();
75 return $self->keeper->t_abort();
76 }
77
78 sub new {
79 $log->error("Method 'new' cannot be called for class Contenido::Object");
80 die;
81 }
82
83 sub class_table {
84 $log->error("Method 'class_table' cannot be called for Contenido::Object");
85 die;
86 }
87
88 #��������� ������ DESTROY ����� ��� ������ � AUTOLOAD �� ��������
89 sub DESTROY {}
90
91 #��������� ����� � ���� �� $object ��� �� $class/$id
92 #can be overloaded in class
93 sub get_object_key {
94 my $self = shift;
95 return $self->class_table->_get_object_key($self, @_);
96 }
97
98 #��������� ����� � ���� �� $object ��� �� $class/$unique
99 #can be overloaded in class
100 sub get_object_unique_key {
101 my $self = shift;
102 return $self->class_table->_get_object_unique_key($self, @_);
103 }
104
105 #�������� ��� ���������� �� ��������... ����������� 1 ��� �� ������ �����
106 #??? �������� ����� ������� ������ ������� � ��������� �� ���� �����
107 sub class_init {
108 my $self = shift;
109 my $class = ref($self) || $self;
110
111 {
112 no strict 'refs';
113 return 1 if (${$class.'::class_init_done'});
114 use strict;
115 }
116
117 #�������������� ��������� �������
118 if ($class->can('class_table')) {
119 eval { SQL::ProtoTable->table_init($class->class_table) };
120 do { $log->error("Cannot initialise class $class!"); die } if ($@);
121 }
122
123 #��������� ������������ ������ (todo)
124 #$self->class_validate();
125
126 my $funct;
127
128 #������ ������ ������� �������������� ������ �� ����
129 my $funct_begin = "
130 my (\$class, \$row, \$keeper, \$light) = \@_;
131 ";
132
133 my $funct_start_obj =' return bless({';
134 my $funct_end_obj = "}, '$class');
135 ";
136 my $funct_begin_if_light = '
137 if ($light) {';
138 my $funct_elsif_light = '
139 } else {';
140 my $funct_endif_light = '
141 }';
142
143 my $func_start_encode = '';
144 my $func_end_encode = '';
145
146 if ($state->db_encode_data) {
147 $func_start_encode = 'Encode::encode("'.$state->db_encode_data.'", ';
148 $func_end_encode = ', Encode::FB_HTMLCREF)';
149 }
150
151 my @funct_default_fields = ("class=>'$class'", "keeper=>\$keeper");
152 my @funct_exra_fields = ();
153
154 #�� ���� ������� ���� ������� ���������� ��� ������������� ������
155 my (%props, %attributes, @extra_fields, %virtual_fields, @structure);
156
157 my $pos = 0;
158 #������������������ reload: required_properties ����� ���� ���������� ����� add_properties ������� ����� ���� ����� �������� ����� extra_properties
159
160 foreach my $prop ($self->required_properties()) {
161 my $attr = $prop->{attr};
162 unless ($attr) {
163 $log->error("$class have wrong data in required_properties (no attr for field)");
164 next;
165 }
166 unless ($prop->{db_type} || $prop->{virtual}) {
167 $log->warning("$class with class table: ".$self->class_table()." property '$attr' missing db_type in table descriptor... can be incompatible with future versions!");
168 }
169
170 $props{$attr} = $prop;
171
172 push @structure, $prop;
173
174 #������ � ������� ���� ��������... ���� ���� ��� ��� ����� ������ ����� ���� �� �����... ������ ����� ���
175 next if ($attr eq 'class');
176
177 #���� ������� ���� � DB ����� ���� ��������� ������ � required_properties
178 if (exists($prop->{db_field}) and $prop->{db_field}) {
179 $pos++;
180 #$DBD::Pg versions since 2.0.0 do it automatically
181 if ($DBD::Pg::VERSION=~/^1\./ and $prop->{db_type} and (($prop->{db_type} eq 'integer[]') or ($prop->{db_type} eq 'integer_ref[]'))) {
182 push @funct_default_fields, "$attr=>[(\$row->[$pos] and \$row->[$pos]=~/^{(\\d+(?:,\\d+)*)}\$/) ? split(/,/, \$1) : ()]";
183 } else {
184 push @funct_default_fields, "$attr=>$func_start_encode\$row->[$pos]$func_end_encode";
185 }
186 }
187
188 if ($prop->{db_type} and ($prop->{db_type} eq 'integer[]')) {
189 $attributes{$attr} = 'ARRAY';
190 } elsif($prop->{db_type} and ($prop->{db_type} eq 'integer_ref[]')) {
191 $attributes{$attr} = 'ARRAY_REF';
192 } else {
193 $attributes{$attr} = 'SCALAR';
194 }
195 }
196 push @funct_default_fields, "attributes=>\$${class}::attributes";
197
198 my $have_extra = $self->class_table->have_extra;
199 if ($have_extra) {
200 my @ap = $self->add_properties() if $self->can('add_properties');
201 #������������������ reload: required_properties ����� ���� ���������� ����� add_properties ������� ����� ���� ����� �������� ����� extra_properties
202 foreach my $prop (@ap, $self->extra_properties()) {
203 my $attr = $prop->{attr};
204 if (exists($props{$attr})) {
205 #reload code
206 $log->info("Reloaded property $attr for class $class") if ($DEBUG);
207 while ( my ($field, $value) = each(%$prop)) {
208 $props{$attr}->{$field} = $value;
209 }
210 } else {
211 $props{$attr} = $prop;
212 #���� ��� ��� �� overload �� ��� ����� extra ����
213 push @extra_fields, $attr;
214 push @structure, $prop;
215 $attributes{$attr} = 'SCALAR';
216 if ($prop->{virtual}) {
217 #���������� ��� ��� ������ ����������� �������
218 $virtual_fields{$attr} = 1;
219 } else {
220 #�������������� �� dump ��� ����� ����������� �������
221 push @funct_exra_fields, "$attr=>$func_start_encode\$dump->{$attr}$func_end_encode";
222 }
223 }
224 }
225 }
226
227 $attributes{class} = 'SCALAR';
228
229 #���� � ������� ���� extra_attributes ���� �� ������� restore_extras ���� �� ������ light
230 #������� have_extra � ������� �� ����� � ������������� ������� extra_fields
231 if (@extra_fields) {
232 # --------------------------------------------------------------------------------------------
233 # ������ �� ������ ����� � ���� ������
234 # --------------------------------------------------------------------------------------------
235 my $funct_eval_dump .= '
236 my $dump = Contenido::Object::eval_dump(\\$row->[-1]);
237 ';
238 $funct = $funct_begin.$funct_begin_if_light.$funct_start_obj.join(', ', @funct_default_fields).$funct_end_obj.$funct_elsif_light.$funct_eval_dump.$funct_start_obj.join(', ', (@funct_default_fields, @funct_exra_fields)).$funct_end_obj.$funct_endif_light;
239 } else {
240 $funct = $funct_begin.$funct_start_obj.join(', ', @funct_default_fields).$funct_end_obj;
241 }
242
243 create_method($class, 'init_from_db', $funct);
244
245 {
246 no strict 'refs';
247 ${$class.'::structure'} = \@structure;
248 ${$class.'::attributes'} = \%attributes;
249 ${$class.'::extra_fields'} = \@extra_fields;
250 ${$class.'::virtual_fields'} = \%virtual_fields;
251 ${$class.'::class_init_done'} = 1;
252 }
253 return 1;
254 }
255
256 # -------------------------------------------------------------------------------------------
257 # ��������� ������� �������� ������� � ����������� �� ���������� �������...
258 # -------------------------------------------------------------------------------------------
259 sub store_extras {
260 my $self = shift;
261 my %opts = @_;
262 do {$log->error("����� store_extras() ����� �������� ������ � ��������, �� �� �������\n"); die } unless ref($self);
263
264 do { $log->error("� ������� �� ���������� ������ �� ���� ������"); die } unless ref($self->keeper);
265 do { $log->error("�� ����� ����� ���������� ������ (insert/update)"); die } if (($opts{mode} ne 'insert') && ($opts{mode} ne 'update'));
266 do { $log->error("�� ����� ������������� ������� (� ������ ���� ����� � ������������ �������)"); die } unless($self->id());
267
268 if ($self->keeper->store_method() eq 'sqldump') {
269 my $extra_table=$self->class_table->extra_table;
270 do { $log->error("No extra table for class $self->{class}"); die } unless ($extra_table);
271 if ($opts{mode} eq 'insert') {
272 $self->keeper->TSQL->do("INSERT INTO $extra_table (id, data) VALUES (?, ?)", {}, $self->id(), $self->_create_extra_dump()) || $self->t_abort();
273 } else {
274 $self->keeper->TSQL->do("UPDATE $extra_table SET data=? WHERE id=?", {}, $self->_create_extra_dump(), $self->id()) || $self->t_abort();
275 }
276
277 } elsif ($self->keeper->store_method() eq 'toast') {
278 my $table = $self->class_table->db_table;
279 do { $log->error("There no db_table for class $self->{class}"); die } unless ($table);
280 $self->keeper->TSQL->do("UPDATE $table SET data=? WHERE id=?", {}, $self->_create_extra_dump(), $self->id()) || $self->t_abort();
281
282 } else {
283 $log->error("����� ���������� �������� ����� �������! ��������� �������� - TOAST, SQLDUMP");
284 die;
285 }
286
287 return 1;
288 }
289
290
291 sub _create_extra_dump {
292 my $self = shift;
293
294 do { $log->error("����� _create_extra_dump ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);
295
296 my $class_table = $self->class_table;
297 return undef unless ($class_table and $class_table->have_extra);
298
299 my $extra_fields = [];
300 my $virtual_fields = {};
301 {
302 no strict 'refs';
303 local $Data::Dumper::Indent = 0;
304 #���������� virtual attributes
305 #�� � ���� ��� ��� ������ ������ �� ���� ����� ��� ���������
306 $extra_fields = ${$self->{class}.'::extra_fields'};
307 $virtual_fields = ${$self->{class}.'::virtual_fields'};
308 #���� ������������ ��� extra ���� ����� ��� ��� ��������� � virtual_fields ������
309 if ($state->db_encode_data) {
310 return Data::Dumper::Dumper({map { $_=> Encode::decode($state->db_encode_data, $self->{$_}, Encode::FB_HTMLCREF) } grep { !$virtual_fields->{$_} && (defined $self->{$_}) } @$extra_fields});
311 } else {
312 return Data::Dumper::Dumper({map { $_=>$self->{$_} } grep { !$virtual_fields->{$_} && (defined $self->{$_}) } @$extra_fields});
313 }
314 }
315 }
316
317 # -------------------------------------------------------------------------------------------
318 # ��������� ������� �������� ������� � ����������� �� ���������� �������...
319 # -------------------------------------------------------------------------------------------
320 sub restore_extras {
321 my ($self, $row) = @_;
322
323 do { $log->error("����� restore_extras() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);
324
325 my $extra_fields;
326 {
327 no strict 'refs';
328 $extra_fields = ${$self->{class}.'::extra_fields'};
329 }
330
331 if (@$extra_fields) {
332 if (($Contenido::Globals::store_method eq 'toast') or ($Contenido::Globals::store_method eq 'sqldump')) {
333 # --------------------------------------------------------------------------------------------
334 # ������ �� ������ ����� � ���� ������
335 # --------------------------------------------------------------------------------------------
336 my $dump_ = eval_dump(\$row->[-1]);
337 if ($dump_) {
338 foreach (@$extra_fields) {
339 $self->{$_} = $dump_->{$_};
340 }
341 }
342 } else {
343 $log->error("����� ���������� �������� ����� �������! ��������� �������� - TOAST, SQLDUMP, SINGLE, DUMP");
344 die;
345 }
346 }
347 }
348
349 # ----------------------------------------------------------------------------
350 # �������� ��� �� ����-����� �� ��������
351 # ������:
352 # my $pics_hashe = $doc->get_data('images');
353 # ----------------------------------------------------------------------------
354 sub get_data {
355 my $self = shift;
356 my $attr = shift;
357 my $data = eval_dump(\$self->{$attr});
358 return ($data || {});
359 }
360
361 # ----------------------------------------------------------------------------
362 # �������� �������� �� ������� �� �� ��������
363 # ���������� ������ ���� Contenido::Image
364 #
365 # ������:
366 # my $pic = $doc->get_pic('top_image');
367 #
368 # ----------------------------------------------------------------------------
369 sub get_pic {
370 my $self = shift;
371 my $attr = shift;
372
373 Contenido::Image->new (
374 img => $self->get_data($attr),
375 attr => $attr,
376 );
377 }
378
379 # ----------------------------------------------------------------------------
380 # �������� �������� �� ������� �� �������� �� ���������
381 # ���������� ������ �������� ���� Contenido::Image
382 #
383 # ������:
384 # my @pics = $doc->get_pics('images', {
385 # order => 'reverse', # ������� ���������� �� ������ ('reverse' ,'asis', �� ��������� - 'direct')
386 # keys => [3..12, 1..2], # �������� ������
387 # });
388 #
389 # ----------------------------------------------------------------------------
390 sub get_pics {
391 my $self = shift;
392 my $attr = shift;
393 my %args = ref $_[0] ? %{$_[0]} : @_;
394 my $pics = $self->get_data($attr);
395
396 # �������
397 $args{order} ||= 'direct';
398
399 # �������� ������� ������ ��� ��������...
400 my @keys = ref $args{keys} ne 'ARRAY' ? grep {s/\D+//, /^\d+$/} keys %{$pics} : @{$args{keys}};
401
402 my $prefix = 'image_'; # � ���� ��, ���� ���: my $prefix = $attr.'_';
403
404 map { Contenido::Image->new (
405 img => $pics->{$prefix.$_},
406 attr => $prefix.$_,
407 group => $attr,
408 key => $_,
409 )} sort { $args{order} eq 'asis' ? 1 : $args{order} ne 'reverse' ? $a <=> $b : $b <=> $a } @keys;
410 }
411
412 sub _get_sql {
413 my ($self,%opts)=@_;
414
415 #������ ������ ������� �� ������� ��������
416 my $table = $self->_get_table(%opts);
417 unless ($table) {
418 $log->error("�� ���� �������� ������� �������");
419 return;
420 }
421
422 my ($query, $binds) = $table->generate_sql(%opts);
423 my @binds = ();
424
425 if ($state->db_encode_data) {
426 foreach my $i (0..$#{$binds}) {
427 $binds->[$i] = Encode::decode($state->db_encode_data, $binds->[$i], Encode::FB_HTMLCREF);
428 }
429 }
430
431 return $query, $binds;
432 }
433
434 # ������ �������������:
435 # $document->store()
436 #
437 # ���� $id ����� �� �� �������, ��� ���� ������ � ���� ����. ����
438 # �� �����, �� �� �������, ��� ����� ������� � ���� ��� � ������� ���.
439 # ----------------------------------------------------------------------------
440 sub store {
441 my $self = shift;
442 do { $log->error("����� store() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);
443
444 do { $log->error("� ������� ��������� �� ���������� ������ �� ���� ������"); die } unless ref($self->keeper);
445
446 return undef if ($self->keeper->state->readonly());
447
448 $self->keeper->t_connect() || do { $self->keeper->error(); return undef; };
449 $self->{status} ||= 0; # �������� ������� �� ��������� = 0
450
451 unless ($self->pre_store()) {
452 $log->notice("pre_store call failed!");
453 return undef;
454 }
455
456 my (@fields, @values, @default_pairs, @default_fields, @default_values, @binary_fields);
457
458 foreach ($self->required_properties()) {
459
460 my $value = $self->{$_->{attr}};
461 $value = undef if (defined($value) and $value eq '') and (lc($_->{db_type}) eq 'float' or lc($_->{db_type} eq 'integer'));
462 $value = undef if lc $_->{db_type} eq 'integer[]' && ref $value ne 'ARRAY';
463 $value = undef if lc $_->{db_type} eq 'integer_ref[]' && ref $value ne 'ARRAY';
464
465 #���������� readonly ���� � ��������� ��� ���� id
466 if ($self->id() and $_->{readonly}) {
467
468 #��� ���� � ���� � ��������
469 } elsif (!$_->{db_field}) {
470
471 #��������� default ���� ��� ���� � ����� ���� ��� ��� �������� � ����
472 } elsif (defined($_->{default}) and ($_->{auto} or !defined($value))) {
473 push @default_fields, $_->{db_field};
474 push @default_values, $_->{default};
475 push @default_pairs, "$_->{db_field}=$_->{default}";
476
477 #���������� auto ��� default
478 } elsif ($_->{auto}) {
479
480 #��������� �������� �����
481 } elsif (defined($value)) {
482 push @fields, $_->{db_field};
483 if ($_->{db_type} eq 'integer[]') {
484 push @values, '{'.join(',', grep { $_ } @$value).'}';
485 } elsif ($_->{db_type} eq 'integer_ref[]') {
486 push @values, '{'.join(',', grep { $_ } @$value).'}';
487 } else {
488 #some special work for bytea column type
489 push @binary_fields, scalar(@fields) if ($_->{db_type} eq 'bytea');
490 if ($state->db_encode_data) {
491 push @values, Encode::decode($state->db_encode_data, $value, Encode::FB_HTMLCREF);
492 } else {
493 push @values, $value;
494 }
495 }
496
497 #undef to NULL or empty array
498 } else {
499 push @default_fields, $_->{db_field};
500 push @default_values, 'NULL';
501 push @default_pairs, "$_->{db_field}=NULL";
502 }
503 }
504
505 #���� ����������� toast �� ���������� �� 1 sql ������ � extra ����
506 if (($self->keeper->store_method() eq 'toast') and $self->class_table->have_extra) {
507 push @fields, 'data';
508 push @values, $self->_create_extra_dump();
509 }
510
511
512 my $values_string = '';
513 my $mode = 'update';
514 if ($self->id()) {
515 if (@fields) {
516 $values_string = join(' = ?, ', @fields).' = ?';
517 $values_string .= ', '.join(', ', @default_pairs) if (@default_pairs);
518 #��� ������� �������� �������� ������ �� @default_pairs
519 } else {
520 $values_string = join(', ', @default_pairs) if (@default_pairs);
521 }
522 my $sql='UPDATE '.$self->class_table->db_table.' SET '.$values_string." WHERE ".$self->class_table()->id_field()." = ?";
523
524 my $sth=$self->keeper->TSQL->prepare_cached($sql, {}, 1) || return $self->t_abort();
525 #settin special escape for bytea column type!!!
526 foreach (@binary_fields) {
527 $sth->bind_param($_, undef, {pg_type => DBD::Pg::PG_BYTEA});
528 }
529 unless ($sth->execute(@values, $self->{id})) {
530 $log->error("DBI execute error on $sql\n".Data::Dumper::Dumper(\@values));
531 $sth->finish();
532 return $self->t_abort();
533 }
534 $sth->finish();
535
536 if (($self->keeper->store_method() ne 'toast') and $self->class_table->have_extra) {
537 $self->store_extras(mode => $mode) || return $self->t_abort();
538 }
539
540 } else {
541 $mode = 'insert';
542 if (@fields) {
543 $values_string = '?, 'x(scalar (@fields)-1).'?';
544 $values_string .= ', '.join(', ', @default_values) if (@default_values);
545 #��� ������� �������� �������� ������ �� @default_pairs
546 } else {
547 $values_string = join(', ', @default_values) if (@default_values);
548 }
549 my $sql='INSERT INTO '.$self->class_table->db_table.' ('.join(', ', (@fields, @default_fields)).') VALUES ('.$values_string.')';
550
551 my $sth=$self->keeper->TSQL->prepare_cached($sql, {}, 1) || return $self->t_abort();
552 #settin special escape for bytea column type!!!
553 foreach (@binary_fields) {
554 $sth->bind_param($_, undef, {pg_type => DBD::Pg::PG_BYTEA});
555 }
556 unless ($sth->execute(@values)) {
557 $log->error("DBI execute error on $sql\n".Data::Dumper::Dumper(\@values));
558 $sth->finish();
559 return $self->t_abort();
560 }
561 $sth->finish();
562
563 my $id = $self->keeper->TSQL->selectrow_array("SELECT currval('documents_id_seq')");
564 $self->id($id);
565 return $self->t_abort("��������� �������� �������� �������������") if (! defined($self->{id}) || ($self->{id} <= 0));
566
567 if (($self->keeper->store_method() ne 'toast') and $self->class_table->have_extra) {
568 $self->store_extras(mode => $mode) || return $self->t_abort();
569 }
570
571 }
572
573 $self->post_store(mode => $mode);
574
575 $self->keeper->t_finish();
576
577 $self->post_finish_store();
578
579 $self->drop_cache($mode) if ($self->keeper->state()->memcached_enable());
580
581 return 1;
582 }
583
584 # ----------------------------------------------------------------------------
585 # ����� delete() ��� �������� ������� �� ���� ������.
586 #
587 # ������ �������������:
588 # $document->delete()
589 # ----------------------------------------------------------------------------
590 sub delete {
591 my $self = shift;
592 my (%opts) = @_;
593 do { $log->error("����� delete() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);
594
595 return undef if ($self->keeper->state->readonly());
596
597 unless ($self->pre_delete()) {
598 $log->error("pre_delete call failed!");
599 return undef;
600 }
601
602 my $keeper = $self->keeper;
603 do { $log->error("� ������� ��������� �� ���������� ������ �� ���� ������"); die } unless ref($keeper);
604
605 if ( exists $opts{attachments} && $opts{attachments} ) {
606 my @props = $self->structure();
607 if ( @props ) {
608 @props = grep { $_->{type} =~ /^(image|images|multimedia_new)$/ } @props;
609 foreach my $prop ( @props ) {
610 my $att = $self->get_image($prop->{attr});
611 if ( $prop->{type} eq 'image' ) {
612 if ( ref $att && exists $att->{filename} && $att->{filename} ) {
613 Contenido::File::remove( $att->{filename} );
614 }
615 56 ahitrov@rambler.ru if ( exists $att->{mini} && ref $att->{mini} eq 'HASH' ) {
616 Contenido::File::remove( $att->{mini}{filename} ) if exists $att->{mini}{filename};
617 foreach my $val ( values %{ $att->{mini} } ) {
618 if ( ref $val && exists $val->{filename} && $val->{filename} && ($val->{filename} ne $att->{mini}{filename}) ) {
619 Contenido::File::remove( $val->{filename} );
620 3 ahitrov@rambler.ru }
621 }
622 }
623
624 } elsif ( $prop->{type} eq 'images' ) {
625 for ( 1..100 ) {
626 next unless exists $att->{"image_$_"};
627 my $img = $att->{"image_$_"};
628 if ( ref $img && exists $img->{filename} && $img->{filename} ) {
629 Contenido::File::remove( $img->{filename} );
630 }
631 56 ahitrov@rambler.ru if ( exists $img->{mini} && ref $img->{mini} eq 'HASH' ) {
632 Contenido::File::remove( $img->{mini}{filename} ) if exists $img->{mini}{filename};
633 foreach my $val ( values %{ $img->{mini} } ) {
634 if ( ref $val && exists $val->{filename} && $val->{filename} && ($val->{filename} ne $img->{mini}{filename}) ) {
635 Contenido::File::remove( $val->{filename} );
636 3 ahitrov@rambler.ru }
637 }
638 }
639 }
640 } elsif ( $prop->{type} eq 'multimedia_new' ) {
641 if ( ref $att && exists $att->{filename} && $att->{filename} ) {
642 Contenido::File::remove( $att->{filename} );
643 }
644 }
645 }
646 }
647 }
648 do { $log->warning("����� ������ delete() ��� �������� �������������� ��� ��������"); return undef }
649 56 ahitrov@rambler.ru unless ($self->{id});
650 3 ahitrov@rambler.ru $keeper->t_connect() || do { $keeper->error(); return undef; };
651 $keeper->TSQL->do("DELETE FROM ".$self->class_table->db_table." WHERE id = ?", {}, $self->id) || return $self->t_abort();
652
653 # �������� ������ ����� ��������� � ������� �����������...
654 my %document_links;
655 if ( $keeper->state->{available_links} && ref $keeper->state->{available_links} eq 'ARRAY' ) {
656 foreach my $classlink ( @{ $keeper->state->{available_links} } ) {
657 my $sources = $classlink->available_sources;
658 if ( ref $sources eq 'ARRAY' && @$sources ) {
659 $document_links{$classlink->class_table->db_table}{source} = 1 if grep { $self->class eq $_ } @$sources;
660 }
661 my $dests = $classlink->available_destinations;
662 if ( ref $dests eq 'ARRAY' && @$dests ) {
663 46 ahitrov@rambler.ru $document_links{$classlink->class_table->db_table}{dest} = 1 if grep { $self->class eq $_ } @$dests;
664 3 ahitrov@rambler.ru }
665 }
666 foreach my $tablename ( keys %document_links ) {
667 my (@wheres, @values);
668 if ( exists $document_links{$tablename}{source} ) {
669 push @wheres, "(source_id = ? AND source_class = ?)";
670 push @values, ( $self->id, $self->class );
671 }
672 if ( exists $document_links{$tablename}{dest} ) {
673 push @wheres, "(dest_id = ? AND dest_class = ?)";
674 push @values, ( $self->id, $self->class );
675 }
676 my $request = "DELETE FROM $tablename WHERE ".join (' OR ', @wheres);
677 warn "DELETE LINKS. Request: [$request]\n" if $DEBUG;
678 warn "Values: [".join(', ', @values)."]\n" if $DEBUG;
679 $keeper->TSQL->do($request, {}, @values) || return $self->t_abort();
680 }
681 } else {
682 $keeper->TSQL->do("DELETE FROM links WHERE source_id = ? AND source_class = ? ", {}, $self->id, $self->class) || return $self->t_abort();
683 $keeper->TSQL->do("DELETE FROM links WHERE dest_id = ? AND dest_class = ? ", {}, $self->id, $self->class) || return $self->t_abort();
684 }
685 $keeper->t_finish();
686
687 $self->post_delete();
688
689 $self->drop_cache('delete') if ($keeper->state()->memcached_enable());
690
691 return 1;
692 }
693
694 # ----------------------------------------------------------------------------
695 # ����� links() ���������� ������ �������� ���� Contenido::Link
696 #
697 # ������ �������������:
698 # $document->links([�����])
699 # ----------------------------------------------------------------------------
700 sub links {
701 my ($self, $lclass, $direction, %opts) = @_;
702 do { $log->error("����� ->links() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);
703
704 do { $log->error("� ������� ��������� �� ���������� ������ �� ���� ������"); die } unless ref($self->keeper);
705
706 do { $log->warning("����� ������ ->links() ��� �������� �������������� ���������-���������"); return () } unless ($self->id() > 0);
707
708 my $check = defined $direction ? 'dest_id' : 'source_id';
709
710 $opts{$check} = $self->id();
711
712 if (defined($lclass) && (length($lclass) > 0)) {
713 56 ahitrov@rambler.ru $opts{class} = $lclass;
714 3 ahitrov@rambler.ru }
715
716 my @links = $self->keeper->get_links(%opts);
717
718 $self->{links} = \@links;
719 return @links;
720 }
721
722
723 sub linked_to {
724 my ($self, $lclass) = @_;
725 $self->links($lclass, 1);
726 }
727
728
729 # ----------------------------------------------------------------------------
730 # ��������� �����. ������ ���� ����������� ����� �����...
731 # � �������� source_id ��������� ������������� �������, � �������� $dest_id -
732 # ��������.
733 #
734 # ������ �������������:
735 # $document->set_link($lclass, $dest_id)
736 #
737 # �������� �� ������������ - � ��������� ����� ���� ��������� ����������
738 # ������.
739 # ----------------------------------------------------------------------------
740 sub set_link {
741 my ($self, $lclass, $dest_id, $dest_class, @opts) = @_;
742 do { $log->error("����� ->set_link() ������ � ������������ ���-��� ����������"); die } if @opts % 2;
743 do { $log->error("����� ->set_link() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);
744 my %opts = @opts;
745
746 return undef if ($self->keeper->state->readonly());
747
748 do { $log->warning("����� ������ ->set_link() ��� �������� �������������� ���������-���������"); return undef } unless ($self->id() > 0);
749 do { $log->warning("����� ������ ->set_link() ��� �������� �������������� ���������-����"); return undef } unless ($dest_id >= 0);
750 do { $log->warning("����� ������ ->set_link() ��� �������� ������ �����"); } unless (defined($lclass) && length($lclass));
751
752 # ������� ������ �����...
753 my $link = $lclass->new($self->keeper);
754
755 $link->dest_id($dest_id);
756 $link->dest_class($dest_class);
757
758 $link->status(1);
759
760 $link->source_id($self->id());
761 $link->source_class($self->class());
762
763 while (my ($k,$v) = each %opts) {
764 56 ahitrov@rambler.ru $link->{$k} = $v;
765 3 ahitrov@rambler.ru }
766
767 if ($link->store())
768 {
769 56 ahitrov@rambler.ru return $link->id;
770 3 ahitrov@rambler.ru } else {
771 56 ahitrov@rambler.ru return undef;
772 3 ahitrov@rambler.ru }
773 }
774
775 # -------------------------------------------------------------------
776 # ���������� ������ � ������������� ���.
777 #
778 sub prepare_for_cache {
779 my $self = shift;
780
781 do { $log->error("����� ->prepare_for_cache() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);
782
783 my $hash = {};
784
785 foreach ( $self->structure() ) {
786 56 ahitrov@rambler.ru $hash->{$_->{attr}} = $self->{$_->{attr}} if defined $self->{$_->{attr}};
787 3 ahitrov@rambler.ru }
788 bless $hash, $self->class();
789 return $hash;
790 }
791
792 # -------------------------------------------------------------------
793 # ��������������� ����������� ������ �� �������������� ����.
794 # ��� ��� ���� ������������ � ����������� ������.
795 # -------------------------------------------------------------------
796 sub recover_from_cache {
797 my $self = shift;
798 my $keeper = shift;
799
800 do { $log->error("����� ->recover_from_cache() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);
801 do { $log->error("� ������� ��������� �� ���������� ������ �� ���� ������"); die } unless ref($keeper);
802
803 #�� ����� ��� bless ���������... 100% ���� �� ������ � ��������� ����� �� �� ���� ����� ����� ������
804 $self->init();
805 $self->keeper($keeper);
806
807 return 1;
808 }
809
810 # -------------------------------------------------------------------
811 # ���������� ���:
812 # {��������1 => [���1, ���2, ...], ��������2 => [���1, ���2, ...], ...}
813 # �.�. ��� ������� �������� �������� ������ ���� ������ � ����,
814 # ������� ���� �������.
815 # ��������� ������� ��������: insert, update, delete
816 # ��� ����� ������� ������ ������ ���� ����� ������ ���� �������������
817 # � ������ ������ �������
818 #
819 sub dependencies {
820 my ($self, $mode) = @_;
821
822 my @keys = ($self->get_object_key,);
823 my $object_unique_key = $self->get_object_unique_key;
824 push @keys, $object_unique_key if defined $object_unique_key;
825
826 return
827 ($mode eq 'delete') || ($mode eq 'insert') || ($mode eq 'update')
828 ? \@keys
829 : [];
830 }
831
832 # -------------------------------------------------------------------
833 # ������� �� ���� �����, �������� ��� ������ dependencies().
834 # ������ ������:
835 # $group->drop_cache('update');
836 #
837 sub drop_cache {
838 my $self = shift;
839 my $mode = shift;
840
841 do { $log->error("����� ->drop_cache() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);
842
843 my $keeper = $self->keeper;
844 do { $log->error("� ������� ��������� �� ���������� ������ �� ���� ������"); die } unless ref($keeper);
845
846 my $dependencies = $self->dependencies($mode, @_);
847
848 my @not_deleted = ();
849 if ( defined($dependencies) && (ref($dependencies) eq 'ARRAY') ) {
850 for (@$dependencies) {
851 my $res = $self->keeper->MEMD ? $self->keeper->MEMD->delete($_) : undef;
852 push @not_deleted, $_ unless $res;
853 $keeper->MEMD->delete($_) if ($keeper->MEMD);
854 }
855 }
856 return @not_deleted;
857 }
858
859
860 sub keeper {
861 my $self = shift;
862 my $project_keeper = shift;
863
864 do { $log->error("����� keeper() ����� �������� ������ � ��������, �� �� �������"); die } unless ref($self);
865
866 if ($project_keeper && ref $project_keeper) {
867 $self->{keeper} = $project_keeper;
868 return $project_keeper;
869 }
870 return $self->{keeper} && ref $self->{keeper} ? $self->{keeper} : $keeper;
871 }
872
873 #������ ������� ��� init_from_db ����� ������������������� ����� ���� ����
874 sub init_from_db {
875 my $self = shift;
876
877 my $class = ref($self) || $self;
878
879 #������ �� ����������� �������� ���� class_init �� �����������
880 if (defined($_[-1]) and ($_[-1] eq 'RECURSIVE CALL FLAG!')) {
881 do { $log->error("$class cannot be initialized (->class_init dont work) (recursive call) !!!"); die };
882 }
883
884 #���� ���� ����� �� �������� ������� ��� ��� �� ������������������ �� ����������� �������������������
885 #������ ������������� ������ init_from_db ��������� �� ref �� �����
886 if ($class and $class->isa('Contenido::Object')) {
887 no strict 'refs';
888 if (${$class.'::class_init_done'}) {
889 do { $log->error("$class already initialized but DONT HAVE init_from_db method!!!"); die };
890 } else {
891 if ($self->class_init()) {
892 return $self->init_from_db(@_, 'RECURSIVE CALL FLAG!');
893 } else {
894 do { $log->error("$class cannot be initialized (->class_init dont work) !!!"); die };
895 }
896 }
897 } else {
898 do { $log->error("$class cannot be initialized (not Contenido::Object child class) !!!"); die };
899 }
900 }
901
902 # ----------------------------------------------------------------------------
903 # ��� ����� AUTOLOAD. ����� ������� ��� ���������/������ �����...
904 # ������ 1.0
905 # ������ �� ���������� ����������� ����� ������� ���� ����
906 # ----------------------------------------------------------------------------
907 sub AUTOLOAD {
908 my $self = shift;
909 my $attribute = $AUTOLOAD;
910
911 $log->info("$self calling AUTOLOAD method: $attribute") if ($DEBUG_CORE);
912
913 $attribute=~s/^.*:://;
914
915 my $class = ref($self);
916 unless ($class and $class->isa('Contenido::Object')) {
917
918 my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef;
919 my $mason_file = ref($mason_comp) ? $mason_comp->path : undef;
920 my ($package, $filename, $line) = caller;
921
922 $log->warning("Wrong AUTOLOAD call with self='$self'/class='$class' and method '$attribute' called from '$package/$filename/$line' ".($mason_file ? "called from $mason_file" : '')."\n".Data::Dumper::Dumper($self));
923 if (wantarray) { return (); } else { return undef; }
924 }
925
926 #�������� ���� ���� �� �� ����� �������� ������������� ������ ���� �� �� ����� �� ������ ���� ������ ��� ��������������������� ������
927 {
928 no strict 'refs';
929 unless (${$class.'::class_init_done'}) {
930 my ($package, $filename, $line) = caller;
931 $log->error("AUTOLOAD called method '$attribute' for not initialised class ($class) from '$package/$filename/$line'");
932 if (wantarray) { return (); } else { return undef; }
933 }
934 }
935
936 if (! exists($self->{attributes}->{$attribute})) {
937
938 my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef;
939 my $mason_file = ref($mason_comp) ? $mason_comp->path : undef;
940 my ($package, $filename, $line) = caller;
941
942 $log->error(ref($self)."): ����� ������, ��� �������� �� ���������� ��������������� ��������: ->$attribute() called from $package/$filename/$line ".($mason_file ? "called from $mason_file" : '')."\n".Data::Dumper::Dumper($self));
943 if (wantarray) { return (); } else { return undef; }
944 #special work with ARRAY types
945 } elsif ($self->{attributes}->{$attribute} eq 'ARRAY') {
946 my $funct = "
947 use Contenido::Globals;
948 my \$self = shift;
949 unless (ref(\$self->{$attribute}) eq 'ARRAY') {
950 my (\$package, \$filename, \$line) = caller;
951 \$log->error(\"Wrong structure in field $attribute called from \$package/\$filename/\$line \\n\".Data::Dumper::Dumper(\$self)) if (\$self->{$attribute});;
952 \$self->{$attribute} = [];
953 }
954 \$self->{$attribute} = [\@_] if (\@_);
955 return \@{\$self->{$attribute}};";
956
957 if (create_method($class, $attribute, $funct)) {
958 return $self->$attribute(@_);
959 } else {
960 $log->error("Cannot create method $attribute for class $self->{class}");
961 #fallback to old autoload method if create method fail
962 unless (ref($self->{$attribute}) eq 'ARRAY') {
963 my ($package, $filename, $line) = caller;
964 $log->error("Wrong structure in field $attribute called from $package/$filename/$line \n".Data::Dumper::Dumper($self));
965 $self->{$attribute} = [];
966 }
967 $self->{$attribute} = [@_] if (@_);
968 return @{$self->{$attribute}};
969 }
970 #todo: �������� ������ � images ���������� ����� ��� ����� ������
971 } else {
972 #todo: ��������� ������� �����
973 my $funct = "
974 my \$self = shift;
975 \$self->{$attribute} = shift if (\@_);
976 return \$self->{$attribute};";
977
978 if (create_method($class, $attribute, $funct)) {
979 return $self->$attribute(@_);
980 } else {
981 $log->error("Cannot create method $attribute for class $self->{class}");
982 #fallback to old autoload method if create method fail
983 $self->{$attribute} = shift if (@_);
984 return $self->{$attribute};
985 }
986 }
987 }
988
989 sub eval_dump {
990 no strict 'vars';
991 return {} unless ${$_[0]};
992 return eval ${$_[0]};
993 }
994
995 sub create_method {
996 my ($class, $sub_name, $code) = @_;
997
998 unless ($class and $sub_name and $code) {
999 $log->error("Wrong call create_method $class/$sub_name/$code");
1000 return 0;
1001 }
1002
1003 my $string = "package $class;\n\nsub $sub_name {\n$code\n}\n\n1;";
1004 eval $string;
1005
1006 if ($@) {
1007 $log->error("Cannot create method $sub_name for class $class because $@ (method code:\n$string\n)");
1008 return 0;
1009 } else {
1010 $log->info("Method '$sub_name' for class '$class' (method code:\n$string\n) created ok") if ($DEBUG_CORE);
1011 return 1;
1012 }
1013 }
1014
1015 ######################################## ONLY FOR INTERNAL USE!!!! #################################################
1016 #todo �������� �������� ��� ���� ������� ������ �� ��������� ��� � ��� 1 table � �� 5 ������
1017 sub _get_table {
1018 my ($self, %opts) = @_;
1019
1020 my $class_table;
1021
1022 my $table=$opts{table};
1023 my $class=$opts{class} || ref $self || $self;
1024
1025 #������ ������� � %opts
1026 if ($table and $table->can('new')) {
1027 $class_table=$table;
1028 #����� ������� �� ������
1029 } elsif ($class and !ref($class)) {
1030 unless ($class->can('class_table')) {
1031 $log->error("$class cannot class_table");
1032 return undef;
1033 }
1034 $class_table=$class->class_table();
1035 #����� ������� �� ������� ������ � ������
1036 } elsif ($class and ref($class) eq 'ARRAY' and @$class) {
1037 unless ($class->[0]->can('class_table')) {
1038 $log->error("$class->[0] cannot class_table");
1039 return undef;
1040 }
1041 $class_table=$class->[0]->class_table();
1042 #����� �������������
1043 } else {
1044 $class_table='SQL::DocumentTable';
1045 }
1046
1047 if ($class_table->can('new')) {
1048 return $class_table->new();
1049 } else {
1050 $log->error("$class_table cannot new!!!!");
1051 return undef;
1052 }
1053 }
1054
1055 #######################################################################################################################
1056 ########## OLD CODE FOR COMPATIBILITY #################################################################################
1057 #######################################################################################################################
1058 sub structure {
1059 my $self = shift;
1060 my $class = ref($self);
1061 {
1062 no strict 'refs';
1063 return @${$class.'::structure'};
1064 }
1065 }
1066
1067
1068 # ��������� ��� �������� �������������...
1069 sub get_image {
1070 my $self = shift;
1071 $self->get_data(shift);
1072 }
1073
1074 sub raw_restore {
1075 my $self = shift;
1076 do { $log->error("����� restore() ����� �������� ������ � ��������, �� �� �������"); die } unless ref $self;
1077 do { $log->warning("����� ������ Contenido\:\:Object\:\:raw_restore() ��� �������� �������������� ��� ������"); return undef } unless $self->id;
1078 $self->restore_extras();
1079 }
1080
1081 sub init {
1082 my $self = shift;
1083 my $class = ref($self) || $self;
1084 $self->class_init();
1085 {
1086 no strict 'refs';
1087 $self->{attributes} = ${$class.'::attributes'};
1088 }
1089 return 1;
1090 }
1091
1092 sub get_file_name {
1093 my $self = shift;
1094
1095 do { $log->error("����� get_file_name ����� �������� ������ � ��������, �� �� �������"); die } unless ref $self;
1096
1097 my @date;
1098 my $time = time;
1099
1100 if ($self->{"dtime"} and $self->{"dtime"} =~ /^(\d{4})-(\d{2})-(\d{2})/) {
1101 @date = ($1, $2, $3);
1102 } else {
1103 @date = (localtime $time)[5, 4, 3]; $date[0] += 1900; $date[1] += 1;
1104 }
1105
1106 my $component_class = lc((reverse split "::", ref $self)[0]);
1107 my $component_date = sprintf "%04d/%02d/%02d", @date;
1108 my $component_time_rand = sprintf "%010d_%05d", $time, int rand 99999;
1109
1110 return join "/", $component_class, $component_date, $component_time_rand;
1111 }
1112
1113 sub get {
1114 my ( $self, %opts ) = @_;
1115 my $class = ref $self || $self;
1116 my $local_keeper = (ref($self) and ref($self->keeper)) ? $self->keeper : $keeper;
1117 delete $opts{class};
1118 return $keeper->get_documents( class => $class, %opts );
1119 }
1120
1121 sub contenido_is_available {
1122 return 1;
1123 }
1124
1125 sub contenido_status_style {
1126 return;
1127 }
1128
1129 sub memcached_expire {
1130 return $_[0]->keeper->state->memcached_object_expire;
1131 }
1132
1133 1;
1134