#!/opt/local/bin/perl -w # Copyright © 2016-2018 Jamie Zawinski # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation. No representations are made about the suitability of this # software for any purpose. It is provided "as is" without express or # implied warranty. # # All-purpose image and video resizer. See --help for usage. # # - Can resize images and videos to fit within max/min sizes and aspect ratios; # - Can truncate videos to a maximum duration; # - Can recode videos until the file is below a maximum size; # - Can extract thumbnail images from videos; # - Can convert anim-GIFs to MP4s; # - Can convert HLS (HTTP Live Streaming) M3U and M3U8 video to MP4; # - Can download/convert Youtube and Vimeo URLs; # - Can strip EXIF and location data; # - Can add word-wrapped caption text to the bottom of images or videos; # - De-rotates EXIF-rotated images; # - Only re-writes files if they would have been changed. # # Requires Image::Magick if images are used and ffmpeg if videos are used. # Requires "youtubedown" if source URLs are Youtube/Vimeo. # # Created: 25-Jun-2016. require 5; use diagnostics; use strict; use POSIX; use IPC::Open3; use LWP::UserAgent; BEGIN { eval 'use Image::Magick;' } # Optional my $progname = $0; $progname =~ s@.*/@@g; my ($version) = ('$Revision: 1.52 $' =~ m/\s(\d[.\d]+)\s/s); my $verbose = 1; my $debug_p = 0; my $strip_p = 0; my $min_image_size = undef; my $max_image_size = undef; my $min_video_size = undef; my $max_video_size = undef; my $min_image_aspect = undef; my $max_image_aspect = undef; my $min_video_aspect = undef; my $max_video_aspect = undef; my $min_video_length = undef; my $max_video_length = undef; my $max_video_bytes = undef; my $drop_frames = undef; my $crop_image_p = 0; my $crop_video_p = 0; my $jpeg_quality = 80; my $background_color = 'white'; my $caption_text = undef; # Default fonts that 'convert' finds are often ASCII-only or otherwise sucky. my $caption_font = '/var/www/dnalounge/gallery/snaps/HelveticaNeue-Bold.ttf'; # Anything placed on this list gets unconditionally deleted when this # script exits, even if abnormally. # my @rm_f = (); END { my $exit = $?; unlink @rm_f if (@rm_f); $? = $exit; # Don't clobber this script's exit code. } sub signal_cleanup($) { my ($s) = @_; print STDERR "$progname: SIG$s\n" if ($verbose > 1); exit (1); # This causes END{} to run. } $SIG{HUP} = \&signal_cleanup; $SIG{INT} = \&signal_cleanup; $SIG{QUIT} = \&signal_cleanup; $SIG{ABRT} = \&signal_cleanup; $SIG{KILL} = \&signal_cleanup; $SIG{TERM} = \&signal_cleanup; sub ext_to_ct($) { my ($file) = @_; return undef unless defined($file); $file =~ s@^.*/@@s; $file =~ s@^.*\.@@s; return ($file =~ m/^p?jpe?g$/si ? 'image/jpeg' : $file =~ m/^gif$/si ? 'image/gif' : $file =~ m/^png$/si ? 'image/png' : $file =~ m/^mp4$/si ? 'video/mp4' : $file =~ m/^webm$/si ? 'video/webm' : $file =~ m/^m4v$/si ? 'video/mp4' : $file =~ m/^mov$/si ? 'video/quicktime' : $file =~ m/^ts$/si ? 'video/mp2t' : $file =~ m/^mkv$/si ? 'video/x-matroska' : $file =~ m/^wmv$/si ? 'video/x-ms-wmv' : $file =~ m/^m3u8?$/si ? 'application/x-mpegurl' : $file =~ m/^([^.\/]+)$/si ? "image/$1" : 'application/octet-stream'); } sub ct_to_ext($) { my ($ct) = @_; return undef unless defined($ct); $ct = lc($ct); $ct =~ s/[;\s].*$//s; return ($ct =~ m@^image/jpeg@si ? 'jpg' : $ct =~ m@^video/m4v@si ? 'mp4' : $ct =~ m@^video/quicktime@si ? 'mov' : $ct =~ m@^video/mp2t@si ? 'ts' : $ct =~ m@^video/x-matroska@si ? 'mkv' : $ct =~ m@^video/wmv@si ? 'wmv' : $ct =~ m@^video/x-ms-wmv@si ? 'wmv' : $ct =~ m@^video/webm@si ? 'webm' : $ct =~ m@^(image|video)/([^/\s]+)@si ? lc($2) : $ct =~ m@^(application|video)/(x-)?mpegurl@si ? 'm3u8' : 'unknown'); } sub size_str($) { my ($size) = @_; if (!defined($size)) { return '0 bytes'; } elsif ($size > 2*1024*1024*1024) { return sprintf("%.1f GB", $size / (1024*1024*1024)); } elsif ($size > 1024*1024) { return sprintf("%.1f MB", $size / (1024*1024)); } elsif ($size > 1024) { return sprintf("%d KB", $size / 1024); } else { return "$size bytes"; } } sub dur_str($) { my ($dur) = @_; my $h = ($dur / 60 / 60) % 60; my $m = ($dur / 60) % 60; my $s = ($dur % 60); my $ss = $dur - int($dur); $dur = ($ss ? sprintf ("%04.1f", $s + $ss) : sprintf("%02d", $s)); $dur = sprintf("%d:%02d:%s", $h, $m, $dur); return $dur; } sub safe_system(@) { my (@cmd) = @_; system @cmd; my $exit_value = $? >> 8; my $signal_num = $? & 127; my $dumped_core = $? & 128; error ("$cmd[0]: core dumped!") if ($dumped_core); error ("$cmd[0]: signal $signal_num!") if ($signal_num); return $exit_value; } # Returns true if the two files differ (by running "cmp") # sub cmp_files($$) { my ($file1, $file2) = @_; return 1 unless (-f $file1); my @cmd = ("cmp", "-s", "$file1", "$file2"); print STDERR "$progname: executing \"" . join(" ", @cmd) . "\"\n" if ($verbose > 3); return safe_system (@cmd); } # returns the full path of the named program, or undef. # sub which($) { my ($prog) = @_; return $prog if ($prog =~ m@^/@s && -x $prog); foreach (split (/:/, $ENV{PATH})) { return $prog if (-x "$_/$prog"); } return undef; } # If the two files differ: # mv file2 file1 # else # rm file2 # sub rename_or_delete($$;$$) { my ($file, $file_tmp, $suffix_msg, $small_p) = @_; my $size = ((stat($file_tmp))[7]) || 0; my $min = ($file_tmp =~ m/\.mp4$/s ? 10240 : 500); $min = 1024 if ($small_p); # GIF-to-MP4 might be tiny if ($size < $min) { error ("$file_tmp: too small: $size bytes"); } elsif (! cmp_files ($file, $file_tmp)) { print STDERR "$progname: $file unchanged" . ($suffix_msg ? " $suffix_msg" : "") . "\n" if ($verbose > 1); } elsif ($debug_p) { print STDERR "$progname: not writing $file" . ($suffix_msg ? " $suffix_msg" : "") . "\n"; } else { rename ("$file_tmp", "$file") || error ("mv $file_tmp $file: $!"); print STDERR "$progname: wrote $file" . ($suffix_msg ? " $suffix_msg" : "") . "\n" if ($verbose); } } # expands the first URL relative to the second. # sub expand_url($$) { my ($url, $base) = @_; $url =~ s/^\s+//gs; # lose whitespace at front and back $url =~ s/\s+$//gs; my ($proto) = ($base =~ m@^([^:/]+):@); # Protocol-relative $url =~ s@^:?//@$proto://@gs; if ($url =~ m@^[a-z]+:|^//@si) { print STDERR "$progname: absolute URL: $url\n" if ($verbose > 3); } else { $base =~ s@(\#.*)$@@; # strip anchors $base =~ s@(\?.*)$@@; # strip arguments $base =~ s@/[^/]*$@/@; # take off trailing file component my $tail = ''; if ($url =~ s@(\#.*)$@@) { $tail = $1; } # save anchors if ($url =~ s@(\?.*)$@@) { $tail = "$1$tail"; } # save arguments my $base2 = $base; $base2 =~ s@^(([a-z]+:)?//[^/]+)/.*@$1@si # url is an absolute path if ($url =~ m@^/@); my $ourl = $url; $url = $base2 . $url; $url =~ s@/\./@/@g; # expand "." 1 while ($url =~ s@/[^/]+/\.\./@/@s); # expand ".." $url .= $tail; # put anchors/args back print STDERR "$progname: relative URL: $ourl --> $url\n" if ($verbose > 3); } return $url; } sub constrain_aspect($$$$$) { my ($fw, $fh, $min_aspect, $max_aspect, $crop_p) = @_; my ($w2, $h2) = ($fw, $fh); my $r = $fw / $fh; if ($crop_p) { if (defined($min_aspect) && $r < $min_aspect) { # Keep width, truncate height $w2 = $fw; $h2 = int ($fw / $min_aspect); } elsif (defined($max_aspect) && $r > $max_aspect) { # Keep height, truncate width $w2 = int ($fh * $max_aspect); $h2 = $fh; } } else { if (defined($min_aspect) && $r < $min_aspect) { # Keep height, expand width $w2 = int ($fh * $min_aspect); $h2 = $fh; } elsif (defined($max_aspect) && $r > $max_aspect) { # Keep width, expand height $w2 = $fw; $h2 = int ($fw / $max_aspect); } } return ($w2, $h2); } sub constrain_size($$$$) { my ($fw, $fh, $min_size, $max_size) = @_; my ($w2, $h2) = ($fw, $fh); my ($max_w, $max_h, $min_w, $min_h); ($max_w, $max_h) = ($max_size =~ m/^(\d+)x(\d+)$/s) if defined($max_size); ($min_w, $min_h) = ($min_size =~ m/^(\d+)x(\d+)$/s) if defined($min_size); if ($min_w && $fw < $min_w) { $w2 = $min_w; $h2 = int($min_w * $fh / $fw); ($fw, $fh) = ($w2, $h2); } if ($max_w && $fw > $max_w) { $w2 = $max_w; $h2 = int($max_w * $fh / $fw); ($fw, $fh) = ($w2, $h2); } if ($min_h && $fh < $min_h) { $h2 = $min_h; $w2 = int($min_h * $fw / $fh); ($fw, $fh) = ($w2, $h2); } if ($max_h && $fh > $max_h) { $h2 = $max_h; $w2 = int($max_h * $fw / $fh); ($fw, $fh) = ($w2, $h2); } $w2-- if ($w2 % 10 == 1); # Let's prefer 1500x1000 over 1500x1001. $h2-- if ($h2 % 10 == 1); $w2++ if ($w2 & 1); # Let's prefer 1920x1280 over 1920x1279. $h2++ if ($h2 & 1); return ($w2, $h2); } sub validate_size($$$$$$$) { my ($file, $w, $h, $min_size, $max_size, $min_a, $max_a) = @_; my ($max_w, $max_h, $min_w, $min_h); ($max_w, $max_h) = ($max_size =~ m/^(\d+)x(\d+)$/s) if defined($max_size); ($min_w, $min_h) = ($min_size =~ m/^(\d+)x(\d+)$/s) if defined($min_size); my $s = "INTERNAL ERROR: $file: ${w}x$h"; error ("$s: smaller than min width $min_size") if ($min_w && $w < $min_w); error ("$s: smaller than min height $min_size") if ($min_h && $h < $min_h); error ("$s: larger than max width $max_size") if ($max_w && $w > $max_w); error ("$s: larger than max height $max_size") if ($max_h && $h > $max_h); my $a = $w / $h; # Only check 2 decimal places. foreach my $s ($a, $min_a, $max_a) { $s = sprintf("%.02f", $s) if $s; } $s .= ": $a"; error ("$s: smaller than min aspect $min_a") if ($min_a && $a < $min_a); error ("$s: larger than max aspect $max_a") if ($max_a && $a > $max_a); } # Reduce width and height until the total number of pixels has been reduced # by at least the ratio. # sub reduce_resolution($$$) { my ($w, $h, $ratio) = @_; return ($w, $h) if (!$ratio || $ratio >= 1.0); $ratio = 0.9 if ($ratio > 0.9); error ("inexplicable ratio $ratio (${w}x${h})") if ($ratio < 0.1); my $aspect = $w / $h; my $target = $w * $h * $ratio; my $step = 16; while ($w > $step && $h > $step && $w * $h > $target) { $w -= $step; $h = int($w / $aspect); $w++ if ($w & 1); # h264 requires even-numbered dimensions. $h++ if ($h & 1); } return ($w, $h); } # Knock out 1 frame of every N, and increase the delay of the remaining # frames appropriately. # sub drop_animgif_frames($$$) { my ($name, $img, $drop_frames) = @_; my ($drop, $span) = ($drop_frames =~ m@^(\d+)/(\d+)$@s); error ("unparsable drop: $drop_frames") unless $drop; my $dropped = 0; my $total = 0; for (my $i = 0; $img->[$i]; $i += $span) { my $deleted_delay = 0; for (my $j = 0; $j < $span; $j++) { my $k = $i + $span - $j - 1; my $img2 = $img->[$k]; next unless defined($img2); $total++; my $d = $img2->Get('delay'); if ($j < $drop) { # deleting $deleted_delay += $d; undef $img->[$k]; $dropped++; } else { # keeping # This isn't quite right because these are integers... # So we end up with 7 + 2.333 = 9. $img2->Set ('delay' => $d + ($deleted_delay / ($span - $drop))); } } } # Some of the frames of $img will be undef now. Pack toward the front. # my $j = 0; my $n = @$img; for (my $i = 0; $i < $n; $i++) { my $img2 = $img->[$i]; $img->[$j++] = $img2 if defined($img2); } for (my $i = $j; $i < $n; $i++) { $img->[$i] = undef; } print STDERR "$progname: $name: dropped $dropped of $total frames" . " (" . int(100 * $dropped / $total) . "%)\n" if ($verbose); } # Generates a random file name. # $base contains the directory to create the file in, if defined. # sub resize_tmpfile(;$$$) { my ($base, $prefix, $suffix) = @_; # If we have an output file, $TMPDIR can mean "Invalid cross-device link" my $tmp = $ENV{TMPDIR} || '/tmp'; my ($dir) = (($base || '') =~ m@^(.*)/[^/]*$@s); $dir = '.' unless $dir; $dir = $tmp if ($dir =~ m/^https?:/s); my $file = sprintf ("%s/.%s%08x%s", $dir, ($prefix || ''), rand(0xFFFFFFFF), ($suffix || '')); $file =~ s@//+@/@gs; $file =~ s@^\./@@gs; return $file; } # PerlMagick can't do caption so we need to use the command line version. # sub make_caption_image($$$) { my ($w, $h, $base) = @_; my $cap = resize_tmpfile ($base, 'cap-', '.png'); push @rm_f, $cap; my $ps = $h / 25; # Scale text to ~25 lines per screen. my $shadow = $ps / 15; my $fg = '#66FF66'; my $bg = 'transparent'; my @bd = ($ps * 0.5, $ps * 3); # Left/right, bottom padding $w -= $bd[0]*2; # Sometimes 2.2 is good, sometimes $h -= $bd[1]; # it needs to be 3 and I don't know # why. $h /= 3; # Truncate text to 1/3 of height. utf8::decode ($caption_text); # Parse multi-byte UTF-8 into wide chars. $caption_font = undef unless -f $caption_font; my @cmd = ('convert'); push @cmd, ('-font', $caption_font) if $caption_font; push @cmd, ( '-size', "${w}x$h", '-gravity', 'northwest', '-background', 'transparent', '-fill', $fg, '-pointsize', $ps, '-interline-spacing', $ps * -0.2, 'caption:' . $caption_text, # Dropshadow 1 '(', '+clone', '-background', $bg, '-shadow', '100x1+' . $shadow . '+' . $shadow, ')', '+swap', '-background', $bg, # Dropshadow 2 '(', '+clone', '-background', $bg, '-shadow', '100x3+0+0', ')', '+swap', '-background', 'transparent', '-layers', 'merge', '+repage', '+trim', '-bordercolor', 'transparent', '-border', $bd[0] . 'x' . $bd[1], $cap); print STDERR "$progname: size: exec: " . join(" ", @cmd) . "\n" if ($verbose > 2); safe_system (@cmd); return $cap; } # Constrain the size and aspect ratio of the image. # Rotate by EXIF. # Strip if necessary. # Write the output file only if it would have changed. # sub constrain_image($$) { my ($in, $out) = @_; my $name = $in; $name =~ s@^.*/@@s; my $ct = ext_to_ct ($in); my $ct2 = ext_to_ct ($out); my $img; eval { $img = Image::Magick->new; }; if (! $img) { error ("$name: can't convert $ct to $ct2: Image::Magick not installed") if ($ct ne $ct2 && !$debug_p); print STDERR "$progname: $name: not checking aspect ratio;" . " Image::Magick not installed\n" if ($verbose || $debug_p); return; } $img->Read ($in); my ($fw, $fh) = $img->Get ('width', 'height'); my ($ofw, $ofh) = ($fw, $fh); error ("$name: Magick: unparsable image or video: $in") unless (($fw || 0) > 0 && ($fh || 0) > 0); print STDERR "$progname: read $in (${fw}x${fh})\n" if ($verbose > 1); my ($orient) = $img->Get('exif:orientation'); $orient = 1 unless defined($orient); # Top-Left my ($max_w, $max_h, $min_w, $min_h); ($max_w, $max_h) = ($max_image_size =~ m/^(\d+)x(\d+)$/s) if defined($max_image_size); ($min_w, $min_h) = ($min_image_size =~ m/^(\d+)x(\d+)$/s) if defined($min_image_size); # Shortcut exit if no changes needed. # Without this, we write and compare a file when we don't need to. # Note: --strip triggers a file-change every time. Sigh. # $drop_frames = undef unless ($ct eq 'image/gif'); if ($in eq $out && $ct eq $ct2 && (!defined($min_image_aspect) || $fw / $fh >= $min_image_aspect) && (!defined($max_image_aspect) || $fw / $fh <= $max_image_aspect) && (!$min_w || $fw >= $min_w) && (!$min_h || $fh >= $min_h) && (!$max_w || $fw <= $max_w) && (!$max_h || $fh <= $max_h) && !$strip_p && !$drop_frames && !$caption_text && $orient == 1) { my $osize = (stat($in))[7]; my $s = sprintf("%dx%d, %s", $ofw, $ofh, size_str ($osize)); print STDERR "$progname: $out: unchanged ($s)\n" if ($verbose); validate_size ($out, $fw, $fh, $min_image_size, $max_image_size, $min_image_aspect, $max_image_aspect); return; } if ($ct eq 'image/gif' && defined ($drop_frames)) { $img = $img->Coalesce(); # Flatten delta frames drop_animgif_frames ($name, $img, $drop_frames); } my $status; if ($orient != 1) { print STDERR "$progname: $name: auto-rotating\n" if ($verbose > 1); $status = $img->AutoOrient(); error ("$name: ImageMagick: $status") if $status; ($fw, $fh) = $img->Get ('width', 'height'); # might have transposed. } if ($strip_p) { print STDERR "$progname: $name: stripping\n" if ($verbose > 1); $status = $img->Strip(); error ("$name: ImageMagick: $status") if $status; } if ($ct =~ m/JPEG/si) { # Default quality for JPEG is 92 if original quality can't be determined. $status = $img->Set (quality => $jpeg_quality); error ("$name: ImageMagick: $status") if $status; $status = $img->Set (interlace => 'plane'); # Progressive JPEGs error ("$name: ImageMagick: $status") if $status; } elsif ($ct =~ m/PNG/si) { # I can't tell what setting to use to mean "best compression, slowest". # http://www.imagemagick.org/script/command-line-options.php#quality # But the default is 75. $status = $img->Set (quality => 95); error ("$name: ImageMagick: $status") if $status; } # Set the output content type. $status = $img->Set (magick => ct_to_ext ($ct2)); error ("$name: ImageMagick: $status") if $status; my ($w2, $h2) = constrain_aspect ($fw, $fh, $min_image_aspect, $max_image_aspect, $crop_image_p); my $x = int (($fw - $w2) / 2); my $y = int (($fh - $h2) / 2); # When padding vertically, put it all on the bottom. # $y = 0 unless $crop_image_p; if ($x != 0 || $y != 0 || $fw != $w2 || $fh != $h2) { print STDERR "$progname: $name: " . ($crop_image_p ? "cropping" : "padding") . " ${fw}x${fh} (" . sprintf("%.2f", $fw / $fh) . ") to" . " ${w2}x${h2}+${x}+${y} (" . sprintf("%.2f", $w2 / $h2) . ")\n" if ($verbose > 1); if (! $crop_image_p) { $status = $img->Extent (x => $x, y => $y, width => $w2, height => $h2, background => $background_color ); error ("$name: ImageMagick: extent: $status") if $status; $x = 0; $y = 0; } $status = $img->Crop (x => $x, y => $y, width => $w2, height => $h2, gravity => 'Center', ); error ("$name: ImageMagick: crop: $status") if $status; $img = $img->Flatten() unless ($crop_image_p); ($fw, $fh) = $img->Get ('width', 'height'); } ($w2, $h2) = constrain_size ($fw, $fh, $min_image_size, $max_image_size); if ($fw != $w2 || $fh != $h2) { print STDERR "$progname: $name: scaling " . sprintf("%dx%d => %dx%d", $fw, $fh, $w2, $h2) . "\n" if ($verbose > 1); $status = $img->Scale (width => $w2, height => $h2); error ("$name: ImageMagick: scale: $status") if $status; ($fw, $fh) = ($w2, $h2); } if ($caption_text) { my $cap = Image::Magick->new; $cap->Read (make_caption_image ($fw, $fh, $out)); $status = $img->Composite ( gravity => 'South', compose => 'over', image => $cap ); error ("$name: ImageMagick: composite: $status") if $status; } validate_size ($out, $fw, $fh, $min_image_size, $max_image_size, $min_image_aspect, $max_image_aspect); my $out_tmp = sprintf ("%s.%08x", $out, rand(0xFFFFFFFF)); push @rm_f, $out_tmp; $status = $img->Write (filename => $out_tmp); error ("$name: ImageMagick: write: $status") if $status; my $osize = (stat($in))[7]; my $size = (stat($out_tmp))[7]; error ("failed resizing $in") unless $size; my $s = sprintf("%dx%d, %s", $ofw, $ofh, size_str ($osize)); $s .= sprintf(" => %dx%d", $fw, $fh) if ($ofw != $fw || $ofh != $fh || int($osize / 1024) != int($size / 1024)); $s .= ", " . size_str ($size); print STDERR "$progname: wrote $out_tmp ($s)\n" if ($verbose > 1); rename_or_delete ($out, $out_tmp, $s); } # Returns width, height, duration, audio_p of the video file. # sub video_size($$) { my ($name, $file) = @_; my @cmd = ('ffmpeg', '-hide_banner', '-v', '32', '-i', $file); print STDERR "$progname: size: exec: " . join(" ", @cmd) . "\n" if ($verbose > 2); my $result = ''; my ($inf, $outf, $errf); $errf = Symbol::gensym; my $pid = eval { open3 ($inf, $outf, $errf, @cmd) }; error ("unable to exec $cmd[0]: $!") unless $pid; close ($inf); close ($outf); my $errs = ''; while (<$errf>) { $errs .= $_; } waitpid ($pid, 0); close ($errf); print STDERR $errs if ($verbose > 3); my ($h, $m, $s, $ss) = ($errs =~ m/Duration: (\d\d):(\d\d):(\d\d).(\d\d),/s); error ("$name: no duration: $errs") unless defined($ss); my $dur = $h*60*60 + $m*60 + $s + $ss/100; my ($fw, $fh) = ($errs =~ m/Stream .* Video: .* (\d\d\d\d?)x(\d\d\d\d?)[, ]/m); error ("no size: $name:\n\n$errs") unless defined($fh); my $audio_p = ($errs =~ m/Stream .* Audio: /m); ($fw, $fh) = ($fh, $fw) if ($errs =~ m/ rotate *: *-?90\b/s); return ($fw, $fh, $dur, $audio_p); } # Constrain the size and aspect ratio of the image. # Write the output file only if it would have changed. # sub constrain_video($$) { my ($in, $out) = @_; my $name = $in; $name =~ s@^.*/@@s; my ($fw, $fh, $dur) = video_size ($name, $in); my ($ofw, $ofh) = ($fw, $fh); my $osize = (stat($in))[7]; my $size = $osize; my $loop = 1; # maybe loop the video to hit the min duration my $odur = $dur; while ($min_video_length && $dur < $min_video_length) { $loop++; $dur += $odur; } print STDERR "$progname: looping $loop times to reach min duration " . dur_str($min_video_length) . " -- " . dur_str($dur) . "\n" if ($loop > 1 && $verbose); my $retries = 0; while (1) { # We might retry to get the file size under the limit my ($w2, $h2) = constrain_aspect ($fw, $fh, $min_video_aspect, $max_video_aspect, $crop_video_p); $w2++ if ($w2 & 1); # h264 requires even-numbered dimensions. $h2++ if ($h2 & 1); my $x = int (($fw - $w2) / 2); my $y = int (($fh - $h2) / 2); my $filter = ''; if ($x != 0 || $y != 0) { if (! $crop_video_p) { $x = -$x; $y = -$y; } $filter = ($crop_video_p ? "crop" : "pad") . "=$w2:$h2:$x:$y"; } ($fw, $fh) = ($w2, $h2); ($w2, $h2) = constrain_size ($fw, $fh, $min_video_size, $max_video_size); # Constrain it again (padding) just in case a rounding error led to # the aspect being slightly off. This rounding error only happens # with tiny videos, I think. Like, 320x180. # # And Ugh, trying to constrain a 640x360 video to story (640x0 9:16 crop) # ends up 202x360 => 640x1140 => 641x1140 => 642x1140 => error. Sigh. # my ($w3, $h3) = constrain_aspect ($w2, $h2, $min_video_aspect, $max_video_aspect, 0); ($w2, $h2) = ($w3, $h3) unless ($w3 >= $w2-2 && $w3 <= $w2+2 && # No change if +/- 2px. $h3 >= $h2-2 && $h3 <= $h2+2); if ($max_video_bytes) { # If this is not the first time through the loop, reduce the resolution. if ($retries > 0) { my $r = $max_video_bytes / $size; $r *= 0.85; # File size doesn't scale linearly with pixels-per-frame... my $p = int (100 * (1-$r)); my ($ow, $oh) = ($w2, $h2); ($w2, $h2) = reduce_resolution ($w2, $h2, $r); print STDERR "$progname: file too large by " . size_str ($size - $max_video_bytes) . " ($p%); reducing ${ow}x${oh} to ${w2}x${h2}\n" if ($verbose); } } elsif ($retries && $loop == 1) { error ("internal error: looping with no max bytes\n"); } $w2++ if ($w2 & 1); # h264 requires even-numbered dimensions. $h2++ if ($h2 & 1); if ($fw != $w2 || $fh != $h2) { $filter .= ',' if $filter; $filter .= "scale=$w2:$h2"; } validate_size ($out, $w2, $h2, $min_video_size, $max_video_size, $min_video_aspect, $max_video_aspect); my ($iext) = ($in =~ m@\.([^/.]+)$@s); my ($oext) = ($out =~ m@\.([^/.]+)$@s); $iext = 'mp4' unless $iext; $oext = 'mp4' unless $oext; $iext = lc($iext); $oext = lc($oext); my $length_slack = 0.4; # God dammit, 60 sec Twit videos are 60.3. if (!$filter && !$caption_text && $loop == 1 && $iext eq $oext && (!$max_video_length || $dur - $length_slack <= $max_video_length)) { # If we weren't going to resize, scale or truncate the video, # but the file is still too large, then go directly to retry #1. if ($retries == 0 && $max_video_bytes && $size > $max_video_bytes) { $retries++; next; } my $s = sprintf("%dx%d, %s", $ofw, $ofh, size_str ($size)); $s .= ", " . dur_str($dur); print STDERR "$progname: $name: unchanged ($s)\n" if ($verbose); return; } my $d1 = dur_str ($dur); my $d2 = dur_str ($max_video_length) if ($max_video_length && $dur > $max_video_length); print STDERR "$progname: $name: " . ($crop_image_p ? "cropping" : "padding") . " ${ofw}x${ofh} (" . sprintf("%.2f", $ofw / $ofh) . ") to" . " ${w2}x${h2}+${x}+${y} (" . sprintf("%.2f", $w2 / $h2) . ")" . " $d1" . ($d2 ? " => $d2" : "") . "\n" if ($verbose > 1); my $base = resize_tmpfile ($out, 'resize-', ''); my $out_tmp = sprintf("%s.%s", $base, $oext); push @rm_f, $out_tmp; my @cmd = ('ffmpeg', '-hide_banner', '-v', '32'); if ($loop == 1) { push @cmd, ('-i', $in); # Single input file } else { my $list = "$base-list.txt"; # Generated list of N input files push @rm_f, $list; my $in2 = $in; $in2 =~ s@([^-_.a-z\d/])@\\$1@gsi; open (my $out, '>', $list) || error ("$list: $!"); for (my $i = 1; $i <= $loop; $i++) { print $out "file $in2\n"; } close $out; push @cmd, ('-f', 'concat', '-safe', '0', '-i', $list); } if ($caption_text) { my $cap = make_caption_image ($w2, $h2, $out); push @cmd, ('-i', $cap); $filter .= ',' if $filter; $filter .= 'overlay=(main_w-overlay_w)/2:main_h-overlay_h'; } push @cmd, ('-filter_complex', $filter) if ($filter); push @cmd, ('-t', $max_video_length) if ($max_video_length); # Total kludge for 'instagram-story' videos: # # If we're truncating a long video to a really short length, # and we're cropping it, then skip forward by N seconds, # so that we get to the good stuff instead of the intro. # if ($crop_video_p && $dur >= 90 && $max_video_length <= 30) { push @cmd, ('-ss', 30); } # Regardless of the $oext container format, we always do h.264 AAC. push @cmd, ('-c:v', 'libx264', # video codec '-profile:v', 'high', '-crf', '24', # h.264 quality (18 is high) '-pix_fmt', 'yuv420p', '-acodec', 'aac', # encode audio as AAC '-ab', '128k', # audio bitrate '-movflags', 'faststart', # Move index to front ); { # Check this before wasting time on ffmpeg. open (my $o2, '>', $out_tmp) || error ("$out_tmp: unwritable"); unlink $out_tmp; } push @cmd, $out_tmp; if ($verbose > 1) { my @c2 = @cmd; print STDERR "$progname: exec: " . join(' ', map { if (m![^-._,:a-z\d/@+=]!s) { s%([\'\!])%\\$1%gsi; $_ = "'$_'"; } $_; } @c2) . "\n"; } $dur = $max_video_length if ($max_video_length && $dur > $max_video_length); my ($inf, $outf, $errf); $errf = Symbol::gensym; my $pid = eval { open3 ($inf, $outf, $errf, @cmd) }; error ("unable to exec $cmd[0]: $!") unless $pid; close ($inf); close ($outf); my $errs = ''; while (<$errf>) { $errs .= $_; } waitpid ($pid, 0); close ($errf); print STDERR $errs if ($verbose > 2); $size = (stat($out_tmp))[7]; error ("failed resizing $in") unless $size; my $s = sprintf("%dx%d, %s", $ofw, $ofh, size_str ($osize)); $s .= sprintf(" => %dx%d", $w2, $h2) if ($ofw != $w2 || $ofh != $h2 || int($osize / 1024) != int($size / 1024)); $s .= ", " . size_str ($size); $s .= ", " . ($d2 || $d1); print STDERR "$progname: wrote $out_tmp ($s)\n" if ($verbose > 1); if (!$max_video_bytes || $size <= $max_video_bytes) { rename_or_delete ($out, $out_tmp, $s); last; } else { # Around the loop again, and retry for a smaller file size... unlink ($out_tmp); $retries++; ($fw, $fh) = ($w2, $h2); } } } # Convert an animated GIF to an MP4. # sub animgif_to_mp4($$) { my ($in, $out) = @_; my $name = $in; $name =~ s@^.*/@@s; my $gif_size = (stat($in))[7]; my $img; eval { $img = Image::Magick->new; }; error ("can't convert GIF to MP4: Image::Magick not installed") unless $img; $img->Read ($in); my ($fw, $fh) = $img->Get ('width', 'height'); error ("$name: unparsable") unless ($fw && $fh && $fw > 0 && $fh > 0); error ("$name: not animated") unless ($img->[1]); $img = $img->Coalesce(); # Flatten delta frames $img->Strip(); $img->Set ('background' => $background_color); $img->Set ('alpha' => 'remove'); drop_animgif_frames ($name, $img, $drop_frames) if defined ($drop_frames); # Sigh, this tends to fail the aspect check by +-0.01 because GIFs are small. $crop_video_p = 0; # Pad the image into the required aspect ratio, if necessary. { my ($w2, $h2) = constrain_aspect ($fw, $fh, $min_video_aspect, $max_video_aspect, $crop_video_p); $w2++ if ($w2 & 1); # h264 requires even-numbered dimensions. $h2++ if ($h2 & 1); if ($w2 != $fw || $h2 != $fh) { my ($ow, $oh) = ($fw, $fh); my $x = int (($w2 - $fw) / 2); my $y = int (($h2 - $fh) / 2); my $status = $img->Extent (geometry => "${w2}x${h2}-$x-$y", background => $background_color); error ("$name: ImageMagick: $status") if $status; ($fw, $fh) = $img->Get ('width', 'height'); print STDERR "$progname: $name: resized ${ow}x${oh} => ${fw}x${fh}\n" if ($verbose); ($fw, $fh) = ($w2, $h2); } } # Scale the image if necessary. # { my ($w2, $h2) = ($fw, $fh); my ($max_w, $max_h, $min_w, $min_h); ($max_w, $max_h) = ($max_image_size =~ m/^(\d+)x(\d+)$/s) if defined($max_image_size); ($min_w, $min_h) = ($min_image_size =~ m/^(\d+)x(\d+)$/s) if defined($min_image_size); if (($min_w && $fw < $min_w)) { $w2 = $min_w; $h2 = int($min_w * $fh / $fw); } if (($max_w && $fw > $max_w)) { $w2 = $max_w; $h2 = int($max_w * $fh / $fw); } if (($min_h && $fh < $min_h)) { $h2 = $min_h; $w2 = int($min_h * $fw / $fh); } if (($max_h && $fh > $max_h)) { $h2 = $max_h; $w2 = int($max_h * $fw / $fh); } if ($fw != $w2 || $fh != $h2) { print STDERR "$progname: $name: scaling " . sprintf("%dx%d => %dx%d", $fw, $fh, $w2, $h2) . "\n" if ($verbose > 1); my $status = $img->Scale (width => $w2, height => $h2); error ("$name: ImageMagick: scale: $status") if $status; ($fw, $fh) = ($w2, $h2); } } my $duration = 0; for (my $i = 0; $img->[$i]; $i++) { my $d = $img->[$i]->Get('delay') / 100; # If any frame has a zero delay, increase it. # This seems to be Safari's default timing for 0. if ($d <= 0.001) { $d = 1/15; $img->[$i]->Set ('delay' => $d * 100); } $duration += $d; } # Ignore the GIF's loop count (specific number, or infinite). # If you want the MP4 to actually include multiple iterations # of the animation, use --min-video-length SECS. # # my $loop = $img->Get ('loop'); my $loop = 1; # Add loop iterations to hit the minimum duration. # while ($min_video_length && $min_video_length > $duration * $loop) { $loop++; } $duration *= $loop; print STDERR "$progname: looping $loop times to reach min duration " . dur_str($min_video_length) . " (" . dur_str($duration) . ")\n" if ($loop > 1 && $verbose); # Duplicate the last frame,with delay 0. So we go from: # F1 delay1 F2 delay2 F3 delay3 # to: F1 delay1 F2 delay2 F3 delay3 F3 delay0 # Without this, the animation ends without the final delay after F3. # { my $last; # find the last one that isn't undef for (my $i = scalar(@$img)-1; $i >= 0; $i--) { $last = $img->[$i]; last if defined ($last); } $last = $last->Clone(); push @$img, $last; my $status = $last->Set('delay' => 0); error ("$name: ImageMagick: set final delay: $status") if $status; } my $type = 'png'; # ffmpeg can't handle GIFs as list-of-images input. my $base = resize_tmpfile ($out, 'resize-', ''); my $pattern = "$base-%04d.$type"; $base =~ s@//+@/@gs; my $out_tmp = sprintf("%s.mp4", $base); push @rm_f, $out_tmp; my @frames = (); my $framerate = 30; # Maybe should be lower? 15? my $quality = 24; # I'm guessing 18 is overkill for GIFs my $filter = ''; my $cap = undef; if ($caption_text) { $cap = Image::Magick->new; $cap->Read (make_caption_image ($fw, $fh, $out)); } my $n = 0; for (my $i = 0; $i < $loop; $i++) { for (my $j = 0; $img->[$j]; $j++) { # The delay of a frame is the time that should be inserted after it. # Test case: images/2018/tumblr_ofq11rr3ob1r6j7rho1_1280.gif my $img2 = $img->[$j]; # my $img3 = ($j > 0 ? $img->[$j-1] : $img->[0]); # my $d = $img3 ? $img3->Get('delay') : 0; my $d = $img2->Get('delay'); $d = int($d / 100 * $framerate); # Anim GIFs can have a different delay per frame. # # Originally I tried to do this using the incomprehensible "zoompan" # filter syntax, to change the per-frame duration, but that screws up # the overall duration of the animation! It seemed to be truncating # the video to what the duration would have been with zero frame delay. # # $filter .= "+'$d*eq(in,$n)'" # if ($d > 0); # # So instead, just duplicate frames, at 30fps. my $file = sprintf("%s-%04d.%s", $base, $n, $type); my $status = $img2->Set (magick => $type); error ("$name: ImageMagick: $status") if $status; if ($cap) { $status = $img2->Composite ( gravity => 'South', compose => 'over', image => $cap ); error ("$name: ImageMagick: composite: $status") if $status; } $img2->Write ($file); print STDERR "$progname: wrote $file\n" if ($verbose > 3); push @rm_f, $file; push @frames, $file; $n++; # Duplicate frames, if this image should last more than one frame. # for (my $i = 0; $i < $d; $i++) { my $file2 = sprintf("%s-%04d.%s", $base, $n, $type); push @rm_f, $file2; push @frames, $file2; my $file3 = $file; $file3 =~ s@^.*/@@s; # relative link in same dir safe_system ('ln', '-sf', $file3, $file2); print STDERR "$progname: dup $file2\n" if ($verbose > 3); $n++; } } } $filter = "zoompan=d=0$filter," if ($filter); $filter .= "scale=$fw:$fh"; # must come after zoompan validate_size ($out, $fw, $fh, $min_video_size, $max_video_size, $min_video_aspect, $max_video_aspect); { my @cmd = ('ffmpeg', '-hide_banner', '-v', '32', '-framerate', $framerate, # input rate: before -i '-f', 'image2', '-i', $pattern, '-vf', $filter, # per-frame frame rates '-r', $framerate, # output rate: after -i '-c:v', 'libx264', # codec '-profile:v', 'high', '-crf', $quality, # h.264 quality '-pix_fmt', 'yuv420p', '-movflags', 'faststart', # Move index to front $out_tmp); print STDERR "$progname: exec: " . join(" ", @cmd) . "\n" if ($verbose > 2); my $result = ''; my ($inf, $outf, $errf); $errf = Symbol::gensym; my $pid = eval { open3 ($inf, $outf, $errf, @cmd) }; error ("unable to exec $cmd[0]: $!") unless $pid; close ($inf); close ($outf); my $errs = ''; while (<$errf>) { $errs .= $_; } waitpid ($pid, 0); close ($errf); print STDERR $errs if ($verbose > 2); } print STDERR "$progname: rm $pattern\n" if ($verbose > 1); foreach my $f (@frames) { unlink ($f); } my $mp4_size = (stat($out_tmp))[7]; error ("failed converting $in") unless $mp4_size; my $s = sprintf("%dx%d, %s", $fw, $fh, size_str ($mp4_size)); $s .= ", " . dur_str ($duration); $s .= ", $n frames"; rename_or_delete ($out, $out_tmp, $s, 1); } # Convert an HLS M3U or M3U8 playlist file to an MP4 or image. # This necessarily hits the network. # sub m3u8_to_video_or_image($$$) { my ($in, $out, $base_url) = @_; my $name = $in; $name =~ s@^.*/@@s; my ($outext) = ($out =~ m@\.([^./]+)$@s); my $outtype = ext_to_ct ($outext || ''); open (my $f, '<:utf8', $in) || error ("$in: $!"); local $/ = undef; # read entire file my $body = <$f>; close $f; # First load the top-level M3U file, which contains a list of # other M3U files for various resolutions of the video. # Pick the highest resolution sub-video. error ("not an M3U file: $in") unless ($body =~ m/^#EXTM3U/s); my $max = 0; my $url = undef; my @lines = split(/\n/, $body); while ($_ = shift @lines) { if (m/^#EXT-X-STREAM-INF/si) { my ($bw) = (m/BANDWIDTH=(\d+)/si); $url = shift @lines if ($bw && $bw > $max); } } error ("no URLs in $in") unless $url; $url = expand_url ($url, $base_url) if ($base_url); # Second, load the M3U file of our selected resolution. # This file contains a list of URLs of each chunk of the video, # divided into short segments (probably 3 seconds each). my $ua = LWP::UserAgent->new; $ua->agent("$progname/$version"); error ("M3U input must be a URL: $url") unless ($url =~ m/^https?:/s); print STDERR "$progname: loading $url\n" if ($verbose); my $res = $ua->get ($url); my $ret = ($res && $res->code) || 'null'; error ("status $ret: $in") unless ($ret eq '200'); $body = $res->content; utf8::decode ($body); # Pack multi-byte UTF-8 back into wide chars. error ("not an M3U file: $url via $in") unless ($body =~ m/^#EXTM3U/s); # If we're just grabbing a thumbnail, we only need the first segment. my $max_length = ($outtype =~ m/^image/si ? 1 : $max_video_length); @lines = split(/\n/, $body); my @urls = (); my $length = 0; while ($_ = shift @lines) { if (m/^#EXTINF/si) { my ($L) = (m/^#[^:]+:(\d+(\.\d*)?)([,;]|$)/si); push @urls, expand_url (shift @lines, $url) # If we have already exceeded the maximum length, we don't need to # download any more segments. if (!$max_length || $length < $max_length); $length += $L if $L; } } error ("no URLs in $url via $in") unless @urls; print STDERR "$progname: $name: found " . scalar(@urls) . " segments of length " . dur_str($length) . "\n" if ($verbose > 1); my ($ext) = ($urls[0] =~ m@\.([^/.]+)$@s); $ext = 'ts' unless $ext; # Third, load all of those sub-files to a tmp file; # then append that tmp file to our output file. # (There's no way to tell :content_file to just append). my $base = resize_tmpfile ($out, 'resize-', ''); my $out_tmp = sprintf("%s.%s", $base, $ext); my $out_tmp2 = sprintf("%s-2.%s", $base, $ext); push @rm_f, $out_tmp; push @rm_f, $out_tmp2; open (my $outf, '>:raw', $out_tmp) || error ("$out_tmp: $!"); my $n = @urls; my $i = 0; foreach my $url2 (@urls) { $i++; print STDERR "$progname: loading $i/$n $url2\n" if ($verbose); my $res = $ua->get ($url2, ':content_file' => $out_tmp2); my $ret = ($res && $res->code) || 'null'; error ("$url2 failed: $ret") unless ($ret eq '200'); open (my $in2, '<:raw', $out_tmp2) || error ("$out_tmp2: $!"); my $bufsiz = 1024 * 100; my $buf = ''; while (1) { my $n = sysread ($in2, $buf, $bufsiz); last if ($n <= 0); syswrite ($outf, $buf); } close ($in2); } close ($outf); unlink $out_tmp2; # Finally, we have the full video as a .ts file. # Convert it to the output format, and resize as needed. resize ($out_tmp, $out); } sub video_to_thumbnail($$) { my ($in, $out) = @_; my $name = $in; $name =~ s@^.*/@@s; my ($ext) = ($out =~ m@\.([^/.]+)$@s); $ext = 'jpg' unless $ext; my $base = resize_tmpfile ($out, 'resize-', ''); my $out_tmp = sprintf("%s.%s", $base, $ext); push @rm_f, $out_tmp; my (undef, undef, $dur) = video_size ($name, $in); my $ss = 12; # Thumbnail from a few secs in $ss = 1 if ($dur < 20); # But from earlier if short $ss = $dur/2 if ($ss > ($dur - 0.5)); # but don't exceed video length $ss = sprintf ("00:00:%06.3f", $ss); my @cmd = ('ffmpeg', '-hide_banner', '-v', '32', '-i', $in, '-ss', $ss, '-vframes', 1, '-f', 'image2', $out_tmp); print STDERR "$progname: thumb: exec: " . join(" ", @cmd) . "\n" if ($verbose > 1); my ($inf, $outf, $errf); $errf = Symbol::gensym; my $pid = eval { open3 ($inf, $outf, $errf, @cmd) }; error ("unable to exec $cmd[0]: $!") unless $pid; close ($inf); close ($outf); my $errs = ''; while (<$errf>) { $errs .= $_; } waitpid ($pid, 0); close ($errf); print STDERR $errs if ($verbose > 2); my $out_tmp2 = sprintf("%s.2.%s", $base, $ext); push @rm_f, $out_tmp2; # We have written an image file. Make sure that image meets the constraints. # $out_tmp2 will only be written if $out_tmp required changes. constrain_image ($out_tmp, $out_tmp2); if (-f $out_tmp2) { rename ($out_tmp2, $out_tmp) || error ("mv $out_tmp2 $out_tmp: $!"); } my $img_size = (stat($out_tmp))[7]; error ("failed thumbnailing $in") unless $img_size; my $s = size_str ($img_size); rename_or_delete ($out, $out_tmp, $s); } sub resize($$) { my ($in, $out) = @_; my $ct = ''; my $base = undef; if ($in =~ m@^https?://(((www\.)?(youtube|vimeo)\.com)|youtu\.be)/@i) { error ("--out must be specified when input is a URL") unless $out; my @cmd = ('youtubedown', '-q', '--out', $out, $in); push @cmd, '-vv' if ($verbose > 1); print STDOUT "$progname: executing " . join(' ', @cmd) . "\n" if ($verbose > 2); my $ret = safe_system (@cmd); error ("$cmd[0] failed: $ret: $out") if $ret; $in = $out; $ct = 'video/mp4'; } elsif ($in =~ m@^https?://@s) { $base = $in; error ("--out must be specified when input is a URL") unless $out; my $file = resize_tmpfile ($out, 'resize-', ''); push @rm_f, $file; my $ua = LWP::UserAgent->new; $ua->agent("$progname/$version"); print STDERR "$progname: saving $in to $file\n" if ($verbose); my $res = $ua->get ($in, ':content_file' => $file); my $ret = ($res && $res->code) || 'null'; error ("$in failed: $ret") unless ($ret eq '200'); # Make sure the tmp file has the right ext, to avoid confusing ffmpeg. $ct = $res->header ('Content-Type') || 'application/octet-stream'; $ct =~ s/[;\s].*$//s; $ct = lc($ct); my $ext = ct_to_ext ($ct); my ($oext) = ($file =~ m@\.([^./]+)$@s); if ($ext && $ext ne ($oext || '')) { my $f2 = $file; $f2 =~ s@\.([^./]+)$@@s; $f2 .= ".$ext"; push @rm_f, $f2; rename ($file, $f2) || error ("mv $file $f2: $!"); print STDERR "$progname: mv $file $f2\n" if ($verbose); $file = $f2; } $in = $file; } $out = $in unless $out; $ct = ext_to_ct ($in) unless $ct; my ($outext) = ($out =~ m@\.([^./]+)$@s); my $outtype = ext_to_ct ($outext) || ''; error ("ffmpeg not found on \$PATH") if (($ct =~ m/^video/s || $outtype =~ m/^video/s) && !which ('ffmpeg')); if ($ct eq 'image/gif' && $outtype =~ m/^video/s) { animgif_to_mp4 ($in, $out); } elsif ($ct =~ m@^(application|video)/(x-)?mpegurl@si) { m3u8_to_video_or_image ($in, $out, $base); } elsif ($ct =~ m/^video/s && $outtype =~ m/^image/s) { video_to_thumbnail ($in, $out); } elsif ($ct =~ m/^video/s && $outtype =~ m/^video/s) { constrain_video ($in, $out); } elsif ($ct =~ m/^image/s && $outtype =~ m/^image/s) { constrain_image ($in, $out); } else { error ("can't convert $ct to $outtype: $in, $out"); } } sub error($) { my ($err) = @_; print STDERR "$progname: $err\n"; exit 1; } sub usage($) { my ($err) = @_; if ($err) { print STDERR "$progname: $err\n"; print STDERR "$progname: try --help\n"; exit (1); } print STDERR "$progname v$version. Usage:" . ' Resize multple files in place, if needed: infile1 infile2 infile3 ... Resize to a different file, writing outfile only if it differs: infile --out outfile The input file can also be a URL. Convert an anim-GIF to an MP4: infile.gif --out outfile.mp4 Extract a thumbnail frame from an MP4: infile.mp4 --out outfile.jpg Options: Strip EXIF and location data: --strip Set allowable sizes: --min-size WxH --max-size WxH --min-image-size WxH --max-image-size WxH --min-video-size WxH --max-video-size WxH --max-video-length D where D is seconds, or HH:MM:SS.NNN --min-video-length D --max-video-bytes S where S is bytes, or "S K", "S MB", "S GB". Set allowable aspect ratios: --min-aspect N where N is a float or ratio: 0.5 or 1:2 --max-aspect N --min-image-aspect N --max-image-aspect N --min-video-aspect N --max-video-aspect N When adjusting aspect, crop versus pad: --pad, --pad-image, --pad-video, --background white --crop, --crop-image, --crop-video Drop N of every M frames from an input anim-GIF, adjusting timing: --drop-frames N/M E.g., "1/2" means drop every other frame; "1/3" means drop 1 keep 2; and "3/4" means keep one frame of every 4. Use defaults appropriate to various services: --preset [ facebook, twitter, instagram, instagram-story, tumblr ] --verbose, -vv Be louder --quiet Print errors only --debug Don\'t write files '; exit 1; } sub main() { my @infiles = (); my $outfile = undef; my $any_p = 0; binmode (STDOUT, ':utf8'); binmode (STDERR, ':utf8'); while ($#ARGV >= 0) { $_ = shift @ARGV; if (m/^--?verbose$/s) { $verbose++; } elsif (m/^-v+$/s) { $verbose += length($_)-1; } elsif (m/^--?q$/s) { $verbose = 0; } elsif (m/^--?quiet$/s) { $verbose = 0; } elsif (m/^--?debug$/s) { $debug_p++; } elsif (m/^--help$/) { usage(undef); } elsif (m/^--?out$/s) { usage ("only one --out option allowed") if $outfile; $outfile = shift @ARGV; usage ("--out FILE") if (!$outfile || $outfile =~ m/^-/s); } elsif (m/^--?strip$/s) { $strip_p++; $any_p++; } elsif (m/^--?pad$/s) { $crop_video_p = $crop_image_p = 0; } elsif (m/^--?crop$/s) { $crop_video_p = $crop_image_p = 1; } elsif (m/^--?pad-image$/s) { $crop_image_p = 0; } elsif (m/^--?crop-image$/s) { $crop_image_p = 1; } elsif (m/^--?pad-video$/s) { $crop_video_p = 0; } elsif (m/^--?crop-video$/s) { $crop_video_p = 1; } elsif (m/^--?background$/s) { $background_color = shift @ARGV; } elsif (m/^--?caption$/s) { $caption_text = shift @ARGV; $any_p++; } elsif (m/^--?min-size$/s) { my $s = shift @ARGV; usage ("unparsable size: $_ $s") unless ($s =~ m/^(\d+)x(\d+)$/s); $min_video_size = $min_image_size = $s; $any_p++; } elsif (m/^--?max-size$/s) { my $s = shift @ARGV; usage ("unparsable size: $_ $s") unless ($s =~ m/^(\d+)x(\d+)$/s); $max_video_size = $max_image_size = $s; $any_p++; } elsif (m/^--?min-image-size$/s) { my $s = shift @ARGV; usage ("unparsable size: $_ $s") unless ($s =~ m/^(\d+)x(\d+)$/s); $min_image_size = $s; $any_p++; } elsif (m/^--?max-image-size$/s) { my $s = shift @ARGV; usage ("unparsable size: $_ $s") unless ($s =~ m/^(\d+)x(\d+)$/s); $max_image_size = $s; $any_p++; } elsif (m/^--?min-video-size$/s) { my $s = shift @ARGV; usage ("unparsable size: $_ $s") unless ($s =~ m/^(\d+)x(\d+)$/s); $min_video_size = $s; $any_p++; } elsif (m/^--?max-video-size$/s) { my $s = shift @ARGV; usage ("unparsable size: $_ $s") unless ($s =~ m/^(\d+)x(\d+)$/s); $max_video_size = $s; $any_p++; } elsif (m/^\d+x\d+$/s && ! -f $_) { # Treat bare WxH as --max-size WxH $max_video_size = $max_image_size = $_; $any_p++; } elsif (m/^--?min-aspect$/s) { my $s = shift @ARGV; if ($s =~ m/^(\d+)(\.(\d+))?$/s) { $s = 0 + $s; } elsif ($s =~ m/^(\d+(?:\.\d+)?):(\d+(?:\.\d+)?)$/s) { $s = $1 / $2; } else { usage ("unparsable aspect: $_ $s"); } $min_video_aspect = $min_image_aspect = $s; $any_p++; } elsif (m/^--?max-aspect$/s) { my $s = shift @ARGV; if ($s =~ m/^(\d+)(\.(\d+))?$/s) { $s = 0 + $s; } elsif ($s =~ m/^(\d+(?:\.\d+)?):(\d+(?:\.\d+)?)$/s) { $s = $1 / $2; } else { usage ("unparsable aspect: $_ $s"); } $max_video_aspect = $max_image_aspect = $s; $any_p++; } elsif (m/^--?min-image-aspect$/s) { my $s = shift @ARGV; if ($s =~ m/^(\d+)(\.(\d+))?$/s) { $s = 0 + $s; } elsif ($s =~ m/^(\d+(?:\.\d+)?):(\d+(?:\.\d+)?)$/s) { $s = $1 / $2; } else { usage ("unparsable aspect: $_ $s"); } $min_image_aspect = $s; $any_p++; } elsif (m/^--?max-image-aspect$/s) { my $s = shift @ARGV; if ($s =~ m/^(\d+)(\.(\d+))?$/s) { $s = 0 + $s; } elsif ($s =~ m/^(\d+(?:\.\d+)?):(\d+(?:\.\d+)?)$/s) { $s = $1 / $2; } else { usage ("unparsable aspect: $_ $s"); } $max_image_aspect = $s; $any_p++; } elsif (m/^--?min-video-aspect$/s) { my $s = shift @ARGV; if ($s =~ m/^(\d+)(\.(\d+))?$/s) { $s = 0 + $s; } elsif ($s =~ m/^(\d+(?:\.\d+)?):(\d+(?:\.\d+)?)$/s) { $s = $1 / $2; } else { usage ("unparsable aspect: $_ $s"); } $min_video_aspect = $s; $any_p++; } elsif (m/^--?max-video-aspect$/s) { my $s = shift @ARGV; if ($s =~ m/^(\d+)(\.(\d+))?$/s) { $s = 0 + $s; } elsif ($s =~ m/^(\d+(?:\.\d+)?):(\d+(?:\.\d+)?)$/s) { $s = $1 / $2; } else { usage ("unparsable aspect: $_ $s"); } $max_video_aspect = $s; $any_p++; } elsif (m/^--?(max|min)-video-length$/s) { my $s = shift @ARGV; if ($s =~ m/^\d+(\.\d+)?$/s) { # SSSS.NN $s = 0 + $s; } elsif ($s =~ m/^(\d+):(\d\d(\.\d+)?)$/s) { # MMMM:SS.NN $s = ($1 * 60) + $2; } elsif ($s =~ m/^(\d+):(\d\d):(\d\d(\.\d+)?)$/s) { # HHHH:MM:SS.NN $s = ($1 * 60 * 60) + ($2 * 60) + $3; } else { usage ("unparsable length: $_ $s"); } if (m/max/s) { $max_video_length = $s; } else { $min_video_length = $s; } $any_p++; } elsif (m/^--?max-video-bytes$/s) { my $s = shift @ARGV; if ($s =~ s@\s*KB?$@@si) { $max_video_bytes = $s * 1024; } elsif ($s =~ s@\s*MB?$@@si) { $max_video_bytes = $s * 1024*1024; } elsif ($s =~ s@\s*GB?$@@si) { $max_video_bytes = $s * 1024*1024*1024; } elsif ($s =~ m/^\d+$/s) { $max_video_bytes = 0 + $s; } else { error ("unparsable units: $s"); } $any_p++; } elsif (m/^--?drop(-frames)?$/s) { $drop_frames = shift @ARGV || ''; my ($drop, $span) = ($drop_frames =~ m@^(\d+)/(\d+)$@s); usage ("$_ $drop_frames must be of the form \"M/N\" where M frames " . " are deleted of every set of N frames") if (!$drop || !$span || $drop >= $span || $span <= 1); $any_p++; } elsif (m/^--?preset$/s) { my $p = shift @ARGV || ''; if ($p eq 'facebook') { # https://developers.facebook.com/docs/graph-api/video-uploads # "Non-Resumable upload supports video uploads that are up to # 1GB and 20 minutes long." # # "Resumable upload supports uploading videos that are up to # 1.75GB and 45 minutes long." # # But later it says: # # "The maximum length for a video is 40 minutes." # "The maximum size for a video is 2 GB." # # I was getting "413 Request Entity Too Large" With non-resumable # uploads on videos of 144 MB and larger, so apparently the limit # for non-resumable uploads is actually lower than advertised # (probably 100 MB). So, I added support for resumable uploads to # dnalounge/utils/fbmirror.pl, and now we get the higher limit. # We don't really need to upload videos better than 720p. But is # it better to save CPU and burn bandwidth by uploading a too-large # video; or to save bandwidth and burn CPU by resizing it first? # I'm gonna vote for the former. unshift @ARGV, ('--min-video-aspect', '9:16', '--max-video-aspect', '16:9', '--max-video-length', '0:40:00', '--min-video-length', '0:00:01', #'--max-video-size', '1280x1280', '--max-image-size', '1920x1920', '--max-video-bytes', '2GB', #'--crop-video' ); } elsif ($p eq 'instagram') { # https://help.instagram.com/1469029763400082 # https://help.instagram.com/1631821640426723 unshift @ARGV, ('--min-aspect', '4:5', '--max-aspect', '1.91', '--min-image-size', '320x0', '--min-video-size', '640x0', '--max-size', '1080x0', '--min-video-length', '0:00:03', '--max-video-length', '0:00:60', '--max-video-bytes', '75MB', '--crop-video' ); } elsif ($p eq 'instagram-story') { # Stories want everything to be 9:16 portrait-mode, and short video. # It accepts slight variations on that ratio, but then it just crops. # And seems to crop inappropriately if size isn't precisely 640x1138. unshift @ARGV, ('--min-aspect', '9:16', '--max-aspect', '9:16', '--min-size', '640x0', '--max-size', '640x0', #'--max-size', '1080x0', '--min-video-length', '0:00:03', '--max-video-length', '0:00:15', '--max-video-bytes', '75MB', '--background', 'black', #'--crop-video' ); } elsif ($p eq 'twitter') { unshift @ARGV, (# https://developer.twitter.com/en/docs/media/upload-media/uploading-media/media-best-practices '--max-video-length', '140', '--min-video-length', '0:00:00.5', '--min-video-size', '32x32', '--max-video-size', '1280x1024', '--min-video-aspect', '1:3', '--max-video-aspect', '3:1', '--max-video-bytes', '512MB', # https://support.twitter.com/articles/20172128 # which contradicts the above: '--max-video-size', '1920x1200', '--min-video-aspect', '1:2.39', '--max-video-aspect', '2.39:1', '--crop-video' ); } elsif ($p eq 'tumblr') { unshift @ARGV, (# https://www.tumblr.com/docs/en/posting # Max static image size is 10MB; # Max anim-GIF size is 2MB, 540px wide; # Video size limit is 100MB per day. '--max-image-size', '1280x1920', # Probably? '--max-video-bytes', '33MB', # Ok, so, 100/3 # '--max-video-length', '0:05:00', # Safe guess? Nope? '--max-video-length', '0:03:00', # Try this? '--max-video-size', '500x700', # Rumored? ); } else { usage ("unknown preset: $_ $p"); } } elsif (m/^-./) { usage ("unknown option: $_"); } else { usage ("file does not exist: $_") unless (m@^https?://@s || -f $_); push @infiles, $_; } } if (! $any_p && $outfile) { # changing extension counts as an alteration. my ($e1) = ($infiles[0] =~ m@\.([^./])+$@s); my ($e2) = ($outfile =~ m@\.([^./])+$@s); $any_p = 1 if (lc($e1) ne lc($e2)); } if (! @infiles) { usage ("no files specified"); } elsif (! $any_p) { usage ("no resizing options specified: nothing to do"); } elsif ($outfile) { usage ("must be exactly one infile if --out is specified") unless (@infiles == 1); resize ($infiles[0], $outfile); } else { foreach my $f (@infiles) { resize ($f, undef); } } } main(); exit 0;