recompress_audio_track.pl 2.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105
  1. #!/usr/bin/perl
  2. # Author: Trizen
  3. # Date: 06 September 2023
  4. # https://github.com/trizen
  5. # Make video files smaller, by recompressing the audio track to the OPUS format (40kbps), using ffmpeg.
  6. # Requires the following tools:
  7. # ffmpeg
  8. # exiftool
  9. # Usage:
  10. # perl recompress_audio_track.pl [files | directories]
  11. use 5.036;
  12. use File::Temp qw(mktemp);
  13. use File::Find qw(find);
  14. use File::Copy qw(move);
  15. use File::Basename qw(dirname basename);
  16. use File::Spec::Functions qw(catfile);
  17. sub is_video_file ($file) {
  18. my $res = `exiftool \Q$file\E`;
  19. $? == 0 or return;
  20. defined($res) or return;
  21. $res =~ m{^MIME\s+Type\s*:\s*video/}mi;
  22. }
  23. sub recompress_audio_track ($video_file) {
  24. say ":: Extracting audio track...";
  25. my $orig_audio_file = mktemp("tempXXXXXXXXXXX") . '.mkv';
  26. system("ffmpeg", "-loglevel", "warning", "-i", $video_file, "-vn", "-acodec", "copy", $orig_audio_file);
  27. $? == 0 or do {
  28. unlink($orig_audio_file);
  29. return;
  30. };
  31. say ":: Recompressing audio track...";
  32. my $new_audio_file = mktemp("tempXXXXXXXXXXX") . '.opus';
  33. system("ffmpeg", "-loglevel", "warning", "-i", $orig_audio_file, "-vn", "-sn", "-dn", "-c:a", "libopus", "-b:a", "40K", $new_audio_file);
  34. $? == 0 or do {
  35. unlink($new_audio_file);
  36. return;
  37. };
  38. # When the original file is smaller, keep the original file
  39. if ((-s $orig_audio_file) <= (-s $new_audio_file)) {
  40. say ":: The original audio track is smaller... Will keep it...";
  41. unlink($new_audio_file);
  42. $new_audio_file = $orig_audio_file;
  43. }
  44. say ":: Merging the recompressed audio track with the video...";
  45. my $new_video_file = mktemp("tempXXXXXXXXXXX") . '.mkv';
  46. system("ffmpeg", "-loglevel", "warning", "-i", $video_file, "-i", $new_audio_file,
  47. "-map_metadata", "0", "-map", "0:v", "-map", "1:a", "-map", "0:s?", "-c", "copy", $new_video_file);
  48. $? == 0 or do {
  49. unlink($new_audio_file);
  50. unlink($new_video_file);
  51. return;
  52. };
  53. my $dir = dirname($video_file);
  54. my $basename = basename($video_file) =~ s{\.\w+\z}{.mkv}r;
  55. my $final_video_file = catfile($dir, $basename);
  56. if ($final_video_file !~ /\.mkv\z/) {
  57. $final_video_file .= '.mkv';
  58. }
  59. my $original_size = -s $orig_audio_file;
  60. my $new_size = -s $new_audio_file;
  61. printf(":: Saved: %.2f MB (%.2f%%)\n", ($original_size - $new_size) / 1024**2, ($original_size - $new_size) / $original_size * 100);
  62. unlink($video_file);
  63. unlink($new_audio_file);
  64. unlink($orig_audio_file);
  65. move($new_video_file, $final_video_file);
  66. }
  67. my @dirs = @ARGV;
  68. if (not @dirs) {
  69. die "usage: $0 [files | directories]\n";
  70. }
  71. find(
  72. {
  73. wanted => sub {
  74. if (-f $_ and is_video_file($_)) {
  75. say "\n:: Processing: $_";
  76. recompress_audio_track($_);
  77. }
  78. },
  79. },
  80. @dirs
  81. );