package Linux::DVB::DVBT::Ffmpeg ; =head1 NAME Linux::DVB::DVBT::Ffmpeg - Helper module for transcoding recorded streams =head1 SYNOPSIS use Linux::DVB::DVBT::Ffmpeg ; =head1 DESCRIPTION Module provides a set of useful routines used for transcoding the recorded .ts transport stream file into mpeg/mp4 etc. Use of these routines is entirely optional and does not form part of the base DVBT functionality. Currently supported file formats are: =over 4 =item B<.mpeg> - mpeg2 video / audio / subtitles =item B<.mp4> - mpeg4 video / audio The mp4 settings are configured to ensure that the file is compatible with playback on the PS3 (server by Twonky media server). Note: if you use this then be prepared for a long wait! On my system, a 2 hour film can take 13 hours to transcode. =item B<.m2v> - mpeg2 video =item B<.mp2> - mpeg2 audio =item B<.mp3> - mpeg3 audio You may notice ffmpeg reports the error: lame: output buffer too small Apparently (accoriding to the ffmpeg developers) this is perfectly fine. For further details see (http://howto-pages.org/ffmpeg/#basicaudio). =back Obviously, ffmpeg must be installed on your machine to run these functions. =head1 SUPPORT I don't intend to support every possible option in ffmpeg! These routines are provided as being helpful, but you can ignore them if you don't like them. Helpful suggestions/requests may result in my adding functionality, but I don't promise anything! =cut #============================================================================================ # USES #============================================================================================ use strict ; use File::Basename ; use Data::Dumper ; #============================================================================================ # GLOBALS #============================================================================================ our $VERSION = '2.10' ; our $DEBUG = 0 ; our $DEBUG_FFMPEG = 0 ; # margin on video length checks (in seconds) - allow for 3 minutes of padding our $DURATION_MARGIN = 180 ; # Niceness level our $NICE = 19 ; ## mpeg4 # const our $vidbitrate='1050kb' ; our $bittolerance='200kb' ; our $audbitrate='128kb' ; our $audchannels=2 ; our $threads=2 ; my $me_method_opt="-me_method" ; my $common_start = "-vcodec libx264 ". "-b $vidbitrate ". "-flags +loop ". "-cmp +chroma ". "-partitions +parti4x4+partp8x8+partb8x8" ; my $common_end = "-bf 3 ". "-b_strategy 1 ". "-threads $threads ". "-level 31 ". "-coder 1 ". "-me_range 16 ". "-g 250 ". "-keyint_min 25 ". "-sc_threshold 40 ". "-i_qfactor 0.71 ". "-bt $bittolerance ". "-rc_eq 'blurCplx^(1-qComp)' ". "-qcomp 0.6 ". "-qmin 10 ". "-qmax 51 ". "-qdiff 4 ". "-aspect 16:9 ". "-y " ; my $pass1_codec = "-an" ; my $pass2_codec = "-acodec libfaac ". "-ac $audchannels ". "-ab $audbitrate ". "-async 1 ". "-f mp4 " ; my $pass1_options = "$me_method_opt epzs ". "-subq 1 ". "-trellis 0 ". "-refs 1" ; my $pass2_options = "$me_method_opt umh ". "-subq 5 ". "-trellis 1 ". "-refs 5 " . "-scodec copy "; ## This is how to transcode the source into the various supported formats our %COMMANDS = ( 'ts' => 'ffmpeg -i "$src" -vcodec copy -acodec copy -scodec copy -async 1 -y "$dest.$ext"', 'mpeg' => [ # First try 'ffmpeg -i "$src" -vcodec copy -acodec copy -scodec copy -async 1 -y "$dest.$ext"', # Alternate 'ffmpeg -i "$src" -vcodec mpeg2video -sameq -acodec copy -scodec copy -async 1 -y "$dest.$ext"', ], 'm2v' => [ # First try 'ffmpeg -i "$src" -vcodec copy -f mpeg2video -y "$dest.$ext"', # Alternate 'ffmpeg -i "$src" -vcodec mpeg2video -sameq -f mpeg2video -y "$dest.$ext"', ], 'mp2' => 'ffmpeg -i "$src" -acodec copy -f mp2 -y "$dest.$ext"', 'mp3' => 'ffmpeg -i "$src" -f mp3 -y "$dest.$ext"', 'mp4' => [ [ # 1st pass 'ffmpeg -i "$src" ' . "$pass1_codec -pass 1 $common_start $pass1_options $common_end" . ' -y "$temp.$ext"', # 2nd pass 'ffmpeg -i "$src" ' . "$pass2_codec -pass 2 $common_start $pass2_options $common_end" . '$title_opt -y "$dest.$ext"', ], ], ) ; ## Order in which to process streams my @STREAM_ORDER = qw/video audio subtitle/ ; ## Map the requested audio/video/subtitle streams into a file format # # file format (extension), output spec regexp, supported audio channels (0, 1, 2+) # # List is ordered so that preferred file formats are earlier in the list # End of lis contain least preferred options. # our @FORMATS ; # map file extension into format my %FORMATS ; # Aliases my %ALIASES ; BEGIN { ## Map the requested audio/video/subtitle streams into a file format # # file format (extension), output spec regexp, supported audio channels (0, 1, 2+) # # List is ordered so that preferred file formats are earlier in the list # End of lis contain least preferred options. # @FORMATS = ( # default ['mpeg', 'va+s*'], # normal video ['m2v', 'v'], ['mp2', 'a'], ['mp3', 'a'], # catch-alls: ['mpeg', 'a+s*'], # mpeg can also be a container for just multiple audio etc ['mpeg', 'vs*'], ['mp4', 'va+s*'], ['mp4', 'a+s*'], ['mp4', 'vs*'], ['ts', 'va+s*'], # normal video ['ts', 'a+s*'], # mpeg can also be a container for just multiple audio etc ['ts', 'vs*'], ['ts', '.+'], # must contain at least 1 stream ) ; # make a HASH keyed on the file format (extension), where the value is an array of the possible # output regexps foreach (@FORMATS) { my ($ext, $regexp) = @$_ ; $FORMATS{$ext} ||= [] ; push @{$FORMATS{$ext}}, $regexp ; } # Create alias list %ALIASES = ( 'mpg' => 'mpeg', 'mpeg2' => 'mpeg', 'mpeg4' => 'mp4', 'TS' => 'ts', ) ; foreach (@FORMATS) { my ($ext, $regexp) = @$_ ; $ALIASES{$ext} = $ext ; } } #============================================================================================ =head2 Functions =over 4 =cut #----------------------------------------------------------------------------- =item B Transcode the recorded transport stream file into the required format, as specified by $multiplex_info_href. (Called by L). Multiplex info HASH ref is of the form: { 'pids' => [ { 'pid' => Stream PID 'pidtype' => pid type (video, audio, subtitle) }, ... ], 'errors' => [], 'warnings' => [], 'lines' => [], 'destfile' => final written file name (set by this function) } $written_files_href is an optional HASH that may be provided by the calling routine to track which files have been written. Since the file type (extension) can be adjusted by the routine to match it's supported formats/codecs, there is the chance that a file may be accidently over written. The tracking HASH ensures that, if a file was previously written with the same filename, then the new file is written with a unique filename. The 'errors' and 'warnings' ARRAY refs are filled with any error/warning messages as the routine is run. Also, the 'lines' ARRAY ref is filled with the ffmpeg output. If $destfile is undefined, then the routine just checks that $srcfile duration is as expected; setting the errors array if not. When $destfile is defined, it's file type is checked to ensure that the number of streams (pids) and the stream types are supported for this file. If not, then the next preferred file type is used and the destination file adjusted accordingly. The final written destination filename is written into the HASH as 'destfile'. The routine returns 0 on success; non-zero for any error. =cut sub ts_transcode { my ($src, $destfile, $multiplex_info_href, $written_files_href) = @_ ; my $error = 0 ; print STDERR "ts_transcode($src, $destfile)\n" if $DEBUG ; ## errors, warnings, and output lines are stored in the HASH my $errors_aref = ($multiplex_info_href->{'errors'} ||= []) ; my $warnings_aref = ($multiplex_info_href->{'warnings'} ||= []) ; my $lines_aref = ($multiplex_info_href->{'lines'} ||= []) ; ## if src not specified, then destination is a ts file - just check it's length if (! $src) { #### Check the destination file duration if (! -s "$destfile") { $error = "final file \"$destfile\" zero length" ; push @$errors_aref, $error ; return $error ; } my $file_duration = video_duration("$destfile") ; if ($file_duration < $multiplex_info_href->{'duration'} - $DURATION_MARGIN) { $error = "Duration of final \"$destfile\" ($file_duration secs) not as expected ($multiplex_info_href->{'duration'} secs)" ; push @$errors_aref, $error ; return $error ; } } else { #### Check the source file duration if (! -s "$src") { $error = "source file \"$src\" zero length" ; push @$errors_aref, $error ; return $error ; } my $file_duration = video_duration("$src") ; if ($file_duration < $multiplex_info_href->{'duration'} - $DURATION_MARGIN) { my $warn = "Duration of source \"$src\" ($file_duration secs) not as expected ($multiplex_info_href->{'duration'} secs)" ; push @$warnings_aref, $warn ; } } ## Save source filename $multiplex_info_href->{'srcfile'} = $src ; #### Select the dest file format if ($src) { # turn the pid types into a valid output spec # e.g. vaa for 2 audio + 1 video my $out_spec = _pids_out_spec(@{$multiplex_info_href->{'pids'}}) ; # Ensure the file format is correct $error = _sanitise_options(\$destfile, \$out_spec, $errors_aref, $warnings_aref) ; return $error if $error ; # check specified filename my ($name, $path, $ext) = fileparse($destfile, '\..*') ; $ext = substr $ext, 1 if $ext ; my $dest = "$path$name" ; # check to see if we've already written this filename if (exists($written_files_href->{"$dest.$ext"})) { # have to amend the filename so we don't overwrite my $num=1 ; while (exists($written_files_href->{"$dest$num.$ext"})) { ++$num ; } # report the change push @$warnings_aref, "Filename \"$dest.$ext\" was modified to \"$dest$num.$ext\" because a previously written file has the same name" ; # change $dest .= $num ; } # track filenames $written_files_href->{"$dest.$ext"} = 1 ; # return written filename & extension $multiplex_info_href->{'destfile'} = "$dest.$ext" ; $multiplex_info_href->{'destext'} = ".$ext" ; # make sure the extension is in a form we understand my $aliased_ext = $ALIASES{$ext} ; print STDERR " + dest=$dest ext=$ext\n" if $DEBUG ; print STDERR "COMMANDS list for $aliased_ext =" . Data::Dumper->Dump([$COMMANDS{$aliased_ext}]) if $DEBUG >= 5 ; ## Run ffmpeg my $cmds_ref = $COMMANDS{$aliased_ext} ; my @cmds = ref($cmds_ref) ? @$cmds_ref : ($cmds_ref) ; # create extra variables for variable replacement my $temp = "${path}temp$$.$name" ; # used for mp4 my $title_opt = "" ; # used for mp4 if ($multiplex_info_href->{'title'}) { $title_opt = "-metadata title=\"$multiplex_info_href->{'title'}\" " ; } # run through alternatives for (my $idx=0; $idx < scalar(@cmds); ++$idx) { my $cmd = $cmds[$idx] ; my $rc=0 ; my $pass_str ; # if this is an array, then it's a multi-pass algorithm my @passes = ref($cmd) ? @$cmd : ($cmd) ; foreach my $pass (@passes) { print STDERR "PASS: $pass\n" if $DEBUG ; ($pass_str = $pass) =~ s/\\/\\\\/g ; $pass_str =~ s/\"/\\\"/g ; print STDERR "PASS STR: $pass_str\n" if $DEBUG ; # expand all variables my $args ; eval "\$args = \"$pass_str\";" ; print STDERR "ARGS: $args\n" if $DEBUG ; # run the ffmpeg command my @lines ; $rc = run_transcoder($args, \@lines) ; # save results push @$lines_aref, @lines ; print STDERR "RC = $rc\n" if $DEBUG ; # stop if failed (non-zero exit status) last if $rc ; } # failed? my $pass_failed ; if ($rc) { $pass_failed = "ffmpeg command failed (status = $rc)" ; } else { # check video duration if (! -s "$dest.$ext") { $pass_failed = "destination file \"$dest.$ext\" zero length" ; } else { my $file_duration = video_duration("$dest.$ext") ; if ($file_duration < $multiplex_info_href->{'duration'} - $DURATION_MARGIN) { $pass_failed = "Duration of \"$dest.$ext\" ($file_duration secs) not as expected ($multiplex_info_href->{'duration'} secs)" ; } else { # all's well so stop last ; } } } if ($pass_failed) { # can we try again if ( ($idx+1) < scalar(@cmds)) { push @$warnings_aref, "$pass_failed, trying alternate command" ; } else { $error = $pass_failed ; push @$errors_aref, $error ; return $error ; } } } # delete any temp files for my $tempfile (glob("${path}temp*")) { unlink $tempfile ; } } return $error ; } #----------------------------------------------------------------------------- =item B Processes the destination file, the requested output spec (if any), and the language spec (if any) to ensure they are set to a valid combination of settings which will result in a supported file format being written. Adjusts/sets the values accordingly. If defined, the output spec (and language) always has precedence over the specified file format and the file format (i.e. extension) will be adjusted to match the required output. This is used when scheduling recording of multiple channels in the multiplex. This routine ensures that the correct streams are added to the recording. =cut # Want Input Out # ext lang out record out ext # av '' '' av av .mpeg # av .mpeg '' '' av av .mpeg (=ext) # a+v .mpeg 'a a' '' a+v a+v .mpeg (=ext) # avs .mpeg '' 'avs' avs =out .mpeg (=ext) # a+vs .mpeg 'a a' 'avs' a+vs =out .mpeg (=ext) # a '' 'a' a =out .mp2 # a 'a' 'a' a =out .mp2 # a .mp2 '' '' a a .mp2 (=ext) # a .mp3 '' '' a a .mp3 (=ext) # a .mp3 'a' '' a a .mp3 (=ext) # v .m2v '' '' v v .m2v (=ext) # v '' 'v' v =out .m2v (=ext) sub sanitise_options { my ($destfile_ref, $out_ref, $lang_ref, $errors_aref, $warnings_aref) = @_ ; my $error = 0 ; # language spec is optional my $lang = "" ; $lang_ref ||= \$lang ; $$destfile_ref ||= "" ; $$lang_ref ||= "" ; my $orig_lang = $$lang_ref ; # merge together the output spec & language spec and ensure output spec is in the correct form ($$out_ref, $$lang_ref) = _normalise_output_spec($$out_ref, $$lang_ref) ; print STDERR "sanitise_options($$destfile_ref, $$out_ref, $$lang_ref)\n" if $DEBUG ; # check specified filename my ($name, $path, $ext) = fileparse($$destfile_ref, '\..*') ; $ext = substr $ext, 1 if $ext ; my $dest = "$path$name" ; print STDERR " + dest=$dest ext=$ext\n" if $DEBUG ; # check output spec if (!$$out_ref) { ## no output spec defined # get default output spec my $default_ext = $FORMATS[0][0] ; print STDERR "format regexp 2 out - Default...\n" if $DEBUG ; my $default_out = _format_regexp2out($FORMATS[0][1], $$lang_ref) ; print STDERR "No out specified: default out=$default_out default ext=$default_ext\n" if $DEBUG ; # check file format if (!$ext) { print STDERR " + No ext specified: using default out=$default_out default ext=$default_ext\n" if $DEBUG ; # no file format, set it based on default output spec $$out_ref = $default_out ; $ext = $default_ext ; } else { # file format specified, see if we support it if (exists($ALIASES{$ext})) { # make sure the extension is in a form we understand my $aliased_ext = $ALIASES{$ext} ; print STDERR "format regexp 2 out - preferred for $ext ...\n" if $DEBUG ; # convert the first (preferred) regexp into output spec ($$out_ref, $$lang_ref) = _format_regexp2out($FORMATS{$aliased_ext}[0], $$lang_ref) ; print STDERR " + ext specified ($ext): using regexp $FORMATS{$aliased_ext}[0] out=$$out_ref ext=$aliased_ext\n" if $DEBUG ; } else { print STDERR " + non-supported ext specified: using default out=$default_out default ext=$default_ext\n" if $DEBUG ; # report warning push @$warnings_aref, "File type \"$ext\" is not supported, changing to \"$default_ext\"" ; # non-supoported file format, set to defaults $$out_ref = $default_out ; $ext = $default_ext ; } } } # check for language spec being dropped due to output spec if (($orig_lang) && ($$lang_ref ne $orig_lang)) { # report warning push @$warnings_aref, "Language spec \"$orig_lang\" is being ignored because of the specified required output (no audio)" ; } ## Do the rest of the processing now that we've handled the language spec $error = _sanitise_options($destfile_ref, $out_ref, $errors_aref, $warnings_aref) ; return $error ; } #----------------------------------------------------------------------------- =item B Uses ffmpeg to determine the video file duration. Returns the duration in seconds. =cut sub video_duration { my ($file) = @_ ; my %info = video_info($file) ; return $info{'duration'} ; } #----------------------------------------------------------------------------- =item B Uses ffmpeg to determine the video file contents. Returns a HASH containing: 'input' => Input number 'duration' => video duration in seconds 'pids' => { $pid => { 'input' => input number that this pid is part of 'stream' => stream number 'lang' => audio language 'pidtype' => pid type (video, audio, subtitle) } } =cut sub video_info { my ($file) = @_ ; my @lines ; run_transcoder("ffmpeg -i '$file'", \@lines) ; my %info = ( 'input' => undef, 'duration' => 0, 'pids' => {}, ) ; foreach my $line (reverse @lines) { # Input #0, mpegts, from 'bbc1-bbc2.ts': # Duration: 00:00:27.18, start: 15213.487800, bitrate: 4049 kb/s # Stream #0.0[0x259]: Audio: mp2, 48000 Hz, 2 channels, s16, 256 kb/s # Stream #0.1[0x258]: Video: mpeg2video, yuv420p, 720x576 [PAR 64:45 DAR 16:9], 15000 kb/s, 25 fps, 25 tbr, 90k tbn, 50 tbc # Stream #0.2[0x262]: Video: mpeg2video, yuv420p, 720x576 [PAR 64:45 DAR 16:9], 15000 kb/s, 25 fps, 25 tbr, 90k tbn, 50 tbc # Stream #0.3[0x263]: Audio: mp2, 48000 Hz, 2 channels, s16, 256 kb/s # At least one output file must be specified # Stream #0.0[0x258]: Video: mpeg2video, yuv420p, 720x576 [PAR 64:45 DAR 16:9], 15000 kb/s, 25 fps, 25 tbr, 90k tbn, 50 tbc # Stream #0.1[0x259](eng): Audio: mp2, 48000 Hz, 2 channels, s16, 256 kb/s # Stream #0.2[0x25a](eng): Audio: mp2, 48000 Hz, 1 channels, s16, 64 kb/s # Stream #0.3[0x25d](eng): Subtitle: dvbsub # Stream #0.1[0x259](eng): Audio: mp2, 48000 Hz, 2 channels, s16, 256 kb/s if ($line =~ /Stream #(\d+)\.(\d+)\[(0x[\da-f]+)\]\((\S+)\): (\S+): /i) { my ($input, $stream, $lang, $pid, $type) = ($1, $2, $3, hex($4), lc $5) ; $info{'pids'}{$pid} = { 'input' => $input, 'stream' => $stream, 'lang' => $lang, 'pidtype' => $type, } ; } # Stream #0.0[0x258]: Video: mpeg2video, yuv420p, 720x576 [PAR 64:45 DAR 16:9], 15000 kb/s, 25 fps, 25 tbr, 90k tbn, 50 tbc elsif ($line =~ /Stream #(\d+)\.(\d+)\[(0x[\da-f]+)\]: (\S+): /i) { my ($input, $stream, $pid, $type) = ($1, $2, hex($3), lc $4) ; $info{'pids'}{$pid} = { 'input' => $input, 'stream' => $stream, 'pidtype' => $type, } ; } # Duration: 00:00:27.18, start: 15213.487800, bitrate: 4049 kb/s elsif ($line =~ /Duration: (\d+):(\d+):(\d+).(\d+)/i) { my ($hour, $min, $sec, $ms) = ($1, $2, $3, $4) ; $sec += $min*60 + $hour*60*60; $info{'duration'} = $sec ; } # Input #0, mpegts, from 'bbc1-bbc2.ts': elsif ($line =~ /Input #(\d+),/i) { $info{'input'} = $1 ; last ; } } return %info ; } #----------------------------------------------------------------------------- =item B Run the transcoder command with the provided arguments. If the $lines_aref ARRAY ref is supplied, then the output lines from ffmpeg are returned in that array (one entry per line). Returns the exit status from ffmpeg. =cut sub run_transcoder { my ($args, $lines_aref) = @_ ; $lines_aref ||= [] ; # get command name my $transcoder = "" ; ($transcoder = $args) =~ s/^\s*(\S+).*/$1/ ; # set niceness my $nice = "" ; if ($NICE) { $nice = "nice -n $NICE" ; } # run ffmpeg # my $cmd = "$nice ffmpeg $args" ; my $cmd = "$nice $args" ; @$lines_aref = `$cmd 2>&1 ; echo RC=$?` ; # strip newlines foreach (@$lines_aref) { chomp $_ ; # Strip out the intermediate processing output $_ =~ s/^.*\r//g ; # prepend with command name $_ = "[$transcoder] $_" ; } # Add command to start unshift @$lines_aref , $cmd ; # get status my $rc=-1 ; if ($lines_aref->[-1] =~ m/RC=(\d+)/) { $rc = $1 ; } if ($DEBUG_FFMPEG) { print STDERR "-------------------------------------------\n" ; foreach (@$lines_aref) { print STDERR "$_\n" ; } print STDERR "STATUS = $rc\n" ; print STDERR "-------------------------------------------\n" ; } return $rc ; } # ============================================================================================ # PRIVATE # ============================================================================================ # -------------------------------------------------------------------------------------------- # Internal routine that expects the output spec to already have been created/normalised into # a valid spec (including any language options) sub _sanitise_options { my ($destfile_ref, $output_spec_ref, $errors_aref, $warnings_aref) = @_ ; my $error = 0 ; $$destfile_ref ||= "" ; $errors_aref ||= [] ; $warnings_aref ||= [] ; print STDERR "_sanitise_options($$destfile_ref, $$output_spec_ref)\n" if $DEBUG ; # check specified filename my ($name, $path, $ext) = fileparse($$destfile_ref, '\..*') ; $ext = substr $ext, 1 if $ext ; my $dest = "$path$name" ; print STDERR " + dest=$dest ext=$ext\n" if $DEBUG ; # check output spec if ($$output_spec_ref) { ## output spec defined # use it to check the file format my @supported_types = _output_formats($$output_spec_ref) ; print STDERR "out specified: supported types=" . Data::Dumper->Dump([\@supported_types]) if $DEBUG ; # check file format if (!$ext) { # no file format, set it based on output spec if (@supported_types) { # use first supported type $ext = $supported_types[0] ; } } else { # file format specified, check it matches supported types my %valid_types = map { $_ => 1} @supported_types ; if (exists($ALIASES{$ext}) && exists($valid_types{ $ALIASES{$ext} })) { # ok to use } else { # file format does not match requested output, use default for the requested output my $old_ext = $ext ; $ext = undef ; if (@supported_types) { # use first supported type my $new_ext = $supported_types[0] ; # report warning push @$warnings_aref, "File type \"$old_ext\" does not match requested output, changing to \"$new_ext\"" ; # change $ext = $new_ext ; } } } } ## If we get here and either the output spec or the file format are not defined, then there's been an error if (!$$output_spec_ref) { $error = "Unable to determine the correct recording type for the specified output file format" ; } elsif (!$ext) { $error = "Unable to determine the correct recording type for the specified output file format" ; } else { ## ok to finish off the output file $$destfile_ref = "$path$name.$ext" ; } if ($error) { push @$errors_aref, $error ; } return $error ; } # -------------------------------------------------------------------------------------------- # Ensure the output spec is in the correct form & has the stream types in the correct order sub _normalise_output_spec { my ($out, $lang) = @_ ; $out ||= "" ; $lang ||= "" ; my $out_spec = "" ; print STDERR "_normalise_output_spec(out=\"$out\", lang=\"$lang\")\n" if $DEBUG ; if ($out) { # number of audio channels (-1 because, if audio is specified in the output, that already adds 1) my $num_audio = _audio_chan_count($lang) ; $num_audio-- if $num_audio >= 1 ; print STDERR " + num_audio=$num_audio\n" if $DEBUG ; # look at each stream type in the correct order foreach my $type (@STREAM_ORDER) { # add stream type code (a=audio, v=video etc) to spec if this type # is in the specified spec my $type_ch = substr $type, 0, 1 ; if ($out =~ /$type_ch/) { $out_spec .= $type_ch ; print STDERR " + + add $type : $type_ch\n" if $DEBUG ; if ($type eq 'audio') { ## add in the language audio channels (-1 ) $out_spec .= 'a'x$num_audio ; print STDERR " + + add lang : ".'a'x$num_audio."\n" if $DEBUG ; } } else { # this type is not in the output spec if ($type eq 'audio') { ## no audio specified, so kill off the language spec $lang = "" ; print STDERR " + + no audio : removing any language spec\n" if $DEBUG ; } } } } print STDERR "final out_spec=\"$out_spec\"\n" if $DEBUG ; return ($out_spec, $lang) ; } # -------------------------------------------------------------------------------------------- # Convert the output spec into a list of supported types sub _output_formats { my ($out) = @_ ; ## Get list of valid file types print STDERR "checking out $out...\n" if $DEBUG ; my @valid_types ; foreach my $fmt_aref (@FORMATS) { my ($valid_fmt, $regexp) = @$fmt_aref ; print STDERR " + check $out : $valid_fmt => $regexp\n" if $DEBUG ; if ($out =~ m/^$regexp$/) { print STDERR " + + match\n" if $DEBUG ; # save format with the command information # $valid_types{$valid_fmt} = $COMMANDS{$valid_fmt} ; push @valid_types, $valid_fmt ; } } return @valid_types ; } # -------------------------------------------------------------------------------------------- # Convert the regular expression string into an output spec string. For example, converts: # v+a+s* # into # va # # Also amends the spec with any language specifier # sub _format_regexp2out { my ($regexp, $lang) = @_ ; my $out = $regexp ; print STDERR "_format_regexp2out($regexp)\n" if $DEBUG ; $out =~ s/\+//g ; print STDERR " + remove + : $out\n" if $DEBUG ; $out =~ s/(.)\*//g ; print STDERR " + remove X* : $out\n" if $DEBUG ; $out =~ s/\*//g ; print STDERR " + remove * : $out\n" if $DEBUG ; # normalise ($out, $lang) = _normalise_output_spec($out, $lang) ; print STDERR " + final out : $out\n" if $DEBUG ; return wantarray ? ($out, $lang) : $out ; } # -------------------------------------------------------------------------------------------- # Return the number of audio channels requested by the language spec # sub _audio_chan_count { my ($language_spec) = @_ ; my $num_audio = 0 ; # process language spec $language_spec ||= "" ; if ($language_spec) { # appends to default audio chan if ($language_spec =~ s/\+//g) { ++$num_audio ; } # work through the language spec my @lang = split /[\s,]+/, $language_spec ; $num_audio += scalar(@lang) ; } return $num_audio ; } # -------------------------------------------------------------------------------------------- # Convert the recorded pids into a valid output spec # sub _pids_out_spec { my (@pids) = @_ ; print STDERR "_pids_out_spec()\n" if $DEBUG>=10 ; ## turn the pid types into a format string of the form: