view release on metacpan or  search on metacpan

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

package MHFS::Plugin::MusicLibrary v0.7.0;
use 5.014;
use strict; use warnings;
use feature 'say';
use Cwd qw(abs_path getcwd);
use File::Find;
use Data::Dumper;
use Devel::Peek;
use Fcntl ':mode';
use File::stat;
use File::Basename;
use File::Path qw(make_path);
use Scalar::Util qw(looks_like_number);
use MHFS::Util qw(get_printable_utf8 escape_html_noquote LOCK_GET_LOCKDATA LOCK_WRITE UNLOCK_WRITE);
BEGIN {
    if( ! (eval "use JSON; 1")) {
        eval "use JSON::PP; 1" or die "No implementation of JSON available";
        warn __PACKAGE__.": Using PurePerl version of JSON (JSON::PP)";
    }
}
use Encode qw(decode encode);
use URI::Escape;
use Storable qw(dclone);
use Fcntl ':mode';
use Time::HiRes qw( usleep clock_gettime CLOCK_REALTIME CLOCK_MONOTONIC);
use Scalar::Util qw(looks_like_number weaken);
use POSIX qw/ceil/;
use Storable qw( freeze thaw);
#use ExtUtils::testlib;
use FindBin;
use File::Spec;
use List::Util qw[min max];
use HTML::Template;
use MHFS::Process;

# Optional dependency, MHFS::XS
BEGIN {
    use constant HAS_MHFS_XS => (eval "use MHFS::XS; 1");
    if(! HAS_MHFS_XS) {
        warn __PACKAGE__.": XS not available";
    }
}

# read the directory tree from desk and store
# this assumes filenames are UTF-8ish, the octlets will be the actual filename, but the printable filename is created by decoding it as UTF-8
sub BuildLibrary {
    my ($path) = @_;
    my $statinfo = stat($path);
    return undef if(! $statinfo);
    my $basepath = basename($path);
    my $utf8name = get_printable_utf8($basepath);

    if(!S_ISDIR($statinfo->mode)){
    return undef if($path !~ /\.(flac|mp3|m4a|wav|ogg|webm)$/);
        return [$basepath, $statinfo->size, undef, $utf8name];
    }
    else {
        my $dir;
        if(! opendir($dir, $path)) {
            warn "outputdir: Cannot open directory: $path $!";
            return undef;
        }
        my @files = sort { uc($a) cmp uc($b)} (readdir $dir);
        closedir($dir);
        my @tree;
        my $size = 0;
        foreach my $file (@files) {
            next if(($file eq '.') || ($file eq '..'));
            if(my $file = BuildLibrary("$path/$file")) {
                    push @tree, $file;
                    $size += $file->[1];
            }
        }
        return undef if( $size eq 0);
        return [$basepath, $size, \@tree, $utf8name];
    }
}

sub ToHTML {
    my ($files, $where) = @_;
    $where //= '';
    my $buf = '';
    my $name_unencoded = $files->[3];
    my $name = ${escape_html_noquote($name_unencoded)};
    if($files->[2]) {
        my $dir = $files->[0];
        $buf .= '<tr>';
        $buf .= '<td>';
        $buf .= '<table border="1" class="tbl_track">';
        $buf .= '<tbody>';
        $buf .= '<tr class="track">';
        $buf .= '<th>' . $name . '</th>';
        $buf .= '<th><a href="#">Play</a></th><th><a href="#">Queue</a></th><th><a href="music_dl?action=dl&name=' . uri_escape_utf8($where.$name_unencoded) . '">DL</a></th>';
        $buf .= '</tr>';
        $where .= $name_unencoded . '/';
        foreach my $file (@{$files->[2]}) {
            $buf .= ToHTML($file, $where) ;
        }
        $buf .= '</tbody></table>';
        $buf .= '</td>';

    }
    else {
        if($where eq '') {
                $buf .= '<table border="1" class="tbl_track">';
                $buf .= '<tbody>';
        }
        $buf .= '<tr class="track">';
        $buf .= '<td>' . $name . '</td>';
        $buf .= '<td><a href="#">Play</a></td><td><a href="#">Queue</a></td><td><a href="music_dl?action=dl&name=' . uri_escape_utf8($where.$name_unencoded).'">DL</a></td>';
        if($where eq '') {
                $buf .= '</tr>';
                $buf .= '</tbody></table>';
                return $buf;
        }
    }
    $buf .= '</tr>';
    return $buf;
}

sub toJSON {
    my ($self) = @_;
    my $head = {'files' => []};
    my @nodestack = ($head);
    my @files = (@{$self->{'library'}});
    while(@files) {
        my $file = shift @files;
        if( ! $file) {
            pop @nodestack;
            next;
        }
        my $node = $nodestack[@nodestack - 1];
        my $newnode = {'name' =>$file->[3]};
        if($file->[2]) {
            $newnode->{'files'} = [];
            push @nodestack, $newnode;
            @files = (@{$file->[2]}, undef, @files);
        }
        push @{$node->{'files'}}, $newnode;
    }
    # encode json outputs bytes NOT unicode string
    return encode_json($head);
}


sub LibraryHTML {
    my ($self) = @_;
    my $buf = '';
    foreach my $file (@{$self->{'library'}}) {
        $buf .= ToHTML($file);
        $buf .= '<br>';
    }

    my $legacy_template = HTML::Template->new(filename => 'templates/music_legacy.html', path => $self->{'settings'}{'APPDIR'} );
    $legacy_template->param(musicdb => $buf);
    $self->{'html'} = encode('UTF-8', $legacy_template->output, Encode::FB_CROAK);

    $self->{'musicdbhtml'} = encode('UTF-8', $buf, Encode::FB_CROAK);
    $self->{'musicdbjson'} = toJSON($self);
}

sub SendLibrary {
    my ($self, $request) = @_;

    # maybe not allow everyone to do these commands?
    if($request->{'qs'}{'forcerefresh'}) {
        say __PACKAGE__.": forcerefresh";
        $self->BuildLibraries();
    }
    elsif($request->{'qs'}{'refresh'}) {