#!/usr/bin/perl
# transform vdr h264 HDTV recordings to Matroska mkv, without prior cutting needet and compile in mkv timestamps
# based on marks2bytepos.pl  --> Thanks alot
# perl script to convert VDR cutting marks (marks.vdr) to byte positions in the stream
# written by Alexander Richter alexanderrichter ät gmx.net
#
# version6
# WARNING: modified version of mpeg_ps_extract (SSEM) necessary!!!
# ACHTUNG: es wird die modifizierte SSEM version von mpeg_ps_extract benötigt!
# SSEM = simultanous stream extraction mod

## TODO
# check for 25 / 50 frames for calculation of cut points <-> bytepos
# shedule list as parameters aka $ myprog file1 file2 file3
# progress bar on cut engine

# better user information design .-)

use strict;

use File::Find ;
use File::Copy ;
use File::Basename ;
use Cwd ;

## Zusatzprogramme

# mpeg4ip
# please use mpeg4ip version 1.6.1 CVS or newer (see forum for compile instructions)

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

# Einstellungen

my $print_debug = "" ;  # empty or not empty
my $tmp_dir = "/mnt/sdb/HD/" ; #  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
my $move_mkv_to = "" ; # abschließend mkv File  nach diesem Verzeichnis verschieben / z.B. -> "/mnt/sdb/HD/"

## prepare
my $last_dir = cwd ;
chomp (my $info_bin = `which mpeg_ps_info`) ;
chomp (my $extract_bin = `which mpeg_ps_extract`) ;

# Infos
print "\n° transform Vdr h264 HDTV recordings to Matroska mkv, without prior cutting needet and compile in mkv timestamps
° Initial written by Alexander Richter alexanderrichter ät gmx.net
° \"reading of multiple Vdr-Files and write to one single File\" is based on marks2bytepos.pl  --> Thanks alot
° VERSION 02.08.2008 - modified by CBArts for SSEM , security Fixes and adding IFrames-correct, rewrite and comments of cutting Engine
\n" ;

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

## Binary checks :
# check, if  mpeg_ps_extract is SSEM patched ...
unless ( `$extract_bin 2>&1` =~ /mpeg-ps-extractor (\d+)\.(\d+) - simultanous stream extraction mod/ and $1 >= 0 and $2 >= 4 ) {
	print "You need the SSEM patched Version of mpeg_ps_extract\nread more about here : http://vdr-portal.de/board/thread.php?threadid=73791\n" ;
	exit 1 ;
}

&correct_IFrames () ;


## get Byte Positions based on marks.vdr
print "get Byte Positions based on marks.vdr\n" ;
open (MARKS, "<$ARGV[0]/marks.vdr") or die ("Couldn't open $ARGV[0]/marks.vdr");
my @marks=<MARKS>;
close(MARKS);

my @reads ;
open (INDEX, "<$ARGV[0]/index.vdr") or die ("Couldn't open $ARGV[0]/index.vdr");

my $y = 0 ; # initial Number of reading Areas per Vdr-File
my $zaehlfilenumber = 0 ; # current VDr-File Counter
foreach (@marks)
{
   my $buffer;
   my @bytepos=(0, 0, 0, 0);
   my ($h,$m,$s,$f) = split /[:.]/,$_;
   ($f,undef)=split / /, $f;
   my $frame = ($h * 3600 + $m * 60 + $s)* 25 + $f-1;

   seek (INDEX, 8*$frame, 'SEEK_SET');
   read(INDEX, $buffer, 8);
   my ($offset, $type, $filenumber, $reserved) = unpack("LCCS", $buffer);

# for debugging
# show Marker ( timecode) , Bytecode , Vdr Number
my $timecode =  $_ ;
chomp $timecode ;
#print "° $startcode\toffset $offset Vdr_number $filenumber\n" ;

# if current marker is locatet in a new Vdr_File
if ( $zaehlfilenumber != $filenumber ) { $y = 0 ; $zaehlfilenumber = $filenumber }
$y++ ;
print "Vdr File : $filenumber Reading Points per Vdr-File : $y Timecode : $timecode Byteposition $offset\n" if ( $print_debug ) ;
$reads[$filenumber][$y]=$offset ; # $reads[nr of vdr file][curr Nr of Cutting Marks per File]=Byteposition
};

