view release on metacpan or  search on metacpan

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

package MHFS::Plugin::GetVideo v0.7.0;
use 5.014;
use strict; use warnings;
use feature 'say';
use Data::Dumper qw (Dumper);
use Fcntl qw(:seek);
use Feature::Compat::Try;
use Scalar::Util qw(weaken);
use URI::Escape qw (uri_escape);
use Devel::Peek qw(Dump);
no warnings "portable";
use Config;
use MHFS::Process;
use MHFS::Util qw(space2us LOCK_WRITE round shellcmd_unlock ASYNC pid_running read_text_file write_text_file ceil_div);

sub new {
    my ($class, $settings) = @_;

    if($Config{ivsize} < 8) {
        warn("Integers are too small!");
        return undef;
    }

    my $self =  {};
    bless $self, $class;

    $self->{'VIDEOFORMATS'} = {
        'hls' => {'lock' => 0, 'create_cmd' => sub {
            my ($video) = @_;
            return ['ffmpeg', '-i', $video->{"src_file"}{"filepath"}, '-codec:v', 'libx264', '-strict', 'experimental', '-codec:a', 'aac', '-ac', '2', '-f', 'hls', '-hls_base_url', $video->{"out_location_url"}, '-hls_time', '5', '-hls_list_size', '0'...
        }, 'ext' => 'm3u8', 'desired_audio' => 'aac',
        'player_html' => $settings->{'DOCUMENTROOT'} . '/static/hls_player.html'},

        'jsmpeg' => {'lock' => 0, 'create_cmd' => sub {
            my ($video) = @_;
            return ['ffmpeg', '-i', $video->{"src_file"}{"filepath"}, '-f', 'mpegts', '-codec:v', 'mpeg1video', '-codec:a', 'mp2', '-b', '0',  $video->{"out_filepath"}];
        }, 'ext' => 'ts', 'player_html' => $settings->{'DOCUMENTROOT'} . '/static/jsmpeg_player.html', 'minsize' => '1048576'},

        'mp4' => {'lock' => 1, 'create_cmd' => sub {
            my ($video) = @_;
            return ['ffmpeg', '-i', $video->{"src_file"}{"filepath"}, '-c:v', 'copy', '-c:a', 'aac', '-f', 'mp4', '-movflags', 'frag_keyframe+empty_moov', $video->{"out_filepath"}];
        }, 'ext' => 'mp4', 'player_html' => $settings->{'DOCUMENTROOT'} . '/static/mp4_player.html', 'minsize' => '1048576'},

        'noconv' => {'lock' => 0, 'ext' => '', 'player_html' => $settings->{'DOCUMENTROOT'} . '/static/noconv_player.html', },

        'mkvinfo' => {'lock' => 0, 'ext' => ''},
        'fmp4' => {'lock' => 0, 'ext' => ''},
    };

    $self->{'routes'} = [
        [
            '/get_video', \&get_video
        ],
    ];

    return $self;
}

sub get_video {
    my ($request) = @_;
    say "/get_video ---------------------------------------";
    my $packagename = __PACKAGE__;
    my $server = $request->{'client'}{'server'};
    my $self = $server->{'loaded_plugins'}{$packagename};
    my $settings = $server->{'settings'};
    my $videoformats = $self->{VIDEOFORMATS};
    $request->{'responseopt'}{'cd_file'} = 'inline';
    my $qs = $request->{'qs'};
    $qs->{'fmt'} //= 'noconv';
    my %video = ('out_fmt' => $self->video_get_format($qs->{'fmt'}));
    if(defined($qs->{'name'})) {
        if(defined($qs->{'sid'})) {
            $video{'src_file'} = $server->{'fs'}->lookup($qs->{'name'}, $qs->{'sid'});
            if( ! $video{'src_file'} ) {
                $request->Send404;
                return undef;
            }
        }
        else {
            $request->Send404;
            return undef;
        }
        print Dumper($video{'src_file'});
        # no conversion necessary, just SEND IT
        if($video{'out_fmt'} eq 'noconv') {
            say "NOCONV: SEND IT";
            $request->SendFile($video{'src_file'}{'filepath'});
            return 1;
        }
        elsif($video{'out_fmt'} eq 'mkvinfo') {
            get_video_mkvinfo($request, $video{'src_file'}{'filepath'});
            return 1;
        }
        elsif($video{'out_fmt'} eq 'fmp4') {
            get_video_fmp4($request, $video{'src_file'}{'filepath'});
            return;
        }

        if(! -e $video{'src_file'}{'filepath'}) {
            $request->Send404;
            return undef;

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

    # Always start at 0, even if we encoded half of the movie
    #$newm3ucontent .= '#EXT-X-START:TIME-OFFSET=0,PRECISE=YES' . "\n";

    # if ffmpeg created a sub include it in the playlist
    ($requestfile =~ /^(.+)\.m3u8$/);
    my $reqsub = "$1_vtt.m3u8";
    if($subm3u && -e $reqsub) {
        $subm3u .= "_vtt.m3u8";
        say "subm3u $subm3u";
        my $default = 'NO';
        my $forced =  'NO';
        foreach my $sub (@{$video->{'subtitle'}}) {
            $default = 'YES' if($sub->{'is_default'});
            $forced = 'YES' if($sub->{'is_forced'});
        }
        # assume its in english
        $newm3ucontent .= '#EXT-X-MEDIA:TYPE=SUBTITLES,GROUP-ID="subs",NAME="English",DEFAULT='.$default.',FORCED='.$forced.',URI="' . $subm3u . '",LANGUAGE="en"' . "\n";
    }
    try { write_text_file($requestfile, $newm3ucontent); }
    catch ($e) { say "writing new m3u failed"; }
    return 1;
}

sub get_video_mkvinfo {
    my ($request, $fileabspath) = @_;
    my $matroska = matroska_open($fileabspath);
    if(! $matroska) {
        $request->Send404;
        return;
    }

    my $obj;
    if(defined $request->{'qs'}{'mkvinfo_time'}) {
        my $track = matroska_get_video_track($matroska);
        if(! $track) {
            $request->Send404;
            return;
        }
        my $gopinfo = matroska_get_gop($matroska, $track, $request->{'qs'}{'mkvinfo_time'});
        if(! $gopinfo) {
            $request->Send404;
            return;
        }
        $obj = $gopinfo;
    }
    else {
        $obj = {};
    }
    $obj->{duration} = $matroska->{'duration'};
    $request->SendAsJSON($obj);
}

sub get_video_fmp4 {
    my ($request, $fileabspath) = @_;
    my @command = ('ffmpeg', '-loglevel', 'fatal');
    if($request->{'qs'}{'fmp4_time'}) {
        my $formattedtime = hls_audio_formattime($request->{'qs'}{'fmp4_time'});
        push @command, ('-ss', $formattedtime);
    }
    push @command, ('-i', $fileabspath, '-c:v', 'copy', '-c:a', 'aac', '-f', 'mp4', '-movflags', 'frag_keyframe+empty_moov', '-');
    my $evp = $request->{'client'}{'server'}{'evp'};
    my $sent;
    print "$_ " foreach @command;
    $request->{'outheaders'}{'Accept-Ranges'} = 'none';

    # avoid bookkeeping, have ffmpeg output straight to the socket
    $request->{'outheaders'}{'Connection'} = 'close';
    $request->{'outheaders'}{'Content-Type'} = 'video/mp4';
    my $sock = $request->{'client'}{'sock'};
    print  $sock  "HTTP/1.0 200 OK\r\n";
    my $headtext = '';
    foreach my $header (keys %{$request->{'outheaders'}}) {
        $headtext .= "$header: " . $request->{'outheaders'}{$header} . "\r\n";
    }
    print $sock $headtext."\r\n";
    $evp->remove($sock);
    $request->{'client'} = undef;
    MHFS::Process->cmd_to_sock(\@command, $sock);
}

sub hls_audio_formattime {
    my ($ttime) = @_;
    my $hours = int($ttime / 3600);
    $ttime -= ($hours * 3600);
    my $minutes = int($ttime / 60);
    $ttime -= ($minutes*60);
    #my $seconds = int($ttime);
    #$ttime -= $seconds;
    #say "ttime $ttime";
    #my $mili = int($ttime * 1000000);
    #say "mili $mili";
    #my $tstring = sprintf "%02d:%02d:%02d.%06d", $hours, $minutes, $seconds, $mili;
    my $tstring = sprintf "%02d:%02d:%f", $hours, $minutes, $ttime;
    return $tstring;
}

sub adts_get_packet_size {
    my ($buf) = @_;
    my ($sync, $stuff, $rest) = unpack('nCN', $buf);
    if(!defined($sync)) {
        say "no pack, len " . length($buf);
        return undef;
    }
    if($sync != 0xFFF1) {
        say "bad sync";
        return undef;
    }

    my $size = ($rest >> 13) & 0x1FFF;
    return $size;
}

sub ebml_read {
    my $ebml = $_[0];
    my $buf = \$_[1];
    my $amount = $_[2];
    my $lastelm = ($ebml->{'elements'} > 0) ? $ebml->{'elements'}[-1] : undef;
    return undef if($lastelm && defined($lastelm->{'size'}) && ($amount > $lastelm->{'size'}));

    my $amtread = read($ebml->{'fh'}, $$buf, $amount);