Create a test pattern video with Perl

I wanted a test pattern video to test a transcoding daemon I wrote for an iPhone application. I wanted to use the classic RCA test pattern image and a tone.

Simply edit the program header with the path to an image you want to use and the name of the output file you’d like to create.

You’ll need FFMPEG installed, of course.

You can change the audio tone if you’d like to.

If you use this script, please let me know.

Share and enjoy.

#!/usr/bin/perl -w
# create_test_pattern_video.pl
# by Andrew Ault, www.andrewault.net
#
# This produces a test pattern video from an image you supply with a tone that you specify.
#
use strict;
use warnings;

use File::Temp qw/ :mktemp tempdir /;
use File::Path;
use File::Spec;
use Audio::Wav;

# still image to create video from
my $fileImage = "/path/imageInputFilename.jpeg";

# output file - name of the file to output to
my $fileOutput = "/path/videoOutputFilename.mp4";

# video parameters
my $vFrameRate      = 25;
my $vBitRate        = "200k";
my $durationSeconds = 10;

# audio parameters - set up the tone to produce and use in the resulting video
my $hertz      = 400;
my $sampleRate = 44100;
my $sampleBits = 16;

#
my $dirTemp = tempdir("tmp-hax-XXXXXXXX");
$dirTemp = File::Spec->rel2abs($dirTemp) . "/";
my $numFrames = $vFrameRate * $durationSeconds;
my $cmd;
my $fileTmpAnimationVideo = $dirTemp . "animation.mp4";
my $fileTmpAudio          = $dirTemp . "sound.wav";

chdir $dirTemp;

# create a sequence of image files
print "creating image sequence\n";
for ( my $i = 1 ; $i <= $numFrames ; $i++ ) {
	my $seq = sprintf( "%08d", $i );
	$cmd = "cp $fileImage " . $seq . ".jpeg";
	print "$cmd\n";
	`$cmd`;
}

# create .mp4 from the image sequence
print "creating animation video\n";
$cmd = "ffmpeg -r $vFrameRate -b $vBitRate -i " . $dirTemp . "%08d.jpeg $fileTmpAnimationVideo";
print "$cmd\n";
`$cmd`;

# create the audio tone .wav
my $wav = Audio::Wav->new;
my $details = {
	'bits_sample' => $sampleBits,
	'sample_rate' => $sampleRate,
	'channels'    => 1,
};
my $write = $wav->write( $fileTmpAudio, $details );
&add_sine( $hertz, $durationSeconds );
$write->finish();

# combine the video and audio files to output
print "creating final output video file\n";
$cmd = "ffmpeg -y -i $fileTmpAnimationVideo -i $fileTmpAudio -acodec libfaac -ab 128k -ar 48000 $fileOutput";
print "$cmd\n";
`$cmd`;

# wrap it up
print "done\n";
rmtree($dirTemp);
exit(0);

sub add_sine {
	my $hz     = shift;
	my $length = shift;
	my $pi     = ( 22 / 7 ) * 2;
	$length *= $sampleRate;
	my $max_no = ( 2**$sampleBits ) / 2;
	for my $pos ( 0 .. $length ) {
		my $time = $pos / $sampleRate;
		$time *= $hz;
		my $val  = sin $pi * $time;
		my $samp = $val * $max_no;
		$write->write($samp);
	}
	return;
}

Be Sociable, Share!

One thought on “Create a test pattern video with Perl

  1. I need the perl script which stream video from server to any mobile device which contains that particular format please mail me a sample code for streaming a video on PC please email to prasad.gummadavelli@gmail.com.what ever you have code for streaming please share with me. Thanks, prasad

Comments are closed.