#!/usr/bin/perl
# transform vdr h264 HDTV ts recordings to Matroska mkv
# written by Alexander Richter alexanderrichter фt gmx.net


use strict;
use File::Find ;
use File::Copy ;
use File::Basename ;
use Cwd ;
use Data::Dumper ;

## necessary programs

# mkvtoolnix http://www.bunkus.org/videotools/mkvtoolnix
## mkvmerge

# tsmuxer from : http://www.smlabs.net/tsMuxer/tsMuxeR_1.10.6.tar.gz
## tsMuxeR

# ----  user settings ----

my $print_debug = "1" ;  # empty or not empty
my $tmp_dir = "./" ; #  muп mind. 2 x so groп, wie der geschnittene HD Film sein --> > 20 Gbyte !!!! frei
my $nice_cmd = "nice -n 5" ; #nice Level, wir wollen ja nicht den ganzen rechner lahmlegen

# ---- END OF user settings ----

## prepare
my $last_dir = cwd ;
chomp (my $info_bin =  "./tsMuxeR") ;
chomp (my $extract_bin = "./tsMuxeR") ;
chomp (my $mkvmerge_bin = `which mkvmerge`);

# Infos
print "\nА transform Vdr h264 HDTV recordings to Matroska mkv, without prior cutting needet 
\n" ;

if (1 != @ARGV)
{
   print "transform vdr tS h264 HDTV recordings to Matroska mkv, without prior cutting needet\nUsage: $0 /path/to/recording\n";
   exit (1);
}


### main 

my $Vdr_dir = $ARGV[0] ;
my @VdrList ;

## Liste aller Video vdr Files im Dir machen
find ( \&funcfind , "$Vdr_dir" )  ;

print "Checking if files contain H264 Video..." ;

my $file_to_check = dosh($VdrList[0]) ;
my @answer_check = `$info_bin $file_to_check` ;
 	unless ( grep /H.264/ , @answer_check  ) {
		print "@answer_check\n" ;
		print "ААА $VdrList[0] does not contain H264 Stream ... exit\n" ;
		exit 1 ;
	}
print "yes\n" ;

## Create Main Titel
print "\nReading info and extracting title name...\n";
my $maintitel ="" ;
open (INFO, "<$Vdr_dir/info") or die ("Couldn't open $Vdr_dir/info");
	while ( my $line = <INFO> ) {
		chomp $line ;
		# T Austin Stevens - Der Gefahrensucher
		# S Die Drachen von Komodo
		if ( $line =~ /^T\s+(.*)$/ ) { $maintitel = $1 ; }
		if ( $line =~ /^S\s+(.*)$/ ) { $maintitel = "$maintitel - $1" ; }
	}
close INFO ;

## get stream Infos
print "\nChecking file for stream info...\n" ;
#Track ID:    6210
#Stream type: H.264
#Stream ID:   V_MPEG4/ISO/AVC
#Stream info: Profile: Main@4.0  Resolution: 1280:720p  Frame rate: 50
#Stream lang:
#Track ID:    6220
#Stream type: AC3
#Stream ID:   A_AC3
#Stream info: Bitrate: 256Kbps Sample Rate: 48KHz Channels: 2
#Stream lang: deu
#Stream delay: -1043
#Track ID:    6221
#Stream type: MPEG-Audio
#Stream ID:   A_MP3
#Stream info: Bitrate: 256Kbps  Sample Rate: 48KHz  Channels: 2  Layer: 2
#Stream lang: deu
#Stream delay: -980
#Track ID:    6222
#Stream type: MPEG-Audio
#Stream ID:   A_MP3
#Stream info: Bitrate: 256Kbps  Sample Rate: 48KHz  Channels: 2  Layer: 2
#Stream lang: fra
#Stream delay: -990


my %Stream ;
my $TrackId ;

foreach ( @answer_check ) {
#	print "check : $_" ;
	if ( $_ =~ /Track ID:\s+(.*)\n/ ) { $TrackId = "$1" ; } #$TrackId =~s/\s+//g ;}
	if ( $_ =~ /Stream type:\s(.*)\n/ ) { $Stream{$TrackId}{Streamtype} = "$1" ; $Stream{$TrackId}{PlaceOnDisk} = "$VdrList[0]" ; }
	if ( $_ =~ /Stream ID:\s+(.*)\n/ ) { $Stream{$TrackId}{StreamID} = "$1" ; }
	if ( $_ =~ /Stream info:\s+(.*)\n/ ) { $Stream{$TrackId}{Streaminfo} = "$1" ; }
	if ( $_ =~ /Stream lang:\s+(.*)\n/ ) { $Stream{$TrackId}{Streamlang} = "$1" ; }
	if ( $_ =~ /Stream delay:\s+(.*)\n/ ) { $Stream{$TrackId}{Streamdelay} = "$1" ; $Stream{$TrackId}{Streamdelay} = $Stream{$TrackId}{Streamdelay} - 82 } # !!!!!!!!!!! correct here the tsremuxer bad delay
}

