API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jun 17th, 2012
84
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 31.62 KB | None | 0 0
raw download clone embed print report
  1. MLD> ps | more /usr/bin/perl /usr/bin/vdrtranscode_server.pl
  2. more: /usr/bin/perl: No such file or directory
  3. #!/usr/bin/perl
  4. # vdrtranscode server Version 0.1
  5. # 2011-04-25
  6.  
  7. # great thanks to this superb howto :
  8. # http://trac.handbrake.fr/wiki/CLIGuide
  9.  
  10. use strict;
  11. use warnings;
  12. use Fcntl qw(:flock) ;
  13. use Proc::Daemon;
  14. use File::Find ;
  15. use File::Copy ;
  16. use File::Basename ;
  17. use Getopt::Long ;
  18. use Cwd;
  19. use Logfile::Rotate;
  20. use Math::BigInt ;
  21.  
  22.  
  23. my $use = "vdrtranscode_server.pl
  24.  
  25. \$ vdrtranscode_server [--daemon][--log][--verbose][--help]
  26. MLD> ps | more /usr/bin/perl /usr/bin/vdrtranscode_server.pl
  27. more: /usr/bin/perl: No such file or directory
  28. #!/usr/bin/perl
  29. # vdrtranscode server Version 0.1
  30. # 2011-04-25
  31.  
  32. # great thanks to this superb howto :
  33. # http://trac.handbrake.fr/wiki/CLIGuide
  34.  
  35. use strict;
  36. use warnings;
  37. use Fcntl qw(:flock) ;
  38. use Proc::Daemon;
  39. use File::Find ;
  40. use File::Copy ;
  41. use File::Basename ;
  42. use Getopt::Long ;
  43. use Cwd;
  44. use Logfile::Rotate;
  45. use Math::BigInt ;
  46.  
  47.  
  48. my $use = "vdrtranscode_server.pl
  49.  
  50. \$ vdrtranscode_server [--daemon][--log][--verbose][--help]
  51.  
  52. " ;
  53.  
  54. # main declarations
  55. my $self="->" ; # only for message system , no OO
  56. my @VideoList ; # all [cut] directoys in /video
  57. my $workfile ; # ${workdir}00001.ts or ${Outdir}vdrtranscode_tmp.ts ( if combined ts )
  58. my $workdir ; # /video/24/[work-HDTV]08.24-15:00_-_16:00_Uhr/2010-06-08.03.36.5-0.rec/
  59. my @TSList ; # combininig more than one ts file
  60. my $daemon_flag ;
  61. my $verbose_flag ;
  62. my $log_flag ;
  63. my $combined_ts ;
  64. my $continue = 1; # condition of main loop
  65.  
  66. #Signals
  67. $SIG{TERM} = \&quit ; # exit clean on Signal kill PID
  68. $SIG{INT} = \&quit ; # exit clean on Signal Str+C
  69. $SIG{CHLD} = 'IGNORE' ;
  70.  
  71. ## GetOpt::Long
  72. GetOptions( "daemon" => \$daemon_flag ,
  73. "log" => \$log_flag ,
  74. "verbose" => \$verbose_flag,
  75. "help" => sub { print "$use" ; exit 0 ;}
  76. ) ;
  77. my $config = &parse_config("/etc/vdrtranscode.conf") ;
  78.  
  79. my $Indir = "$config->{Indir}" ;
  80. my $Outdir = "$config->{Outdir}" ;
  81. # check given Directorys
  82. foreach ( $Indir , $Outdir ) {
  83. if ( -l $_ ) { $_ = readlink ( $_ ) } ;
  84. unless ( -e $_ || -d $_ ) { &message("$_ not found or is not a Directory, check please...") ; &quit ;}
  85. $_ .= "/" ;
  86. $_ =~s/\/\//\//g ;
  87. }
  88.  
  89. chdir($Outdir) ;
  90.  
  91. # change user to vdr running User if called as root
  92. if ( $> == 0 ) {
  93. my $uid = getpwnam($config->{vdr_user});
  94. $> = $uid ;
  95. &message("$self change effective User ID to $config->{vdr_user} : $uid") ;
  96. }
  97.  
  98. if ( $daemon_flag ) {
  99. undef $verbose_flag ;
  100. Proc::Daemon::Init;
  101. }
  102. else { &message("$self running in foreground...") };
  103.  
  104.  
  105. # leave our process ID for init
  106. open MYPID , (">/tmp/vdrtranscode_server.pid") ;
  107. print MYPID $$ ;
  108. close MYPID ;
  109.  
  110. # find binarys
  111. my $hb_bin = `which HandBrakeCLI` ; # eg. /usr/bin/HandBrakeCLI
  112. chomp $hb_bin ;
  113.  
  114.  
  115.  
  116. while ($continue) { # main loop
  117.  
  118. # log rotation , to prevent large Logfiles
  119. if ( -f "./vdrtranscode_server.log" and -s "./vdrtranscode_server.log" > 1024000 ) { # log file larger than 1024 Kbyte
  120. message("$self rotate Logfiles...") ;
  121. my $gzip_bin =`which gzip`; chomp $gzip_bin ;
  122. my $logdatei = new Logfile::Rotate(
  123. File => "./vdrtranscode_server.log",
  124. Count => 5,
  125. Gzip => "$gzip_bin",
  126. );
  127. $logdatei->rotate();
  128. undef $logdatei;
  129. }
  130.  
  131. # File find [cut- in /video
  132. # reset on every new main loop
  133. @VideoList =() ;
  134. $workfile ="" ;
  135. $workdir ="" ;
  136.  
  137. find ( \&funcfind_index , "$Indir" ) ; # alle /.*\/\[cut\].*\/.*rec\/00001.ts/ Dateien finden
  138. # if yes
  139. if ( $#VideoList >= 0 ) {
  140. &message("$self found $VideoList[0]") ;
  141. #mark [work
  142. &rename_vdr_file( $VideoList[0] , "cut" , "work") ;
  143. ( $workdir = $VideoList[0] ) =~ s/\[cut/\[work/ ; # looks like /video/24/[work-HDTV]08.24-15:00_-_16:00_Uhr/2010-06-08.03.36.5-0.rec/
  144.  
  145. # pre analysis to get fps for calculating start point
  146. undef $/ ; # unset line separator, to slurp the content to one var
  147. open INFO , "${workdir}/info" ; my $info_slurp = <INFO> ; close INFO ;
  148. $/ = "\n" ;
  149. my ( $fps ) = $info_slurp =~/F\s(\d{2})\n/ ;
  150. $fps = 25 if ( $fps !~/50|25/ ) ; # set default if slurp of info failed
  151. # DEBUG
  152. #$fps = 25 ;
  153. # test to prevent jerky playing on 25 fps sources
  154. my $set_fps="" ;
  155. if ( $fps == 25 ) { $set_fps ="-r $fps"}
  156. &message("$self fps : $fps") ;
  157.  
  158. # read all marks
  159. my @marks ;
  160. if ( -e "${workdir}/marks" ) {
  161. open MARKS , "<${workdir}/marks" ;
  162. @marks = <MARKS> ;
  163. foreach (@marks) { $_ =~s/\s\w+.*$// } # cleanup entrys from noad comments
  164. close MARKS ;
  165. }
  166.  
  167. # call subroutine combine_ts if
  168. # - there are more than one ts files
  169. # - there are more than 2 marks ( use as cutting engine )
  170.  
  171. if ( -e "${workdir}/00002.ts" or $#marks > 2 ) { # need to be merged to one big ts file in ${$Outdir}
  172. &combine_ts("${Outdir}vdrtranscode_tmp.ts" , \@marks , $fps ) ;
  173. $combined_ts = 1 ;
  174. ${workfile} = "${Outdir}vdrtranscode_tmp.ts" ;
  175. }
  176. else { ${workfile} = "${workdir}00001.ts" ; $combined_ts = 0 ;}
  177.  
  178. # analyse File
  179. &message("$self analyse...") ;
  180. my $workfile_dosh = dosh($workfile) ;
  181.  
  182.  
  183. # check marks and resolve start and end point
  184. # looks like :
  185. # 0:05:36.25
  186. # 0:48:21.04
  187. my $param_start = "" ;
  188. my $param_stop = "" ;
  189. my $Durframes = 0 ;
  190. # use only if not combined ts before....
  191. if ( $combined_ts == 0 and $#marks > 0 ) {
  192. if ( $#marks == 1 ) {
  193. my $z = 0 ;
  194. foreach ( @marks ) {
  195. $z++ ;
  196. my ( $Hour , $Minute , $Second , $Frame ) = $_ =~/(\d+):(\d+):(\d+).(\d+)/ ;
  197. $param_start = ( ($Hour * 60 *60 *$fps) + ($Minute * 60 *$fps) + ($Second *$fps)+ $Frame) if $z == 1 ;
  198. $param_stop = ( ($Hour * 60 *60 *$fps) + ($Minute * 60 *$fps) + ($Second *$fps)+ $Frame) if $z == 2 ;
  199. }
  200. # stop frame is counted from start frame, not from Filebegin
  201. $param_stop = $param_stop - $param_start ;
  202. $Durframes = $param_stop ;
  203. $param_stop = "--stop-at frame:$param_stop" ;
  204. $param_start = "--start-at frame:$param_start" ;
  205. }
  206. }
  207. &message("$self \$param_start $param_start") ;
  208. &message("$self \$param_stop $param_stop") ;
  209.  
  210. open ANALYZER , "nice -n $config->{nice_level} $hb_bin -i $workfile_dosh -o /dev/null $param_start -t 0 2>&1 |" ;
  211.  
  212. # declarations
  213. my $follow_audiotracks = 0 ;
  214. my $WxH = "" ;
  215. my ( $hours , $minutes , $seconds ) = "" ;
  216. my @Atracks = () ;
  217. my @new_crop = () ;
  218. while ( my $Zeile = <ANALYZER> ) {
  219. # find informations
  220. # + duration: 00:55:41
  221. if ( $Zeile =~/duration: / ) {
  222. ( $hours , $minutes , $seconds ) = $Zeile =~/(\d+):(\d+):(\d+)/ ;
  223. }
  224. # + size: 1920x1080, pixel aspect: 1/1, display aspect: 1.78, 25.000 fps
  225. if ( $Zeile =~/size: / ) {
  226. ( $WxH , undef ) = $Zeile =~/size:\s(\d+x\d+),.*,\s(\d+)\.\d+\sfps/ ;
  227. &message("$self $WxH") ;
  228. # calculate frames all over
  229. if ( $Durframes == 0 ) { # no markers used
  230. $Durframes = (( $hours * 60 * 60 )+ ( $minutes *60 ) + $seconds ) * $fps ;
  231. &message("$self \$Durframes new $Durframes") ;
  232. }
  233. }
  234. # get autocrop
  235. # + autocrop: 2/0/170/100
  236. if ( $Zeile =~/autocrop: / ) {
  237. my ( @orig_crop ) = $Zeile =~/autocrop:\s(\d+)\/(\d+)\/(\d+)\/(\d+)/ ;#top, Bottom , left , Right
  238. # set both crops ( per top/ bottom and Left/Rigth) on larger crop found by handbrake, to prevent crop is only left and not right side for example
  239. foreach ( 0..1 ) {$new_crop[$_] = $orig_crop[0] > $orig_crop[1] ? $orig_crop[0] : $orig_crop[1] ;}
  240. foreach ( 2..3 ) {$new_crop[$_] = $orig_crop[2] > $orig_crop[3] ? $orig_crop[2] : $orig_crop[3] ;}
  241. # rounding by modulo 8( sprintf "%.0f" , ( $probe_memory_ammount_Mbyte / 25 )) * 25 ;
  242. foreach ( @new_crop ) { $_ = ( sprintf "%.0f" , ( ${_} / 8 )) * 8 } ;
  243. &message("$self crop old : @orig_crop crop new : @new_crop") ;
  244. }
  245. # + audio tracks:
  246. if ( $Zeile =~/audio tracks:/ ) { $follow_audiotracks = 1 ; }
  247. if ( $Zeile =~/1,|2,|3,|4,/ and $follow_audiotracks == 1 ) {
  248. # print "$Zeile" ;
  249. my ( $nr , $lang , $codec ) = $Zeile =~/\+\s(\d+),\s+(\w+)\s+\((\w+)\)/ ;
  250. my $kbps = "" ;
  251. if ( $Zeile =~ /AC3/ ) { ( $kbps ) = $Zeile =~/,\s+(\d+)bps/ ; $kbps = $kbps / 1000 ; } # for Ac3 files get bitrate in kbps
  252. # print "$nr , $lang , $codec , $kbps\n" ;
  253. @{$Atracks[$nr]} = ( $lang , $codec , $kbps ) ; # structure Array[Tracknumber]->[field 0 : language] , [field 1 : codec] , [field 2: kbs]
  254. # + 1, Deutsch (AC3) (2.0 ch) (iso639-2: deu), 48000Hz, 384000bps
  255. # + 2, English (AC3) (2.0 ch) (iso639-2: eng), 48000Hz, 384000bps
  256. }
  257. }
  258. close ANALYZER ;
  259.  
  260. # get Informations for processing from File Flag
  261. # [mp4|m4v|mkv] [DD|noDD|HD-HD|HD-smallHD] [UVHQ|VHQ|HQ|MQ|LQ] [first|all]
  262.  
  263. my ( $container , $dd_hd_sd , $quali , $atracks ) = $workdir =~ /\[work-(mp4|m4v|mkv)\|(DD|noDD|HD-HD|HD-smallHD)\|(UVHQ|VHQ|HQ|MQ|LQ|VLQ)\|(first|all)\]/ ;
  264. &message("$self $container , $dd_hd_sd , $quali , $atracks") ;
  265.  
  266. # build cmd line
  267. # audiopart
  268. # -a 1,1,2 -A "Main Audio","Downmixed Audio","Director's Commentary"-E ac3,aac,aac -B auto,160,128 -R auto,auto,44100 -6 auto,dpl2,stereo
  269. # which audiotracks ?
  270. my $param_a ="" ; # Orig. Audio Tracks to use
  271. my $param_A ="" ; # Audio description
  272. my $param_E ="" ; # Audio Encoder
  273. my $param_B ="" ; # Audio Bitrates
  274. my $param_D ="" ;# normalize Audio
  275. my $nr_of_mp2 = 0 ;
  276. my $nr_of_mp2_used = 0 ;
  277. my @arr_of_track_contain_mp2 =() ;
  278. my $nr_of_ac3 = 0 ;
  279. my $nr_of_ac3_used = 0 ;
  280. my $ac3_bitrate = 0 ;
  281. my @arr_of_track_contain_ac3 =() ;
  282. foreach my $i ( 1..$#Atracks ) {
  283. #structure Array[Tracknumber]->[field 0 : language] , [field 1 : codec] , [field 2: kbs]
  284. if ( $Atracks[$i][1] =~/mp2|MPEG1/ ) { $nr_of_mp2++ ; push @arr_of_track_contain_mp2 , $i }
  285. if ( $Atracks[$i][1] =~/AC3/ ) { $nr_of_ac3++ ; push @arr_of_track_contain_ac3 , $i }
  286. &message("$self Atracks : $Atracks[$i][0], $Atracks[$i][1], $Atracks[$i][2]") ;
  287. }
  288. # mp2
  289. if ($atracks eq "first" and $nr_of_mp2 >=1 ) {
  290. $param_a = "$arr_of_track_contain_mp2[0]," ;
  291. $param_A = "\"$Atracks[$arr_of_track_contain_mp2[0]][0]\"" ;
  292. $param_E = "faac," ;
  293. $param_B = "$config->{AAC_Bitrate}," ;
  294. $param_D = "$config->{DRC}," ;
  295. $nr_of_mp2_used++ ;
  296. }
  297. if ($atracks eq "all" and $nr_of_mp2 >=1 ) {
  298. foreach ( @arr_of_track_contain_mp2 ) {
  299. $param_a .= "${_}," ;
  300. $param_A .="\"$Atracks[${_}][0]\"," ;
  301. $param_E .= "faac," ;
  302. $param_B .= "$config->{AAC_Bitrate}," ;
  303. $param_D .= "$config->{DRC}," ;
  304. $nr_of_mp2_used++ ;
  305. }
  306. }
  307. # ac3
  308. if ($dd_hd_sd =~ /^(DD|HD-HD|HD-smallHD)$/ and $nr_of_ac3 >=1) {
  309. foreach ( @arr_of_track_contain_ac3 ) {
  310. $param_a .= "${_}," ;
  311. $param_A .="\"$Atracks[${_}][0]\"," ;
  312. $param_E .= "copy," ;
  313. $param_B .= "auto," ;
  314. $param_D .= "1.0," ;
  315. $nr_of_ac3_used++ ;
  316. $ac3_bitrate = "$Atracks[${_}][2]" ;
  317.  
  318. }
  319. }
  320. foreach ( $param_a, $param_A , $param_E , $param_B , $param_D ) { $_ =~s/,$// ; } # remove last komma
  321.  
  322. my $param_crop = "--crop $new_crop[0]:$new_crop[1]:$new_crop[2]:$new_crop[3]" ;
  323.  
  324. &message("$self \$param_a -a $param_a\n\$param_A -A $param_A\n\$param_E -E $param_E\n\$param_B -B $param_B\n\$param_D -D $param_D\n\$param_crop $param_crop") ;
  325.  
  326.  
  327.  
  328. my $x264_opts ="ref=2:mixed-refs:bframes=2:b-pyramid=1:weightb=1:analyse=all:8x8dct=1:subme=7:me=umh:merange=24:trellis=1:no-fast-pskip=1:no-dct-decimate=1:direct=auto" ;
  329.  
  330. # Picture Size
  331. # $dd_hd_sd holds one of this -> DD|noDD|HD-HD|HD-smallHD
  332. my $param_X = 720 ; # max. Dimension Width ( 720 SD ( default ) , 1280 smallHD , 1920 HD )
  333. $param_X = 1920 if ( $dd_hd_sd eq "HD-HD" ) ;
  334. $param_X = 1280 if ( $dd_hd_sd eq "HD-smallHD" ) ;
  335. # anamorphic encoding
  336. my $param_anamorph = "" ;
  337. if ( $config->{anamorph_encoding} == 1 ) { $param_anamorph = "--loose-anamorphic" } # enable anamorph_encoding
  338.  
  339. # LQ for Webencoding -> sets maximum width of picture to 480 , disables anamorph encoding, sets AAC Rate to 96
  340. if ( $quali eq "LQ" ) { $param_X = 640 ; $param_anamorph = "" ; }
  341. if ( $quali eq "VLQ" ) { $param_X = 480 ; $param_anamorph = "" ; }
  342. # TODO current all Audiotracks are passed from general Settings above , override here
  343. # $ac3_bitrate = 96 ; ##TODO
  344. # ${container} = "m4v" if ( $nr_of_ac3 > 0 ) ; # change container from mp4 to m4v , if ac3 avaible
  345. #}
  346.  
  347. # TODO wenn kein dd gewählt dann keine änderung in m4v
  348. ${container} = "m4v" if ( $nr_of_ac3 > 0 and ${container} =~/mp4/ ) ; # change container from mp4 to m4v , if ac3 avaible
  349. my $outfile = "${Outdir}vdrtrancode_tmp.${container}" ;
  350. # recalculate Videobitrate to match round Mbyte Sizes ( cosmetic programming )
  351. # $frames
  352. # $fps
  353. # $aac_nr
  354. # $aac_bitrate
  355. # $ac3_nr
  356. # $ac3_bitrate
  357. # $wish_bitrate
  358. my ( $recalc_video_bitrate , $target_Mbyte_size ) = &recalculate_video_bitrate( $Durframes , $fps , $nr_of_mp2_used , $config->{AAC_Bitrate}, $nr_of_ac3_used , $ac3_bitrate , $config->{$quali}) ;
  359.  
  360. # large file bug // mp4 file over 4 Gbyte Size need "--large-file"
  361. my $set_large_file = "" ;
  362. if ( $target_Mbyte_size >= 4000 and ${container} =~/(mp4|m4v)/ ) { $set_large_file = "--large-file" } ;
  363.  
  364. ## strucure of proccesing line
  365. ## HandBrakeCLI -i /video/Wir_sind_Kaiser_-_Best_of/2010-10-26.21.55.15-0.rec/00001.ts -o ./test3.mp4 -e x264 -O -b 500 -2 -T -x ref=2:mixed-refs:bframes=2:b-pyramid=1:
  366. ## weightb=1:analyse=all:8x8dct=1:subme=7:me=umh:merange=24:trellis=1:no-fast-pskip=1:no-dct-decimate=1:direct=auto -5 -B 128 --stop-at frame:3000 --strict-anamorphic
  367.  
  368. # use classic profile for speedup, lowers the encoding quallity
  369. my $encoder_profile_to_use ="-2 -T -e x264 -x $x264_opts" ; # use x264 , instead ffmpeg , enable 2Pass and the x264 encoder options
  370. if ( $config->{use_classic_profile} eq 1 ) { $encoder_profile_to_use = "" ; &message("$self use classic Profile , to speedup...") ; }
  371.  
  372. # overwrite for debug
  373. #$param_stop = "--stop-at frame:3000" ;
  374. &message("$self JOBSTART --- $workfile") ;
  375. open HB , "nice -n $config->{nice_level} $hb_bin -i $workfile_dosh -O $set_large_file $param_crop $set_fps -b $recalc_video_bitrate $encoder_profile_to_use -5 -a $param_a -A $param_A -E $param_E -B $param_B -D $param_D $param_anamorph --modulus 8 -X $param_X -o $outfile $param_start $param_stop 2>&1 1>${Outdir}progress.log |" ;
  376. ## separate log for STOUT ( progress ) and STERR
  377. my $pid = fork();
  378.  
  379. # childs code to handle STDOUT
  380. if ($pid==0) {
  381. sleep 2 ; # wait $cmd is up
  382. if ( -f "${Outdir}progress.log" ) {
  383. $/="\r" ; # separator from \n to \r
  384. while (1) {
  385. sleep 5 ; #
  386. exit 0 unless ( -f "${Outdir}progress.log" ) ; # exit on log lost by father
  387. open (PROGRESS , "<${Outdir}progress.log" ) ;
  388. my @lines = reverse <PROGRESS> ;
  389. close PROGRESS ;
  390. if ( $lines[0] ) {&message("$lines[0]") ; }
  391. }
  392. }
  393. exit 0; # child exit
  394. }
  395. # end of child code
  396. while ( my $Zeile = <HB> ) {&message("° $Zeile") ;}
  397. unlink ("${Outdir}progress.log") ; # and ends childprocess
  398. close HB ;
  399.  
  400. # cleanup merged ts file
  401. if ( $combined_ts == 1 and -e "${Outdir}vdrtranscode_tmp.ts" ) { unlink "${Outdir}vdrtranscode_tmp.ts" } ;
  402. # mark [del
  403. # ( $workfile = $workfile ) =~s/00001.ts// ;
  404. &rename_vdr_file( $workdir , "work" , "del") ;
  405.  
  406.  
  407. #rename outfile
  408. # $workfile looks like # "/video/Der_Terminator/[work-m4v|HD-smallHD|VHQ|all]Science-Fiction/2010-06-08.03.36.5-0.rec/"
  409. my $copy_workdir = $workdir ;
  410. $copy_workdir =~s/\/\d{4}-\d{2}-\d{2}.*rec\/// ;
  411. $copy_workdir =~s/\[work.*(first|all)\]// ;
  412. $copy_workdir =~s/$Indir// ;
  413. $copy_workdir =~s/\//-/g ;
  414.  
  415. # include Videoformat on HD Targets
  416. if ( $config->{Name_incl_Videoformat} == 1 and $dd_hd_sd =~/(HD-smallHD|HD-HD)/ ) {
  417. # orifg size is in $WxH
  418. my ( $orig_W , $orig_H ) = split "x" , $WxH ;
  419. my %target_dimension_preset = ( 1920 => '1080' , 1280 => '720' ) ;
  420. $copy_workdir .= "-${target_dimension_preset{${orig_W}}}p${fps}" ; #result in "Filename-1080p25"
  421. }
  422.  
  423. $copy_workdir .= ".${container}" ;
  424. rename ("$outfile" , "${Outdir}$copy_workdir") ;
  425. &message("$self rename $outfile -> ${Outdir}$copy_workdir") ;
  426.  
  427. }
  428. # if no "[cut-" File found
  429. else {
  430. # wait 60 seconds
  431. &message("waiting") ;
  432. sleep 60 ;
  433. }
  434.  
  435. # functions inside loop
  436. #################################################################
  437. sub dosh {
  438. my $in = $_[0] ;
  439. #$in =~ s/\s+/\ /g ; ## doppelte oder mehrere Leerzeichen auf eins reduzieren
  440. $in =~ s/(\(\d+)\/(\d+\))/${1}\/${2}/g ; ## das (1/5) problem
  441. $in =~ s/([\s \( \) \$ \& \§ \" \! \? \[ \] \' \,\@ \| \> \<])/\\$1/g; # viele absonderliche Sonderzeichen für die shell qouten
  442. $in =~ s/\\\\/\\/g ; # wenn ausdruck vorher schon geqotet war, die doppelten backslashes wieder auf einen kompenisieren
  443. return $in ;
  444. }
  445. #################################################################
  446. sub funcfind_index {
  447. return unless ( $File::Find::name =~ /.*\/\[cut-.*\].*\/.*rec\/00001.ts$/ ) ;
  448. $File::Find::name=~s/00001.ts// ;
  449. push ( @VideoList , $File::Find::name ) ;
  450. }
  451. #################################################################
  452. sub rename_vdr_file {
  453. # /video/24/[cut-HDTV]08.24-15:00_-_16:00_Uhr/2010-06-08.03.36.5-0.rec
  454. ( my $filename = $_[0] ) =~ s/\d{4}-\d{2}-.*\.rec// ;
  455. my $from = $_[1] ;
  456. my $to = $_[2] ;
  457. my $dir = dirname($filename) ;
  458. my $file = basename($filename) ;
  459. ( my $file_neu = $file )=~ s/\[$from/\[$to/ ;
  460. &message("$self rename : ${dir}/${file} , ${dir}/${file_neu}") ;
  461. rename ( "${dir}/${file}" , "${dir}/${file_neu}" ) ;
  462. open REFRESH , ">$Indir/.update" ;
  463. close REFRESH ;
  464. }
  465. #################################################################
  466. sub recalculate_video_bitrate {
  467. my $frames = shift ;
  468. my $fps = shift ;
  469. my $aac_nr = shift ;
  470. my $aac_bitrate = shift ;
  471. my $ac3_nr = shift ;
  472. my $ac3_bitrate = shift ;
  473. my $wish_bitrate = shift ;
  474.  
  475. # Calculate Size of AAC Files
  476. my $AudioKbyte ;
  477. if ( $aac_nr > 0 ) {
  478. $AudioKbyte = sprintf ( "%.8f" , ( $aac_bitrate * $frames / $fps / 8 ) ) ; # ohne Overhead
  479. if ( $aac_nr >= 1 ) { $AudioKbyte = $AudioKbyte * $aac_nr }
  480. }
  481. else { $AudioKbyte = 0 }
  482. # print "\$AudioKbyte $AudioKbyte\n" ;
  483.  
  484. # Calculate Size of Ac3 Files
  485. my $ac3_kbyte_sec ;
  486. my $ac3_kbyteSize ;
  487. if ( $ac3_nr > 0 ) {
  488. $ac3_kbyte_sec = $ac3_bitrate / 8 ;
  489. $ac3_kbyteSize = sprintf ( "%.8f" , ( $ac3_kbyte_sec * $frames / $fps )) ;
  490. if ( $ac3_nr >= 1 ) { $ac3_kbyteSize = $ac3_kbyteSize * $ac3_nr }
  491. }
  492. else { $ac3_kbyteSize = 0 }
  493. # print "\$ac3_kbyteSize $ac3_kbyteSize\n" ;
  494.  
  495.  
  496. # Memory count
  497. my $minutes = $frames * $fps * 60 ;
  498. my $video_kbyte_sec = $wish_bitrate / 8 ;
  499. my $video_kbyte_size = ( $video_kbyte_sec * $frames ) / $fps ;
  500. my $probe_memory_ammount_kbyte = $video_kbyte_size + $ac3_kbyteSize + $AudioKbyte ;
  501. my $probe_memory_ammount_Mbyte = sprintf "%i" , $probe_memory_ammount_kbyte / 1024 ;
  502. &message("$self \$probe_memory_ammount_Mbyte $probe_memory_ammount_Mbyte") ;
  503.  
  504. my $round_memory_ammount_Mbyte ;
  505. # rounding
  506. if ( $probe_memory_ammount_Mbyte < 20 ) {
  507. $round_memory_ammount_Mbyte = ( sprintf "%.0f" , ( $probe_memory_ammount_Mbyte / 1 )) * 1 ;
  508. # if ( $round_memory_ammount_Mbyte < $probe_memory_ammount_Mbyte ){ $round_memory_ammount_Mbyte+=5}
  509. }
  510. if ( $probe_memory_ammount_Mbyte < 100 ) {
  511. $round_memory_ammount_Mbyte = ( sprintf "%.0f" , ( $probe_memory_ammount_Mbyte / 5 )) * 5 ;
  512. # if ( $round_memory_ammount_Mbyte < $probe_memory_ammount_Mbyte ){ $round_memory_ammount_Mbyte+=5}
  513. }
  514. elsif ( $probe_memory_ammount_Mbyte < 600 ) {
  515. $round_memory_ammount_Mbyte = ( sprintf "%.0f" , ( $probe_memory_ammount_Mbyte / 25 )) * 25 ;
  516. # if ( $round_memory_ammount_Mbyte < $probe_memory_ammount_Mbyte ){ $round_memory_ammount_Mbyte+=25}
  517. }
  518. elsif ( $probe_memory_ammount_Mbyte >= 600 ) {
  519. $round_memory_ammount_Mbyte = ( sprintf "%.0f" , ( $probe_memory_ammount_Mbyte / 50 )) * 50 ;
  520. # if ( $round_memory_ammount_Mbyte < $probe_memory_ammount_Mbyte ){ $round_memory_ammount_Mbyte+=50}
  521. }
  522. &message("$self \$round_memory_ammount_Mbyte $round_memory_ammount_Mbyte") ;
  523. my $round_memory_ammount_kbyte = $round_memory_ammount_Mbyte * 1024 ;
  524. $round_memory_ammount_kbyte = $round_memory_ammount_kbyte * 1.018 ; # empiric factor add
  525. my $round_memory_ammount_video_kbit = ( $round_memory_ammount_kbyte - $ac3_kbyteSize - $AudioKbyte ) * 8 ;
  526. my $round_memory_ammount_video_kbit_sec = sprintf "%.0f" , $round_memory_ammount_video_kbit / ( $frames / $fps ) ;
  527. &message("$self \$round_memory_ammount_video_kbit_sec $round_memory_ammount_video_kbit_sec") ;
  528. return $round_memory_ammount_video_kbit_sec , $round_memory_ammount_Mbyte ;
  529. }
  530. #################################################################
  531. sub combine_ts {
  532. my $target_ts = shift ;
  533. my $ref_marks = shift ;
  534. my $fps = shift ;
  535. @TSList = () ;
  536. ## get Byte Positions based on marks
  537. &message("$self combine TS Files active") ;
  538. &message("$self get Byte Positions based on marks") ;
  539.  
  540. my @reads ;
  541. open (INDEX, "<$workdir/index") or die ("Couldn't open $workdir/index");
  542.  
  543. my $y = 0 ; # initial Number of reading Areas per ts-File
  544. my $zaehlfilenumber = 0 ; # current ts-File Counter
  545. foreach (@$ref_marks){
  546. # can hold 0:05:33.16 Logo start cleanup
  547. my $buffer;
  548. my @bytepos=(0, 0, 0, 0);
  549. my ($h,$m,$s,$f) = split /[:.]/,$_;
  550. ($f,undef)=split / /, $f;
  551. chomp $f ;
  552. my $frame = ($h * 3600 + $m * 60 + $s)* $fps + $f-1;
  553. # &message("$self HMSF : $h,$m,$s,$f -> frame $frame") ;
  554.  
  555. # from recording.c vdr 1.7.18
  556. # uint64_t offset:40; // up to 1TB per file (not using off_t here - must definitely be exactly 64 bit!) 8byte
  557. # int reserved:7; // reserved for future use 1 byte
  558. # int independent:1; // marks frames that can be displayed by themselves (for trick modes) 1 byte
  559. # uint16_t number:16; // up to 64K files per recording 2 byte
  560. # tIndexTs(off_t Offset, bool Independent, uint16_t Number)
  561. # {
  562. # offset = Offset;
  563. # reserved = 0;
  564. # independent = Independent;
  565. # number = Number;
  566. # }
  567. # };
  568. seek (INDEX, 8*$frame,'0');
  569. read(INDEX, $buffer, 8);
  570. my ( @hex_littleendian ) = unpack ("H2H2H2H2H2H2H2H2" , $buffer) ; # 5 bytes offset , 1 byte reserved , 2 bytes filename
  571. # print "\@hex_littleendian @hex_littleendian\n" ;
  572. my @hex_ordert = reverse @hex_littleendian ; # now 2 bytes filename , 1 byte reserved , 5 bytes offset
  573. my $hex_offset = join "" , @hex_ordert[3..7] ;
  574. my $hex_number = join "" , @hex_ordert[0..1] ;
  575. # for use in 32 Bit
  576. my $offset = Math::BigInt->new("0x$hex_offset");
  577. # my $offset = hex ("$hex_offset") ;
  578. my $filenumber = hex ("$hex_number") ;
  579.  
  580. # &message("$self offset : $hex_offset -> $offset number : $hex_number -> $filenumber") ;
  581.  
  582. # if current marker is locatet in a new TS_File
  583. if ( $zaehlfilenumber != $filenumber ) { $y = 0 ; $zaehlfilenumber = $filenumber }
  584. $y++ ;
  585. &message("$self filenumber -> $filenumber || HMSF : ${h}:${m}:${s}.${f} || Frame -> $frame || Byteposition -> $offset") ;
  586. $reads[$filenumber][$y]=$offset ; # $reads[nr of vdr file][curr Nr of Cutting Marks per File]=Byteposition
  587. };
  588. close (INDEX);
  589. ## Liste aller Video TS Files im Dir machen
  590. find ( \&funcfind_ts , "$workdir" ) ;
  591.  
  592. &message("$self Creating cut-list...") ;
  593. # Adding Start and Stop Marks if reading Areas are set over Fileborders :
  594. # _________--------------______----------------______________________
  595. # off on off on off
  596. # |---------------------------------------||-----------------------------------------|
  597. # 001.vdr 002.vdr
  598. # / / / / // /
  599. # ^New Marker on FileBorders
  600. my $inout = 0 ;
  601. foreach my $w ( 1..$#reads ) { # Array of all VdrFiles --> within anonym Array of Marks , Starts on field 1, not 0 --> within Byteposition
  602. my $ww = sprintf("%0.5i",$w) ; # aus Zählung 1, 2 , 3 wieder 00001 , 00002 ,00003 herstellen
  603. ( my $curr_vdr = $TSList[$w - 1] )=~ s/\d+\.ts/${ww}\.ts/ ; # foreach -> zu bearbeitenden File mit voller Pfadangabe und 00x benennen
  604. my $curr_size = -s $curr_vdr ; # Filesize
  605. next if ($w == 1 && $#{$reads[$w]} < 1) ; # wenn 001.vdr keine Marks hat, Sprung zum nächsten File ( 002.vdr )
  606. if ( $w == 1 && $#{$reads[$w]}%2 != 0) { # wenn 001.vdr ungerade marks hat, ....
  607. $reads[$w][$#{$reads[$w]} + 1]= $curr_size ; # .... dann fullsize als letzten marker ....
  608. $inout = 1 ; # und Flag setzen, dass 001.vdr nicht mit Stop Marker marker endete
  609. &message ("$self 00001 no Stop, insert one") ;
  610. }
  611. 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
  612. if ( $#{$reads[$w]}%2 != 0) { # Wenn ungerade Anzahl von Marks, File endet also mit Stop Marker
  613. unshift @{$reads[$w]},0 ; # Leeren neuen Marker vorne dran bauen , wenn letzter File keinen Stopmarker hatte
  614. $reads[$w][1]=0; # ersten Marker mit Bytepos Null belegen, die nachfolgenden haben sich ja durch unshift 1 nach hinten bewegt
  615. $inout = 0 ; # Endete mit Stopmarker
  616. &message ("$self 0000${w} no Start --> insert one\n") ;
  617. }
  618. else { # Marker Anzahl gerade
  619. unshift @{$reads[$w]},0 ; # Leeren neuen Marker vorne dran bauen , da letzter File keinen Stopmarker hatte
  620. $reads[$w][1]=0; # ersten Marker mit Bytepos Null belegen, die nachfolgenden haben sich ja durch unshift 1 nach hinten bewegt
  621. $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 ;
  622. $inout = 1 ; # Endete nicht mit Stopmarker
  623. &message ("$self 0000${w} no Start no End --> insert both\n") ;
  624. }
  625. }
  626. elsif ( $w != 1 && $#{$reads[$w]} >= 1 && $inout == 0 ) { # wenn ungleich 001.vdr und eine/mehrere marks , Start Marker stimmt bereits
  627. if ( $#{$reads[$w]}%2 != 0) { # Wenn ugerade Anzahl von Marks, File endet also auch nicht mit Stop Marker
  628. $reads[$w][$#{$reads[$w]} + 1]= $curr_size ; # ende Marker bei fullsize setzen ;
  629. $inout = 1 ;
  630. &message ("$self 0000${w} no Stop --> insert one\n") ;
  631. }
  632. }
  633. if ( $w != 1 && $#{$reads[$w]} == -1 && $inout == 1 ) { # wenn ungleich 001.vdr und keine marks
  634. $reads[$w][1]=0 ; # start bei null
  635. $reads[$w][$#{$reads[$w]} + 1]= $curr_size ; # ende bei fullsize ;
  636. &message ("$self 0000${w} no Markers, but marked \"on-reading\" during last File , no Start no End --> insert both\n") ;
  637. }
  638.  
  639. foreach my $j ( 1..$#{$reads[$w]} ) {
  640. &message ("$self $w $j $reads[$w][$j]") ;
  641. }
  642. }
  643. #einzel ts zu geschnittenem ts
  644. open TOFH, ">$target_ts" or die "cannot open $target_ts for writing..." ;
  645. &message ("$self Combining ts-file using cut-list...") ;
  646. my $byteshift = 16777216 ;
  647. foreach my $w ( 1..$#reads ) {
  648. next if ( $#{$reads[$w]} <=1 ) ; # überspringen wenn weniger als 2 Marks
  649. my $lesevorgaenge = $#{$reads[$w]} / 2 ;
  650. my $lvshift = -1 ;
  651. foreach my $j ( 1..$lesevorgaenge ) {
  652. $lvshift = $lvshift +2 ; # start at anonym Array[1] not [0]
  653. &message ("$self file $w") ;
  654. my $start = $reads[$w][$lvshift] ;# anonym Array[1] / Array[3] / Array[5]
  655. my $stop = $reads[$w][$lvshift + 1] ; # anonym Array[2] / Array[4] / Array[6]
  656. my $vdr = sprintf ("%0.3i" , $w) ;
  657. my @curr = grep /${vdr}\.ts/, @TSList ;
  658. my $act = $curr[0] ;
  659.  
  660. open FH , "<$act" or die " konnte $act nicht öffnen..." ;
  661. my $cont ;
  662. while (1) {
  663. my $aktpos = tell FH ;
  664. # debug
  665. if ( $aktpos >= $stop ) { &message ("$self endpos : $aktpos")} ;
  666.  
  667. last if ( $aktpos >= $stop ) ;
  668. if ( $stop - $aktpos < $byteshift ) { $byteshift = $stop - $aktpos };
  669. if ( $aktpos == 0 ) {
  670. #debug
  671. &message ("$self seeking : $start") ;
  672.  
  673. seek FH, $start, 0 ;
  674. $aktpos = tell FH ;
  675. }
  676. read FH, $cont , $byteshift ;
  677. print TOFH $cont ;
  678. }
  679. undef $cont ;
  680. close FH ;
  681. }
  682. }
  683. close TOFH ;
  684. ## end read write
  685. }
  686. #################################################################
  687.  
  688.  
  689. #################################################################
  690. # end while}
  691. }
  692. #################################################################
  693. sub funcfind_ts {
  694. return unless ( $File::Find::name =~ /\d+\.ts/ ) ;
  695. push ( @TSList , $File::Find::name ) ;
  696. }
  697. #################################################################
  698.  
  699. # global functions
  700. #################################################################
  701. sub quit {
  702. message("*quit...") ;
  703. unlink ("/tmp/vdrtranscode_server.pid") if ( -f "/tmp/vdrtranscode_server.pid" ) ;
  704. die ;
  705. }
  706. #################################################################
  707. # thanks to http://www.patshaping.de/hilfen_ta/codeschnipsel/perl-configparser.htm
  708. sub parse_config($)
  709. {
  710. my $file = shift;
  711. local *CF;
  712.  
  713. open(CF,'<'.$file) or die "Open $file: $!";
  714. read(CF, my $data, -s $file);
  715. close(CF);
  716.  
  717. my @lines = split(/\015\012|\012|\015/,$data);
  718. my $config = {};
  719. my $count = 0;
  720.  
  721. foreach my $line(@lines)
  722. {
  723. $count++;
  724.  
  725. next if($line =~ /^\s*#/);
  726. next if($line !~ /^\s*\S+\s*=.*$/);
  727.  
  728. my ($key,$value) = split(/=/,$line,2);
  729.  
  730. # Remove whitespaces at the beginning and at the end
  731.  
  732. $key =~ s/^\s+//g;
  733. $key =~ s/\s+$//g;
  734. $value =~ s/^\s+//g;
  735. $value =~ s/\s+$//g;
  736.  
  737. # die "Configuration option '$key' defined twice in line $count of configuration file '$file'" if($config->{$key});
  738.  
  739. $config->{$key} = $value;
  740. }
  741.  
  742. return $config;
  743. }
  744. #################################################################
  745. sub message {
  746. # consider if message goes to STDOUT , Logfile or /dev/zero
  747. my $message = shift ;
  748. chomp $message ;
  749. if ( $verbose_flag and not $daemon_flag ) {
  750. print "$message\n" ;
  751. }
  752. if ( $log_flag ) {
  753. open LOG , ">>./vdrtranscode_server.log" ;
  754. flock(LOG, LOCK_EX) ;
  755. unless ( $message =~/waiting/ ) { print LOG "$message\n" ; } # dont flood log with "waiting"
  756. close LOG ;
  757. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!