#!/opt/local/bin/perl -w # Copyright © 2016-2021 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 re-encode videos until the file is below a maximum size; # - Can re-encode videos until the file is below a maximum bitrate; # - Can normalize overall audio volume; # - Can automatically remove letterboxing/pillarboxing padding; # - Can extract thumbnail images from videos; # - Can convert anim-GIFs to MP4s; # - Can convert MP4s to anim-GIFs; # - Can convert HLS (HTTP Live Streaming) M3U and M3U8 video to MP4; # - Can extract audio from video; # - 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; use Fcntl ':flock'; # import LOCK_* constants BEGIN { eval 'use Image::Magick;' } # Optional my $progname = $0; $progname =~ s@.*/@@g; my ($version) = ('$Revision: 1.88 $' =~ m/\s(\d[.\d]+)\s/s); my $verbose = 1; my $debug_p = 0; my $strip_p = 0; my $progress_p = 0; my $min_image_size = undef; my $max_image_size = undef; my $min_video_size = undef; my $max_video_size = undef; my $max_video_bitrate = undef; # in bytes 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 $autocrop_p = 0; my $replaygain_p = 0; my $trash_p = 0; my $jpeg_quality = 80; my $mp4_quality = 20; my $mp4_quality_step = 2; my $mp4_worst_quality = 26; # When retrying, don't go worse than this my $background_color = 'blur'; 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'; # $caption_font = '/Library/Fonts/Impact.ttf'; # Anything placed on this list gets unconditionally deleted when this # script exits, even if abnormally. # my @rm_f = (); my @rm_rf = (); END { my $exit = $?; unlink @rm_f if (@rm_f); system ("rm", "-rf", @rm_rf) if (@rm_rf); $? = $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/^heic$/si ? 'image/heic' : $file =~ m/^heif$/si ? 'image/heif' : $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/^flv$/si ? 'video/x-flv' : $file =~ m/^avi$/si ? 'video/avi' : $file =~ m/^m3u8?$/si ? 'application/x-mpegurl' : $file =~ m/^(mp3|m3a)$/si ? 'audio/mpeg' : $file =~ m/^wav$/si ? 'audio/x-wav' : $file =~ m/^x-m4[abp]$/si ? 'audio/mp4' : # AAC $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; $ct =~ s@/x-@/@s; return ($ct =~ m@^image/jpeg@si ? 'jpg' : $ct =~ m@^image/heic@si ? 'heic' : $ct =~ m@^image/heif@si ? 'heif' : $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@^video/x-flv@si ? 'flv' : $ct =~ m@^video/flv@si ? 'flv' : $ct =~ m@^video/avi@si ? 'avi' : $ct =~ m@^video/msvideo@si ? 'avi' : $ct =~ m@^video/x-msvideo@si ? 'avi' : $ct =~ m@^audio/mpeg@si ? 'mp3' : $ct =~ m@^audio/(m4a|mp4)@si ? 'm4a' : $ct =~ m@^(application|video)/(x-)?mpegurl@si ? 'm3u8' : $ct =~ m@^(image|video|audio)/([^/\s]+)@si ? lc($2) : '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); $ss = 0 if ($dur > 60); # Only include fractional seconds on short files. $dur = ($ss ? sprintf ("%05.2f", $s + $ss) : sprintf("%02d", $s)); $dur = sprintf("%d:%02d:%s", $h, $m, $dur); return $dur; } sub bps_str($) { # bits per sec, not bytes my ($bps) = @_; return ($bps > 1024*1024 ? sprintf ("%.1f Mbps", $bps/(1024*1024)) : $bps > 1024 ? sprintf ("%.1f Kbps", $bps/1024) : "$bps bps"); } # Like system but handles error conditions. # 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; } # Runs the program under a pipe and returns its stderr as a string. # sub exec_1($$$@) { my ($subtitle, $vv, $input_bytes, @cmd) = @_; my $errs = ''; if ($verbose > $vv) { # Print the command with arguments quoted as needed. my @c2 = @cmd; print STDERR "$progname: " . ($subtitle ? "$subtitle: " : "") . "exec: " . join(' ', map { if (m![^-._,:a-z\d/@+=]!s) { s%([\'\!])%\\$1%gsi; $_ = "'$_'"; } $_; } @c2) . "\n"; } 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); if (!$progress_p || $input_bytes == 0) { while (<$errf>) { $errs .= $_; } } else { my $dur = undef; my $start_time = time(); # The stderr output from ffmpeg sometimes uses \n and sometimes \r # so we have to use sysread here and split manually instead of # while (<$err>) or the whole stderr buffers. # my $bufsiz = 16384; while (1) { my ($rin, $win, $ein, $rout, $wout, $eout); $rin = $win = $ein = ''; vec ($rin, fileno($errf), 1) = 1; $ein = $rin | $win; my $nfound = select ($rout = $rin, $wout = $win, $eout = $ein, undef); my $chunk = ''; my $size = sysread ($errf, $chunk, $bufsiz); last if ($nfound && !$size); # closed $errs .= $chunk; if ($progress_p) { # Let's just assume ffmpeg never splits writes mid-line. # (Actually "rarely" is as good as "never") $chunk =~ s/\r\n?/\n/gs; foreach my $line (split(/\n/, $chunk)) { print STDERR " <== $line\n" if ($verbose > 3); # ffmpeg doesn't provide the total number of frames anywhere, # so we have to go by timestamp instead: # # Input #0, ... # Duration: 00:03:26.99, start: 0.000000, bitrate: 3005 kb/s # ... # frame= 3378 fps= 88 q=30.0 size= 7680kB time=00:00:55.21 ... # if (!$dur && $line =~ m/^\s*Duration:\s+(\d+):(\d\d):(\d\d(\.\d+)?)\b/s) { $dur = $1*60*60 + $2*60 + $3; } elsif ($dur && $progress_p && $line =~ m/^\s* frame= .* \b time= \s* (\d+):(\d\d):(\d\d(\.\d+)?)/sx) { my $cur = $1*60*60 + $2*60 + $3; my $elapsed = time() - $start_time; my $bps = $elapsed ? ($input_bytes * 8 / $elapsed) : 0; draw_progress ($cur / $dur, $bps, 0); } } } } draw_progress (1, 0, 1) if ($dur && $progress_p); } waitpid ($pid, 0); close ($errf); return $errs; } # 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: exec: " . 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; } # Find a non-conflicting output file name by appending numbers. # sub unique_file_name($) { my ($file) = @_; my $i = 2; my $ofile = $file; $ofile =~ s@ \d+(\.[^.]+)$@$1@s; # Omit existing numbers while (-f $file) { $file = $ofile; $file =~ s@(\.[^.]+)$@ $i$1@s; # increment until unique $i++; } return $file; } # Move the file to the macOS trash, with a non-conflicting file name. # sub trash($) { my ($file) = @_; my $dir = $ENV{HOME} . "/.Trash"; my $f0 = $file; $f0 = `pwd` unless ($f0 =~ m@^/@s); if ($f0 =~ m@^(/Volumes/[^/\r\n]+)@s) { # /Volumes/X/.Trashes/N/ $dir = $1 . "/.Trashes"; error ("$dir does not exist") unless (-d $dir); my $uid = `id -u`; chop $uid; error ("no uid") if ($uid eq ""); $dir .= "/$uid"; if (! -d $dir) { mkdir ($dir) || error ("mkdir $dir: $!"); print STDERR "$progname: mkdir \"$dir\"\n" if ($verbose > 1); } } error ("$dir does not exist") unless (-d $dir); my $f2 = $file; $f2 =~ s@^.*/@@s; $f2 = unique_file_name ("$dir/$f2"); rename ($file, $f2) || error ("mv \"$file\" \"$f2\": $!"); if ($verbose > 2) { print STDERR "$progname: mv \"$file\" \"$f2\"\n"; } elsif ($verbose > 1) { print STDERR "$progname: trashed $file\n"; } } # 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 my $f2 = $file; utf8::decode ($f2); # Parse multi-byte UTF-8 into wide chars. if ($size < $min) { error ("$file_tmp: too small: $size bytes"); } elsif (! cmp_files ($file, $file_tmp)) { print STDERR "$progname: $f2 unchanged" . ($suffix_msg ? " $suffix_msg" : "") . "\n" if ($verbose > 1); } elsif ($debug_p) { print STDERR "$progname: not writing $f2" . ($suffix_msg ? " $suffix_msg" : "") . "\n"; } else { trash ($file) if ($trash_p && -f $file); rename ($file_tmp, $file) || error ("mv $file_tmp $f2: $!"); print STDERR "$progname: wrote $f2" . ($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; } my $lock_fd = undef; # global scope so it doesn't GC sub acquire_lock() { my $lockfile = (($ENV{TMPDIR} || "/tmp") . "/.$progname.LCK"); $lockfile =~ s@//+@/@gs; open ($lock_fd, '+>>', $lockfile) || error ("writing $lockfile: $!"); while (1) { if (! flock ($lock_fd, LOCK_EX | LOCK_NB)) { my $age = time() - (stat($lock_fd))[9]; $age = sprintf("%d:%02d:%02d", $age/60/60, ($age/60)%60, $age%60); print STDERR "waiting for lock (locked for $age)\n" if ($verbose > 1); sleep (5); } else { print STDERR "$progname: locked\n" if ($verbose > 1); utime (undef, undef, $lock_fd); # acquired lock, set file mtime to now last; } } } my $progress_ticks = 0; my $progress_time = 0; my $progress_rubout = ''; my $progress_last = 0; my $progress_start = 0; sub draw_progress($$$) { my ($ratio, $bps, $eof) = @_; # bits per sec, not bytes my $cols = 52; my $ticks = int($cols * $ratio); my $cursep = (!($verbose > 4) && ((($ENV{TERM} || 'dumb') ne 'dumb') || (($ENV{INSIDE_EMACS} || '') =~ m/comint/))); my $now = time(); $progress_start = $now unless ($progress_start); return if ($progress_time == $now && !$eof); if ($now > $progress_last) { $progress_last = $now; my $elapsed = $now - $progress_start; my $remaining = $ratio ? ($elapsed / $ratio) - $elapsed : 0; my $pct = sprintf ("%3d%% %s, %s ETA", 100 * $ratio, bps_str ($bps || 0), dur_str (int ($remaining))); $pct =~ s/^ /. /s; my $L = length($pct); my $OL = length($progress_rubout); print STDERR $progress_rubout if ($OL && $cursep); # erase previous pct $progress_rubout = "\b" x $L; while ($ticks > $progress_ticks) { print STDERR "."; $progress_ticks++; } print STDERR $pct; my $L2 = $OL - $L; # If the current pct is shorter, clear to EOL print STDERR ((' ' x $L2) . ("\b" x $L2)) if ($L2 > 0 && $cursep); print STDERR "\n" unless ($cursep); } print STDERR "\r" . (' ' x ($cols + 4)) . "\r" # erase line if ($eof && $cursep); $progress_time = $now; $progress_ticks = 0 if ($eof || !$cursep); $progress_rubout = '' if ($eof); $progress_last = 0 if ($eof); $progress_start = 0 if ($eof); } sub constrain_aspect($$$$$) { my ($fw, $fh, $min_aspect, $max_aspect, $crop_p) = @_; my ($w2, $h2) = ($fw, $fh); return ($w2, $h2) unless ($w2 && $h2); 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) = @_; error ("bogus ratio $ratio (${w}x${h})") if ($ratio > 1); $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. # $ps *= 2.5; my $shadow = $ps / 15; my $fg = '#66FF66'; # $fg = '#FFFFFF'; 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: caption: 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_1($$$) { my ($in, $out, $img) = @_; my $name = $in; $name =~ s@^.*/@@s; my $ct = ext_to_ct ($in); my $ct2 = ext_to_ct ($out); 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 ($ct2 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 ($ct2 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) { if ($background_color eq 'blur') { # Make a blurred image that completely covers the desired output # rectangle: if we are padding horizontally, this image will be # taller than the output. If vertically, wider. # my $img2 = $img->Clone(); my $w3 = $w2; my $h3 = $h2; my $r = $fw / $fh; ($w3, $h3) = ($fw < $w2 # padding horizontally ? ($w3, $w3 / $r) : ($h3 * $r, $h3)); # Fastest way to blur is to shrink then enlarge. # my $blur = 150; $status = $img2->Resize (width => $w3 / $blur, height => $h3 / $blur); error ("$name: ImageMagick: blur shrink: $status") if $status; $status = $img2->Resize (width => $w3, height => $h3); error ("$name: ImageMagick: blur expand: $status") if $status; # Now crop the blurred image to the size with the proper aspect. # $status = $img2->Extent (x => ($w3 - $w2) / 2, y => ($h3 - $h2) / 2, width => $w2, height => $h2); error ("$name: ImageMagick: blur extent: $status") if $status; # Give the un-blurred image an extent that centers it. # $status = $img->Extent (x => $x, y => $y, width => $w2, height => $h2, background => 'None'); error ("$name: ImageMagick: blur extent: $status") if $status; # Add the blurred image behind the unblurred one, and flatten. unshift @$img, $img2; $img = $img->Flatten(); $x = 0; $y = 0; } else { # Pad with a solid color. $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); return ($fw, $fh, $ofw, $ofh); } 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->Set ('density' => '300x300') # Set PDF DPI before reading the file. if ($ct eq 'image/pdf'); $img->Read ($in); constrain_image_1 ($in, $out, $img); } # Returns width, height, duration, audio_p of the video file. # sub video_size($$) { my ($name, $file) = @_; my @cmd = ('ffmpeg', '-hide_banner', '-loglevel', 'info', # so it prints duration, etc. '-i', $file, # This makes it read the whole file! Leaving it off errors # out with "At least one output file must be specified", # but does so quickly. # '-f', 'null', # '/dev/null' ); my $errs = exec_1 ("size", 2, 0, @cmd); 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; # $dur = sprintf("%.1f", $dur) + 0; # one significant digit my ($fw, $fh) = ($errs =~ m/Stream .* Video: .* (\d\d\d?\d?)x(\d\d\d?\d?)[, ]/m); ($fw, $fh) = ($fh, $fw) if ($errs =~ m/ rotate *: *-?90\b/s); my $audio_p = ($errs =~ m/Stream .* Audio: /m); error ("no size: $name:\n\n$errs") unless (defined($fh) || $audio_p); return ($fw, $fh, $dur, $audio_p); } # Detects the overall volume of the video and returns ($ratio, $db) # of the desired audio adjustment to be applied. # sub video_volume_adjustment($$) { my ($file, $dur) = @_; error ("$file does not exist") unless -f $file; my $tmp = sprintf ("%s/.replaygain.%08x.wav", ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp"), rand(0xFFFFFFFF)); push @rm_f, $tmp; # Examine audio from the middle 50% of the video, but don't let it be # too short or too long. # my $start = int ($dur * 0.25); my $end = int ($dur * 0.75); my $dur2 = $end - $start; if ($dur2 < 45) { $start = 0; $end = $dur; $dur2 = $dur; } elsif ($dur2 > 60*15) { $dur2 = 60*15; $end = $start + $dur2; } print STDERR "$progname: replaygain: checking range $start-$end of $dur\n" if ($verbose > 2); my $db; if (1) { # Extract the audio track from the video file as a 16 bit 44.1kHz WAV # then run it through LAME to get the volume adjustment. error ("lame not found on \$PATH") unless which ('lame'); my @cmd = ('ffmpeg', '-hide_banner', '-loglevel', 'warning', '-ss', $start, # -ss before -i is way faster '-i', $file, '-t', $dur2, '-vn', '-acodec', 'pcm_s16le', '-ar', '44100', '-ac', '2', $tmp); my $errs = exec_1 ("replaygain", 2, 0, @cmd); if ($errs =~ m/does not contain any stream/) { print STDERR "$progname: replaygain: $file is silent\n" if ($verbose); return (1, 0); } error ("$tmp: extracting audio failed:\n$errs") if (! -f $tmp || -z $tmp); print STDERR $errs if ($verbose > 3); # Use lame to determine the volume adjustment for that WAV file in dB. @cmd = ('lame', '--replaygain-accurate', '-f', $tmp, '/dev/null'); $errs = exec_1 ("replaygain", 2, 0, @cmd); ($db) = ($errs =~ m/^ReplayGain: \s+ ( [-+]?[\d.]+ ) \s* dB $/mx); error ("no ReplayGain from: " . join(' ', @cmd) . "\n$errs") unless defined($db); } else { # This way is faster, but ffmpeg gives very different results than LAME. # E.g. on https://youtu.be/1P-mvWSAyNQ # LAME reports -1.7 dB but # ffmpeg reports -16.9 dB. my @cmd = ('ffmpeg', '-hide_banner', '-loglevel', 'info', # So it prints volume '-ss', $start, # -ss before -i is way faster '-i', $file, '-t', $dur2, '-filter:a', 'volumedetect', '-f', 'null', '/dev/null'); my $errs = exec_1 ("replaygain", 2, 0, @cmd); error ("$tmp: extracting audio failed:\n$errs") if (-z $tmp); print STDERR $errs if ($verbose > 3); ($db) = ($errs =~ m/ mean_volume: \s+ ( [-+]?\d+[\d.]* ) \s* dB $/mx); error ("no replaygain from: " . join(' ', @cmd)) unless defined($db); } print STDERR "$progname: replaygain: $db dB\n" if ($verbose > 1); # The minimum volume difference the human ear can perceive is about 1.0 dB. # So if the dB change is that small, do nothing. # $db = 0 if ($db > -1.0 && $db < 1.0); # Convert the dB value to a ratio (1.0 for no change, 0.5 for half as loud). # # For relative volume x, dB value is 20*log[10](x) # if y=log[b](x) then x=b^y # db=20*log[10](x) # and x=10^(db/20) return ((10 ** ($db/20)), $db); } # Detects the hardcoded letterboxing / pillarboxing on the video. # Returns desired cropping as ($w, $h, $x, $y) # sub video_letterboxing($$) { my ($file, $dur) = @_; error ("$file does not exist") unless -f $file; # Examine audio from the middle 50% of the video, but don't let it be # too short or too long. # my $start = int ($dur * 0.25); my $end = int ($dur * 0.75); my $dur2 = $end - $start; if ($dur2 < 45) { $start = 0; $end = $dur; $dur2 = $dur; } elsif ($dur2 > 60*15) { $dur2 = 60*15; $end = $start + $dur2; } print STDERR "$progname: cropdetect: checking range $start-$end of $dur\n" if ($verbose > 2); # cropdetect outputs non-black rectangle (W:H:X:Y) for every input frame. # That rectangle only ever expands compared to the previous rectangle; # but it starts over every reset_count. # # https://github.com/FFmpeg/FFmpeg/blob/master/libavfilter/vf_cropdetect.c # # So it's ok to just take the last line, if you want the maximal rectangle # that encloses every frame. # # Or, we could detect problems by using reset_count to start over every # few seconds; collect stats on every rectangle detected; and print a # warning if there are too many outliers. my $filter = ('select=' . 'not(mod(n\,30))' . # Only examine every 30th frame ', ' . 'cropdetect=' . 'limit=24' . # Black level (default 24) ':round=2' . # Width/height rounding quantum (default 16) ':reset=0'); # How often to start over (default 0) my @cmd = ('ffmpeg', '-hide_banner', '-loglevel', 'info', # So it prints cropdetect '-ss', $start, # -ss before -i is way faster '-i', $file, '-t', $dur2, '-filter:v', $filter, '-f', 'null', '/dev/null'); my $errs = exec_1 ("cropdetect", 2, 0, @cmd); print STDERR $errs if ($verbose > 3); my $crop = undef; foreach my $line (split(/\n/, $errs)) { $crop = $1 if ($line =~ m/ crop=([-:\d]+)\b/s); } error ("no cropdetect from: " . join(' ', @cmd)) unless defined($crop); my ($w, $h, $x, $y) = ($crop =~ m/^(\d+):(\d+):(\d+):(\d+)$/s); error ("cropdetect: unparsable: $crop") unless ($w && $h); print STDERR "$progname: cropdetect: $crop\n" if ($verbose > 1); return ($w, $h, $x, $y); } # 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 $prev_bitrate = $size / $dur; 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 $oct = ext_to_ct ($out); my $audiop = ($oct =~ m/^audio/s); my $loop = 1; # maybe loop the video to hit the min duration # No quality retry if the --quality option was already out of range. $max_video_bitrate = undef if ($mp4_quality >= $mp4_worst_quality); 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; $fw = 0 unless defined($fw); $fh = 0 unless defined($fh); my ($volume_ratio, $db_change) = ($replaygain_p ? video_volume_adjustment ($in, $dur) : (1, 0)); my ($lb_w, $lb_h, $lb_x, $lb_y) = ($autocrop_p && !$audiop ? video_letterboxing ($in, $dur) : ($fw, $fh, 0, 0)); my $lb_p = ($lb_w != $fw || $lb_h != $fh); ($fw, $fh) = ($lb_w, $lb_h) if $lb_p; my ($nw2, $nh2, $nsize); while (1) { # We might retry to get the size or bitrate 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 ($lb_p) { $filter .= ', ' if $filter; $filter .= "crop=$lb_w:$lb_h:$lb_x:$lb_y"; } if ($x != 0 || $y != 0) { if (! $crop_video_p) { $x = -$x; $y = -$y; } if (! $audiop) { $filter .= ', ' if $filter; $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) = ($audiop ? ($w2, $h2) : 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); ($nw2, $nh2, $nsize) = ($w2, $h2, $size) unless $nsize; if ($max_video_bytes && (!$max_video_bitrate || ($size / $dur <= $max_video_bitrate))) { # If this is not the first time through the loop, reduce the resolution. if ($audiop && $retries > 0) { error ("--max-video-bytes unimplemented on audio output"); } if ($retries > 0) { my $r = $max_video_bytes / $nsize; my $p = int (100 * (1-$r)); # File size doesn't scale linearly with pixels-per-frame... $r *= 0.8 if ($r < 1); ($w2, $h2) = reduce_resolution ($nw2, $nh2, $r); print STDERR "$progname: file too large by " . size_str ($nsize - $max_video_bytes) . " ($p%); reducing ${nw2}x${nh2} to ${w2}x${h2}\n" if ($verbose); } } elsif ($max_video_bitrate) { # If this is not the first time through the loop, reduce the quality. if ($audiop && $retries > 0) { error ("--max-video-bitrate unimplemented on audio output"); } if ($retries > 0) { my $oq = $mp4_quality; $mp4_quality += $mp4_quality_step; my $b = $prev_bitrate; my $b1 = sprintf ("%.0f KBps", $b / 1024); my $pct = sprintf ("%.0f%%", (100 * $b / $max_video_bitrate) - 100); print STDERR "$progname: quality $oq bitrate $b1 too high" . " by $pct; retrying quality $mp4_quality...\n" if ($verbose); } } elsif ($retries && $loop == 1) { error ("internal error: looping with no max bytes or bitrate\n"); } $w2++ if ($w2 & 1); # h264 requires even-numbered dimensions. $h2++ if ($h2 & 1); if (!$audiop && ($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) unless $audiop; my $length_slack = 0.4; # God dammit, 60 sec Twit videos are 60.3. if (!$audiop && !$filter && !$caption_text && $loop == 1 && $iext eq $oext && $volume_ratio == 1.0 && !$strip_p && # For video means "force recode" (!$max_video_length || $dur - $length_slack <= $max_video_length) && (!$max_video_bitrate || $size / $dur <= $max_video_bitrate) ) { # 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) || ($max_video_bitrate && $size / $dur > $max_video_bitrate))) { $retries++; next; } my $s = sprintf("%dx%d, %s", $ofw, $ofh, size_str ($size)); $s .= ", " . dur_str($dur); $s .= ", ${db_change} dB" if ($db_change); 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 (!$audiop && $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', '-loglevel', 'info', # So it prints progress ); 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 (!$audiop && $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'; } if ($volume_ratio != 1.0) { $volume_ratio = sprintf("%.3f", $volume_ratio); $filter .= '; ' if $filter; $filter .= 'volume=' . $volume_ratio; } 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 (!$audiop && $crop_video_p && $dur >= 90 && $max_video_length <= 30) { # Moving the -ss to before the -i would be faster, but these are # small videos anyway. push @cmd, ('-ss', 30); } if ($audiop) { if ($oct =~ m@mpeg$@s) { push @cmd, ('-vcodec', 'none', '-acodec', 'libmp3lame', '-q:a', '0', # VBR 220-260 kbps ); } elsif ($oct =~ m@wav$@s) { push @cmd, ('-vcodec', 'none', '-acodec', 'pcm_s16le', '-ar', '22050', ); } else { error ("unknown audio output format: $oct"); } } else { # Regardless of the $oext container format, we always do h.264 AAC. push @cmd, ('-c:v', 'libx264', # video codec '-profile:v', 'high', '-crf', $mp4_quality, # h.264 quality (18 is high) '-pix_fmt', 'yuv420p', # '-acodec', 'aac', # encode audio as AAC '-acodec', 'libfdk_aac', # higher quality encoder '-b:a', '192k', # audio bitrate '-movflags', 'faststart', # Move index to front # Avoid "Too many packets buffered" with sparse audio frames. '-max_muxing_queue_size', '1024', ); } { # Check this before wasting time on ffmpeg. open (my $o2, '>', $out_tmp) || error ("$out_tmp: unwritable"); close $o2; unlink $out_tmp; } push @cmd, $out_tmp; my $input_bytes = (stat($in))[7]; my $errs = exec_1 (undef, 1, $input_bytes, @cmd); print STDERR $errs if ($verbose > 2); $dur = $max_video_length if ($max_video_length && $dur > $max_video_length); $size = (stat($out_tmp))[7]; error ("failed resizing $in") unless $size; my $lf = "\n "; my $s = ($audiop ? "" : $lf) . (($ofw && $ofh ? sprintf("%dx%d, ", $ofw, $ofh) : "") . size_str ($osize)); $s .= sprintf (", %.0f KBps", $osize / 1024 / $odur); if ($audiop) { $s .= " => " if (int($osize / 1024) != int($size / 1024)); } else { $s .= sprintf(" =>$lf%dx%d, ", $w2, $h2) if ($ofw != $w2 || $ofh != $h2 || int($osize / 1024) != int($size / 1024)); } $s .= size_str ($size); $s .= sprintf (", %.0f KBps", $size / 1024 / $dur); $s .= ", " . ($d2 || $d1); $s .= ", ${db_change} dB" if ($db_change); print STDERR "$progname: wrote $out_tmp ($s)\n" if ($verbose > 1); if ((!$max_video_bytes || $size <= $max_video_bytes) && (!$max_video_bitrate || $size / $dur <= $max_video_bitrate)) { rename_or_delete ($out, $out_tmp, $s); last; } elsif ($max_video_bitrate && $mp4_quality + $mp4_quality_step > $mp4_worst_quality) { my $b = $size / $dur; my $b1 = sprintf ("%.0f KBps", $b / 1024); my $pct = sprintf ("%.0f%%", (100 * $b / $max_video_bitrate) - 100); print STDERR "$progname: bitrate $b1 is too high by $pct " . "but quality $mp4_quality is already low.\n" if ($verbose); rename_or_delete ($out, $out_tmp, $s); last; } else { # Around the loop again, and retry for a smaller file size... unlink ($out_tmp); $retries++; $prev_bitrate = $size / $dur; # Reset these since we're starting over from the original. ($nw2, $nh2, $nsize) = ($w2, $h2, $size); ($fw, $fh, $size) = ($ofw, $ofh, $osize); } } } # 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 $background_color = 'black' if ($background_color eq 'blur'); $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 $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', '-loglevel', 'info', # So it prints progress '-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', $mp4_quality, # h.264 quality '-pix_fmt', 'yuv420p', '-movflags', 'faststart', # Move index to front $out_tmp); my $errs = exec_1 ("gif", 2, $gif_size, @cmd); 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 a video to an animated GIF. # sub video_to_animgif($$) { 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; }; error ("$name: can't convert $ct to $ct2: Image::Magick not installed") unless $img; my $tmpdir = $out; $tmpdir =~ s@[^/]+$@@s; $tmpdir .= sprintf (".frames.%08x", rand(0xFFFFFFFF)); mkdir ($tmpdir) || error ("mkdir $tmpdir: $!"); push @rm_rf, $tmpdir; my @cmd = ('ffmpeg', '-hide_banner', '-loglevel', 'info', # So it prints progress '-i', $in, "$tmpdir/%06d.png"); my $input_bytes = (stat($in))[7]; my $errs = exec_1 ("gif", 1, $input_bytes, @cmd); print STDERR $errs if ($verbose > 2); my $dur; { my ($hh, $mm, $ss) = ($errs =~ m/ Duration: (\d+):(\d+):([\d.]+)\b/s); error ("no duration: $errs") unless $ss; $dur = $hh*60*60 + $mm*60 + $ss; } opendir (my $dh, $tmpdir) || error ("$tmpdir: $!"); foreach my $f (sort readdir ($dh)) { next if ($f =~ m/^\./si); my $status = $img->Read ("$tmpdir/$f"); error ("$name: ImageMagick: $status") if $status; } closedir $dh; my $frames = scalar @$img; my $fps = $frames / $dur; my $delay = int ((100 * (1 / $fps)) + 0.5); $img->Set (delay => $delay); # Set the output content type. my $status = $img->Set (magick => ct_to_ext ($ct2)); error ("$name: ImageMagick: $status") if $status; constrain_image_1 ($in, $out, $img); } # 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', '-loglevel', 'error', '-ss', $ss, # -ss before -i is way faster '-i', $in, '-vframes', 1, '-f', 'image2', $out_tmp); my $errs = exec_1 ("thumb", 1, 0, @cmd); 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. my $ov = $verbose; $verbose = ($verbose > 0 ? $verbose-1 : 0); constrain_image ($out_tmp, $out_tmp2); $verbose = $ov; 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; # We might change this in the loop; reset it for the next file. my $orig_mp4_quality = $mp4_quality; if ($in =~ m@^https?://(((www\.)?(youtube|vimeo)\.com)|youtu\.be)/@i) { error ("--out must be specified when input is a URL") unless $out; # Make sure it has an MP4 extension my $out2 = $out; $out2 =~ s@\.[^./]+@@s; $out2 .= '.mp4'; push @rm_f, $out2 unless ($out eq $out2); error ("youtubedown not found on \$PATH") unless which ('youtubedown'); my @cmd = ('youtubedown', '-q', '--out', $out2, $in); push @cmd, '-vv' if ($verbose > 2); if ($verbose > 2) { print STDOUT "$progname: executing " . join(' ', @cmd) . "\n"; } elsif ($verbose) { print STDOUT "$progname: downloading $in\n"; } my $ret = safe_system (@cmd); error ("$cmd[0] failed: $ret: $out2") if $ret; $in = $out2; $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\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); error ("can't convert $ct: $in") if ($ct =~ m@^text/@si); my $ext = ct_to_ext ($ct); my ($oext) = ($file =~ m@\.([^./]+)$@s); if ($ext && $ext ne ($oext || '')) { my $f2 = $file; $f2 =~ s@([^./]+)\.([^./]+)$@$1@s; $f2 .= ".$ext"; push @rm_f, $f2; rename ($file, $f2) || error ("mv $file $f2: $!"); print STDERR "$progname: mv $file $f2\n" if ($verbose > 1); $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) || ''; my $intype = ext_to_ct ($in) || ''; error ("ffmpeg not found on \$PATH") if (($ct =~ m/^video/s || $outtype =~ m/^video/s) && !which ('ffmpeg')); error ("lame not found on \$PATH") if ($ct =~ m/^video/s && $replaygain_p && !which ('lame')); if ($ct eq 'image/gif' && $outtype =~ m/^video/s) { animgif_to_mp4 ($in, $out); } elsif ($ct =~ m/^video/s && $outtype =~ m@^image/gif@s) { video_to_animgif ($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|audio)/s && $outtype =~ m/^(video|audio)/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"); } # With --trash, trash the input if --out was specified. # That is, "--trash --out" behaves more like "mv" than "cp". trash ($in) if ($trash_p && $out && $in ne $out && -f $out); $mp4_quality = $orig_mp4_quality; } sub parse_size($$) { my ($arg, $s) = @_; usage ("unparsable size: $arg") unless defined($s); if ($s =~ m/^8K$/si) { $s = '7680x4320'; } elsif ($s =~ m/^UHD$/si) { $s = '7680x4320'; } elsif ($s =~ m/^4320[pi]$/si) { $s = '7680x4320'; } elsif ($s =~ m/^5K$/si) { $s = '5120x2880'; } elsif ($s =~ m/^2880[pi]$/si) { $s = '5120x2880'; } elsif ($s =~ m/^4K$/si) { $s = '4096x2160'; } elsif ($s =~ m/^QHD$/si) { $s = '2560x1440'; } elsif ($s =~ m/^1440[pi]?$/si) { $s = '2560x1440'; } elsif ($s =~ m/^2K$/si) { $s = '2048x1080'; } elsif ($s =~ m/^1080[pi]?$/si) { $s = '1920x1080'; } elsif ($s =~ m/^720[pi]?$/si) { $s = '1280x720'; } elsif ($s =~ m/^PAL$/si) { $s = '720x576'; } elsif ($s =~ m/^576[pi]?$/si) { $s = '720x576'; } elsif ($s =~ m/^DV$/si) { $s = '720x480'; } elsif ($s =~ m/^480[pi]$/si) { $s = '720x480'; } elsif ($s =~ m/^SD$/si) { $s = '640x480'; } elsif ($s =~ m/^NTSC$/si) { $s = '640x480'; } return $s if ($s =~ m/^(\d+)x(\d+)$/s); usage ("unparsable size: $arg $s"); } 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 multiple 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 Convert an MP4 to an anim-GIF: infile.mp4 --out outfile.gif --max-size 480x480 --drop-frames 2/3 Extract a thumbnail frame from an MP4: infile.mp4 --out outfile.jpg Extract audio from a video: infile.mp4 --out outfile.mp3 Options: Strip EXIF and location data: --strip Set allowable sizes: --min-size WxH, 720p, 1080p, 4K, etc. --max-size WxH --min-image-size WxH --max-image-size WxH --min-video-size WxH --max-video-size WxH --max-video-length D Truncate, where D is seconds, or HH:MM:SS.NNN --min-video-length D Loop the video until it is this long. 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: --crop, --crop-image, --crop-video --pad, --pad-image, --pad-video --background "white" (Default padding background is "blur") Successively re-encode the video with a lower quality setting: --max-video-bytes S File size; S can be "S K", "S MB" or "S GB". --max-video-bitrate S File bytes per second; can be "S Mbps", etc. --worst-quality N When re-encoding, don\'t let quality drop below this; default: ' . $mp4_worst_quality . '. Drop N of every M frames from an input anim-GIF, while preserving playback speed: --drop-frames N/M "1/2" means drop every other frame; "1/3" means drop 1 keep 2; "3/4" means keep one frame of every 4. Use defaults appropriate to various services: --preset [ facebook, twitter, instagram, instagram-story, tumblr ] Other: --quality N MP4; 18 is high, 25 is low; default: ' . $mp4_quality . '. JPG: 95 is high, 40 is low; default: ' . $jpeg_quality . '. --autocrop Detect and remove hardcoded video letterboxing. --replaygain Normalize audio volume. --verbose, -vv Print more diagnostics. --quiet Print errors only. --debug Don\'t write files. --progress Print a progress bar for long-running transcodes. --trash Move the old file to ~/.Trash/ --lock Wait for other runs of this program to complete. '; exit 1; } sub main() { my @infiles = (); my $outfile = undef; my $any_p = 0; my $lock_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/^--?progress$/s) { $progress_p++; } elsif (m/^--?no-progress$/s) { $progress_p = 0; } elsif (m/^--help$/) { usage(undef); } 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/^--?quality$/s) { $mp4_quality = 0 + shift @ARGV; $any_p++; } elsif (m/^--?worst-quality$/s) { $mp4_worst_quality = 0 + shift @ARGV; $any_p++; } elsif (m/^--?autocrop$/s) { $autocrop_p = 1; $any_p++; } elsif (m/^--?replaygain$/s) { $replaygain_p = 1; $any_p++; } elsif (m/^--?trash$/s) { $trash_p = 1; } elsif (m/^--?no-trash$/s) { $trash_p = 0; } elsif (m/^--?lock$/) { $lock_p = 1; } 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/^--?min-size$/s) { $min_video_size = $min_image_size = parse_size ($_, shift @ARGV); $any_p++; } elsif (m/^--?max-size$/s) { $max_video_size = $max_image_size = parse_size ($_, shift @ARGV); $any_p++; } elsif (m/^--?min-image-size$/s) { $min_image_size = parse_size ($_, shift @ARGV); $any_p++; } elsif (m/^--?max-image-size$/s) { $max_image_size = parse_size ($_, shift @ARGV); $any_p++; } elsif (m/^--?min-video-size$/s) { $min_video_size = parse_size ($_, shift @ARGV); $any_p++; } elsif (m/^--?max-video-size$/s) { $max_video_size = parse_size ($_, shift @ARGV); $any_p++; } elsif (m/^--?max-video-bitrate$/s) { my $s = shift @ARGV; my ($n, $unit) = ($s =~ m@^(\d+(?:\.\d+)?)\s*([a-z/]+)?\s*$@si); usage ("unparsable bitrate: $_ $s") unless ($n); if (!$unit || $unit =~ m@^(b|B|B/s|Bps|bytes?)$@s) { } elsif ($unit =~ m@^(bps|bits?)$@s) { $n /= 8; } elsif ($unit =~ m@^(k|K|KB|KB/s|KBps)$@s) { $n *= 1024; } elsif ($unit =~ m@^(m|M|MB|MB/s|MBps)$@s) { $n *= 1024 * 1024; } elsif ($unit =~ m@^(Kb|Kb/s|Kbps)$@s) { $n *= 128; } elsif ($unit =~ m@^(kb|kb/s|kbps)$@s) { $n *= 128; } elsif ($unit =~ m@^(Mb|Mb/s|Mbps)$@s) { $n *= 128 * 1024; } elsif ($unit =~ m@^(mb|mb/s|mbps)$@s) { $n *= 128 * 1024; } else { error ("unparsable units: $s"); } $max_video_bitrate = $n; $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 || ''; unshift @ARGV, ('--quality', 24); # Lower quality for all presets 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', #'--crop-image', # Good for photos, bad for flyers. ); } 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', '--crop-video', #'--crop-image', # Good for photos, bad for flyers. ); } elsif ($p eq 'instagram-hootsuite') { unshift @ARGV, ('--preset', 'instagram', # Required by Hootsuite, but I think not by Instagram. '--max-video-bitrate', '5Mbps', '--worst-quality', '40', ); } 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, $_; $any_p = 1 if (m/^https?:/s); # downloading counts as an alteration. } } 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"); } else { acquire_lock() if $lock_p; if ($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;