close (INDEX);
# End of get Byte Positions based on marks.vdr

my @VdrList ;
## Liste aller Video vdr Files im Dir machen
find ( \&funcfind , "$ARGV[0]" )  ;

print "Checking if files contain H264 Video..." ;
# test , ob HD material
my $file_to_check = dosh($VdrList[0]) ;
my $check_HD = `$info_bin $file_to_check` ;
 	unless ( $check_HD  =~ /H.264/ ) {
		print "$check_HD" ;
		print "°°° $VdrList[0] enthält keinen H264 Strom ... exit\n" ;
		exit 1 ;
	}
print "OK\n." ;

unless ( $check_HD =~ /mpeg_ps_info version 1\.6\.1/ ) {
print "Please use CVS 1.6.1 of mpeg4ip , or later " ;
print "(the tarball version is broken --> please use CVS)...\n" ;
print "or you can download the source tar of 1.5.0.1 Version from :\n" ;
print "http://sourceforge.net/project/downloading.php?group_id=18676&use_mirror=kent&filename=mpeg4ip-1.5.0.1.tar.gz&17340763\n" ;
#	print "by ...\n" ;
#	exit 0 ;
}

print "Creating cut-list...\n" ;
# Adding Start and Stop Marks if reading Areas are set over Fileborders :
#	 _________--------------______----------------______________________
#	off 			on 		   off    	on         		off
# |---------------------------------------||-----------------------------------------|
#     001.vdr              					002.vdr
#   	/		  /		      /		  /   //		   /
# 							      ^New Marker on FileBorders
my $inout = 0 ;
foreach my $w ( 1..$#reads ) { # Array of all VdrFiles --> within anonym Array of Marks , Starts on field 1, not 0 --> within Byteposition
	my $ww = sprintf("%0.3i",$w) ; # aus Zählung 1, 2 , 3 wieder 001 , 002 ,003 herstellen
	( my $curr_vdr  = $VdrList[$w - 1] )=~  s/\d+\.vdr/${ww}\.vdr/ ; # foreach -> zu bearbeitenden File mit voller Pfadangabe und 00x benennen
	my $curr_size = -s $curr_vdr ; # Filesize
	next if ($w == 1 &&  $#{$reads[$w]} < 1) ; # wenn 001.vdr keine Marks hat, Sprung  zum nächsten File  (  002.vdr )
	if ( $w == 1 && $#{$reads[$w]}%2 != 0) { # wenn 001.vdr ungerade marks hat, ....
		$reads[$w][$#{$reads[$w]} + 1]= $curr_size ; # .... dann fullsize als letzten marker ....
		$inout = 1 ; # und Flag setzen, dass 001.vdr  nicht mit Stop Marker marker endete
		print "001 no Stop, insert one\n" if ( $print_debug ) ;
	}
	if ( $w != 1 && $#{$reads[$w]} >= 1 && $inout == 1 ) { # wenn ungleich 001.vdr und "mehr als / oder" eine  Marks und vorhergehender File endet nicht mit Stoppmarke
		if ( $#{$reads[$w]}%2 != 0) { 	# Wenn ungerade Anzahl von Marks, File endet also mit Stop Marker
			unshift @{$reads[$w]},0 ; # Leeren neuen Marker vorne dran bauen , wenn letzter File keinen Stopmarker hatte
			$reads[$w][1]=0; # ersten Marker mit Bytepos Null belegen, die nachfolgenden haben sich ja durch unshift 1 nach hinten bewegt
			$inout = 0 ; # Endete mit Stopmarker
			print "00${w} no Start --> insert one\n" if ( $print_debug ) ;
		}
		else { # Marker Anzahl gerade
			unshift @{$reads[$w]},0 ; # Leeren neuen Marker vorne dran bauen , da letzter File keinen Stopmarker hatte
			$reads[$w][1]=0; # ersten Marker mit Bytepos Null belegen, die nachfolgenden haben sich ja durch unshift 1 nach hinten bewegt
			$reads[$w][$#{$reads[$w]} + 1]= $curr_size ; # weil ja gerade Anzahl von Markern, endet auch dieser File nicht mit Stop Marker --> letzter bytepos ende bei fullsize ;
			$inout = 1 ; # Endete nicht mit Stopmarker
			print "00${w} no Start no End  --> insert both\n" if ( $print_debug ) ;
		}
	}
	elsif ( $w != 1 && $#{$reads[$w]} >= 1 && $inout == 0 ) { # wenn ungleich 001.vdr und eine/mehrere marks , Start Marker stimmt bereits
		if ( $#{$reads[$w]}%2 != 0) { 	# Wenn ugerade Anzahl von Marks, File endet also auch nicht mit Stop Marker
			$reads[$w][$#{$reads[$w]} + 1]= $curr_size ; # ende Marker bei fullsize setzen ;
			$inout = 1 ;
			print "00${w} no Stop --> insert one\n" if ( $print_debug ) ;
		}
	}
	if ( $w != 1 && $#{$reads[$w]} == -1 && $inout == 1 ) { # wenn ungleich 001.vdr und keine marks
		$reads[$w][1]=0 ; # start bei null
		$reads[$w][$#{$reads[$w]} + 1]= $curr_size ; # ende bei fullsize ;
			print "00${w} no Markers, but marked \"on-reading\" during last File , no Start no End  --> insert both\n" if ( $print_debug ) ;
	}

	if ( $print_debug ) {
		foreach my $j ( 1..$#{$reads[$w]} ) {
			print "$w $j $reads[$w][$j]\n" ;
		}
	}
}


#einzel vdrs zu geschnittenem vdr
open TOFH, ">${tmp_dir}test.vdr" or die " >${tmp_dir}test.vdr nicht öffnen..." ;

print "Combining vdr-file using cut-list...\n" ;
my $byteshift = 16777216 ;
foreach my $w ( 1..$#reads ) {
	next if ( $#{$reads[$w]} <=1 ) ; # überspringen wenn weniger als 2 Marks
	my $lesevorgaenge = $#{$reads[$w]} / 2 ;
	my $lvshift = -1 ;
	foreach my $j ( 1..$lesevorgaenge ) {
		$lvshift = $lvshift +2 ; # start at anonym Array[1] not [0]
		print "file $w\t\$lesevorgaenge $lesevorgaenge \$lvshift $lvshift\n" if ( $print_debug ) ;
		my $start = $reads[$w][$lvshift] ;# anonym Array[1] / Array[3] / Array[5]
		my $stop = $reads[$w][$lvshift + 1] ; # anonym Array[2] / Array[4] / Array[6]
		my $vdr = sprintf ("%0.3i" , $w) ;
		my @curr = grep /${vdr}\.vdr/, @VdrList ;
		my $act = $curr[0] ;

		open FH , "<$act" or die " konnte $act nicht öffnen..." ;
		while (1) {
			my $cont ;
			my $aktpos = tell FH ;
			# debug
			if ( $aktpos >= $stop ) { print "endpos : $aktpos\n"} ;

			last if ( $aktpos >= $stop ) ;
			if ( $stop - $aktpos < $byteshift ) { $byteshift = $stop - $aktpos };
			if ( $aktpos == 0 ) {
				#debug
				print "seeking : $start\n" ;

				seek FH,  $start, 0 ;
				$aktpos = tell FH ;
			}
			read FH, $cont , $byteshift ;
			print TOFH $cont ;
		}
		close FH ;
	}
}
## end read write

if ( ! -f "${tmp_dir}test.vdr" ) { #check if cutting worked...
    print "ERROR: Cutting failed!" ;
    exit(-1) ;
}

&checkspace () ;

print "\nChecking file for stream info...\n" ;
### h264 extract
my $ac31 = "" ;
my $mp3 ="" ;
my @answer_check = `$info_bin ${tmp_dir}test.vdr` ;
my $info_video ;
my $info_audio ;
my $extract_audio = 0;
my $change_audio =0 ;
foreach ( @answer_check ) {
	print "check : $_" ;
	if ( $_  =~ /(H.264) Main\@4 (\d+x\d+)/ ) { $info_video = "$1_$2" ; }
	if ( $_  =~ /stream 0: (AC3),?\s+(\d+)/) { $info_audio = "$1_${2}ch" ; }
	if ( $_  =~ /stream 1: (AC3),?\s+(\d+)/) { $info_audio = "${info_audio}_$1_${2}ch" ; $ac31="yes" }
# check :    stream 1: MP3 2 channels 48000 sample rate 192000 bitrate
	if ( $info_audio =~ /AC3_(\d+)ch_AC3_(\d+)ch/ and $1 <6 and $2 == 6 ) {  $change_audio = 1; $info_audio =~ s/AC3_(\d+)ch_AC3_(\d+)ch/AC3_${2}ch_AC3_${1}ch/ ;  print "° audio gedreht : $info_audio\n" ;}
}
print "DEBUG: My findings:video: $info_video  audio: $info_audio  second_audio_stream: $ac31\n";

# zweite Tonspur aus dem vdr holen --> not necessary see SSEM patch

# demuxen von h264 und erster Tonspur --> not necessary ...

# demuxen von h264 und allen tonspuren (SSEM)
print "\nExtracting video and every available audio stream from vdr-file...\n";
chdir "${tmp_dir}" ;
system ("$nice_cmd $extract_bin --progress  ${tmp_dir}test.vdr") ;
chdir "$last_dir" ;



### bugcatcher "The remaining frames of this track might not be timestamped the way you intended them to be" --> add 2 pts informations with 40 difference on end of test.264.sync
open (my $OLD , "<${tmp_dir}test.264.sync" ) ;
open (my $NEW , ">${tmp_dir}test.264.sync.new" ) ;
my $z ;
while (<$OLD>) {
	next  if ( $_ =~ /^\n$/ ) ;
	$z = $_ ;
	print $NEW "$z"
}
close $OLD ;
chomp $z ;
foreach ( 1..2) {
	$z=$z+40 ;
	print $NEW "$z\n" ;
}
close $NEW ;
unlink "${tmp_dir}test.264.sync.orig" ;
rename ("${tmp_dir}test.264.sync.new" , "${tmp_dir}test.264.sync") ;
### Ende ### bugcatcher "The remaining frames of this track might not be timestamped the way you intended them to be"



## Main Tilte erstellen
print "\nReading info.vdr and extracting title name...\n";
my $maintitel ="" ;
open (INFO, "<$ARGV[0]/info.vdr") or die ("Couldn't open $ARGV[0]/info.vdr");
	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 ;

unlink "${tmp_dir}test.vdr" ;
my $outfile_cmd = dosh("${maintitel}_${info_video}_${info_audio}.mkv") ;

#Audio track # corrections
my $audio1 = "${tmp_dir}test01.ac3";
my $audio2 = "${tmp_dir}test02.ac3";
#check if we should switch audio-tracks...
if ( $change_audio != 0 ) {
#change audio stream order since it's likely that your native language version
#contains more channels than the 2nd stream
print "\nSwitching audio streams... (2nd audiostream has more channels)" ;
my $sw = "${audio1}" ;
$audio1 = "${audio2}" ;
$audio2 = "${sw}" ;
}

## TODO timecode-order fix... on start up to 4 lines with to big Indexes .... realy UGLY but playable
foreach my $audio_sync ( "${audio1}.sync" , "${audio2}.sync" ) {
	next unless ( -f $audio_sync ) ;
	print "\ntry to correct timcodes order in : $audio_sync \n" ;
	open ( my $OLD , "<$audio_sync" ) ;
	open (my $NEW , ">$audio_sync.new" ) ;
	print $NEW "# timecode format v2\n" ;
	my @timecodes ;
	while (<$OLD>) {
		next if ( $_ =~ /# timecode format v2/ ) ;
		next  if ( $_ =~ /^\n$/ ) ;
		chomp $_ ;
		push @timecodes , $_ ;
	}
	my @rev = reverse @timecodes ;
	for ( my $i=0 ; $i<=$#rev ; $i++ ) {
#		print "$i\n" ;
		next if ( $i <= 5 ) ; # irgnore last 5 timecodes for overflow of last entry
		if ( $rev[$i] > $rev[$i - 1] ) {
			print  "OLD : $rev[$i]\n" ;
			if ( $rev[$i - 1] - 32 >= 0 ) {  $rev[$i] = $rev[$i - 1] - 32 }
			else { $rev[$i] = $rev[$i - 1] }
			print  "NEW : $rev[$i]\n" ;
		}
	}
	my @timecodes_rev_rev = reverse @rev ;
	foreach ( @timecodes_rev_rev ) {
		print $NEW "$_\n" ;
	}
close $OLD ;
close $NEW ;
unlink "$audio_sync" ;
rename ("$audio_sync.new" , "$audio_sync") ;
}


#new fast muxing...
print "\nCreating Matroska file with video and audio...\n";
my $result ;
if ( -f "${audio2}") { #two audio streams detected
  $result = system ("mkvmerge --priority lower -o ${tmp_dir}test.mkv --timecodes 0:${tmp_dir}test.264.sync ${tmp_dir}test.264 --timecodes 0:${audio1}.sync ${audio1} --timecodes 0:${audio2}.sync ${audio2}") ;
} else {
  $result = system ("mkvmerge --priority lower -o ${tmp_dir}test.mkv --timecodes 0:${tmp_dir}test.264.sync ${tmp_dir}test.264 --timecodes 0:${audio1}.sync ${audio1}") ;
}
if ( $result == 0 ) { #everything ok, cleanup now
  print "Renaming output Matroska file to \"$outfile_cmd\"\n" ;
  system ("mv ${tmp_dir}test.mkv ${tmp_dir}$outfile_cmd") ;
  print "Copying movie infofile to \"${tmp_dir}${maintitel}-info.txt\"\n" ;
  system ("cp \"${ARGV[0]}/info.vdr\" \"${tmp_dir}${maintitel}-info.txt\"") ;
  print "Cleaning up...\n" ;
  unlink "${tmp_dir}test.264" ;
  unlink "${audio1}" ;
  if ( -f "${audio2}") { unlink "${audio2}" ; }
  unlink "${tmp_dir}test.264.sync" ;
  unlink "${audio1}.sync" ;
  unlink "${audio2}.sync" ;

	# move mkv File and info.txt from temp Dir to Final Dest.
	unless ( $move_mkv_to eq "" ) {
		unless ( $move_mkv_to =~ /\/$/ ) { $move_mkv_to =~ s/$move_mkv_to/${move_mkv_to}\// }
		print "° Moving \"${tmp_dir}$outfile_cmd\" --> \"${move_mkv_to}$outfile_cmd\"\n" ;
		system ("mv ${tmp_dir}$outfile_cmd ${move_mkv_to}${outfile_cmd}") ;
  		print "Copying movie infofile to \"${tmp_dir}${maintitel}-info.txt\"\n" ;
  		system ("mv \"${tmp_dir}${maintitel}-info.txt\" \"${move_mkv_to}${maintitel}-info.txt\"") ;
	}

  print "done!\n\n" ;
} else {
  print "\nERROR: Matroska merge failed!!! - please check input/outputfiles...\n" ;
}



### Funtionen

#################################################################
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\.vdr/ ) ;
#$File::Find::name = dosh($File::Find::name) ;
#print "\$File::Find::name : $File::Find::name\n" ;
push ( @VdrList , $File::Find::name ) ;
}

#################################################################
sub checkspace {
my $FileSize = -s "${tmp_dir}test.vdr" ;
$FileSize = $FileSize /1024 ; # in Kbyte
	my @df = split " " , (`df ${tmp_dir}`) ; # freier Platz in Kbytes
	if ( $df[10] <= ( $FileSize ) ) {
		my $needet = sprintf ("%.i" , ( ( $FileSize ) - $df[10] ) / 1024 ) ;
		print "° Nicht genügend Platz in ${tmp_dir}, bitte mind. $needet MBytes freimachen\n" ;
		exit 1 ;
	}
}
#################################################################
sub add
{
   my ($pint, $add) = @_;

   for (my $i=3; $i>0; $i--)
   {
      $pint->[$i] += $add%1000;
      if ($pint->[$i] >=1000)
      {
         $pint->[$i-1] += int($pint->[$i]/1000);
         $pint->[$i] = $pint->[$i]%1000;
      }
      $add = int($add/1000);
   }
   $pint->[0] += $add;
}
#################################################################
sub correct_IFrames {
	# Code  GoranAgar --> correkt cut points on non I-Frames from marks.vdr to I-Frames
	print "\nCorrect IFrames \n" ;
	open (MARKS, "<$ARGV[0]/marks.vdr") || die "Couldn't open $ARGV[0]/marks.vdr\n";
	my @marks=<MARKS>;
	close(MARKS);
	print "° Before :\n" if ( $print_debug ) ;
	$"="" ;
	print ("@marks") if ( $print_debug ) ;
	$"=" " ;
	print "° After :\n"if ( $print_debug ) ;
	my @stat = stat ("$ARGV[0]/index.vdr");
	my $length = $stat[7];

	my $buffer = "";
	open (INDEX, "<$ARGV[0]/index.vdr");
	binmode (INDEX);
	open (MARKS, ">$ARGV[0]/marks.vdr");
	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 $frame = ($h * 3600 + $m * 60 + $s)* 25 + $f-1;

		my $pos = 8 * $frame;
		sysseek (INDEX, $pos, 0);
		sysread (INDEX, $buffer, 8);
		my ($offset, $type, $filenumber, $reserved) = unpack ("LCCS", $buffer);

		# erstes I-Frame vor der Startposition finden, die anderen danach
		if ($i == 0)
		{
			while ($type != 1)
			{
				sysseek (INDEX, $pos, 0);
				sysread (INDEX, $buffer, 8);
				($offset, $type, $filenumber, $reserved) = unpack ("LCCS", $buffer);
				$pos -= 8;
			}
		}
		else
		{
			while ($type != 1)
			{
				sysread (INDEX, $buffer, 8);
				($offset, $type, $filenumber, $reserved) = unpack ("LCCS", $buffer);

				# falls Dateiende erreicht wurde ohne ein I-Frame zu finden gehe zum letzten vorhandenen
				if (sysseek (INDEX, 0, 1) == $length)
				{
					while ($type != 1)
					{
						sysseek (INDEX, $pos, 0);
						sysread (INDEX, $buffer, 8);
						($offset, $type, $filenumber, $reserved) = unpack ("LCCS", $buffer);
						$pos -= 8;
					}
				}
			}
		}

		$pos = (sysseek (INDEX, 0, 1)) / 8;
		$f = $pos % 25;
		$pos -= $f;
		$pos /= 25;
		$s = $pos % 60;
		$pos -= $s;
		$pos /= 60;
		$m = $pos % 60;
		$pos -= $m;
		$pos /= 60;
		$h = $pos;

		printf ("%02d:%02d:%02d.%02d\n", $h, $m, $s, $f) if ( $print_debug ) ;
		printf MARKS ("%02d:%02d:%02d.%02d\n", $h, $m, $s, $f);
	}

	close (INDEX);

	## End correct I-Frames
}


exit (0);
