You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

164 lines
4.2KB

  1. #!/usr/bin/env perl
  2. use strict;
  3. use warnings;
  4. use File::Path;
  5. use Getopt::Long;
  6. use File::Copy qw(copy);
  7. ## Parse arguments
  8. my $updir = 0;
  9. my $help = 0;
  10. my $forcecover;
  11. GetOptions(
  12. "help" => \$help,
  13. "updir=i" => \$updir,
  14. "cover=s" => \$forcecover)
  15. or die("Error in command line options");
  16. if ($help) {
  17. help();
  18. }
  19. if (scalar @ARGV != 2) {
  20. print("Bad arguments\n");
  21. usage();
  22. }
  23. my ($IDIR, $ODIR) = @ARGV;
  24. my @flacMapPaths = mapInputToOutput($IDIR, $ODIR, q(*.flac));
  25. my $sizeLength = scalar @flacMapPaths != 0 ? int(log(scalar @flacMapPaths / 2)/log(10)) : 0;
  26. ## Transcode here
  27. for (my $i = 0; $i < @flacMapPaths; $i += 2) {
  28. my $inp = $flacMapPaths[$i ];
  29. my $out = $flacMapPaths[$i+1];
  30. $out =~ s/\.flac$/.opus/;
  31. next if (-e $out);
  32. File::Path::make_path(dirname($out));
  33. $inp = qq($inp);
  34. $out = qq($out);
  35. my $coverOpts = "";
  36. my $cover = $forcecover;
  37. if ($cover || (!hasImage($inp) && defined($cover = getcover($inp)))) {
  38. $coverOpts .= qq(--picture "$cover");
  39. print("## Adding cover $cover ##\n");
  40. }
  41. printf("[%0*d/%d] %s -> %s\n", $sizeLength, $i/2+1, @flacMapPaths / 2, $inp, $out);
  42. `opusenc --music --comp 10 $coverOpts -- "$inp" "$out"`;
  43. }
  44. print("## Starting copying files ##\n");
  45. my @plainMapPaths = mapInputToOutput($IDIR, $ODIR, "*.mp3' -o -iname '*.m4a' -o -iname '*.ogg' -o -iname '*.opus");
  46. $sizeLength = scalar @plainMapPaths != 0 ? int(log(scalar @plainMapPaths / 2)/log(10)) : 0;
  47. ## Just copy here
  48. for (my $i = 0; $i < @plainMapPaths; $i += 2) {
  49. my $inp = $plainMapPaths[$i ];
  50. my $out = $plainMapPaths[$i+1];
  51. next if (-e $out);
  52. # TODO? Add covers to these too? Naaah
  53. File::Path::make_path(dirname($out));
  54. printf("[%0*d/%d] %s -> %s\n", $sizeLength, $i/2+1, @plainMapPaths / 2, $inp, $out);
  55. copy($inp, $out);
  56. }
  57. print("\n## Conversion done! ##\n");
  58. exit(0);
  59. ###############################################################################
  60. ###############################################################################
  61. ## Return a list of string pairs that maps like this:
  62. ## original file name, output file name ...
  63. ## Args:
  64. ## 1) input directory
  65. ## 2) output directory
  66. ## 3) iname option for find
  67. sub mapInputToOutput {
  68. my $inpDir = shift;
  69. my $outDir = shift;
  70. my $fglob = shift;
  71. ## Get the path of every file in the given directory, and below it
  72. my @files = qx(find "$inpDir" -type f -iname '$fglob');
  73. ## Get directories where files are located
  74. my @dirs;
  75. foreach my $file (@files) {
  76. #$file =~ s/\R//;
  77. chomp($file);
  78. my $found = 0;
  79. my $dirn = dirname($file);
  80. foreach my $dir (@dirs) {
  81. if ($dir eq $dirn) {
  82. $found = 1;
  83. last;
  84. }
  85. }
  86. if (!$found) {
  87. push(@dirs, $dirn);
  88. }
  89. }
  90. my @splitInpDir = split("/", $inpDir);
  91. my @plusDirs = @splitInpDir[scalar @splitInpDir - $updir..scalar @splitInpDir - 1];
  92. my $outpath = "$outDir/" . join("/", @plusDirs);
  93. my @result;
  94. foreach my $file (@files) {
  95. chomp($file);
  96. my $outfname = "$outpath/" . substr($file, length $inpDir);
  97. my $inp = qq($file);
  98. my $out = qq($outfname);
  99. push(@result, $file);
  100. push(@result, $outfname);
  101. }
  102. return @result;
  103. }
  104. ## Easy, just print how to use
  105. sub usage {
  106. print("Usage: $0 [-h | --help] [-u | --uplevel NUM] [-c | --cover IMG] <input_dir> <output_dir>\n");
  107. exit 1;
  108. }
  109. sub help {
  110. my $h = <<EOF;
  111. Usage:
  112. flac-mass-transcode.pl [options] <input_dir> <output_dir>
  113. -h, --help print this help text
  114. -u, --uplevel NUM take this number of directories from the input path
  115. -c, --cover IMG add this image as an album cover
  116. EOF
  117. print("$h");
  118. exit 0;
  119. }
  120. ## Get the directory of the file
  121. ## /a/b/c.flac -> /a/b
  122. sub dirname {
  123. my $str = shift;
  124. my $ind = rindex($str, '/');
  125. return substr($str, 0, $ind);
  126. }
  127. ## Search for a cover image in the given path
  128. sub getcover {
  129. my $flacpath = shift;
  130. my $dir = dirname($flacpath);
  131. my $regex = "\\(thumb\\|albumartwork\\|cover\\|folder\\)\\.\\(pn\\|jp\\)g\$";
  132. my $cmd = "find '$dir' -maxdepth 20 -type f -iregex '.*/$regex'";
  133. my @imgs = split(/\n/, `$cmd`);
  134. return undef if scalar(@imgs) == 0;
  135. return $imgs[0];
  136. }
  137. ## Checks if a flac file has a cover embedded or not
  138. sub hasImage {
  139. my $flacpath = shift;
  140. my $fname = qq($flacpath);
  141. my $lines = `metaflac --list --block-type=PICTURE "$fname" | wc -l`;
  142. return $lines != 0;
  143. }