#!/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 18.03.2008
#
# version3 - modified by CBArts 3.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 (additional software)

# mpeg4ip http://www.mpeg4ip.net/
## mpeg_ps_info
## mpeg_ps_extract (modified SSEM version --> see patch @ vdr-portal.de)

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

# Einstellungen (Settings)

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

## prepare
my $last_dir = cwd ;
chomp (my $info_bin = `which mpeg_ps_info`) ;
chomp (my $extract_bin = `which mpeg_ps_extract`) ;
# check if extract-version is usable...
# TODO...
##print "SSEM mpeg_ps_extract needs to be at least version 0.6!!!" ;
## print "ERROR: Wrong mpeg_ps_extract version!\nThis script needs an modified mpeg_ps_extract (SSEM-version)\nSearch in www.vdr-portal.de for the SSEM patch!\n" ;


# ok everything seems to be ok

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\nDid you forget to set the cutting marks?");
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 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]" )  ;

# test , ob HD material
my $check_HD = `$info_bin $VdrList[0]` ;
 	unless ( $check_HD  =~ /H.264/ ) { 
		print "$check_HD" ;
		print "°°° $VdrList[0] doesn't contain any H264 streams ... exit\n" ; 
		exit 1 ;
	}

my $inout = 0 ;
foreach my $w ( 1..$#reads ) {
	( my $curr_vdr  = $VdrList[$w - 1] )=~  s/\d\.vdr/$w\.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 xxx.vdr keine markierung hat überspringen bis 1. markierung gefunden, dann starten mit inout
#hotfix if ($w == 2 && $#{$reads[$w]} >= 1 ) { $inout = 1; } # hotfix start now - warning this may cause problems with more than 2 cuts...
	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;
		$inout = 0 ;
		#hotfix... (fixes problems with too small 001.vdr-files)
#		if ($w == 2) { $reads[$w][1] = $reads[$w][2]; $reads[$w][2] = $curr_size ; $inout = 1 ; }
#		$reads[$w][$#{$reads[$w]} + 1]= $curr_size ; # ende bei fullsize ;
		}
	}
	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
print "\nCombining VDR-files to cutted vdr file...\n";
open TOFH, ">${tmp_dir}test.vdr" or die "couldn't open >${tmp_dir}test.vdr ..." ;

my $byteshift = 16777216 ;
foreach my $w ( 1..$#reads ) {
#print "$w $#{$reads[$w]}" ;
	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 " couldn't open $act ..." ;
		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
print "\nChecking file for stream info...\n" ;
### h264 extract
my $ac31 = "" ;
my @answer_check = `$info_bin ${tmp_dir}test.vdr` ;
my $info_video ;
my $info_audio ;
my $a1_chan ;
my $a2_chan ;
my $extract_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" ; $a1_chan = "${2}" ; } 
	if ( $_  =~ /stream 1: (AC3),\s+(\d+)/) { $info_audio = "${info_audio}_$1_${2}ch" ; $ac31 = "yes" ; $a2_chan = "${2}" ; } 
}

print "debug: My findings:video: $info_video  audio: $info_audio  second_audio_stream: $ac31\n";

# zweite Tonspur aus dem vdr holen
# fÃ¤llt alles weg mit neuem demux-mod...
#if ( $ac31 =~/yes/ ) {
#print "\nExtracting secondary audio stream first...\n";
#chdir "${tmp_dir}" ;
#system ("$nice_cmd $extract_bin --audio=1 ${tmp_dir}test.vdr >${tmp_dir}sync_audio2.txt") ;
#File::Copy::move "${tmp_dir}test.ac3" , "${tmp_dir}test1.ac3" ;
#chdir "$last_dir" ;
#}

