view release on metacpan or  search on metacpan

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

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;
        }

        $video{'out_base'} = $video{'src_file'}{'name'};

        # soon https://github.com/video-dev/hls.js/pull/1899
        $video{'out_base'} = space2us($video{'out_base'}) if ($video{'out_fmt'} eq 'hls');
    }
    elsif($videoformats->{$video{'out_fmt'}}{'plugin'}) {
        $video{'plugin'} = $videoformats->{$video{'out_fmt'}}{'plugin'};
        if(!($video{'out_base'} = $video{'plugin'}->getOutBase($qs))) {
            $request->Send404;
            return undef;
        }
    }
    else {
        $request->Send404;
        return undef;
    }

    # Determine the full path to the desired file
    my $fmt = $video{'out_fmt'};
    $video{'out_location'} = $settings->{'VIDEO_TMPDIR'} . '/' . $video{'out_base'};
    $video{'out_filepath'} = $video{'out_location'} . '/' . $video{'out_base'} . '.' . $videoformats->{$video{'out_fmt'}}{'ext'};
    $video{'out_location_url'} = 'get_video?'.$settings->{VIDEO_TMPDIR_QS}.'&fmt=noconv&name='.$video{'out_base'}.'%2F';

    # Serve it up if it has been created
    if(-e $video{'out_filepath'}) {
        say $video{'out_filepath'} . " already exists";
        $request->SendFile($video{'out_filepath'});
        return 1;
    }
    # otherwise create it
    mkdir($video{'out_location'});
    if(($videoformats->{$fmt}{'lock'} == 1) && (LOCK_WRITE($video{'out_filepath'}) != 1)) {
        say "FAILED to LOCK";
        # we should do something here
    }
    if($video{'plugin'}) {
        $video{'plugin'}->downloadAndServe($request, \%video);
        return 1;
    }
    elsif(defined($videoformats->{$fmt}{'create_cmd'})) {
        my @cmd = @{$videoformats->{$fmt}{'create_cmd'}->(\%video)};
        print "$_ " foreach @cmd;
        print "\n";

        video_on_streams(\%video, $request, sub {
        #say "there should be no pids around";
        #$request->Send404;
        #return undef;

        if($fmt eq 'hls') {
            $video{'on_exists'} = \&video_hls_write_master_playlist;
        }

        # deprecated
        $video{'pid'} = ASYNC(\&shellcmd_unlock, \@cmd, $video{'out_filepath'});

        # our file isn't ready yet, so create a timer to check the progress and act
        weaken($request); # the only one who should be keeping $request alive is the client
        $request->{'client'}{'server'}{'evp'}->add_timer(0, 0, sub {
            if(! defined $request) {
                say "\$request undef, ignoring CB";
                return undef;
            }
            # test if its ready to send
            while(1) {
                    my $filename = $video{'out_filepath'};
                    if(! -e $filename) {
                        last;
                    }
                    my $minsize = $videoformats->{$fmt}{'minsize'};
                    if(defined($minsize) && ((-s $filename) < $minsize)) {
                        last;
                    }
                    if(defined $video{'on_exists'}) {
                        last if (! $video{'on_exists'}->($settings, \%video));
                    }
                    say "get_video_timer is destructing";
                    $request->SendLocalFile($filename);
                    return undef;
            }
            # 404, if we didn't send yet the process is not running
            if(pid_running($video{'pid'})) {
                return 1;
            }
            say "pid not running: " . $video{'pid'} . " get_video_timer done with 404";
            $request->Send404;
            return undef;
        });
        say "get_video: added timer " . $video{'out_filepath'};
        });
    }
    else {
        say "out_fmt: " . $video{'out_fmt'};
        $request->Send404;
        return undef;
    }
    return 1;
}

sub video_get_format {
    my ($self, $fmt) = @_;

    if(defined($fmt)) {
        # hack for jsmpeg corrupting the url
        $fmt =~ s/\?.+$//;
        if(defined $self->{VIDEOFORMATS}{$fmt}) {
            return $fmt;
        }
    }

    return 'noconv';
}
sub video_hls_write_master_playlist {
    # Rebuilt the master playlist because reasons; YOU ARE TEARING ME APART, FFMPEG!
    my ($settings, $video) = @_;
    my $requestfile = $video->{'out_filepath'};

    # fix the path to the video playlist to be correct
    my $m3ucontent = do {
        try { read_text_file($requestfile) }
        catch ($e) {
            say "$requestfile does not exist or is not UTF-8";
            ''
        }
    };
    my $subm3u;
    my $newm3ucontent = '';
    foreach my $line (split("\n", $m3ucontent)) {
        # master playlist doesn't get written with base url ...
        if($line =~ /^(.+)\.m3u8_v$/) {
            $subm3u = "get_video?".$settings->{VIDEO_TMPDIR_QS}."&fmt=noconv&name=" . uri_escape("$1/$1");
            $line = $subm3u . '.m3u8_v';
        }
        $newm3ucontent .= $line . "\n";
    }

    # 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);