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