# 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
##audio time stamps
#nicht mehr nÃ¶tig... (erfolgt direkt in mpeg_ps_extract - dateiendung .sync)
#print "\nCreating timecode files...\n";
#open AUDIO , ">${tmp_dir}audio.tc" ;
#print AUDIO "# timecode format v2\n" ;
#open VIDEO , ">${tmp_dir}video.tc" ;
#print VIDEO "# timecode format v2\n" ;
#my $videostart = 0 ;
#if ( -f "${tmp_dir}sync.txt" ) {
#	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++ ; 
#		print AUDIO "$1\n" ;
#		}
#		if ( $line =~ /video len \d+ time\s+(\d+)/ ) {
#			$x++ ; 
#		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" ;
#		}
#	}	
#	close $FH ;
#	close AUDIO ;
#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 $z =0 ;
#	while ( my $line = <$FH> ) { 
#		# video len 1371 time 977
#		if ( $line =~ /audio len \d+ time\s+\d+\s+(\d+)/ ) {
#			$z++ ; 
#		print AUDIO1 "$1\n" ;
#		}
#		if ( $line =~ /(\d+)\s+audio frames/ ) {
#		print "Audio Frames aus log : $1\n" ;
#		}
#	}
#	close $FH ;
#	close AUDIO1 ;
#print "Audio2 frames : $z\n" ;
#}

# ende Audiosync
print "\nReading info.vdr and extracting title name...\n";
## Main Tilte erstellen
my $maintitel ="" ;
open (INFO, "<$ARGV[0]/info.vdr") or die ("Couldn't open $ARGV[0]/info.vdr");
	while ( my $line = <INFO> ) { 
		chomp $line ;
		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 ( $a1_chan < $a2_chan ) { 
#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}") {
  $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
  system ("rm ${tmp_dir}test.264") ;
  system ("rm ${audio1}") ;
  if ( -f "${audio2}") { system ("rm ${audio2}") ; }
  unlink "${tmp_dir}test.264.sync" ;
  unlink "${audio1}.sync" ;
  unlink "${audio2}.sync" ;
  system ("mv ${tmp_dir}test.mkv ${tmp_dir}$outfile_cmd") ;
  system ("cp \"${ARGV[0]}/info.vdr\" \"${tmp_dir}${maintitel}-info.vdr\"") ;
} else {
  print "\nERROR: Matroska merge failed!!! - please check input/outputfiles...\n" ; 
}
#old:
#print "\nCreating Matroska file with video...\n";
#system ("$nice_cmd mkvmerge -o ${tmp_dir}test.mkv --timecodes 0:${tmp_dir}test.264.sync ${tmp_dir}test.264") ;
#system ("rm ${tmp_dir}test.264") ;
#print "\nAdding first audio stream in sync with video\n";
#system ("$nice_cmd mkvmerge -o ${tmp_dir}test2.mkv ${tmp_dir}test.mkv --timecodes 0:${audio1}.sync ${audio1}") ;
#system ("rm ${tmp_dir}test.mkv && rm ${audio1}") ;
#if ( -f "${audio2}") {
#	print "\nAdding secondary audio stream in sync with video\n";
#	system ("$nice_cmd mkvmerge -o ${tmp_dir}test3.mkv ${tmp_dir}test2.mkv --timecodes 0:${audio2}.sync ${audio2}") ;
#	system ("rm ${tmp_dir}test2.mkv && rm ${audio2}") ;
#	system ("mv ${tmp_dir}test3.mkv ${tmp_dir}$outfile_cmd") ;
#}
#else { system ("mv ${tmp_dir}test2.mkv ${tmp_dir}$outfile_cmd") ; }
#system ("cp \"${ARGV[0]}/info.vdr\" \"${tmp_dir}${maintitel}-info.vdr\"") ;


#print "mkvmerge -o $outfile_cmd test.264 sync0.ac3 $ac31\n" ;
#system ("mkvmerge -o $outfile_cmd test.264 sync0.ac3 $ac31") ;

#unlink "${tmp_dir}test.264.sync" ;
#unlink "${audio1}.sync" ;
#unlink "${audio2}.sync" ;

#system ("ls -lha1 ${tmp_dir}"); 
#system ("mv ${tmp_dir}$outfile_cmd /video/$outfile_cmd") ;
#system ("mv ${tmp_dir}$outfile_cmd /mnt/sdb/$outfile_cmd") ;



### Funtionen

#################################################################
sub dosh {
my $in = $_[0] ;
$in =~ s/\s+/\ /g ; ## doppelte oder mehrere Leerzeichen auf eins reduzieren
$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 ) ;
}

exit (0);