print Dumper (%Stream) if $print_debug ;

# find start and end code , if "marks" exists
print "\nChecking Directory for marks ..." ;
my $cmd_marks ="" ;
my @ms_pos ;
if ( -f "${Vdr_dir}marks" ) {
	open (MARKS, "<${Vdr_dir}marks");
	my @marks=<MARKS>;
	if ( $#marks ne 1 ) {
		print "ААА  The File \"marks\" contain more or less than 2 marks ( -> $#marks found ) , please correct this ....\n" ; exit 1 ;
	}
	for (my $i = 0; $i <= $#marks; $i++)
	{
		$marks[$i] =~ s/\n//;
		my ($h, $m, $s, $f) = split (/[:.]/, $marks[$i]);
		my ($f, undef) = split (/ /, $f);
		my $ms_pos = ($h * 3600 + $m * 60 + $s)* 1000 ;# sec -> msec
		my $frames_msec = sprintf "%d" ,( 1000 / 25 * ( $f )) ; # always calculate 25 frames -> 1sec 
		$ms_pos = $ms_pos + $frames_msec ;
		push @ms_pos , $ms_pos ; 
	}
	close MARKS ;
	$cmd_marks = "--cut-start=$ms_pos[0]ms --cut-end=$ms_pos[1]ms" ;
	print "OK\n\n" ;
}
else { print "no marks, use default File Begin and End\n\n" ; }

## write metafile
my $fps ;
open FH , (">./current.meta") ;
print FH "MUXOPT --no-pcr-on-video-pid --new-audio-pes --demux --vbr $cmd_marks --no-asyncio --vbv-len=500\n" ;
foreach my $ID ( sort keys %Stream ) {
	# Video track :
	if ( $Stream{$ID}{StreamID} =~/^\s?V_/ ) {
	( $fps ) = $Stream{$ID}{Streaminfo} =~ /Frame rate:\s+(\d+)/ ; 
	  print FH "$Stream{$ID}{StreamID}, \"$Stream{$ID}{PlaceOnDisk}\", fps=$fps, insertSEI, contSPS, track=$ID\n" ;
	}  
	# audio tracks :
	else { 
	  print FH "$Stream{$ID}{StreamID}, \"$Stream{$ID}{PlaceOnDisk}\", timeshift=$Stream{$ID}{Streamdelay}, track=$ID, lang=$Stream{$ID}{Streamlang}\n" ;
	}
}
close FH ;

## demuxing of h264 and all audio tracks 
my $demux_cmd = "./current.meta ./" ;
system ("$extract_bin $demux_cmd ") ;


## muxing of streams to mkv
my $mkv_cmdline = "--priority lower --default-duration 0:50fps -o ./test.mkv" ; # works for 720p50 and 1080i50
my %fileext = ( 'H.264' => '264' , 'AC3' => 'ac3' , 'MPEG-Audio' => 'mpa' ) ;
my @streamlist ;
foreach my $ID ( sort keys %Stream ) {
  # mpa, ac3 or 264
  
  print "./00001.track_$ID.$fileext{$Stream{$ID}{Streamtype}}\n" ;
  push @streamlist , "./00001.track_$ID.$fileext{$Stream{$ID}{Streamtype}}" ;
  $mkv_cmdline = "$mkv_cmdline ./00001.track_$ID.$fileext{$Stream{$ID}{Streamtype}}" ;
}

print "$mkvmerge_bin $mkv_cmdline\n" ;
system ("$mkvmerge_bin $mkv_cmdline") ;

## Rename File
my $cmd_target_file = dosh("$maintitel.mkv") ;
print "\nRenaming output Matroska file to \"$maintitel.mkv\"\n" ;
system ("mv ./test.mkv ./$cmd_target_file") ;

# cleanup
foreach ( @streamlist ) { unlink "$_" ; }
unlink "./current.meta" ;



### functions

#################################################################
sub dosh {
my $in = $_[0] ;
$in =~ s/\s+/\ /g ; ## doppelte oder mehrere Leerzeichen auf eins reduzieren
$in =~ s/(\(\d+)\/(\d+\))/${1}\/${2}/g ;       ## das (1/5) problem
$in =~ s/([\s \( \) \$ \& \Ї \" \! \? \[  \] \' \,\@])/\\$1/g; # viele absonderliche Sonderzeichen fќr die shell qouten
$in =~ s/\\\\/\\/g ; # wenn ausdruck vorher schon geqotet war, die doppelten backslashes wieder auf einen kompenisieren
return $in ;
}
#################################################################
sub funcfind {
return unless ( $File::Find::name =~ /\d\d\d\.ts/ ) ;
#$File::Find::name = dosh($File::Find::name) ;
#print "\$File::Find::name : $File::Find::name\n" ;
push ( @VdrList , $File::Find::name ) ;
}

exit (0);
