Revision 641
Date:
2017/03/21 15:48:41
Author:
ahitrov
Revision Log:
Memory usage optimization
Files:
Legend:
Added
Removed
Modified
utf8/core/lib/Contenido/File.pm
185
185
my (%opts) = @_;
186
186
my $object = delete $opts{object} || return;
187
187
my $attr = delete $opts{attr};
188
my $no_rename = delete $opts{no_rename};
188
189
189
190
my ($prop) = exists $opts{prop} && ref $opts{prop} ? ($opts{prop}) : $attr ? grep { $_->{attr} eq $attr } $object->structure : (undef);
190
191
return unless ref $prop;
…
…
193
194
my @shrinks = exists $prop->{'shrink'} && ref $prop->{'shrink'} eq 'ARRAY' ? @{$prop->{'shrink'}} : exists $prop->{'shrink'} && $prop->{'shrink'} ? ($prop->{'shrink'}) : ();
194
195
195
196
my $filename = '/images/'.$object->get_file_name() || return;
197
if ( $no_rename ) {
198
my $orig_name = '';
199
if ( ref $input eq 'Apache::Upload' ) {
200
$orig_name = $input->filename();
201
} elsif ( !ref $input ) {
202
$orig_name = $input;
203
}
204
if ( $orig_name ) {
205
if ( $orig_name =~ /\\([^\\]+)$/ ) {
206
$orig_name = $1;
207
} elsif ( $orig_name =~ /\/([^\/]+)$/ ) {
208
$orig_name = $1;
209
}
210
$filename =~ s/\/([^\/]+)$//;
211
my $fname = $1;
212
$filename .= '/'.($orig_name || $fname);
213
$filename =~ s/\.([^\.]+)$//;
214
}
215
}
196
216
my $filename_tmp = $state->{'tmp_dir'}.'/'.join('_', split('/', $filename));
197
217
198
218
my $fh = get_fh($input);
…
…
202
222
my $size = 1073741824;
203
223
if ( not ref $input ) {
204
224
$ext = $input =~ /(jpe?g|gif|png)$/i ? lc $1 : 'bin';
205
if ( scheme($input) eq 'file' ) {
206
$size = (stat $fh)[7];
207
}
208
225
} elsif ( ref $input eq 'Apache::Upload' ) {
209
226
$ext = $input->filename() =~ /(jpe?g|gif|png)$/i ? lc $1 : 'bin';
210
$size = (stat $fh)[7];
211
227
} elsif ( $opts{filename} ) {
212
228
$ext = $opts{filename} =~ /(jpe?g|gif|png)$/i ? lc $1 : 'bin';
213
229
}
214
230
if ( ref $fh eq 'IO::Scalar' ) {
215
231
$size = length("$fh");
232
} else {
233
$size = (stat $fh)[7];
216
234
}
235
warn "Size calculated: $size\n" if $DEBUG;
217
236
$ext ||= 'bin';
218
237
219
238
my $fh_tmp = IO::File->new('>'.$filename_tmp.'.'.$ext) || return;
220
239
my $buffer;
240
my $read_count = 0;
241
while ( my $bytes_read = sysread( $fh, $buffer, 4096 ) ) {
242
$read_count += $bytes_read;
243
syswrite $fh_tmp, $buffer, $bytes_read;
244
}
245
$size = $read_count;
221
246
222
$size = sysread $fh, $buffer, $size;
223
syswrite $fh_tmp, $buffer, $size;
224
225
247
undef $fh_tmp;
226
248
undef $buffer;
249
undef $fh;
227
250
228
251
my $image_info = image_info($filename_tmp.'.'.$ext);
229
252
if ( !(ref $image_info && $image_info->{width} && $image_info->{height}) || (ref $image_info && $image_info->{error}) ) {
230
unlink $filename_tmp.'.'.$ext;
253
warn "$filename_tmp.$ext has error: ".$image_info->{error}."\n";
254
# unlink $filename_tmp.'.'.$ext;
231
255
return undef;
232
256
}
257
warn "Got image info\n" if $DEBUG;
233
258
if ( $image_info->{file_ext} ne $ext ) {
234
259
rename $filename_tmp.'.'.$ext, $filename_tmp.'.'.$image_info->{file_ext};
235
260
$ext = $image_info->{file_ext};
…
…
242
267
}
243
268
my $transformed;
244
269
if ( exists $prop->{transform} && ref $prop->{transform} eq 'ARRAY' && scalar @{$prop->{transform}} == 2 && $prop->{transform}[0] =~ /(crop|resize|shrink)/ ) {
270
warn "Need transform\n" if $DEBUG;
245
271
my $c_line;
246
272
if ( $prop->{transform}[0] eq 'resize' ) {
247
273
$c_line = $state->{'convert_binary'}.' -adaptive-resize \''.$prop->{transform}[1].'>\' -quality 100 '.$filename_tmp.'.'.$ext.' '.$filename_tmp.'.transformed.'.$ext;
…
…
276
302
}
277
303
my $result = `$c_line`;
278
304
$transformed = 1;
305
warn "Transformed\n" if $DEBUG;
279
306
unlink $filename_tmp.'.shaved.'.$ext if -e $filename_tmp.'.shaved.'.$ext;
307
$size = -s $filename_tmp.'.transformed.'.$ext;
280
308
}
281
309
282
310
if ( exists $opts{watermark} && $opts{watermark} ) {
311
warn "Need watermark\n" if $DEBUG;
283
312
my $gravity = delete $opts{gravity} || 'Center';
284
313
my $source = $transformed ? $filename_tmp.'.transformed.'.$ext : $filename_tmp.'.'.$ext;
285
314
my $target = $filename_tmp.'.transformed.'.$ext;
286
315
my $offset = delete $opts{offset} || '+0+0';
287
316
my $c_line = $state->{'composite_binary'}." -geometry $offset -gravity $gravity -quality 99 $opts{watermark} $source $target";
288
warn "Watermark: $c_line\n" if $DEBUG;
317
warn "Watermark: $c_line\n" if $DEBUG;
289
318
my $result = `$c_line`;
290
319
$transformed = 1;
320
warn "Watermarked\n" if $DEBUG;
291
321
}
292
322
293
323
my $IMAGE;
294
324
my $stored = $transformed ? store($filename.'.'.$ext, $filename_tmp.'.transformed.'.$ext) : store($filename.'.'.$ext, $filename_tmp.'.'.$ext);
295
325
if ( $stored ) {
326
warn "Stored\n" if $DEBUG;
296
327
$IMAGE = {};
297
328
# hashref slice assigning - жжесть
298
329
if ( $transformed && -e $filename_tmp.'.transformed.'.$ext ) {
299
330
my ($tw, $th) = Image::Size::imgsize($filename_tmp.'.transformed.'.$ext);
300
331
my ($w, $h) = Image::Size::imgsize($filename_tmp.'.'.$ext);
301
@{$IMAGE}{'filename', 't_width', 't_height', 'width', 'height'} = (
302
$filename.'.'.$ext, $tw, $th, $w, $h
332
@{$IMAGE}{'filename', 't_width', 't_height', 'width', 'height', 'size'} = (
333
$filename.'.'.$ext, $tw, $th, $w, $h, $size
303
334
);
304
335
unlink $filename_tmp.'.transformed.'.$ext;
305
336
} else {
306
@{$IMAGE}{'filename', 'width', 'height'} = (
337
@{$IMAGE}{'filename', 'size', 'width', 'height'} = (
307
338
$filename.'.'.$ext,
339
$size,
308
340
Image::Size::imgsize($filename_tmp.'.'.$ext),
309
341
);
310
342
}
311
343
344
warn "Thumbnail generator (preview)\n" if $DEBUG;
312
345
foreach my $suffix (@preview) {
313
346
my $c_line = $state->{'convert_binary'}.' -resize \''.$suffix.'>\' -quality 90 '.$filename_tmp.'.'.$ext.' '.$filename_tmp.'.'.$suffix.'.'.$ext;
314
347
my $result = `$c_line`;
…
…
317
350
warn 'Contenido Error: При вызове "'.$c_line.'" произошла ошибка "'.$result.'" ('.$@.")\n";
318
351
return undef;
319
352
}
320
@{$IMAGE->{'mini'}{$suffix}}{'filename', 'width', 'height'} = (
353
@{$IMAGE->{'mini'}{$suffix}}{'filename', 'size', 'width', 'height'} = (
321
354
$filename.'.'.$suffix.'.'.$ext,
355
-s $filename_tmp.'.'.$suffix.'.'.$ext,
322
356
Image::Size::imgsize($filename_tmp.'.'.$suffix.'.'.$ext),
323
357
);
324
358
%{$IMAGE->{'resize'}{$suffix}} = %{$IMAGE->{'mini'}{$suffix}};
…
…
331
365
}
332
366
333
367
########## CROPS
368
warn "Thumbnail generator (crop)\n" if $DEBUG;
334
369
foreach my $suffix (@crops) {
335
370
336
371
my $shave_string;
…
…
363
398
warn 'Contenido Error: При вызове "'.$c_line.'" произошла ошибка "'.$result.'" ('.$@.")\n";
364
399
return undef;
365
400
}
366
@{$IMAGE->{'mini'}{$suffix}}{'filename', 'width', 'height'} = (
401
@{$IMAGE->{'mini'}{$suffix}}{'filename', 'size', 'width', 'height'} = (
367
402
$filename.'.'.$suffix.'.'.$ext,
403
-s $filename_tmp.'.'.$suffix.'.'.$ext,
368
404
Image::Size::imgsize($filename_tmp.'.'.$suffix.'.'.$ext),
369
405
);
370
406
%{$IMAGE->{'crop'}{$suffix}} = %{$IMAGE->{'mini'}{$suffix}};
…
…
381
417
382
418
383
419
########## SHRINKS
420
warn "Thumbnail generator (shrink)\n" if $DEBUG;
384
421
foreach my $suffix (@shrinks) {
385
422
386
423
my $c_line = $state->{'convert_binary'}.' -geometry \''.$suffix.'!\' -quality 90 '.$filename_tmp.'.'.$ext.' '.$filename_tmp.'.'.$suffix.'.'.$ext;
…
…
390
427
warn 'Contenido Error: При вызове "'.$c_line.'" произошла ошибка "'.$result.'" ('.$@.")\n";
391
428
return undef;
392
429
}
393
@{$IMAGE->{'mini'}{$suffix}}{'filename', 'width', 'height'} = (
430
@{$IMAGE->{'mini'}{$suffix}}{'filename', 'size', 'width', 'height'} = (
394
431
$filename.'.'.$suffix.'.'.$ext,
432
-s $filename_tmp.'.'.$suffix.'.'.$ext,
395
433
Image::Size::imgsize($filename_tmp.'.'.$suffix.'.'.$ext),
396
434
);
397
435
%{$IMAGE->{'shrink'}{$suffix}} = %{$IMAGE->{'mini'}{$suffix}};
…
…
410
448
$IMAGE->{height} = delete $IMAGE->{t_height} if exists $IMAGE->{t_height};
411
449
}
412
450
451
warn "That's all: ".Dumper($IMAGE) if $DEBUG;
413
452
return $IMAGE;
414
453
}
415
454
…
…
434
473
my $input = shift;
435
474
my (%opts) = @_;
436
475
my $object = delete $opts{object} || return;
437
my $attr = delete $opts{attr} || return;
476
my $attr = delete $opts{attr};
438
477
439
my ($prop) = grep { $_->{attr} eq $attr } $object->structure;
478
my ($prop) = exists $opts{prop} && ref $opts{prop} ? ($opts{prop}) : $attr ? grep { $_->{attr} eq $attr } $object->structure : (undef);
440
479
return unless ref $prop;
441
480
442
481
my $filename = '/binary/'.$object->get_file_name() || return;
…
…
482
521
my $size = 1073741824;
483
522
if ( not ref $input ) {
484
523
$ext = $input =~ /\.([^\.]+)$/ ? lc($1) : 'bin';
485
if ( scheme($input) eq 'file' ) {
486
$size = (stat $fh)[7];
487
}
488
524
} elsif ( ref $input eq 'Apache::Upload' ) {
489
525
$ext = $input->filename() =~ /\.([^\.]+)$/ ? lc($1) : 'bin';
490
526
$size = (stat $fh)[7];
…
…
493
529
}
494
530
if ( ref $fh eq 'IO::Scalar' ) {
495
531
$size = length("$fh");
532
} else {
533
$size = (stat $fh)[7];
496
534
}
497
535
$ext ||= 'bin';
498
536
499
537
my $fh_tmp = IO::File->new('>'.$filename_tmp.'.'.$ext) || return;
500
538
my $buffer;
539
my $read_count = 0;
540
while ( my $bytes_read = sysread( $fh, $buffer, 4096 ) ) {
541
$read_count += $bytes_read;
542
syswrite $fh_tmp, $buffer, $bytes_read;
543
}
544
$size = $read_count;
501
545
502
$size = sysread $fh, $buffer, $size;
503
syswrite $fh_tmp, $buffer, $size;
504
505
546
undef $fh_tmp;
506
547
undef $buffer;
548
undef $fh;
507
549
508
550
my $BINARY;
509
551
if ( store($filename.'.'.$ext, $filename_tmp.'.'.$ext) ) {
utf8/core/lib/Contenido/File/Scheme/HTTP.pm
12
12
use LWP::UserAgent;
13
13
use File::Temp;
14
14
15
my %LWP_ARGS = (timeout => 10);
15
my %LWP_ARGS = (timeout => 180);
16
16
17
17
sub fetch {
18
18
my $path = shift || return;
…
…
23
23
SUFFIX => '.dat'
24
24
);
25
25
26
warn "HTTP fetch start\n" if $DEBUG;
26
27
my $ua = LWP::UserAgent->new(%LWP_ARGS);
27
28
28
29
my $res = $ua->get(
29
30
$path,
30
':read_size_hint' => 10 * 1024,
31
':read_size_hint' => 4 * 1024,
31
32
':content_cb' => sub {
32
33
$fh->write(shift());
33
34
},
…
…
35
36
36
37
seek $fh, 0, 0;
37
38
39
warn "HTTP fetch end\n" if $DEBUG;
38
40
return $res->is_success() ? $fh : undef;
39
41
}
40
42
…
…
120
122
121
123
sub get_fh {
122
124
my $path = shift;
123
my $fh;
124
125
125
return unless Contenido::File::scheme($path) eq "http";
126
126
127
my $fh = File::Temp->new(
128
TEMPLATE => 'tempXXXXX',
129
DIR => $keeper->state()->{tmp_dir},
130
SUFFIX => '.dat'
131
);
132
133
warn "HTTP get_fh start\n" if $DEBUG;
127
134
my $ua = LWP::UserAgent->new(%LWP_ARGS);
135
my $response = $ua->get(
136
$path,
137
':read_size_hint' => 4 * 1024,
138
':content_cb' => sub {
139
$fh->write(shift());
140
},
141
);
128
142
129
my $response = $ua->get($path);
130
131
if ($response->is_success()) {
132
$fh = IO::Scalar->new(\($response->content()));
133
} else {
134
warn $response->status_line();
135
}
136
137
return $fh;
143
warn "HTTP get_fh end\n" if $DEBUG;
144
if ($response->is_success()) {
145
seek $fh, 0, 0;
146
} else {
147
warn $response->status_line();
148
undef $fh;
149
}
150
return $fh;
138
151
}
139
152
140
153
1;
Небольшая справка по веткам
cnddist – контейнер, в котором хранятся все дистрибутивы всех библиотек и программных пакетов, которые использовались при построении различных версий Contenido. Если какой-то библиотеки в данном хранилище нет, инсталлятор сделает попытку "подтянуть" ее с веба (например, с CPAN). Если библиотека слишком старая, есть очень большая вероятность, что ее там уже нет. Поэтому мы храним весь хлам от всех сборок. Если какой-то дистрибутив вдруг отсутствует в cnddist - напишите нам, мы положим его туда.
koi8 – отмирающая ветка, чей код, выдача и все внутренние библиотеки заточены на кодировку KOI8-R. Вносятся только те дополнения, которые касаются внешнего вида и функционала админки, баги ядра, обязательные обновления портов и мелочи, которые легко скопипастить. В дальнейшем планируется полная остановка поддержки по данной ветке.
utf8 – актуальная ветка, заточенная под UTF-8.
Внутри каждой ветки: core – исходники ядра; install – скрипт установки инсталляции; plugins – плагины; samples – "готовые к употреблению" проекты, которые можно поставить, запустить и посмотреть, как они работают.