view release on metacpan or  search on metacpan

lib/MHFS/Plugin/MusicLibrary.pm  view on Meta::CPAN

    $info->{'NUMCHANNELS'}      = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 100, 3), -32))) + 1;
    $info->{'BITSPERSAMPLE'}    = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 103, 5), -32))) + 1;

    # Calculate total samples in two parts
    my $highBits = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 108, 4), -32)));

    $info->{'TOTALSAMPLES'} = $highBits * 2 ** 32 +
            unpack('N', pack('B32', substr($x32 . substr($metaBinString, 112, 32), -32)));

    # Return the MD5 as a 32-character hexadecimal string
    $info->{'MD5CHECKSUM'} = unpack('H32',substr($buf, 18, 16));
    return $info;
}

sub GetTrackInfo {
    my ($file) = @_;
    open(my $fh, '<', $file) or die "open failed";
    my $buf = '';
    seek($fh, 8, 0) or die "seek failed";
    (read($fh, $buf, 34) == 34) or die "short read";
    my $info = parseStreamInfo($buf);
    $info->{'duration'} = $info->{'TOTALSAMPLES'}/$info->{'SAMPLERATE'};
    print Dumper($info);
    return $info;
}

sub SendLocalTrack {
    my ($request, $file) = @_;

    # fast path, just send the file
    my $justsendfile = (!defined($request->{'qs'}{'fmt'})) && (!defined($request->{'qs'}{'max_sample_rate'})) && (!defined($request->{'qs'}{'bitdepth'})) && (!defined($request->{'qs'}{'part'}));
    if($justsendfile) {
        SendTrack($request, $file);
        return;
    }

    my $evp = $request->{'client'}{'server'}{'evp'};
    my $tmpfileloc = $request->{'client'}{'server'}{'settings'}{'MUSIC_TMPDIR'} . '/';
    my $nameloc = $request->{'localtrack'}{'nameloc'};
    $tmpfileloc .= $nameloc if($nameloc);
    my $filebase = $request->{'localtrack'}{'basename'};

    # convert to lossy flac if necessary
    my $is_flac = lc(substr($file, -5)) eq '.flac';
    if(!$is_flac) {
        $filebase =~ s/\.[^.]+$/.lossy.flac/;
        $request->{'localtrack'}{'basename'} = $filebase;
        my $tlossy = $tmpfileloc . $filebase;
        if(-e $tlossy ) {
            $is_flac = 1;
            $file = $tlossy;

            if(defined LOCK_GET_LOCKDATA($tlossy)) {
                    # unlikely
                say "SendLocalTrack: lossy flac exists and is locked 503";
                $request->Send503;
                return;
            }
        }
        else {
            make_path($tmpfileloc, {chmod => 0755});
            my @cmd = ('ffmpeg', '-i', $file, '-c:a', 'flac', '-sample_fmt', 's16', $tlossy);
            my $buf;
            if(LOCK_WRITE($tlossy)) {
                $request->{'process'} = MHFS::Process->new(\@cmd, $evp, {
                'SIGCHLD' => sub {
                    UNLOCK_WRITE($tlossy);
                    SendLocalTrack($request,$tlossy);
                },
                'STDERR' => sub {
                    my ($terr) = @_;
                    read($terr, $buf, 4096);
                }});
            }
            else {
                # unlikely
                say "SendLocalTrack: lossy flac is locked 503";
                $request->Send503;
            }

            return;
        }
    }

    # everything should be flac now, grab the track info
    if(!defined($TRACKINFO{$file}))
    {
        $TRACKINFO{$file} = GetTrackInfo($file);
        $TRACKDURATION{$file} = $TRACKINFO{$file}{'duration'};
    }

    my $max_sample_rate = $request->{'qs'}{'max_sample_rate'} // 192000;
    my $bitdepth = $request->{'qs'}{'bitdepth'} // ($max_sample_rate > 48000 ? 24 : 16);

    # check to see if the raw file fullfills the requirements
    my $samplerate = $TRACKINFO{$file}{'SAMPLERATE'};
    my $inbitdepth = $TRACKINFO{$file}{'BITSPERSAMPLE'};
    say "input: samplerate $samplerate inbitdepth $inbitdepth";
    say "maxsamplerate $max_sample_rate bitdepth $bitdepth";
    if(($samplerate <= $max_sample_rate) && ($inbitdepth <= $bitdepth)) {
        say "samplerate is <= max_sample_rate, not resampling";
        SendTrack($request, $file);
        return;
    }

    # determine the acceptable samplerate, bitdepth combinations to send
    my %rates = (
        '48000' => [192000, 96000, 48000],
        '44100' => [176400, 88200, 44100]
    );
    my @acceptable_settings = ( [24, 192000], [24, 96000], [24, 48000], [24, 176400],  [24, 88200], [16, 48000], [16, 44100]);
    my @desired = ([$bitdepth, $max_sample_rate]);
    foreach my $setting (@acceptable_settings) {
        if(($setting->[0] <= $bitdepth) && ($setting->[1] <= $max_sample_rate)) {
            push @desired, $setting;
        }
    }

    # if we already transcoded/resampled, don't waste time doing it again
    foreach my $setting (@desired) {
        my $tmpfile = $tmpfileloc . $setting->[0] . '_' . $setting->[1] . '_' . $filebase;
        if(-e $tmpfile) {
            say "No need to resample $tmpfile exists";
            SendTrack($request, $tmpfile);
            return;
        }
    }
    make_path($tmpfileloc, {chmod => 0755});

    # resampling
    my $desiredrate;
    RATE_FACTOR: foreach my $key (keys %rates) {
        if(($samplerate % $key) == 0) {
            foreach my $rate (@{$rates{$key}}) {
                if(($rate <= $samplerate) && ($rate <= $max_sample_rate)) {
                    $desiredrate = $rate;
                    last RATE_FACTOR;
                }
            }
        }
    }
    $desiredrate //= $max_sample_rate;
    say "desired rate: $desiredrate";
    # build the command
    my $outfile = $tmpfileloc . $bitdepth . '_' . $desiredrate . '_' . $filebase;
    my @cmd = ('sox', $file, '-G', '-b', $bitdepth, $outfile, 'rate', '-v', '-L', $desiredrate, 'dither');
    say "cmd: " . join(' ', @cmd);

    if(LOCK_WRITE($outfile)) {
        $request->{'process'} = MHFS::Process->new(\@cmd, $evp, {
        'SIGCHLD' => sub {
            UNLOCK_WRITE($outfile);
            # BUG? files isn't necessarily flushed to disk on SIGCHLD. filesize can be wrong
            SendTrack($request, $outfile);
        },
        'STDERR' => sub {
            my ($terr) = @_;
            my $buf;
            read($terr, $buf, 4096);
        }});
    }
    else {
        # unlikely
        say "SendLocalTrack: sox is locked 503";
        $request->Send503;
    }
    return;
}


sub BuildLibraries {
    my ($self) = @_;
    my @wholeLibrary;

    $self->{'sources'} = [];

    foreach my $sid (@{$self->{'settings'}{'MEDIASOURCES'}{'music'}}) {
        my $source = $self->{'settings'}{'SOURCES'}{$sid};
        my $lib;
        if($source->{'type'} eq 'local') {
            say __PACKAGE__.": building music " . clock_gettime(CLOCK_MONOTONIC);
            $lib = BuildLibrary($source->{'folder'});
            say __PACKAGE__.": done building music " . clock_gettime(CLOCK_MONOTONIC);
        }
        elsif($source->{'type'} eq 'ssh') {
        }
        elsif($source->{'type'} eq 'mhfs') {
        }