25'ten fazla konu seçemezsiniz Konular bir harf veya rakamla başlamalı, kısa çizgiler ('-') içerebilir ve en fazla 35 karakter uzunluğunda olabilir.

161 satır
4.0KB

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