Here, BTW, is the complete prog. Tried to post it earlier as a response, but it wouldn't let me create a response -- only add to the original post...
#!/usr/bin/perl -w
use 5.12.0;
use warnings FATAL => 'all';
use Carp::Always;
our ($__PB, $__SB, $__NR) = qw{ /usr/bin/perl /usr/bin/sudo };
unless (defined ($ENV{PERLDB_OPTS}) && $ENV{PERLDB_OPTS} =~ /warnLevel
+/) {
$ENV{PERLDB_OPTS}="NonStop -o dieLevel=1 -o warnLevel=1";
exec $__PB, ("-S", "$0", "-wd", @ARGV);
}
$__NR && $>==0 and (-x $__SB && exec $__SB, ($__PB, "-S", "$0", @ARGV)
+) ||
die "must be run as root";
# gvim=:SetNumberAndWidth #rm 'no' to activate in gvim, '=:' delibe
+rate
use Readonly; sub RO(\[$@%]@){goto &Readonly};
my ($Devel, $Debuff_Output) = (1,1);
if ($Debuff_Output) { select STDERR; $| = 1; select STDOUT; $| = 1; }
#use Fcntl;
#use POSIX qw(strftime);
#use Time::HiRes qw (usleep gettimeofday tv_interval);
# $start =[gettimeofday];
# $elapsed = tv_interval ($t0 , < [$seconds, $microseconds] | [gettime
+ofday]);
# $float_start=gettimeofday; $float_elapsed=gettimeofday-$float_start;
# see Bench.template for Benchmark code; (probably want Time::HiRes)!!
+!
use utf8;
use charnames ':full';
use Time::HiRes qw(sleep);
use version;
binmode STDOUT, ':encoding(UTF-8)';
binmode STDERR, ':encoding(UTF-8)';
## Generic prog devel stuff I often use -- meant to be copied
## to start new prog, and deleted to fit...
my $curdir = getcwd;
my $please_die = 0;
my $signame;
my @stdpath = qw( /usr/local/bin /usr/bin );
RO my $Wav => 1;
RO my $Mp3 => 2;
RO my $Flac => 3;
my %ext2cons = {
'wav' => $Wav,
'mp3' => $Mp3,
'flac'=> $Flac,
};
package ID3_Vars;
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT=qw(
album album_artist
+ artist
clipdetect displaytime
+ freeDB_DiskID
genre histogram
+ interchannelmaskratio
noverbose quality
+ replaygain_accurate
temporalmasking trknum
+ trktitle
year vbr
);
our (
$album, $album_artist,
+ $artist,
$clipdetect, $displaytime,
+ $freeDB_DiskID,
$genre, $histogram,
+ $interchannelmaskratio,
$noverbose, $quality,
+ $replaygain_accurate,
$temporalmasking, $trknum,
+ $trktitle,
$vbr, $year,
);
package Debug;{
use Readonly; sub RO(\[$@%]@) {goto &Readonly};
use Exporter 'import';
our @ISA = qw (Exporter);
our @EXPORT=qw( Debug DEBUG_OPS $Filename2Fields $Halt_on_Error);
BEGIN {$INC{+__PACKAGE__}=__FILE__}
my %dop = (
Filename2Fields => 1,
HaltOnError => 2,
);
sub _flagval { return $dop{$_[0]} }
our $Filename2Fields = $dop{Filename2Fields};
our $HaltOnError = $dop{HaltOnError};
our $DEBUG_OPS = 0
| $Filename2Fields
| $HaltOnError
;
sub Debug($$) {
my ($what, $str)=@_;
if ($what & $DEBUG_OPS) { print STDERR $str; }
}
}
;
package Transcode_plug;{
use Debug;
import Vars;
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT=qw( album album_artist artist freeDB_DiskID
genre trknum trktitle year push_ar
+ginfo
get_bin_path );
sub get_fieldAR_from_filename($) {
my $file=$_[0];
Debug($Filename2Fields,"get_fieldAR_from_filename($file)\n");
my ($trknum, $trktitle, $artist, $album_artist,
$genre, $year,$freeDB_DiscID);
my ($rest,$tt_a, $aa_g_y);
($trknum,$rest) = $file =~ /(\d+)-(.*)/;
my ($lastchr,) = $rest =~ /^.*?(.)$/;
Debug($Filename2Fields,"lastchr=$lastchr\n");
if ($lastchr && $lastchr eq ']') {
($rest,$freeDB_DiscID) = $rest =~ /(.*) \[ ( .* ) /x;
$freeDB_DiscID =~ s/\]//;
}
Debug($Filename2Fields,"rest=$rest\n");
($tt_a,$aa_g_y)= ($rest =~ / (.*) \}-\{ (.*\}.*) \)$/x);
Debug($Filename2Fields,"tt_a=$tt_a, aa_g_y=$aa_g_y\n");
if ( ($tt_a,$aa_g_y) = $rest =~ / (.*) \}-\{ (.*\}.*) \)$/x )
+{
Debug($Filename2Fields,"tt_a=$tt_a, aa_g_y=$aa_g_y\n");
($trktitle, $artist) = $tt_a =~ /(.*) -\{ (.*) /x;
Debug($Filename2Fields,"tt=$trktitle, a=$artist\n");
# - (todo?) %XX as hex encodings and %U+XXXX as Unicode
# make sure no spaces at e
+nd of title
($album_artist, $genre, $year) = $trktitle =~ s/^(.*?)\s+$
+/$1/;
# - substitute full-width colons for "- " in "album" (base
+-dir)
$album =~ s/- /\N{FULLWIDTH COLON}/g;
$artist //= $album_artist;
$album_artist = "Various" unless length $album_artist;
return ($trknum,$trktitle, $artist, $album_artist,
$genre, $year, $freeDB_DiscID);
}
}
# get fields from filename - old pattern:
# m{(\d+)-(.*)-(.*?)_\((.*?)-(.*),(\d+)\)$}
# old filename pattern not robust enough! new pattern:
# \d+-TrackTitle-{Artist}-{AlbumArtist}(Genre,Year)[FreeDB_Dis
+cID]
# if something in 'BinEnvName' and -e -x, then use it; -- no PATH
+search
# else search PATH & stdpath for lame binary
sub get_bin_path($$) {
my ($BinName, $BinEnvName) = @_;
my $EnvBinPath=$ENV{$BinEnvName};
if ($EnvBinPath) {
if (-f $EnvBinPath && -x $EnvBinPath) { return $EnvBinPath
+ }
print STDERR "WARNING: ENV var \"$BinEnvName\" is set,",
"but does not point to an executa
+ble file.\n",
" Searching Path for \"$BinNam
+e\".\n";
}
my $pathp = ARp_fromPath($ENV{'PATH'});
$pathp = append_path($pathp, \@stdpath);
foreach(@$pathp) {
my $binary=$_ . '/' . $BinName;
return -f $binary && -x $binary ? $binary: undef;
}
}
# vars common to transcoders of Music...id3v2.3, id3v2.4 fields
#
sub init_common_from_env {
( $noverbose, $clipdetect, $d
+isplaytime,
$histogram, $interchannelmaskratio, $quali
+ty,
$replaygain_accurate, $temporalmasking, $vbr)
= ( $ENV{'NoVerbose'} // 1,
$ENV{'ClipDetect'} // 1,
$ENV{'DisplayTime'},
$ENV{'HistoGram'} // "-
+-nohist",
$ENV{'InterChannelMaskRatio'} // ".2",
$ENV{'Quality'} //
+"0",
$ENV{'ReplayGain_Accurate'} // "1",
$ENV{'TemporalMasking'} // "1",
$ENV{'Vbr'}
+ // 0,
);
}
#TODO: read fields from existing meta data if going from a format
# w/metadata to another;
#
sub get_fieldHASH_from_meta($$) { undef }
sub push_arginfo($$) {
my ($keyp, $valp) = @_;
$keyp && $valp or
die sprintf "Invalid params keyp=%s, valp=%s\n", $keyp, $v
+alp;
my @arglist;
my ($arg,$type) = @$valp;
my $key = *$keyp;
if ($key) {
#TODO: Need constants instead of numbers or something bett
+er
given ($type) {
when (0) { push @arglist,$arg }
when (1) { push @arglist,$arg, $key; }
when (2) { push @arglist,"$arg=$key"; continue }
when (3) { push @arglist, "--tag=$arg=$key" }
when (length $type && length $type > 1 && $type =~ /%
+/) {
my @fmt=($type, $arg, $key);
push @arglist, sprintf @fmt;
}
default {
printf STDERR
"Fatal: Corruption indicated on Invalid type %s, a
+rg=%s\n",
$type//"undef", $arg//"undef";
}
}
}
vars('s','arglist',\@arglist);/
}
};
package Lame; {
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT=qw( push_args get_path);
import push_arginfo;
our ($abr, $cbr, $minbitrate, $preset, $resample, $lowpass, $downm
+ix);
our ($addid3v2, $id3v2_only);
our %lame_vars_to_fields = (
\$album, ["--tl", 1],
\$artist, ["--ta", 1],
\$genre, ["--tg", 1],
\$trknum, ["--tn", 1],
\$trktitle, ["--tt", 1],
\$year, ["--ty", 1],
## lame params
\$addid3v2, ["--add-id3v2", 0],
\$id3v2_only, ["--id3v2-only", 0],
\$abr, ["--abr", 1],
\$cbr, ["--cbr", 1],
\$clipdetect, ["--clipdetect", 0],
\$displaytime, ["--disptime", 1],
\$downmix, ["-a", 0],
\$histogram, ["--nohist", 0],
\$interchannelmaskratio, ["--interch", 1],
\$lowpass, ["--lowpass", 1],
\$minbitrate, ["-b", 1],
\$noverbose, ["-S", 0],
\$preset, ["--preset", 1],
\$quality, ["-q", 1],
\$replaygain_accurate, ["--replaygain-accurate", 0],
\$resample, ["--resample", 1],
\$temporalmasking, ["--temporal-masking", 1],
\$vbr, ["-V", 1],
);
########
## Lame(Mp3) helpers & arg pushing
##
sub get_path() { get_bin_path('lame', 'LAME') }
sub push_args() {
$id3v2_only=1;
foreach my $keyp (keys %lame_vars_to_fields) {
my $valp=$lame_vars_to_fields{$keyp};
push_arginfo($keyp, $valp);
}
}
}
};
package Flac; {
use Exporter;
our @ISA = qw(Exporter);
import push_arginfo;
our ( $best,
$catalog, $catalog_number, $CDDB, $composer,
$discid,
$disc_number,
$max_lpc_order,
$exhaustive_model_search, $qlp_coeff_precision_search,
$force,
$replay_gain,
$silent,
$totally_silent,
$total_discs,
$performer, $publisher,
);
my %flac_vars_to_fields = (
[\$album, "Albu
+m", 3],
[\$album_artist, "Album Artist"
+, 3],
[\$artist, "Artist"
+, 3],
[\$CDDB, "CDDB"
+, 3],
[\$genre, "Genr
+e", 3],
[\$catalog, "Catalo
+g", 3],
[\$catalog_number, "Catalog Number"
+, 3],
[\$composer, "Composer"
+, 3],
[\$disc_number, "DiscNumber
+", 3],
[\$discid, "DiscID"
+, 3],
[\$performer, "Performe
+r", 3],
[\$publisher, "Publishe
+r", 3],
[\$trktitle, "Title", 3
+],
[\$total_discs, "TotalDiscs
+", 3],
[\$trknum, "TrackNu
+mber", 3],
[\$year, "Date"
+, 3],
[\$force, "--fo
+rce", 2],
[\$silent, "--silen
+t", 2],
[\$totally_silent, "--totally-silen
+t", 2],
[\$best, "--bes
+t", 2],
[\$exhaustive_model_search, "--exhaustive-model-sea
+rch", 2],
[\$max_lpc_order, "--max-lpc_or
+der",3],
[\$qlp_coeff_precision_search,"--qlp-coeff-precision-searc
+h", 2],
[\$replay_gain, "--replay-g
+ain", 2],
);
sub push_args() {
($best, $exhaustive_model_search,
$replay_gain, $qlp_coeff_precision_search) = (1, 1, 1, 1);
($totally_silent,$silent,$force) = (1,1,1);
$max_lpc_order = 16;
foreach my $keyp (keys %flac_vars_to_fields) {
my $valp=$flac_vars_to_fields{$keyp};
push_arginfo($keyp, $valp);
}
}
};
package Vars;
use Exporter 'import';
our @ISA = qw(Exporter);
our @EXPORT = qw (var);
sub HaCF() {
use Carp qw(confess);
confess("Called unsupported function, going down in flames...\
+n");
}
sub var {
state $vp;
$vp={} unless $vp;
my ($name,$op,$data) = @_;
given($op) {
when (/^s(?:et)?/) {
$vp->{$name}=$data;
}
when ( m{^g(?:et)?}) {
return $vp->{name}
}
default {
# tricky case as it is not explicit.
# 1) act like a 'getter-setter', with extra behaviors:
# a) A get with an unused return value, yields a r
+un-time warning
# b) a get on a non existent value returns an ERRN
+O
#
if (defined $name && defined $op && defined $data) {
printf "Unknown op \"%s\" on name \"%s,\" w/data
+\"%s\"\n",
$op, $name // "undef", $data//"und
+ef";
HaCF();
} elsif (defined $name && defined $op) {
$vp->{$name}=$op;
} elsif (wantarray == undef) {
my $loc = caller
warn sprintf ("Unless use of %s in %s at %s, line
+%s\n",
$name, caller);
return undef;
} elsif (defined $name) { # no 2nd arg
use Errno;
if (not defined wantarray) {
my $loc = caller
warnmsg("Useless use of %s in %s at %s, line %
+s\n",
$name, caller);
$! = &Errno::EOVERFLOW; undef;
} elsif (exists $vp->{$name}) {
$! = 0;
return wantarray? ($vp->{$name}, $!) : $vp->{$
+name};
} else {
$! = &Errno::ENOENT; #no entry in direc
+tory of vars
return wantarray? (undef, $!) : undef;
}
}
}
}
}
}
package Transcode; #{
import Debug;
import Vars;
use POSIX qw(nice);
use charnames ':full';
{ my @cons2ext = qw (undef wav mp3 flac);
sub SrcExt () { cons2ext[var('from_type')] }
sub DstExt () { cons2ext[var('to_type')] }
}
my ($SrcExt = &SrcExt, $quiet = vars('quiet'), $DstExt = &DstExt);
my $CodeTo = vars('to_type');
#$SrcExt $quiet $DstExt $CodeTo $Mp3
sub TranscodeSrc2Dst($$) {
my ($path, $file) = @_;
my $oldfn = $path . '/' . $file;
use Errno;
($album,) = ($path =~ m{^.*/([^\/]+)/?$});
$file =~ s/$SrcExt$//;
my %basic_tags;
my %extended_tags;
my %extended_tags_from_file;
my @fieldAR_from_filename;
($trknum, $trktitle, $artist, $album_artist,
$genre, $year, $freeDB_DiscID) =
@fieldAR_from_filename=get_fieldAR_from_filename($file) o
+r do {
print STDERR
"Warning: ##-TrackTitle-{Artist}-{AlbumArtist}(Gen
+re,Year)" .
" not found from $file\n" if !$quiet;
my %fields;
if (get_fieldHASH_from_filename_meta( \%fields, "$p
+ath/$file.meta")) {
my @fieldAR_from_Hash=fieldAR_from_Hash(\%fields);
}
return &IO_EBADF;
};
my $newfn = $path . '/' . $trknum . '-' . $trktitle . $DstExt;
my $encoder;
my @arglist;
my %encoder_path_func= {
$Mp3 => \&Lame::getpath,
$Flac => \&Flac::get_path,
};
my %encoder_arg_funcs = {
$Mp3 => \&push_lame_args,
$Flac => \&push_flac_args,
};
push @arglist, $encoder = $encoder_path_func($CodeTo);
my $argp = $encoder_arg_funcs->(\@arglist);
push @$argp, $oldfn, $newfn;
nice 19;
if ($trknum) {print "$trknum " if (!$quiet);}
my $status;
#(($status = system $encoder @arglist) >> 8) || $status << 8;
$status = system $encoder @arglist;
$status >>= 8;
$status &= 0xff;
#returns status (0 if ok)
}
# relational creation statement:
# $task = [$pid, undef, $songdir, $wavpath];
# task points to 4 member array
# $pid of child task, "status" (undef until task complet
+es)
# dir the song was in, and 4th:
# the entire path to the wave file
# push @tasks, $task_by_pid{"$pid"} = $task;
# pids allows lookup by pid of it's task array
my @tasks;
my %task_by_pid;
sub load {
my $children = 0;
foreach (@tasks) {
++$children
if ($_ && $_->[0] && $_->[1] && kill 0, $task_by_pid{"
+$_"}->[0]);
}
# printf STDERR "CurLoad:%d\n", $children;
return $children;
}
use POSIX ":sys_wait_h";
sub catch_child {
my $waitedpid;
my $pid_errno;
# signal catch code from perlipc manpage (reliable signal catc
+h section)
while (($waitedpid = waitpid(-1, WNOHANG)) > 0) {
my $pid_errno = $? & 0xff;
if ($waitedpid > 0) {
my $tp = $task_by_pid{"$waitedpid"};
$task_by_pid{"$waitedpid"} = undef;
$tp->[0] = undef;
$tp->[1] = $pid_errno;
}
}
$SIG{"CHLD"} = \&catch_child;
}
sub numcpus {
my $cpi;
open($cpi, "</proc/cpuinfo") || return 1;
my @cpuinfo = <$cpi>;
my @cpus = grep (/processor\s+:\s+\d+/i, @cpuinfo);
return $#cpus + 1;
}
my $MAX_CONCURRENT_TASKS = &numcpus + 2;
sub TranscodeSrc2Dst_background($$) {
my $task;
$SIG{'CHLD'} = \&catch_child;
my $pid = fork();
if (!$pid) {
$pid = Transcode::TranscodeSrc2Dst($_[0], $_[1]);
exit($pid);
} elsif ($pid == -1) {
return -1;
} elsif ($pid > 0) {
$task = [$pid, undef, $songdir, $wavpath];
push @tasks, $task_by_pid{"$pid"} = $task;
return 0;
}
}
sub kill_children_and_die {
foreach (@tasks) {
my $task = $_->[0];
$task && kill 9, $task;
}
die "dying on SIG$signame\n";
}
sub min ($$) { return ($_[0] <=> $_[1]) < 0 ? $_[0] : $_[1] }
sub Enqueue_Transcode_Tasks($$) {
import Transcode;
my ($TCBp, $numtasks)=@_;
my ($songdir, $wavs_p,$start_wavp, $max_wavs) = @$TCBp;
if ($debugging) {
print STDERR "NQXcode Tasks: (dir,$songdir), (maxSrcs=$max
+_wavs), " ;
printf STDERR "%d srcs, Idx=%d\n", $#$wavs_p, $$start_wavp
+;
}
# start num tasks passed in, limited by MAX_CONCURRENT
$numtasks = min ($MAX_CONCURRENT_TASKS, $numtasks);
my $end_wav = min ($max_wavs, $$start_wavp + $MAX_CONCURRENT_T
+ASKS-1);
my $wav;
for ($wav=$$start_wavp; $wav<=$end_wav; ++$wav) {
$wavpath = $wavs_p->[$wav];
my $status;
(($status = TranscodeSrc2Dst_background($songdir, $wavpath
+)) == 0)
or print STDERR
"$0 $songdir, $wavpath failed to convert ($status) $!\
+n";
kill_children_and_die() if ($please_die); #check fo
+r abort
$$start_wavp ++;
}
}
;
# # # # # #
#
package VarKeep; {
sub maker ($;*) {
my $p = shift;
my $name = shift;
my $aux_pckgname = $_[0] if @_;
my $lsub_fmt = q{
sub %s::%s {
my $p=shift;
my $var=shift;
$p->{$var}=$_[0] if @;
$p->{$var}
};
};
my $def1=sprintf $lsub_fmt, __PACKAGE__,$name;
my $def2 = $aux_pkgname ?
(sprintf $lsub_fmt, $aux_pckgname, $name) : "";
my $prg=$def1.$def2;
eval $prg; warn $@ if $@;
}
sub lEnv {
my $p=$_[0];
bless $p={}, $_
my $new=0;
my $var=shift;
$new=1 unless exists $p->{$var};
my $p->{$var}=$_[0] if @_;
if ($new) {
my $cp = caller[0];
$p->maker($var,$cp);
}
$p->{$var};
}
};
package main;
import debug;
import Vars;
$SIG{'int'} = $SIG{'TERM'} = sub () { $signame = shift; $please_die =
+1 };
my ($progdir, $prog) = ($0 =~ m{^(.*)/([/]*)$});
my ($ftypet,$ttypet) = ($prog =~ (/cnv(\w+)2(\w+)/i);
$ftypet = lc $ftypet;
$ttypet = lc $ttypet;
my ($frm_t, $to_t) = ($ext2cons{$ftypet}, $ext2cons{$ttypet});
var('s','from_type' => $frm_t);
var('s','to_type' => $to_t);
die "Source \".$ftype\" is not currently supported\n"
unless $ftype && $ftype == $Wav;
my ($Test, $encode) = ($ENV{'Test'}, $ENV{'Encode'} // 'LAME');
my ($songdir, $wavpath);
my ($debugging, $quiet, $verbose) = (0, 1, 0);
while ($#argv >= 0) {
if ($argv[0] =~ /^-?-d(?:ebug)?$/) {$debugging = 1}
elsif ($argV[0] =~ /^-?-n(?:o)?d(?:ebug)?$/) {$debugging = 0}
elsif ($argV[0] =~ /^-?-q(?:uiet)?$/) {$quiet = 1}
elsif ($argV[0] =~ /^-?-n(?:o)?q(?:uiet)?$/) {$quiet = 0}
elsif ($argV[0] =~ /^-?-v(?:erbose)?$/) {$verbose = 1; $quiet = 0}
elsif ($argV[0] =~ /^-?-n(?:o)?v(?:erbose)?$/) {$verbose = 0}
elsif ($argV[0] =~ /^--/) { last; }
else { last;}
shift @argv;
}
#printf stderR "Quiet=$quiet, verbose=$verbose\n";
if ($#argv == -1) {
$songdir = $curdir;
} else {
$_ = $songdir = $ARGV[0];
m|^\.//| and die "$songdir: double slash after .: illegal director
+y name";
s|^\./||;
s|^\.||;
if ($songdir && length $songdir) {
if ((index $curdir, '/') != 0) {
$songdir = $curdir . '/' . $songdir;
}
if (!-d $songdir) {
if (!-f $songdir && $songdir !~ m{.*$SrcExt$}) {
die "$songdir not dir nor music source file";
} else {
$wavpath = $songdir;
$songdir = $curdir;
}
}
}
}
sub append_path { #(path, <scalar|array>)
my $pathaR_p = $_[0];
if (ref($_[1]) eq 'SCALAR') {
push @$pathAR_p, $_[1];
} elsif (ref($_[1]) eq 'ARRAY') {
push @$pathAR_p, @$_[1];
}
$pathar_p; #return as value
}
sub arp_fromPath($) { # ('foo1:foo2') -> ['foo1', 'foo2']
my $path=$_[0];
my @ar = split /:/, $path;
return \@ar;
}
sub cmpver($$) { version->parse($_[0]) <=> version->parse($_[1]) }
if ($Devel) {
use carp qw(cluck confess);
$SIG{__warn__} = $SIG{__DIE__} =
sub { confess @_; if ($Halt_on_Error) { $please_die=1; } };
}
if ($wavpath) {
my $status;
printf "wavpath\n";
(($status = Transcode::TranscodeSrc2Dst($songdir, $wavpath)) == 0)
or print STDERR "$0: $!\n";
} else {
my $converted=0;
chdir $songdir if ($songdir ne $curdir);
my @wavs; {
my $dirhandle;
opendir $dirhandle, "$songdir" ||
die "couldn't open dir $songdir for read\n";
print "converting $SrcExt => $DstExt in directory \"$songdir\"
+...\n"
unless $quiet;
my @uwavs = grep {/^(.*?$SrcExt)$/ && -f "$_"} readdir $dirhan
+dle;
@wavs = sort @uwavs;
}
# &Enqueue_trancode_Tasks($TCB);
# for (my $wav=$start_wav; $wav<=$max_wav; ++$wav) ) {
# $wavpath = $wavs[$wav];
# (($status = TranscodeSrc2Dst_background($songdir, $wavpath))
+== 0)
# or print STDERR "$0 $songdir, $wavpath failed to convert
+$!\n";
# kill_children_and_die() if ($please_die); #check for a
+bort
# $start_wav++;
# }
my $taskharvestWait_Init = 0.1;
my $taskharvestWait_Increment = 0;
my $taskharvestWait_Multiplier = 1.1;
my $taskharvestWait_Max = 1.5;
my $running=0;
my $sleep_time = $TaskHarvestWait_Init;
my ($start_wav, $max_wavs) = (0,$#wavs);
my $tcb = [ $songdir, \@wavs, \$start_wav, $max_wavs];
do { # start by enqueing tasks
&Enqueue_Transcode_Tasks($TCB,$MAX_CONCURRENT_TASKS-$running);
$running = 0;
foreach (@tasks) {
if ($_) {
my ($pid, $stat, $songdir, $wavpath) = @{$_};
if ($pid || defined($stat)) {
if (defined $stat) {
if ($stat) {
print STDERR
"$0: conversion error of $wavpath in $
+songdir, stat=$stat\n";
} else { ++$converted; }
$_ = undef;
# reaping someone resets sleep timer;
$sleep_time = $TaskHarvestWait_Init;
} else { ++$running; }
}
}
}
print "$running tasks running... \r" if $verbose;
sleep($sleep_time);
kill_children_and_die() if ($please_die); #break-check
$sleep_time *= $TaskHarvestWait_Multiplier;
$sleep_time += $TaskHarvestWait_Increment;
$sleep_time = $TaskHarvestWait_Max if $sleep_time >= $TaskHarv
+estWait_Max;
}
} while ($running > 0);
unless ($quiet) {
print " \r";
print "\n" if $verbose;
}
unless ($converted) {
print STDERR "No songs converted.\n"
} else {
printf "Done.\n" if !$quiet;
}
}
exit 0;
# vim: ts=2 sw=2