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