#!/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
#
# version 7a
# 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 -> works at this time
# shedule list as parameters aka $ myprog file1 file2 file3
# progress bar on cut engine

# CHANGELOG
# 2008-09-07 reinsert command "cleanup test.vdr" after use, forgotten in last version v7
# 2008-08-10 rewrite Audio Dedection, Sort Order now : AC3 >=5ch , AC3 <5ch , Mp2 , Mp3 , / User Info Design cleanup (Alex)
# 2008-08-09 Added flexible stream detection for AC3 and MP2/3 audio (CBArts)



use strict;

use File::Find ;
use File::Copy ;
use File::Basename ;
use Cwd ;
# for DEBUG Audio
use Data::Dumper ;

## Zusatzprogramme / necessary programs

# 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 / user settings ----

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/"

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

## 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 - Developers Board Thread ( german ) : http://vdr-portal.de/board/thread.php?threadid=73791
А \"reading of multiple Vdr-Files and write to one single File\" is based on marks2bytepos.pl  --> Thanks alot
А VERSION 7.09.2008 V7a - modified by CBArts for SSEM , security Fixes and adding IFrames-correct, Rewrites and Comments of cutting Engine and Audio Order sorting
\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/ or $check_HD =~ /mpeg_ps_info version 1\.5\.0\.1/  ) {
print "Please use CVS 1.6.1 of mpeg4ip , or later (the tarball version 1.6.1 is broken --> please use CVS)...\n" ;
print "also you can download and use the source tar of 1.5.0.1 Version from : 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 "\nCreating 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..." ;
		my $cont ;
		while (1) {
			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 ;
		}
		undef $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" ;

#check :    stream 0: H.264 High@4 1920x1088
## ORF 720p
#check :   Video streams:
#check :    stream 0: H.264 Main@4 1280x720
#check :  Audio streams:
#check :    stream 0: MP3 2 channels 48000 sample rate 256000 bitrate
#check :    stream 1: MP3 2 channels 48000 sample rate 256000 bitrate

## Premiere HD 1080I
#check :    stream 0: MP3 2 channels 48000 sample rate 160000 bitrate
#check :    stream 1: MP3 2 channels 48000 sample rate 160000 bitrate
#check :    stream 2: AC3 5 channels 48000 sample rate 448000 bitrate

my @answer_check = `$info_bin ${tmp_dir}test.vdr` ;

my $info_video ;
# allover array which hold within one anonymus array per mp2/mp3 FIle infos : [0][0] filename / [0][1] sync / [0][2] info
my @audiofiles ;
# them like above for ac3
my @audiofiles_ac3 ;

foreach ( @answer_check ) {
	print "check : $_" if ( $print_debug ) ;
	if ( $_  =~ /(H.264) Main\@4 (\d+x\d+)/ ) { $info_video = "$1_$2" ; }
	if ( $_  =~ /(H.264) High\@4 (\d+x\d+)/ ) { $info_video = "$1_$2" ; }
	# add mp2/mp3 Streams in normal Order
	if ( $_  =~ /stream (\d+): MP2\s+(\d+)/) { my $z = sprintf ( "%02d" , $1 + 1 ) ; push (@audiofiles, ["test${z}.mp2","test${z}.mp2.sync","MP2_${2}ch"]) ; print  "ААА test${z}.mp2\n" if ( $print_debug ) }
	if ( $_  =~ /stream (\d+): MP3\s+(\d+)/) { my $z = sprintf ( "%02d" , $1 + 1 ) ; push (@audiofiles, ["test${z}.mp3","test${z}.mp3.sync","MP2_${2}ch"]) ; print  "ААА test${z}.mp3\n" if ( $print_debug ) }
	# first add AC3 Streams with lower than 5 Channels
	if ( $_  =~ /stream (\d+): (AC3),?\s+(\d+)/ and $2 < 5) { my $z = sprintf ( "%02d" , $1 + 1 ) ; push (@audiofiles_ac3, ["test${z}.ac3","test${z}.ac3.sync","AC3_${3}ch"]) ; print  "ААА test${z}.ac3\n" if ( $print_debug ) }
	# add AC3 with more than 5 Channels on beginn of the Array
	if ( $_  =~ /stream (\d+): (AC3),?\s+(\d+)/ and $2 >= 5) { my $z = sprintf ( "%02d" , $1 + 1 ) ; unshift (@audiofiles_ac3, ["test${z}.ac3","test${z}.ac3.sync","AC3_${3}ch"]) ; print  "ААА test${z}.ac3\n" if ( $print_debug ) }
}
# join Array AC3 first and Array of mp2/mp3 second
unshift @audiofiles , @audiofiles_ac3 ;
undef @audiofiles_ac3 ;
print Dumper (@audiofiles) if ( $print_debug ) ;

# 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" ) or die "cannot open for read ${tmp_dir}test.264.sync" ;
open (my $NEW , ">${tmp_dir}test.264.sync.new" ) or die "cannot open for write ${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") ;
### End ### bugcatcher "The remaining frames of this track might not be timestamped the way you intended them to be"


