Revision 823
Date:
2021/06/25 22:28:36
Author:
ahitrov
Revision Log:
Recursive::Encoder -> inner perl-based encoder
Files:
Legend:
Added
Removed
Modified
utf8/core/lib/Contenido/Keeper.pm
17
17
18
18
use Contenido::Globals;
19
19
use Contenido::Msg;
20
use Utils;
20
21
21
22
# TODO
22
23
# побить на 2-4 модуля вменяемого размера....!
…
…
210
211
# warn Data::Dumper::Dumper($binds);
211
212
unless ($sth->execute(@$binds)) {
212
213
$self->error;
213
$log->error("DBI execute error on $$query\n".Data::Dumper::Dumper($DBD::Pg::VERSION >= '3' ? Data::Recursive::Encode->encode_utf8($binds) : $binds)."\ncalled with opts:\n".Data::Dumper::Dumper(\%opts));
214
$log->error("DBI execute error on $$query\n".Data::Dumper::Dumper($DBD::Pg::VERSION >= '3' ? Utils::encode_struct($binds) : $binds)."\ncalled with opts:\n".Data::Dumper::Dumper(\%opts));
214
215
return;
215
216
}
216
217
my $finish1 = Time::HiRes::time() if ($DEBUG);
…
…
236
237
$Contenido::Globals::CORE_TIME += $finish2-$finish1;
237
238
$Contenido::Globals::DB_COUNT++;
238
239
239
$log->info("get_items($proto) ".($mason_file ? "called from $mason_file" : '')." SQL: '$$query' with binds: '".join("', '", map { ref $_ ? Data::Dumper::Dumper($DBD::Pg::VERSION >= '3' ? Data::Recursive::Encode->encode_utf8($_) : $_) : $DBD::Pg::VERSION >= '3' ? Encode::encode('utf-8', $_) : $_ } @$binds)."' fetched: $total records (total work time: $total_time ms, database time $db_time ms, core time $core_time ms)");
240
$log->info("get_items($proto) ".($mason_file ? "called from $mason_file" : '')." SQL: '$$query' with binds: '".join("', '", map { ref $_ ? Data::Dumper::Dumper($DBD::Pg::VERSION >= '3' ? Utils::encode_struct($_) : $_) : $DBD::Pg::VERSION >= '3' ? Encode::encode('utf-8', $_) : $_ } @$binds)."' fetched: $total records (total work time: $total_time ms, database time $db_time ms, core time $core_time ms)");
240
241
}
241
242
242
243
#выдает предупреждение если полученно более 500 обьектов но не выставлен no_limit
243
244
if ($total>999 and !($opts{no_limit} or $opts{limit})) {
244
245
my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef;
245
246
my $mason_file = ref($mason_comp) ? $mason_comp->path : undef;
246
$log->error("get_items($proto) ".($mason_file ? "called from $mason_file" : '')." SQL: '$$query' with binds: '".join("', '", map { ref $_ ? Data::Dumper::Dumper($DBD::Pg::VERSION >= '3' ? Data::Recursive::Encode->encode_utf8($_) : $_) : $DBD::Pg::VERSION >= '3' ? Encode::encode('utf-8', $_) : $_ } @$binds)."' fetched 1000 records... гарантированно часть записей не получена из базы... или добавьте no_limit=>1 или разберитесь почему так много данных получаете");
247
$log->error("get_items($proto) ".($mason_file ? "called from $mason_file" : '')." SQL: '$$query' with binds: '".join("', '", map { ref $_ ? Data::Dumper::Dumper($DBD::Pg::VERSION >= '3' ? Utils::encode_struct($_) : $_) : $DBD::Pg::VERSION >= '3' ? Encode::encode('utf-8', $_) : $_ } @$binds)."' fetched 1000 records... гарантированно часть записей не получена из базы... или добавьте no_limit=>1 или разберитесь почему так много данных получаете");
247
248
} elsif ($total>500 and !($opts{no_limit} or $opts{limit})) {
248
249
my $mason_comp = ref($HTML::Mason::Commands::m) ? $HTML::Mason::Commands::m->current_comp() : undef;
249
250
my $mason_file = ref($mason_comp) ? $mason_comp->path : undef;
utf8/core/lib/Contenido/Object.pm
225
225
$virtual_fields{$attr} = 1;
226
226
} else {
227
227
#инициализируем из dump все кроме виртуальных свойств
228
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)";
228
push @funct_exra_fields, "$attr=>(\$keeper->serialize_with eq 'json' ? (ref \$dump->{$attr} ? Utils::encode_struct(\$dump->{$attr}) : Encode::encode('utf-8', \$dump->{$attr}, Encode::FB_HTMLCREF) ) : $func_start_encode\$dump->{$attr}$func_end_encode)";
229
229
}
230
230
}
231
231
}
…
…
395
395
if ( ref $self->$attr ) {
396
396
return $self->$attr;
397
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});
398
my $data = $self->keeper->serialize_with eq 'json' ? ( $encode ? Utils::encode_struct(eval_json(\$self->{$attr})) : eval_json(\$self->{$attr}) ) : eval_dump(\$self->{$attr});
399
399
return ($data || {});
400
400
}
401
401
}
…
…
476
476
} elsif ( version->parse($DBD::Pg::VERSION) > version->parse('3') && $] < '5.026' ) {
477
477
foreach my $i (0..$#{$binds}) {
478
478
if ( ref $binds->[$i] ) {
479
$binds->[$i] = Data::Recursive::Encode->decode_utf8($binds->[$i]);
479
$binds->[$i] = Utils::decode_struct($binds->[$i]);
480
480
} else {
481
481
$binds->[$i] = Encode::decode('utf-8', $binds->[$i], Encode::FB_HTMLCREF);
482
482
}
…
…
601
601
}
602
602
# warn Data::Dumper::Dumper(\@values) if $DEBUG;
603
603
unless ($sth->execute(@values, $self->{id})) {
604
$log->error("DBI execute error on $sql\n".Data::Dumper::Dumper( $DBD::Pg::VERSION >= '3' && $] < '5.026' ? Data::Recursive::Encode->encode_utf8( \@values ) : \@values ));
604
$log->error("DBI execute error on $sql\n".Data::Dumper::Dumper( $DBD::Pg::VERSION >= '3' && $] < '5.026' ? Utils::encode_struct( \@values ) : \@values ));
605
605
$sth->finish();
606
606
return $self->t_abort();
607
607
}
…
…
633
633
$sth->bind_param($_, undef, {pg_type => DBD::Pg::PG_BYTEA});
634
634
}
635
635
unless ($sth->execute(@values)) {
636
$log->error("DBI execute error on $sql\n".Data::Dumper::Dumper( $DBD::Pg::VERSION >= '3' && $] < '5.026' ? Data::Recursive::Encode->encode_utf8( \@values ) : \@values ));
636
$log->error("DBI execute error on $sql\n".Data::Dumper::Dumper( $DBD::Pg::VERSION >= '3' && $] < '5.026' ? Utils::encode_struct( \@values ) : \@values ));
637
637
$sth->finish();
638
638
return $self->t_abort();
639
639
}
…
…
1091
1091
return undef unless ${$_[0]};
1092
1092
my $str = ${$_[0]};
1093
1093
if ( $str =~ /^\$VAR/ ) {
1094
return Data::Recursive::Encode->decode_utf8(Contenido::Object::eval_dump( \$str ));
1094
return Utils::decode_struct(Contenido::Object::eval_dump( \$str ));
1095
1095
}
1096
1096
my $chr = substr($str, 0, 1); return $str unless $chr eq '{' || $chr eq '[';
1097
1097
my $value = $json_u->decode( $str );
utf8/core/lib/Utils.pm
8
8
@ISA = qw(Exporter);
9
9
@EXPORT = qw( &eval_config_file
10
10
&dump_config_file
11
&decode_struct
12
&encode_struct
11
13
&_mkdir
12
14
&looks_like_id
13
15
&time_unix_to_timestamp
…
…
204
206
my ($from, $to, $str) = @_;
205
207
return Convert::Cyrillic::cstocs($from, $to, $str);
206
208
}
207
208
209
210
sub encode_struct {
211
return recode_struct_recursive($_[0], 'encode');
212
}
213
214
sub decode_struct {
215
return recode_struct_recursive($_[0], 'decode');
216
}
217
218
sub recode_struct_recursive {
219
my ($struct, $action) = @_;
220
return unless ref $struct;
221
222
my @stack;
223
if ( ref $struct eq 'HASH' ) {
224
foreach my $key ( keys %$struct ) {
225
push @stack, { root => $struct, type => 'hash', key => $key };
226
}
227
} elsif ( ref $struct eq 'ARRAY' ) {
228
for( my $i == 0; $i < scalar @$struct; $i++ ) {
229
push @stack, { root => $struct, type => 'array', index => $i };
230
}
231
} else {
232
return;
233
}
234
while ( @stack ) {
235
my $data = pop @stack;
236
if ( $data->{type} eq 'hash' ) {
237
if ( ref $data->{root}{$data->{key}} eq 'HASH' ) {
238
foreach my $key ( keys %{$data->{root}{$data->{key}}} ) {
239
push @stack, { root => $data->{root}{$data->{key}}, type => 'hash', key => $key };
240
}
241
} elsif ( ref $data->{root}{$data->{key}} eq 'ARRAY' ) {
242
for( my $i == 0; $i < scalar @{$data->{root}{$data->{key}}}; $i++ ) {
243
push @stack, { root => $data->{root}{$data->{key}}, type => 'array', index => $i };
244
}
245
} else {
246
if ( $action eq 'encode' ) {
247
$data->{root}{$data->{key}} = Encode::encode('utf-8', $data->{root}{$data->{key}}, Encode::FB_HTMLCREF);
248
} else {
249
$data->{root}{$data->{key}} = Encode::decode('utf-8', $data->{root}{$data->{key}}, Encode::FB_HTMLCREF);
250
}
251
}
252
} else {
253
if ( ref $data->{root}->[$data->{index}] eq 'HASH' ) {
254
foreach my $key ( keys %{$data->{root}->[$data->{index}]} ) {
255
push @stack, { root => $data->{root}->[$data->{index}], type => 'hash', key => $key };
256
}
257
} elsif ( ref $data->{root}->[$data->{index}] eq 'ARRAY' ) {
258
for( my $i == 0; $i < scalar @{$data->{root}->[$data->{index}]}; $i++ ) {
259
push @stack, { root => $data->{root}->[$data->{index}], type => 'array', index => $i };
260
}
261
} else {
262
if ( $action eq 'encode' ) {
263
$data->{root}->[$data->{key}] = Encode::encode('utf-8', $data->{root}->[$data->{key}], Encode::FB_HTMLCREF);
264
} else {
265
$data->{root}->[$data->{key}] = Encode::decode('utf-8', $data->{root}->[$data->{key}], Encode::FB_HTMLCREF);
266
}
267
}
268
}
269
}
270
return $struct;
271
}
272
209
273
# загрузка модулей
210
274
sub load_modules {
211
275
my $list = shift;
Небольшая справка по веткам
cnddist – контейнер, в котором хранятся все дистрибутивы всех библиотек и программных пакетов, которые использовались при построении различных версий Contenido. Если какой-то библиотеки в данном хранилище нет, инсталлятор сделает попытку "подтянуть" ее с веба (например, с CPAN). Если библиотека слишком старая, есть очень большая вероятность, что ее там уже нет. Поэтому мы храним весь хлам от всех сборок. Если какой-то дистрибутив вдруг отсутствует в cnddist - напишите нам, мы положим его туда.
koi8 – отмирающая ветка, чей код, выдача и все внутренние библиотеки заточены на кодировку KOI8-R. Вносятся только те дополнения, которые касаются внешнего вида и функционала админки, баги ядра, обязательные обновления портов и мелочи, которые легко скопипастить. В дальнейшем планируется полная остановка поддержки по данной ветке.
utf8 – актуальная ветка, заточенная под UTF-8.
Внутри каждой ветки: core – исходники ядра; install – скрипт установки инсталляции; plugins – плагины; samples – "готовые к употреблению" проекты, которые можно поставить, запустить и посмотреть, как они работают.
