#!/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
# last edit 03.04.2008
#
# version4b - modified by CBArts 5.04.2008
# 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


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 $tmp_dir = "/tmp/" ; #  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
А 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 05.04.2008 - modified by CBArts for SSEM
\n" ;

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

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

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 ;
my $zaehlfilenumber = 0 ;
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);

my $startcode =  $_ ;
chomp $startcode ;
print "А $startcode\toffset $offset Vdr_number $filenumber\n" ;
if ( $zaehlfilenumber != $filenumber ) { $y = 0 ; $zaehlfilenumber = $filenumber }
$y++ ;
$reads[$filenumber][$y]=$offset ;
};

close (INDEX);

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

print "Checking if files contain H264 Video...\n" ;
# test , ob HD material
my $check_HD = `$info_bin $VdrList[0]` ;
 	unless ( $check_HD  =~ /H.264/ ) { 
		print "$check_HD" ;
		print "ААА $VdrList[0] enthфlt keinen H264 Strom ... exit\n" ; 
		exit 1 ;
	}
	
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" ;
my $inout = 0 ;
foreach my $w ( 1..$#reads ) {
	my $ww = sprintf("%0.3i",$w) ;
	( my $curr_vdr  = $VdrList[$w - 1] )=~  s/\d+\.vdr/${ww}\.vdr/ ;
	my $curr_size = -s $curr_vdr ;
#	print "\$curr_vdr $curr_vdr \$curr_size $curr_size $#{$reads[$w]}\n" ;
	next if ($w == 1 &&  $#{$reads[$w]} < 1) ; # wenn 001.vdr keine markierung hat ќberspringen
	if ( $w == 1 && $#{$reads[$w]}%2 != 0) { # wenn 001.vdr ungerade marks hat, fullsize als letzten marker
		$reads[$w][$#{$reads[$w]} + 1]= $curr_size ;
		$inout = 1 ;
	} 
	if ( $w != 1 && $#{$reads[$w]} >= 1 && $inout == 1 ) { # wenn ungleich 001.vdr und ein oder mehrere marks
		if ( $#{$reads[$w]}%2 == 0) { 	# gerade Anzahl von marks
			$inout = 0 ; 
			unshift @{$reads[$w]},0 ; # start bei null , wenn inout lesend 
			$reads[$w][1]=0;
			$reads[$w][$#{$reads[$w]} + 1]= $curr_size ; # ende bei fullsize ;
			$inout = 1 ;
		}
	}
	if ( $w != 1 && $#{$reads[$w]} == 1 && $inout == 1 ) { # wenn ungleich 001.vdr und eine marks
#		$inout = 0 ; 
		if ( $inout == 1 ) {
		unshift @{$reads[$w]},0 ; # start bei null , wenn inout lesend 
		$reads[$w][1]=0;
#		$reads[$w][$#{$reads[$w]} + 1]= $curr_size ; # ende bei fullsize ;
		$inout = 0 ;
		}
	}
	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 ;
	}

	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" ;
print "А schreibe einzelnen vdr File nach Schnittvorgaben\n" ;
my $byteshift = 16777216 ;
foreach my $w ( 1..$#reads ) {
	next if ( $#{$reads[$w]} <=1 ) ; # ќberspringen wenn weniger als 1 Startstopmarkierung
	my $lesevorgaenge = $#{$reads[$w]} / 2 ;
	my $lvshift = -1 ;
	foreach my $j ( 1..$lesevorgaenge ) {
		$lvshift = $lvshift +2 ;
		print "file $w\t\$lesevorgaenge $lesevorgaenge \$lvshift $lvshift\n" ;
		my $start = $reads[$w][$lvshift] ;
		my $stop = $reads[$w][$lvshift + 1] ;
		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 ${tmp_dir}test.vdr") ;
chdir "$last_dir" ;


##audio sync neu --> conversion not necessary ... SSEM
##
## TODO timecode-order fix...
## 
##audio time stamps
#open AUDIO , ">${tmp_dir}audio.tc" ;
#print AUDIO "# timecode format v2\n" ;
#open VIDEO , ">${tmp_dir}video.tc" ;
#print VIDEO "# timecode format v2\n" ;

#if ( -f "${tmp_dir}sync.txt" ) {
## es sollte immer 1 x Audio und 1 x Video geben
#my @unsort_video ;
#my @unsort_audio ;
#	open my $FH , "<${tmp_dir}sync.txt" ;
#		my $z =0 ;
#		my $x =0;
#	while ( my $line = <$FH> ) { 
#		# video len 1371 time 977
#		if ( $line =~ /audio len \d+ time\s+\d+\s+(\d+)/ ) {
#			$z++ ; 
#		push @unsort_audio , $1 ;
##		print AUDIO "$1\n" ;
#		}
#		if ( $line =~ /video len \d+ time\s+(\d+)/ ) {
#			$x++ ; 
#		push @unsort_video , $1 ;
##		print VIDEO "$1\n" ;
#		}
#		if ( $line =~ /(\d+)\s+audio frames/ ) {
#			print "Audio Frames aus log : $1\n" ;
#		}
#		if ( $line =~ /(\d+)\s+video frames/ ) {
#			print "Video Frames aus log : $1\n" ;
#		}
#	}
#	foreach ( sort {$a <=>$b} @unsort_video ) {	print VIDEO "$_\n" ; } # unsortierte Liste der Timcodes Video sortiert ausgeben
#	foreach ( sort {$a <=>$b} @unsort_audio ) {	print AUDIO "$_\n" ; } # unsortierte Liste der Timcodes Audio sortiert ausgeben
#	close $FH ;
#	close AUDIO ;
#	close VIDEO ;
#	print "Audio frames : $z\nVideo frames : $x\n" ;
#}
#if ( -f "${tmp_dir}sync_audio2.txt") {
#	open AUDIO1 , ">${tmp_dir}audio1.tc" ;
#	print AUDIO1 "# timecode format v2\n" ;
#	open my $FH , "<${tmp_dir}sync_audio2.txt" ;
#	my @unsort_audio2 ;
#		my $z =0 ;
#	while ( my $line = <$FH> ) { 
#		# video len 1371 time 977
#		if ( $line =~ /audio len \d+ time\s+\d+\s+(\d+)/ ) {
#			$z++ ; 
#		push @unsort_audio2 , $1 ;
##		print AUDIO1 "$1\n" ;
#		}
#		if ( $line =~ /(\d+)\s+audio frames/ ) {
#		print "Audio2 Frames aus log : $1\n" ;
#		}
#	}
#	foreach ( sort {$a <=>$b} @unsort_audio2 ) { print AUDIO1 "$_\n" ; } # unsortierte Liste der Timcodes Audio2 sortiert ausgeben
#	close $FH ;
#	close AUDIO1 ;
#	print "Audio2 frames : $z\n" ;
#}

# ende Audiosync

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

#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..." ;
  unlink "${tmp_dir}test.264" ;
  unlink "${audio1}" ;
  if ( -f "${audio2}") { unlink "${audio2}" ; }
  unlink "${tmp_dir}test.264.sync" ;
  unlink "${audio1}.sync" ;
  unlink "${audio2}.sync" ;
  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 ;
	}
}

exit (0);