## Create Main Titel
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 ;

# Main Titel Audio Infos
my $info_audio ;
for ( my $z = 0 ; $z<=$#audiofiles ; $z ++ ) {	$info_audio = "${info_audio}_${audiofiles[$z][2]}" }

unlink "${tmp_dir}test.vdr" ;
my $outfile_cmd = dosh("${maintitel}_${info_video}${info_audio}.mkv") ;
# debug
print "\nFilename with new ordered Audio --> $outfile_cmd\n\n" ;

## Bugcatcher :  timecode-order fix... on start up to 4 lines with to big Indexes .... realy UGLY but playable
for ( my $z = 0 ; $z<=$#audiofiles ; $z ++ ) {
	my $audio_sync = "${tmp_dir}${audiofiles[$z][1]}" ;
	next unless ( -f "$audio_sync" ) ;
	print "try to correct timcodes order in : $audio_sync " ;
	open ( my $OLD , "<$audio_sync") or die "cannot open $audio_sync"  ;
	open (my $NEW , ">$audio_sync.new") or die "cannot open $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] ) {
			my  $old = $rev[$i] ;
			if ( $rev[$i - 1] - 32 >= 0 ) {  $rev[$i] = $rev[$i - 1] - 32 }
			else { $rev[$i] = $rev[$i - 1] }
			print  "($old -> $rev[$i])  " ;
		}
	}
	print "...OK\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 ;
my $cmdline = "mkvmerge --priority lower -o ${tmp_dir}test.mkv --timecodes 0:${tmp_dir}test.264.sync ${tmp_dir}test.264" ;
# audio part
for ( my $z = 0 ; $z<=$#audiofiles ; $z ++ ) {	$cmdline = "$cmdline --timecodes 0:${tmp_dir}${audiofiles[$z][1]} ${tmp_dir}${audiofiles[$z][0]}" ;}

print "DEBUG: cmd: $cmdline\n\n" if ( $print_debug ) ;
$result = system ($cmdline) ;

if ( $result == 0 ) { #everything ok, cleanup now
  print "\nRenaming 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 "\nCleaning up...\n" ;
  unlink "${tmp_dir}test.264" ;
  unlink "${tmp_dir}test.264.sync" ;

	# cleanup audio and audio.sync files
	for ( my $z = 0 ; $z<=$#audiofiles ; $z ++ ) {
		    if ( -f "${tmp_dir}${audiofiles[$z][0]}") { unlink "${tmp_dir}${audiofiles[$z][0]}"; }
		    if ( -f "${tmp_dir}${audiofiles[$z][1]}") { unlink "${tmp_dir}${audiofiles[$z][1]}"; }
	}

	# 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);
