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;