App-MHFS
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);
lib/MHFS/Plugin/GetVideo.pm view on Meta::CPAN
'EBMLID_EBMLDocType' => 0x4282,
'EBMLID_EBMLDocTypeVer' => 0x4287,
'EBMLID_EBMLDocTypeReadVer' => 0x4285,
'EBMLID_Segment' => 0x18538067,
'EBMLID_SegmentInfo' => 0x1549A966,
'EBMLID_TimestampScale' => 0x2AD7B1,
'EBMLID_Duration' => 0x4489,
'EBMLID_MuxingApp' => 0x4D80,
'EBMLID_WritingApp' => 0x5741,
'EBMLID_Tracks' => 0x1654AE6B,
'EBMLID_Track' => 0xAE,
'EBMLID_TrackNumber' => 0xD7,
'EBMLID_TrackUID' => 0x73C5,
'EBMLID_TrackType' => 0x83,
'EBMLID_DefaulDuration' => 0x23E383,
'EBMLID_CodecID' => 0x86,
'EBMLID_CodecPrivData', => 0x63A2,
'EBMLID_AudioTrack' => 0xE1,
'EBMLID_AudioChannels' => 0x9F,
'EBMLID_AudioSampleRate' => 0xB5,
'EBMLID_AudioBitDepth' => 0x6264,
'EBMLID_Cluster' => 0x1F43B675,
'EBMLID_ClusterTimestamp' => 0xE7,
'EBMLID_SimpleBlock' => 0xA3,
'EBMLID_BlockGroup' => 0xA0,
'EBMLID_Block' => 0xA1
};
sub matroska_cluster_parse_simpleblock_or_blockgroup {
my ($elm) = @_;
my $data = $elm->{'data'};
if($elm->{'id'} == EBMLID_BlockGroup) {
say "blockgroup";
while(1) {
my $width;
my $id = read_vint_from_buf(\$data, \$width);
defined($id) or return undef;
my $size = read_and_parse_vint_from_buf(\$data);
defined($size) or return undef;
say "blockgroup item: $id $size";
last if($id == EBMLID_Block);
substr($data, 0, $size, '');
}
say "IS BLOCK";
}
elsif($elm->{'id'} == EBMLID_SimpleBlock) {
#say "IS SIMPLEBLOCK";
}
else {
die "unhandled block type";
}
my $trackno = read_and_parse_vint_from_buf(\$data);
if((!defined $trackno) || (length($data) < 3)) {
return undef;
}
my $rawts = substr($data, 0, 2, '');
my $rawflag = substr($data, 0, 1, '');
my $lacing = unpack('C', $rawflag) & 0x6;
my $framecnt;
my @sizes;
# XIPH
if($lacing == 0x2) {
$framecnt = unpack('C', substr($data, 0, 1, ''))+1;
my $firstframessize = 0;
for(my $i = 0; $i < ($framecnt-1); $i++) {
my $fsize = 0;
while(1) {
my $val = unpack('C', substr($data, 0, 1, ''));
$fsize += $val;
last if($val < 255);
}
push @sizes, $fsize;
$firstframessize += $fsize;
}
push @sizes, (length($data) - $firstframessize);
}
# EBML
elsif($lacing == 0x6) {
$framecnt = unpack('C', substr($data, 0, 1, ''))+1;
my $last = read_and_parse_vint_from_buf(\$data);
push @sizes, $last;
my $sum = $last;
for(my $i = 0; $i < ($framecnt - 2); $i++) {
my $width;
my $offset = read_and_parse_vint_from_buf(\$data, \$width);
# multiple by 2^bitwidth - 1 (with adjusted bitwidth)
my $desiredbits = (8 * $width) - ($width+1);
my $subtract = (1 << $desiredbits) - 1;
my $result = $offset - $subtract;
$last += $result;
say "offset $offset width $width factor: " . sprintf("0x%X ", $subtract) . "result $result evaled $last";
push @sizes, $last;
$sum += $last;
}
my $lastlast = length($data) - $sum;
say "lastlast $lastlast";
push @sizes, $lastlast;
}
# fixed
elsif($lacing == 0x4) {
$framecnt = unpack('C', substr($data, 0, 1, ''))+1;
my $framesize = length($data) / $framecnt;
for(my $i = 0; $i < $framecnt; $i++) {
push @sizes, $framesize;
}
}
# no lacing
else {
push @sizes, length($data);
}
return {
'trackno' => $trackno,
'rawts' => $rawts,
'rawflag' => $rawflag,
'frame_lengths' => \@sizes,
'data' => $data,
'ts' => unpack('s>', $rawts)
};
}
sub telmval {
my ($track, $stringid) = @_;
my $constname = "EBMLID_$stringid";
my $id = __PACKAGE__->$constname;
return $track->{$id}{'value'} // $track->{$id}{'data'};
#return $track->{"$stringid"}}{'value'} // $track->{$EBMLID->{$stringid}}{'data'};
}
sub trackno_is_audio {
my ($tracks, $trackno) = @_;
foreach my $track (@$tracks) {
if(telmval($track, 'TrackNumber') == $trackno) {
return telmval($track, 'TrackType') == 0x2;
}
}
return undef;
}
sub flac_read_METADATA_BLOCK {
my $fh = $_[0];
my $type = \$_[1];
my $done = \$_[2];
my $buf;
my $headread = read($fh, $buf, 4);
($headread && ($headread == 4)) or return undef;
my ($blocktypelast, $sizehi, $sizemid, $sizelo) = unpack('CCCC',$buf);
$$done = $blocktypelast & 0x80;
$$type = $blocktypelast & 0x7F;
my $size = ($sizehi << 16) | ($sizemid << 8) | ($sizelo);
#say "islast $$done type $type size $size";
$$type != 0x7F or return undef;
my $tbuf;
my $dataread = read($fh, $tbuf, $size);
($dataread && ($dataread == $size)) or return undef;
$buf .= $tbuf;
return \$buf;
}
sub flac_parseStreamInfo {
# https://metacpan.org/source/DANIEL/Audio-FLAC-Header-2.4/Header.pm
my ($buf) = @_;
my $metaBinString = unpack('B144', $buf);
my $x32 = 0 x 32;
my $info = {};
$info->{'MINIMUMBLOCKSIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 0, 16), -32)));
$info->{'MAXIMUMBLOCKSIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 16, 16), -32)));
$info->{'MINIMUMFRAMESIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 32, 24), -32)));
$info->{'MAXIMUMFRAMESIZE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 56, 24), -32)));
$info->{'SAMPLERATE'} = unpack('N', pack('B32', substr($x32 . substr($metaBinString, 80, 20), -32)));
$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
lib/MHFS/Plugin/GetVideo.pm view on Meta::CPAN
$elm{'value'} = parse_uinteger_str($elm{'data'});
$track{$elm{'id'}} = \%elm;
$track{'fps'} = int(((1/($elm{'value'} / 1000000000)) * 1000) + 0.5)/1000;
}
elsif($elm{'id'} == EBMLID_AudioTrack) {
say "audiotrack";
my $buf = $elm{'data'};
while(length($buf)) {
# read the id, size, and data
my $vintwidth;
my $id = read_vint_from_buf(\$buf, \$vintwidth);
if(!$id) {
last;
}
say "elmid $id width $vintwidth";
say sprintf("0x%X 0x%X", ord(substr($buf, 0, 1)), ord(substr($buf, 1, 1)));
my $size = read_and_parse_vint_from_buf(\$buf);
if(!$size) {
last;
}
say "size $size";
my $data = substr($buf, 0, $size, '');
# save metadata
if($id == EBMLID_AudioSampleRate) {
$track{$id} = parse_float_str($data);
say "samplerate " . $track{$id};
}
elsif($id == EBMLID_AudioChannels) {
$track{$id} = parse_uinteger_str($data);
say "channels " . $track{$id};
}
}
}
ebml_skip($ebml);
}
# add the fake track
if(($track{'CodecID_Major'} eq 'EAC3') || ($track{'CodecID_Major'} eq 'AC3')) {
$track{'faketrack'} = {
'PCMFrameLength' => $CodecPCMFrameLength{'AAC'},
&EBMLID_AudioSampleRate => $track{&EBMLID_AudioSampleRate},
&EBMLID_AudioChannels => $track{&EBMLID_AudioChannels}
};
#$track{'outfmt'} = 'PCM';
#$track{'outChannels'} = $track{&EBMLID_AudioChannels};
$track{'outfmt'} = 'AAC';
$track{'outChannels'} = 2;
$track{'outPCMFrameLength'} = $CodecPCMFrameLength{$track{'outfmt'}};
$track{'outGetSegment'} = $CodecGetSegment{$track{'outfmt'}};
}
push @tracks, \%track;
}
if(scalar(@tracks) == 0) {
return undef;
}
my $segmentelm = $ebml->{'elements'}[0];
my %matroska = ('ebml' => $ebml, 'tsscale' => $tsval, 'rawduration' => $scaledduration, 'duration' => $duration, 'tracks' => \@tracks, 'segment_data_start' => {'size' => $segmentelm->{'size'}, 'id' => $segmentelm->{'id'}, 'fileoffset' => tell($eb...
return \%matroska;
}
sub matroska_get_audio_track {
my ($matroska) = @_;
foreach my $track (@{$matroska->{'tracks'}}) {
my $tt = $track->{&EBMLID_TrackType};
if(defined $tt && ($tt->{'value'} == 2)) {
return $track;
}
}
return undef;
}
sub matroska_get_video_track {
my ($matroska) = @_;
foreach my $track (@{$matroska->{'tracks'}}) {
my $tt = $track->{&EBMLID_TrackType};
if(defined $tt && ($tt->{'value'} == 1)) {
return $track;
}
}
return undef;
}
sub matroska_read_cluster_metadata {
my ($matroska) = @_;
my $ebml = $matroska->{'ebml'};
# find a cluster
my $custer = ebml_find_id($ebml, EBMLID_Cluster);
return undef if(! $custer);
my %cluster = ( 'fileoffset' => tell($ebml->{'fh'}), 'size' => $custer->{'size'}, 'Segment_sizeleft' => $ebml->{'elements'}[0]{'size'});
# find the cluster timestamp
for(;;) {
my $belm = ebml_read_element($ebml);
if(!$belm) {
ebml_skip($ebml);
last;
}
my %elm = ('id' => $belm->{'id'}, 'data' => '');
#say "elm size " . $belm->{'size'};
ebml_read($ebml, $elm{'data'}, $belm->{'size'});
if($elm{'id'} == EBMLID_ClusterTimestamp) {
$cluster{'rawts'} = parse_uinteger_str($elm{'data'});
$cluster{'ts'} = $cluster{'rawts'} * $matroska->{'tsscale'};
# exit ClusterTimestamp
ebml_skip($ebml);
# exit cluster
ebml_skip($ebml);
return \%cluster;
}
ebml_skip($ebml);
}
return undef;
}
sub ebml_set_cluster {
my ($ebml, $cluster) = @_;
seek($ebml->{'fh'}, $cluster->{'fileoffset'}, SEEK_SET);
$ebml->{'elements'} = [
{
'id' => EBMLID_Segment,
'size' => $cluster->{'Segment_sizeleft'}
},
{
'id' => EBMLID_Cluster,
'size' => $cluster->{'size'}
}
];
}
sub matroska_get_track_block {
my ($matroska, $tid) = @_;
my $ebml = $matroska->{'ebml'};
for(;;) {
my $belm = ebml_read_element($ebml);
if(!$belm) {
ebml_skip($ebml); # leave cluster
my $cluster = matroska_read_cluster_metadata($matroska);
if($cluster) {
say "advancing cluster";
$matroska->{'dc'} = $cluster;
ebml_set_cluster($ebml, $matroska->{'dc'});
next;
}
last;
}
my %elm = ('id' => $belm->{'id'}, 'data' => '');
#say "elm size " . $belm->{'size'};
ebml_read($ebml, $elm{'data'}, $belm->{'size'});
if(($elm{'id'} == EBMLID_SimpleBlock) || ($elm{'id'} == EBMLID_BlockGroup)) {
my $block = matroska_cluster_parse_simpleblock_or_blockgroup(\%elm);
if($block && ($block->{'trackno'} == $tid)) {
ebml_skip($ebml);
return $block;
}
}
ebml_skip($ebml);
}
return undef;
}
sub matroska_ts_to_sample {
my ($matroska, $samplerate, $ts) = @_;
my $curframe = int(($ts * $samplerate / 1000000000)+ 0.5);
return $curframe;
}
sub matroska_get_gop {
my ($matroska, $track, $timeinseconds) = @_;
my $tid = $track->{&EBMLID_TrackNumber}{'value'};
my $prevcluster;
my $desiredcluster;
while(1) {
my $cluster = matroska_read_cluster_metadata($matroska);
last if(!$cluster);
my $ctime = $cluster->{'ts'} / 1000000000;
# this cluster could have our GOP, save it's info
if($ctime <= $timeinseconds) {
$prevcluster = $desiredcluster;
$desiredcluster = $cluster;
if($prevcluster) {
$prevcluster->{'prevcluster'} = undef;
$desiredcluster->{'prevcluster'} = $prevcluster;
}
}
if($ctime >= $timeinseconds) {
last;
}
}
say "before dc check";
return undef if(! $desiredcluster);
say "cur rawts " . $desiredcluster->{'rawts'};
say "last rawts " . $desiredcluster->{'prevcluster'}{'rawts'} if($desiredcluster->{'prevcluster'});
# restore to the the cluster that probably has the GOP
my $ebml = $matroska->{'ebml'};
ebml_set_cluster($ebml, $desiredcluster);
$matroska->{'dc'} = $desiredcluster;
# find a valid track block that includes pcmFrameIndex;
my $block;
my $blocktime;
while(1) {
$block = matroska_get_track_block($matroska, $tid);
if($block) {
$blocktime = matroska_calc_block_fullts($matroska, $block);
if($blocktime > $timeinseconds) {
$block = undef;
}
if(! $matroska->{'dc'}{'firstblk'}) {
$matroska->{'dc'}{'firstblk'} = $blocktime;
}
}
if(! $block) {
if(! $prevcluster) {
return undef;
}
say "revert cluster";
$matroska->{'dc'} = $prevcluster;
ebml_set_cluster($ebml, $matroska->{'dc'});
next;
}
$prevcluster = undef;
my $blockduration = ((1/24) * scalar(@{$block->{'frame_lengths'}}));
if($timeinseconds < ($blocktime + $blockduration)) {
say 'got GOP at ' . $matroska->{'dc'}{'firstblk'};
return {'goptime' => $matroska->{'dc'}{'firstblk'}};
last;
}
}
}
sub matroska_seek_track {
my ($matroska, $track, $pcmFrameIndex) = @_;
my $tid = $track->{&EBMLID_TrackNumber}{'value'};
$matroska->{'curframe'} = 0;
$matroska->{'curpaks'} = [];
my $samplerate = $track->{&EBMLID_AudioSampleRate};
my $pcmFrameLen = $track->{'PCMFrameLength'};
if(!$pcmFrameLen) {
warn("Unknown codec");
return undef;
}
my $prevcluster;
my $desiredcluster;
while(1) {
my $cluster = matroska_read_cluster_metadata($matroska);
last if(!$cluster);
my $curframe = matroska_ts_to_sample($matroska, $samplerate, $cluster->{'ts'});
#$curframe = int(($curframe/$pcmFrameLen)+0.5)*$pcmFrameLen; # requires revert cluster
$curframe = ceil_div($curframe, $pcmFrameLen) * $pcmFrameLen;
# this cluster could contain our frame, save it's info
if($curframe <= $pcmFrameIndex) {
$prevcluster = $desiredcluster;
$desiredcluster = $cluster;
$desiredcluster->{'frameIndex'} = $curframe;
if($prevcluster) {
$prevcluster->{'prevcluster'} = undef;
$desiredcluster->{'prevcluster'} = $prevcluster;
}
}
# this cluster is at or past the frame, breakout
if($curframe >= $pcmFrameIndex){
last;
}
}
say "before dc check";
return undef if(! $desiredcluster);
say "cur rawts " . $desiredcluster->{'rawts'};
say "last rawts " . $desiredcluster->{'prevcluster'}{'rawts'} if($desiredcluster->{'prevcluster'});
# restore to the the cluster that probably has our audio
my $ebml = $matroska->{'ebml'};
ebml_set_cluster($ebml, $desiredcluster);
$matroska->{'dc'} = $desiredcluster;
# find a valid track block that includes pcmFrameIndex;
my $block;
my $blockframe;
while(1) {
$block = matroska_get_track_block($matroska, $tid);
if($block) {
$blockframe = matroska_block_calc_frame($matroska, $block, $samplerate, $pcmFrameLen);
if($blockframe > $pcmFrameIndex) {
$block = undef;
}
}
if(! $block) {
if(! $prevcluster) {
return undef;
}
say "revert cluster";
$matroska->{'dc'} = $prevcluster;
ebml_set_cluster($ebml, $matroska->{'dc'});
next;
}
$prevcluster = undef;
my $pcmSampleCount = ($pcmFrameLen * scalar(@{$block->{'frame_lengths'}}));
if($pcmFrameIndex < ($blockframe + $pcmSampleCount)) {
if((($pcmFrameIndex - $blockframe) % $pcmFrameLen) != 0) {
say "Frame index does not align with block!";
return undef;
}
last;
}
}
# add the data to packs
my $offset = 0;
while($blockframe < $pcmFrameIndex) {
my $len = shift @{$block->{'frame_lengths'}};
$offset += $len;
$blockframe += $pcmFrameLen;
}
$matroska->{'curframe'} = $pcmFrameIndex;
foreach my $len (@{$block->{'frame_lengths'}}) {
push @{$matroska->{'curpaks'}}, substr($block->{'data'}, $offset, $len);
$offset += $len;
}
return 1;
}
sub matroska_calc_block_fullts {
my ($matroska, $block) = @_;
say 'clusterts ' . ($matroska->{'dc'}->{'ts'}/1000000000);
say 'blockts ' . $block->{'ts'};
my $time = ($matroska->{'dc'}->{'rawts'} + $block->{'ts'}) * $matroska->{'tsscale'};
return ($time/1000000000);
}
sub matroska_block_calc_frame {
my ($matroska, $block, $samplerate, $pcmFrameLen) = @_;
say 'clusterts ' . ($matroska->{'dc'}->{'ts'}/1000000000);
say 'blockts ' . $block->{'ts'};
my $time = ($matroska->{'dc'}->{'rawts'} + $block->{'ts'}) * $matroska->{'tsscale'};
say 'blocktime ' . ($time/1000000000);
my $calcframe = matroska_ts_to_sample($matroska, $samplerate, $time);
return round($calcframe/$pcmFrameLen)*$pcmFrameLen;
}
sub matroska_read_track {
my ($matroska, $track, $pcmFrameIndex, $numsamples, $formatpacket) = @_;
my $tid = $track->{&EBMLID_TrackNumber}{'value'};
my $samplerate = $track->{&EBMLID_AudioSampleRate};
my $pcmFrameLen = $track->{'PCMFrameLength'};
if(!$pcmFrameLen) {
warn("Unknown codec");
return undef;
}
# find the cluster that might have the start of our audio
if($matroska->{'curframe'} != $pcmFrameIndex) {
say "do seek";
if(!matroska_seek_track($matroska, $track, $pcmFrameIndex)) {
return undef;
}
}
my $outdata;
my $destframe = $matroska->{'curframe'} + $numsamples;
while(1) {
# add read audio
while(@{$matroska->{'curpaks'}}) {
my $pak = shift @{$matroska->{'curpaks'}};
$outdata .= $formatpacket->($pak, $samplerate);
$matroska->{'curframe'} += $pcmFrameLen;
if($matroska->{'curframe'} == $destframe) {
say "done, read enough";
return $outdata;
}
}
# load a block
my $block = matroska_get_track_block($matroska, $tid);
if(! $block) {
if(($matroska->{'ebml'}{'elements'}[0]{'id'} == EBMLID_Segment) && ($matroska->{'ebml'}{'elements'}[0]{'size'} == 0)) {
say "done, EOF";
}
else {
say "done, Error";
}
return $outdata;
}
# add the data to paks
my $offset = 0;
foreach my $len (@{$block->{'frame_lengths'}}) {
push @{$matroska->{'curpaks'}}, substr($block->{'data'}, $offset, $len);
$offset += $len;
}
}
}
sub video_on_streams {
my ($video, $request, $continue) = @_;
$video->{'audio'} = [];
$video->{'video'} = [];
$video->{'subtitle'} = [];
my $input_file = $video->{'src_file'}{'filepath'};
my @command = ('ffmpeg', '-i', $input_file);
my $evp = $request->{'client'}{'server'}{'evp'};
MHFS::Process->new_output_process($evp, \@command, sub {
my ($output, $error) = @_;
my @lines = split(/\n/, $error);
my $current_stream;
my $current_element;
foreach my $eline (@lines) {
if($eline =~ /^\s*Stream\s#0:(\d+)(?:\((.+)\)){0,1}:\s(.+):\s(.+)(.*)$/) {
my $type = $3;
$current_stream = $1;
$current_element = { 'sindex' => $current_stream, 'lang' => $2, 'fmt' => $4, 'additional' => $5, 'metadata' => '' };
$current_element->{'is_default'} = 1 if($current_element->{'fmt'} =~ /\(default\)$/i);
$current_element->{'is_forced'} = 1 if($current_element->{'fmt'} =~ /FORCED/i);
if($type =~ /audio/i) {
push @{$video->{'audio'}} , $current_element;
}
elsif($type =~ /video/i) {
push @{$video->{'video'}} , $current_element;
}
elsif($type =~ /subtitle/i) {
push @{$video->{'subtitle'}} , $current_element;
}
say $eline;
}
elsif($eline =~ /^\s+Duration:\s+(\d\d):(\d\d):(\d\d)\.(\d\d)/) {
#TODO add support for over day long video
$video->{'duration'} //= "PT$1H$2M$3.$4S";
try { write_text_file($video->{'out_location'} . '/duration', $video->{'duration'}); }
catch ($e) { say "writing new duration file failed"; }
}
elsif(defined $current_stream) {
if($eline !~ /^\s\s+/) {
$current_stream = undef;
$current_element = undef;
next;
}
$current_element->{'metadata'} .= $eline;
if($eline =~ /\s+title\s*:\s*(.+)$/) {
$current_element->{'title'} = $1;
}
}
}
print Dumper($video);
$continue->();
});
}
( run in 1.536 second using v1.01-cache-2.11-cpan-e1769b4cff6 )