pastebin - collaborative debugging tool
kpaste.net RSS


flac2lame perl script threaded
Posted by Anonymous on Sat 15th Sep 2012 12:43
raw | new post

  1. #!/usr/bin/perl
  2.  
  3. # Copyright © 2012 Adam Nilsson
  4. #
  5. # This program is free software: you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License as published by
  7. # the Free Software Foundation, either version 3 of the License, or
  8. # (at your option) any later version.
  9. #
  10. # This program is distributed in the hope that it will be useful,
  11. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. # GNU General Public License for more details.
  14. #
  15. # You should have received a copy of the GNU General Public License
  16. # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17.  
  18. # This script decodes FLAC files into RAM up to the limit defined in
  19. # $disk_size. The $total variable is used to count the total amount
  20. # of data decoded and stored in RAM at any time.
  21.  
  22. # The script looks for the CPU core count in /proc/cpuinfo and starts
  23. # as many threads of 'lame' as it finds cores. The threads are left
  24. # waiting for files to be enqueued.
  25.  
  26. use 5.14.0;
  27. use strict;
  28. use warnings;
  29. use Cwd qw(abs_path);
  30. use File::Path qw(make_path);
  31. use File::Basename qw(basename);
  32.  
  33. use threads qw(yield);
  34. use threads::shared;
  35. use Thread::Queue;
  36.  
  37. my $total :shared = 0;
  38. my $disk_size = 1000000000;
  39. my $end :shared;
  40. my %decoded :shared;
  41.  
  42. my @dirs;
  43. my %pcm :shared;
  44. my @opts = ('-q 0', '-V 2', '--silent', '--id3v2-only');
  45. my $q = Thread::Queue->new();
  46. chomp(my $cpu_count = `grep -c "^processor" /proc/cpuinfo`);
  47.  
  48. if (!$ARGV[0] || ! -d $ARGV[0]) {
  49.         say "Usage: " . basename($0) .
  50.         " [FLAC directory 1] .. [FLAC directory n]";
  51.         exit;
  52. }
  53.  
  54. foreach my $arg (@ARGV) {
  55.         my $src = abs_path($arg);
  56.         if (-d $src) {
  57.                 getdirs($src);
  58.         }
  59. }
  60.  
  61. sub gettags {
  62.         my $fn = shift;
  63.         my (%t, @mflac);
  64.         open(OUTPUT, '-|',
  65.         qq{metaflac --no-utf8-convert --export-tags-to=- "$fn"})
  66.         or die "can't run metaflac: $!";
  67.  
  68.         chomp(@mflac = (<OUTPUT>));
  69.         foreach (@mflac) {
  70.                 my @tag = split('=');
  71.                 my $tagname = lc($tag[0]) or say $fn;
  72.  
  73.                 if ($t{$tagname}) { next; }
  74.                 elsif ($tag[1]) {
  75.                         $t{$tagname} = quotemeta($tag[1]); }
  76.                 else { $t{$tagname} = 'null'; }
  77.         }
  78.         close(OUTPUT) || die "couldn't close metaflac: $!";
  79.         return %t;
  80. }
  81.  
  82. sub getdirs {
  83.  
  84.         my $dn = shift;
  85.  
  86.         open(FIND, '-|', qq{find -L "$dn" -name "*" -type d})
  87.         or die "Can't run 'find': $!";
  88.         push(@dirs, (<FIND>));
  89.         chomp(@dirs);
  90.         close(FIND) or die "Can't close 'find': $!";
  91. }
  92.  
  93. sub getfiles {
  94.         my $dn = shift;
  95.         my @files;
  96.         opendir(my $dh, $dn) or die "Can't open directory '$dn': $!";
  97.         foreach (readdir $dh) {
  98.                 my $fn = "$dn/$_";
  99.                 if (/.flac$/ && -f $fn) {
  100.                         push(@files, $fn);
  101.                 }
  102.         }
  103.         closedir $dh or die "Can't close directory '$dn': $!";
  104.         return @files;
  105. }
  106.  
  107. sub name {
  108.  
  109.         my $fn = shift;
  110.         my %t = gettags($fn);
  111.         my $tref = \%t;
  112.         my $dest;
  113.  
  114.         checktags($fn, $tref);
  115.  
  116.         my %ct = ( albumartist => $t{albumartist}, album => $t{album},
  117.         discnumber => $t{discnumber}, tracknumber => $t{tracknumber},
  118.         title => $t{title} );
  119.  
  120.         foreach my $tag (keys(%ct)) {
  121.                 $ct{$tag} =~ s/[[:punct:]]//g;
  122.         }
  123.  
  124.         my @dest = ($ENV{HOME}, 'lame', $ct{albumartist},
  125.         $ct{album});
  126.         { local $" = '/'; $dest = "@{dest}/"; }
  127.  
  128.         unless (-d $dest) {
  129.                 make_path($dest) or warn "Can't make_path '$dest': $!";
  130.                 #system('mkdir', '-p', $dest) or warn "Can't run 'mkdir': $!";
  131.         }
  132.  
  133.         my $newfn = sprintf('%s-%02s. %s.mp3', $ct{discnumber},
  134.         $ct{tracknumber}, $ct{title});
  135.         $newfn = $dest . $newfn;
  136.  
  137.         return($newfn, $tref);
  138. }
  139.  
  140. sub decode {
  141.  
  142.         my $fn = shift;
  143.         local $/; # Enable slurp mode.
  144.         open(FLAC, '-|:raw', qq{flac --silent --stdout --decode "$fn"})
  145.         or die "can't run 'flac': $!";
  146.         chomp($pcm{$fn} = (<FLAC>));
  147.         close(FLAC) || die "couldn't close 'flac': $!";
  148.         lock(%decoded);
  149.         lock($total);
  150.         $decoded{$fn} = 1;
  151.         $total += length($pcm{$fn});
  152. }
  153.  
  154. sub checktags {
  155.         my $fn = shift;
  156.         my $tref = shift;
  157.         my %t = %{$tref};
  158.         foreach my $tag ('discnumber', 'albumartist', 'album',
  159.         'tracknumber', 'title') {
  160.                 if (! $t{$tag}) {
  161.                         say "${fn}: missing '$tag' tag.";
  162.                         exit;
  163.                 }
  164.         }
  165. }
  166.  
  167. say "Starting threads";
  168. my @threads;
  169. foreach (1 .. $cpu_count) {
  170.         push(@threads, threads->create(\&lame));
  171. }
  172.  
  173. sub lame {
  174.  
  175.         while (!$q->pending() && !$end) {
  176.                 yield();
  177.         }
  178.  
  179.         my $tid = threads->tid();
  180.         my @old_opts = @opts;
  181.  
  182.         LOOP: while (my $fn = $q->dequeue_nb()) {
  183.  
  184.                 my $oldfn = $fn;
  185.                 my ($newfn, $tref) = name($fn);
  186.                 my %t = %{$tref};
  187.  
  188.                 foreach my $tag ('artist', 'title', 'album', 'tracknumber',
  189.                 'date') {
  190.                         if ($t{$tag}) {
  191.                                 given($tag) {
  192.                                         when ('artist') {
  193.                                                 push(@opts, ('--ta', $t{artist}));
  194.                                         }
  195.                                         when ('title') {
  196.                                                 push(@opts, ('--tt', $t{title}));
  197.                                         }
  198.                                         when ('album') {
  199.                                                 push(@opts, ('--tl', $t{album}));
  200.                                         }
  201.                                         when ('tracknumber') {
  202.                                                 push(@opts, ('--tn', $t{tracknumber}));
  203.                                         }
  204.                                         when ('date') {
  205.                                                 $t{date} =~ /[0-9]{4}/;
  206.                                                 push(@opts, ('--ty', $t{date}));
  207.                                         }
  208.                                 }
  209.                         }
  210.                 }
  211.  
  212.                 say "thread${tid} ${newfn}: encoding...";
  213.                 open(LAME, '|-:raw', qq{lame @opts - "$newfn"})
  214.                 or die "can't run 'lame': $!";
  215.                 print LAME $pcm{$oldfn};
  216.                 close(LAME) || die "couldn't close 'lame': $!";
  217.  
  218.                 @opts = @old_opts;
  219.                 lock(%pcm);
  220.                 lock($total);
  221.                 $total -= length($pcm{$oldfn});
  222.                 delete($pcm{$oldfn});
  223.         }
  224.        
  225.         if (!$q->pending() && !$end) {
  226.                 yield();
  227.                 goto(LOOP);
  228.         }
  229. }
  230.  
  231. foreach my $dn (sort(@dirs)) {
  232.  
  233.         my @files = getfiles($dn);
  234.  
  235.         if (!@files) {
  236.                 next;
  237.         }
  238.  
  239.         foreach my $fn (@files) {
  240.  
  241.                 decode($fn);
  242.  
  243.                 # If the RAM disk is full, put decoded files in the queue,
  244.                 # and then yield until the LAME threads have cleared some RAM.
  245.  
  246.                 while ($total > $disk_size) {
  247.                         foreach my $fn (keys(%decoded)) {
  248.                                 $q->enqueue($fn);
  249.                                 lock(%decoded);
  250.                                 delete($decoded{$fn});
  251.                         }
  252.                         yield();
  253.                 }
  254.         }
  255.        
  256.         foreach my $fn (keys(%decoded)) {
  257.                 $q->enqueue($fn);
  258.                 lock(%decoded);
  259.                 delete($decoded{$fn});
  260.         }
  261. }
  262.  
  263. $end = 1;
  264.  
  265. foreach my $t (threads->list()) { $t->join(); }
  266. say "All threads joined";

Submit a correction or amendment below (click here to make a fresh posting)
After submitting an amendment, you'll be able to view the differences between the old and new posts easily.

Syntax highlighting:

To highlight particular lines, prefix each line with {%HIGHLIGHT}





All content is user-submitted.
The administrators of this site (kpaste.net) are not responsible for their content.
Abuse reports should be emailed to us at