Tag Archives: perl

Perl script to get video details

This is a command line Perl script I made a while back to simply show details about a specified video. It is tested on Ubuntu.

You can modify it for your specific requirements or grab some code for another use.

#!/usr/bin/perl -w
use strict;
use warnings;
 
use IPC::Open3;
 
# example
my $filename  = $ARGV[0];
my %videoInfo = videoInfo($filename);
print "duration: " . $videoInfo{'duration'} . "\n";
print "durationsecs: " . $videoInfo{'durationsecs'} . "\n";
print "bitrate: " . $videoInfo{'bitrate'} . "\n";
print "vcodec: " . $videoInfo{'vcodec'} . "\n";
print "vformat: " . $videoInfo{'vformat'} . "\n";
print "acodec: " . $videoInfo{'acodec'} . "\n";
print "asamplerate: " . $videoInfo{'asamplerate'} . "\n";
print "achannels: " . $videoInfo{'achannels'} . "\n";
 
#
# returns media information in a hash
sub videoInfo {
	# ffmpeg command
	my $ffmpeg = '/usr/local/bin/ffmpeg';
 
	my %finfo = (
				  'duration'     => "00:00:00.00",
				  'durationsecs' => "0",
				  'bitrate'      => "0",
				  'vcodec'       => "",
				  'vformat'      => "",
				  'acodec'       => "",
				  'asamplerate'   => "0",
				  'achannels'       => "0", 
	);
 
	my $file = shift;
 
	# escaping characters
	$file =~ s/(\W)/\\$1/g;
 
	open3( "/dev/null", \*ERPH, "$ffmpeg -i $file" ) or die "can't run $ffmpeg\n";
	my @res = ;
 
	# parse ffmpeg output
	foreach (@res) {
        print;
 
		# duration
		if (m!Duration: ([0-9][0-9]:[0-9][0-9]:[0-9][0-9].[0-9][0-9])!) {
			$finfo{'duration'} = $1;
		}
 
		# bitrate
		if (m!bitrate: (\d*) kb/s!) {
			$finfo{'bitrate'} = $1;
		}
 
		# vcodec and vformat
		if (/Video: (\w*), (\w*),/) {
			$finfo{'vcodec'}  = $1;
			$finfo{'vformat'} = $2;
		}
 
        # Stream #0.1(und): Audio: aac, 48000 Hz, 1 channels, s16, 64 kb/s
 
		# acodec, samplerate, stereo and audiorate
		if (m!Audio: (\w*), (\d*) Hz, (\d*)!) {
			$finfo{'acodec'}     = $1;
			$finfo{'asamplerate'} = $2;
			$finfo{'achannels'}     = $3;
		}
	}
 
	my $tenths  = substr( $finfo{'duration'}, 9, 2 );
	my $seconds = substr( $finfo{'duration'}, 6, 2 );
	my $minutes = substr( $finfo{'duration'}, 3, 2 );
	my $hours   = substr( $finfo{'duration'}, 0, 2 );
	$finfo{'durationsecs'} = ( $tenths * .01 ) + $seconds + ( $minutes * 60 ) + ( $hours * 360 );
 
	return %finfo;
}

Creating a Perl Daemon in Ubuntu

If you have a process that need to run in the background, creating a daemon is the key. Some examples of what your can do:

  • Wait for video files to be dropped via FTP and then process them
  • Check for a recurring problem and report it to admin
  • Monitor system load and report to the admin at a certain threshold

In this post we’ll take a look at how to create a Perl daemon script and how to get it to run as a daemon whenever the system is started. For the Perl script, a template will be created and for control of the daemon process, standard Debian facilities will be used.

What will be covered:

  • Create the start/stop script in /etc/init.d
  • Create the Perl daemon script in /usr/bin/
  • Create the log file in /var/log/
  • Get the daemon to start automatically when the system boots
  • How to manage your daemon

The start/stop script starts and stops the daemon. It is also used by the system to start your daemon when the system starts.

The Perl daemon script contains your custom Perl code to run in the background. It executes your code every x number of seconds.

Create the Start/stop Script

Happily, Debian and therefore Ubuntu, supplies a template that uses the Debian start-stop-daemon command to start and stop daemons. It is only necessary to copy this template to a new file of the correct name and modify it for the purpose.

These scripts reside in the /etc/init.d/ directory. The script you create will have the exact same filename as the Perl daemon script you will create and the name cannot have a file extension – just the bare name.

Substitute your daemon’s name for “mydaemon” in the examples.

sudo cp /etc/init.d/skeleton /etc/init.d/mydaemon
sudo chmod +x /etc/init.d/mydaemon
sudo vi /etc/init.d/mydaemon

Make changes to your start/stop script. Locate the header in the script:

PATH=/sbin:/usr/sbin:/bin:/usr/bin
DESC="Description of the service"
NAME=daemonexecutablename
DAEMON=/usr/bin/$NAME
DAEMON_ARGS="--options args"
PIDFILE=/var/run/$NAME.pid
SCRIPTNAME=/etc/init.d/$NAME
  • Change the content of DESC to a meaningful description of your daemon.
  • Change the content for NAME to the exact name of your daemon.
  • Create the Perl Daemon Script

    Use the Perl Daemon Script Template located at the end of this post. In the following, the script template is copied to /usr/bin/where executables specific to this system are located. Actually, you would copy the template to your home directory, make the changes and then copy the daemon script to /usr/bin/.

    sudo cp daemon_template.pl /usr/bin/mydaemon
    sudo vi /usr/bin/mydaemon
    sudo chmod +x /usr/bin/mydaemon
    

    The script template is commented with the changes that are needed. In particular, change the value of $daemonName to the exact name of your new daemon. Ten, add your custom code where # do something appears.

    Prerequisites

    The script uses File::Pid and POSIX from CPAN, so you’ll need to install that module:

    sudo aptitude install cpan
    sudo cpan POSIX
    sudo cpan File::Pid
    

    Create the Log File

    We’ll create the log file so it has the correct ownership and permissions. The log fie has the daemon name appended with “.log”. It is located in the /var/log/ directory.

    sudo touch /var/log/mydaemon.log
    sudo chmod 640 /var/log/mydaemon.log
    sudo chown root:adm /var/log/mydaemon.log
    

    The permissions and ownership change allow adm group members to read the log, per convention. Add yourself to adm group to view logs.

    Run your Daemon

    As you have created a standard start/stop script for your daemon, you can start it the standard way:

    sudo /etc/init.d/mydaemon start
    

    Stop your Daemon

    Similarly, your daemon is easy to stop and restart:

    sudo /etc/init.d/mydaemon stop
    
    sudo /etc/init.d/mydaemon restart
    

    Automatically Start your Daemon

    This command tells your system to start your daemon automatically when the system starts:

    update-rc.d mydaemon defaults 99
    

    To keep your daemon from starting, if needed:

    update-rc.d -f mydaemon remove
    

    Managing Daemons

    List running daemons

    Well-behaved daemons generally create a PID file in /var/run/. List that directory and your have a fair list of running daemons.

    sudo ls /var/run/
    

    Get PID for a particular daemon

    If you know the name of a daemon and want to see if it is running and get its PID, use pgrep.

    pgrep mydaemon
    

    Also useful is the ps command, which list processes.

    ps aux
    

    The aux switch limits output to processes not associated with a terminal.

    Show programs running as daemons

    This line attempts to show programs that are running as daemons.

    which `ps aux | cut -c 66- | cut -d\  -f 1` | sort | uniq
    

    The Perl Daemon Script Template

    #!/usr/bin/perl -w
    #
    # mydaemon.pl by Andrew Ault, www.andrewault.net
    #
    # Free software. Use this as you wish.
    #
    # Throughout this template "mydaemon" is used where the name of your daemon should
    # be, replace occurrences of "mydaemon" with the name of your daemon.
    #
    # This name will also be the exact name to give this file (WITHOUT a ".pl" extension).
    #
    # It is also the exact name to give the start-stop script that will go into the
    # /etc/init.d/ directory.
    #
    # It is also the name of the log file in the /var/log/ directory WITH a ".log"
    # file extension.
    #
    # Replace "# do something" with your super useful code.
    #
    # Use "# logEntry("log something");" to log whatever your need to see in the log.
    #
    use strict;
    use warnings;
    use POSIX;
    use File::Pid;
     
    # make "mydaemon.log" file in /var/log/ with "chown root:adm mydaemon"
     
    # TODO: change "mydaemon" to the exact name of your daemon.
    my $daemonName    = "mydaemon";
    #
    my $dieNow        = 0;                                     # used for "infinte loop" construct - allows daemon mode to gracefully exit
    my $sleepMainLoop = 120;                                    # number of seconds to wait between "do something" execution after queue is clear
    my $logging       = 1;                                     # 1= logging is on
    my $logFilePath   = "/var/log/";                           # log file path
    my $logFile       = $logFilePath . $daemonName . ".log";
    my $pidFilePath   = "/var/run/";                           # PID file path
    my $pidFile       = $pidFilePath . $daemonName . ".pid";
     
    # daemonize
    use POSIX qw(setsid);
    chdir '/';
    umask 0;
    open STDIN,  '/dev/null'   or die "Can't read /dev/null: $!";
    open STDOUT, '>>/dev/null' or die "Can't write to /dev/null: $!";
    open STDERR, '>>/dev/null' or die "Can't write to /dev/null: $!";
    defined( my $pid = fork ) or die "Can't fork: $!";
    exit if $pid;
     
    # dissociate this process from the controlling terminal that started it and stop being part
    # of whatever process group this process was a part of.
    POSIX::setsid() or die "Can't start a new session.";
     
    # callback signal handler for signals.
    $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&signalHandler;
    $SIG{PIPE} = 'ignore';
     
    # create pid file in /var/run/
    my $pidfile = File::Pid->new( { file => $pidFile, } );
     
    $pidfile->write or die "Can't write PID file, /dev/null: $!";
     
    # turn on logging
    if ($logging) {
    	open LOG, ">>$logFile";
    	select((select(LOG), $|=1)[0]); # make the log file "hot" - turn off buffering
    }
     
    # "infinite" loop where some useful process happens
    until ($dieNow) {
    	sleep($sleepMainLoop);
     
    	# TODO: put your custom code here!
    	# do something
     
    	# logEntry("log something"); # use this to log whatever you need to
    }
     
    # add a line to the log file
    sub logEntry {
    	my ($logText) = @_;
    	my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time);
    	my $dateTime = sprintf "%4d-%02d-%02d %02d:%02d:%02d", $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
    	if ($logging) {
    		print LOG "$dateTime $logText\n";
    	}
    }
     
    # catch signals and end the program if one is caught.
    sub signalHandler {
    	$dieNow = 1;    # this will cause the "infinite loop" to exit
    }
     
    # do this stuff when exit() is called.
    END {
    	if ($logging) { close LOG }
    	$pidfile->remove if defined $pidfile;
    }
    

    UPDATE:

    Looks like there’s a page in French about this post: http://www.duncane.net/2011/02/25/perl-daemon/. Merci Duncane!

    My remote Subversion dump/tar/rotating file Perl script

    This is the script I use to SSH remotely dump Subversion repositories on various servers for which I am responsible.

    Before you can use this script, you need to set up SSH so your local cron can access the remote servers without a password.

    One thing to note about this script is that it automatically rotates the archived dump files; keeping a fie for the 1st of the week on a month, 1st of the month and 1st of the year.

    see: Using Public/Private Key Pairs with SSH

    Then, just modify the script for your database/servers (the block @ about line 22).

    This will create a series of files over time with daily/weekly/monthly Subversion dump backup tar files. The point is not so much to have every state of every repository, but to grab the daily changes without clobbering the last know good one. More is better, no?

    #!/usr/bin/perl -w
    #
    # rtar_svn.pl
    #
    # by Andrew Ault www.andrewault.net
    #
    # No arguments. The program is to be modified to include each Subversion repository to be archived.
    #
    # Saves a tar of a remote Subversion dump in a rotating file.
    #
    # Of course you have to have SSH authentication already set up.
    #
    # This get cron'd daily on my local workstation.
    #
    use strict;
    use warnings;
    
    use DateTime;
    
    my $fileError;
    my $jobError  = 0;
    my $jobErrors = "";
    my $result;
    
    # Specify a data block for each remote repository to be archived.
    my %dumpJobs = (
    				 'servername-repositoryname' => {
    							'remoteServer' => 'servername',
    							'repository'     => 'repositoryname',
    							'dumpFilename' => 'servername-repositoryname.dump.svn',
    							'svnDumpCmd' => '/usr/bin/svnadmin dump', # find svnadmin on your server
    							'tarCmd'       => '/bin/tar', # find tar on your server
    				 },
    				 'servername-repositoryname2' => {
    							'remoteServer' => 'servername',
    							'repository'     => 'repositoryname2',
    							'dumpFilename' => 'servername-repositoryname2.dump.svn',
    							'svnDumpCmd' => '/usr/bin/svnadmin dump',
    							'tarCmd'       => '/bin/tar',
    				 },
    );
    
    # Process each specified repository dump/archive job.
    for my $dumpJob ( sort keys %dumpJobs ) {
    	$fileError = 0;
    	my $tarballFilename = "$dumpJobs{$dumpJob}{'dumpFilename'}-" . tarDateSegment() . ".tgz";
    	my $svnDumpCmd    = $dumpJobs{$dumpJob}{'svnDumpCmd'};
    	my $tarCmd          = $dumpJobs{$dumpJob}{'tarCmd'};
    	print "$dumpJob\n";
    
    	my $dumpCommand = "ssh $dumpJobs{$dumpJob}{'remoteServer'} '$svnDumpCmd ";
    	$dumpCommand .= "/var/lib/svn/$dumpJobs{$dumpJob}{'repository'} > $dumpJobs{$dumpJob}{'dumpFilename'}'";
    	print $dumpCommand . "\n";
    	$result = system($dumpCommand );
    	if ($result) { $fileError = 1; }
    
    	if ( !$fileError ) {
    		my $remoteMakeTarball = "ssh $dumpJobs{$dumpJob}{'remoteServer'} '$tarCmd ";
    		$remoteMakeTarball .= "cvfz $tarballFilename $dumpJobs{$dumpJob}{'dumpFilename'}'";
    		print $remoteMakeTarball . "\n";
    		$result = system($remoteMakeTarball );
    		if ($result) { $fileError = 1; }
    	}
    
    	if ( !$fileError ) {
    		my $downloadCommand = "scp $dumpJobs{$dumpJob}{'remoteServer'}:$tarballFilename .";
    		print $downloadCommand . "\n";
    		$result = system($downloadCommand );
    		if ($result) { $fileError = 1; }
    	}
    
    	if ($fileError) {
    		$jobError = 1;
    		$jobErrors .= "$dumpJob ";
    	}
    }
    if ($jobError) {
    	warn "Errors were encountered: $jobErrors\n";
    	exit(1);
    }
    
    sub tarDateSegment {
    	my $dt = DateTime->now();
    
    	my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time);
    	$year += 1900;
    	my $dateTime = sprintf "%4d-%02d-%02d %02d:%02d:%02d", $year, $mon + 1, $mday, $hour, $min, $sec;
    	my $date     = sprintf "%4d-%02d-%02d",                $year, $mon + 1, $mday;
    	my @weekdays = qw( sun mon tue wed thu fri sat );
    	my $weekday  = $weekdays[$wday];
    	my @months   = qw( jan feb mar apr may jun jul aug sep oct nov dec );
    	my $month    = $months[$mon];
    
    	my $weekOfMonth = $dt->week_of_month;
    
    	my $dateTar = "";
    
    	# if the first day of the year, set $dateTar like: 2009-1st
    	if ( $yday == 1 ) {
    		$dateTar = "$year-1st";
    	}
    
    	# if the first day of the month, set $dateTar like: feb-1st
    	elsif ( $mday == 1 ) {
    		$dateTar = "$month-1st";
    	}
    
    	# if the first day of the week, set $dateTar like: mon-1
    	# where the number is the week of the month number
    	elsif ( $wday == 1 ) {
    		$dateTar = "$weekday-$weekOfMonth";
    	}
    
    	# otherwise, set the $dateTar like: mon
    	else {
    		$dateTar = "$weekday";
    	}
    
    	# $sec      seconds          54
    	# $min      monutes          37
    	# $hour     hour             11
    	# $mon      month            4
    	# $year     year             2009
    	# $wday     weekday          3
    	# $yday     day of the year  146
    	# $isdst    is DST           1
    	# $weekday  day of the week  wed
    	# $month    month            may
    	# $dateTime date and time    2009-05-27 11:37:54
    	# $date     date             2009-05-27
    	return $dateTar;
    }
    
    =head1 NAME
    
    rtar_svn.pl - Andrew's remote Subversion repository archive program.
    
    =head1 SYNOPSIS
    
        use: rtar_svn.pl
    
    =head1 DESCRIPTION
    
    This is a program I wrote to SSH/dump/tar/download/rotate archives of Subversion repositories.
    
    =over
    
    =back
    
    =head1 LICENSE
    
    Use this as you will.
    
    =head1 AUTHOR
    
    Andrew Ault 
    
    =cut
    

    Installing Net::Amazon::S3 Perl module on an Ubuntu server

    The following is the same on recent Ubuntu releases, including Karmic, Lucid and Maverick.

    What will not work

    There seems to be a problem if you install Net::Amazon::S3 from CPAN. This will not work:

    sudo cpan Net::Amazon::S3
    

    Just about every dependency in the world installs, but fails in the home stretch when XML::LibXML::XPathContext and XML::LibXML fail to install.

    What will work

    sudo aptitude install libnet-amazon-s3-perl
    sudo cpan Net::Amazon::S3::Client
    

    Test your install with this

    After throwing some data into S3 with S3Fox, test your installation. You will need to set values for aws_access_key_id and aws_secret_access_key, of course.

    #!/usr/bin/perl
    use warnings;
    use strict;
    use Net::Amazon::S3;
    use Net::Amazon::S3::Client;
    
    my %s3_hash = (
    				aws_access_key_id     => "XXXXXXXXXXXXXXXXX",
    				aws_secret_access_key => "YYYYYYYYYYYYYYYYYYYYYYYYYY",
    				retry                 => 1,
    );
    
    my $s3 = Net::Amazon::S3->new( \%s3_hash );
    my $client = Net::Amazon::S3::Client->new( s3 => $s3 );
    
    my @buckets = $client->buckets;
    foreach my $bucket (@buckets) {
    	print $bucket->name . "\n";
    }
    

    Perl function that returns info about a video (uses FFMPEG)

    This program contains a Perl function I wrote to extract data about a given video.

    It also shows how to parse information from program output and organize it usefully.

    This has been used a few times in production systems.

    If you use this, please drop a comment! It would be fun to know.

    Share and enjoy!

    #!/usr/bin/perl -w
    # get_video_info.pl
    # by Andrew Ault, www.andrewault.net
    # Please drop me a note it you use this.
    
    use strict;
    use warnings;
    
    use IPC::Open3;
    
    # example
    my $filename  = "yourvideoFilenameHere.mp4";
    my %videoInfo = videoInfo($filename);
    print "duration: " . $videoInfo{'duration'} . "\n";
    print "durationsecs: " . $videoInfo{'durationsecs'} . "\n";
    print "bitrate: " . $videoInfo{'bitrate'} . "\n";
    print "vcodec: " . $videoInfo{'vcodec'} . "\n";
    print "vformat: " . $videoInfo{'vformat'} . "\n";
    print "acodec: " . $videoInfo{'acodec'} . "\n";
    print "asamplerate: " . $videoInfo{'asamplerate'} . "\n";
    print "achannels: " . $videoInfo{'achannels'} . "\n";
    
    #
    # returns media information in a hash
    sub videoInfo {
    	# ffmpeg command
    	my $ffmpeg = '/usr/local/bin/ffmpeg';
    
    	my %finfo = (
    				  'duration'     => "00:00:00.00",
    				  'durationsecs' => "0",
    				  'bitrate'      => "0",
    				  'vcodec'       => "",
    				  'vformat'      => "",
    				  'acodec'       => "",
    				  'asamplerate'   => "0",
    				  'achannels'       => "0", 
    	);
    
    	my $file = shift;
    
    	# escaping characters
    	$file =~ s/(\W)/\\$1/g;
    
    	open3( "/dev/null", \*ERPH, "$ffmpeg -i $file" ) or die "can't run $ffmpeg\n";
    	my @res = ;
    
    	# parse ffmpeg output
    	foreach (@res) {
    
    		# duration
    		if (m!Duration: ([0-9][0-9]:[0-9][0-9]:[0-9][0-9].[0-9][0-9])!) {
    			$finfo{'duration'} = $1;
    		}
    
    		# bitrate
    		if (m!bitrate: (\d*) kb/s!) {
    			$finfo{'bitrate'} = $1;
    		}
    
    		# vcodec and vformat
    		if (/Video: (\w*), (\w*),/) {
    			$finfo{'vcodec'}  = $1;
    			$finfo{'vformat'} = $2;
    		}
    
            # Stream #0.1(und): Audio: aac, 48000 Hz, 1 channels, s16, 64 kb/s
    
    		# acodec, samplerate, stereo and audiorate
    		if (m!Audio: (\w*), (\d*) Hz, (\d*)!) {
    			$finfo{'acodec'}     = $1;
    			$finfo{'asamplerate'} = $2;
    			$finfo{'achannels'}     = $3;
    		}
    	}
    
    	my $tenths  = substr( $finfo{'duration'}, 9, 2 );
    	my $seconds = substr( $finfo{'duration'}, 6, 2 );
    	my $minutes = substr( $finfo{'duration'}, 3, 2 );
    	my $hours   = substr( $finfo{'duration'}, 0, 2 );
    	$finfo{'durationsecs'} = ( $tenths * .01 ) + $seconds + ( $minutes * 60 ) + ( $hours * 360 );
    
    	return %finfo;
    }
    
    

    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;
    }
    
    

    Top 10 Perl Sites

    As is typical of my posts, this is another reference for my own use. When I can’t immediately remember something, I look here or on my private wiki. I hope you find this list useful.

    perl.org

    http://www.perl.org/

    The mothership. Includes: Planet Perl : Perl History : Learn Perl : Online Perl Documentation

    Home of the baddest Swiss Army Chainsaw there is.

    CPAN

    http://www.cpan.org/

    The Comprehensive Perl Network. The reason I use Perl. Don not leave the womb with it.

    Perl Monks

    http://www.perlmonks.com/

    Wide-ranging discussions of every possible Perl permutation.

    Planet Perl

    http://planet.perl.org/

    Planet Perl is a regularly updated Perl blog with news from around the ‘net about Perl and Perl people. Definitely worth adding the RSS feed to Google Reader.

    Perl.com

    http://www.perl.com/

    Infrequently updated, but still an interesting aggregate of Perl @ O’Reilly – the source of Perl paper artifacts.

    Wiki Books Perl

    http://en.wikibooks.org/wiki/Perl

    A nice concentration of easily accessible Perl know how.

    Perl 6

    http://www.perl6.org/

    The future of Perl…beyond 5.x

    http://perl.net.au

    http://perl.net.au

    Great Perl resource.

    The Perl Foundation

    http://www.perlfoundation.org/

    The Perl Foundation is dedicated to the advancement of the Perl programming language through open discussion, collaboration, design, and code.

    Perl Design Patterns

    http://perldesignpatterns.com/

    Cargill’s quandary: “any design problem can be solved by adding an additional level of indirection, except for too many levels of indirection.”

    Perl script to compare 2 directories

    This is a quick Perl script that I wrote to solve a particular problem; I needed to check two directories, one of original files and one of transcoded files, to see which files were missing from the second directory. The files in the second directory have different filename extensions, so the utility needs to take this into consideration.

    So, this utility checks the two directories, ignoring file extensions and shows the missing files in each directory.

    #!/usr/bin/perl -w
    # dircomp.pl
    #
    # Compares filenames in two directories, without regard to 3-letter file extension.
    # Displays list(s) of the differences.
    #
    # This was written to show missing transcoded files in one dir compared to another.
    #
    use strict;
    use List::Compare;
    use File::Basename;
    
    my $resultsFound = 0;
    my $fileName;
    my $filePath;
    my $fileExt;
    
    if ( $#ARGV < 1 ) {
        &usage;
    }
    
    my $dir1 = $ARGV[0];
    my $dir2 = $ARGV[1];
    
    print "\ndircomp directory comparison\n";
    print "\ncomparing:\t$dir1\nwith:\t\t$dir2";
    
    opendir( DIR1h, $dir1 )
      || die("cannot open directory: $dir1");
    opendir( DIR2h, $dir2 )
      || die("cannot open directory: $dir2");
    
    my @files1 = readdir(DIR1h);
    my @files2 = readdir(DIR2h);
    
    
    # Remove filename extensions for each list.
    foreach my $item (@files1) {
        my ( $fileName, $filePath, $fileExt ) = fileparse($item, qr/\.[^.]*/);
        $item = $fileName;
    }
    
    foreach my $item (@files2) {
        my ( $fileName, $filePath, $fileExt ) = fileparse($item, qr/\.[^.]*/);
        $item = $fileName;
    }
    
    my $lc = List::Compare->new( \@files1, \@files2 );
    
    my @onlyInDir1 = $lc->get_Lonly;
    my @onlyInDir2 = $lc->get_Ronly;
    
    if ( @onlyInDir1 > 0 ) {
        $resultsFound = 1;
        print "\n\nonly in $dir1:\n\n";
        for my $entry (@onlyInDir1) {
            print "$entry\n";
        }
    }
    
    if ( @onlyInDir2 > 0 ) {
        $resultsFound = 1;
        print "\n\nonly in $dir2:\n\n";
        for my $entry (@onlyInDir2) {
            print "$entry\n";
        }
    }
    
    if ( !$resultsFound ) {
        print "\n\nboth directories are identical.\n";
    }
    
    sub usage
    {
        print "usage: dircomp.pl dir1 dir2\n";
        exit(0);
    }
    

    My file rotating MySQL database dumper

    This is a script to be run from a daily cron that created a series of sanely named SQL dump files: weekly, monthly, etc.

    Always have that backup ready!

    #!/usr/bin/perl -w
    #
    # No arguments. The program is to be modified to include each database to be archived.
    #
    #
    use strict;
    use warnings;
    
    use DateTime;
    
    my $numRotations = 6;    # base 0,  so 6 = 7 rotations (.0 through .6)... plus the new file, so 8 total files
    my $fileError;
    my $jobError  = 0;
    my $jobErrors = "";
    my $result;
    
    # Specify a data block for each remote database to be archived.
    my %dumpJobs = (
    				 'db1' => {
    							'database'     => 'db1',
    							'dbUser'       => 'db1username',
    							'dbPassword'   => 'db1password',
    							'dumpFilename' => 'db1.dump.sql',
    							'mysqlDumpCmd' => '/usr/bin/mysqldump',
    							'tarCmd'       => '/usr/bin/tar',
    				 },
    );
    
    # Process each specified database dump/archive job.
    for my $dumpJob ( sort keys %dumpJobs ) {
    	$fileError = 0;
    	my $tarballFilename = "$dumpJobs{$dumpJob}{'dumpFilename'}-" . tarDateSegment() . ".tgz";
    	my $mysqlDumpCmd    = $dumpJobs{$dumpJob}{'mysqlDumpCmd'};
    	my $tarCmd          = $dumpJobs{$dumpJob}{'tarCmd'};
    	print "$dumpJob\n";
    
    	my $dumpCommand = "$mysqlDumpCmd ";
    	$dumpCommand .= "--user=$dumpJobs{$dumpJob}{'dbUser'} --password=$dumpJobs{$dumpJob}{'dbPassword'} ";
    	$dumpCommand .= "$dumpJobs{$dumpJob}{'database'} > $dumpJobs{$dumpJob}{'dumpFilename'}";
    	print $dumpCommand . "\n";
    	$result = system($dumpCommand );
    	if ($result) { $fileError = 1; }
    
    	# create tarball
    	if ( !$fileError ) {
    		my $makeTarball = "$tarCmd ";
    		$makeTarball .= "cvfz $tarballFilename $dumpJobs{$dumpJob}{'dumpFilename'}";
    		print $makeTarball . "\n";
    		$result = system($makeTarball );
    		if ($result) { $fileError = 1; }
    	}
    
    	if ($fileError) {
    		$jobError = 1;
    		$jobErrors .= "$dumpJob ";
    	}
    }
    if ($jobError) {
    	warn "Errors were encountered: $jobErrors\n";
    	exit(1);
    }
    
    # This rotates a series of files Unix log rotation style.
    # CURRENTLY UNUSED - KEPT BECAUSE IT IS SO HANDY
    #
    # Run this with the name of the file to rotate and the max # of rotations, just before you
    # create the newest iteration of the file. This will rename the older versions by appending
    # ".0" though the number of rotations specified. (So it will actually keep one more than specified,
    # including ".0".)
    sub rotateFile {
    	my ( $filename, $numRotations ) = @_;
    
    	# if the highest exists, delete it
    	if ( -f $filename . ".$numRotations" ) { unlink $filename . ".$numRotations"; }
    
    	#
    	for ( my $count = $numRotations ; $count >= 1 ; $count-- ) {
    		my $fromFilename = $filename . "." . ( $count - 1 );
    		my $toFilename = $filename . "." . $count;
    		if ( -f $fromFilename ) {
    			rename $fromFilename, $toFilename;
    		}
    	}
    	if ( -f $filename ) {
    		rename $filename, $filename . ".0";
    	}
    }
    
    sub tarDateSegment {
    	my $dt = DateTime->now();
    
    	my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time);
    	$year += 1900;
    	my $dateTime = sprintf "%4d-%02d-%02d %02d:%02d:%02d", $year, $mon + 1, $mday, $hour, $min, $sec;
    	my $date     = sprintf "%4d-%02d-%02d",                $year, $mon + 1, $mday;
    	my @weekdays = qw( sun mon tue wed thu fri sat );
    	my $weekday  = $weekdays[$wday];
    	my @months   = qw( jan feb mar apr may jun jul aug sep oct nov dec );
    	my $month    = $months[$mon];
    
    	my $weekOfMonth = $dt->week_of_month;
    
    	my $dateTar = "";
    
    	# if the first day of the year, set $dateTar like: 2009-1st
    	if ( $yday == 1 ) {
    		$dateTar = "$year-1st";
    	}
    
    	# if the first day of the month, set $dateTar like: feb-1st
    	elsif ( $mday == 1 ) {
    		$dateTar = "$month-1st";
    	}
    
    	# if the first day of the week, set $dateTar like: mon-1
    	# where the number is the week of the month number
    	elsif ( $wday == 1 ) {
    		$dateTar = "$weekday-$weekOfMonth";
    	}
    
    	# otherwise, set the $dateTar like: mon
    	else {
    		$dateTar = "$weekday";
    	}
    
    	# $sec      seconds          54
    	# $min      monutes          37
    	# $hour     hour             11
    	# $mon      month            4
    	# $year     year             2009
    	# $wday     weekday          3
    	# $yday     day of the year  146
    	# $isdst    is DST           1
    	# $weekday  day of the week  wed
    	# $month    month            may
    	# $dateTime date and time    2009-05-27 11:37:54
    	# $date     date             2009-05-27
    	return $dateTar;
    }
    
    =head1 NAME
    
    rtar_mysql.pl - Andrew's remote MySQL archive program.
    
    =head1 SYNOPSIS
    
        use: rtar_mysql.pl
    
    =head1 DESCRIPTION
    
    This is a program I wrote to SSH/dump/tar/download/rotate archives of MySQL databases.
    
    =over
    
    =back
    
    =head1 LICENSE
    
    None.
    
    =head1 AUTHOR
    
    Andrew Ault 
    
    =cut
    

    Perl Low Disk Space Warning Cron Script

    This is a quick little script I wrote to warn me when disk space is getting low on a server I’m responsible for.

    i just stuck this into a daily cron and now I know when to act!

    #!/usr/bin/perl
    #
    # lowdiskspacewarning.pl
    #
    use strict;
    use Filesys::DiskFree;
    
    # init
    my $sendmail = "/usr/lib/sendmail -t";
    
    # file system to monitor
    my $dirFilesystem = "/";
    my $systemName = "putYourSystemNameHere";
    
    # low diskspace warning threshhold
    my $warningThreshhold=20 ; # in percent
    
    # fs disk freespace
    my $fsHandle = new Filesys::DiskFree;
    $fsHandle->;df();
    my $fsSpaceAvail = $fsHandle->;avail($dirFilesystem);
    my $fsSpaceTotal = $fsHandle->;total($dirFilesystem);
    my $fsSpaceUsed = $fsHandle->;used($dirFilesystem);
    my $fsSpaceAvailPct = (($fsSpaceAvail) / ($fsSpaceAvail+$fsSpaceUsed)) * 100.0;
    
    # email setup
    my $emailTo='it@yourdomain.com';
    my $emailFrom='root@yourdomain.com';
    my $emailSubject="WARNING Low Disk Space for: $systemName";
    my $emailBody = sprintf("WARNING Low Disk Space on '$systemName $dirFilesystem': %0.2f%%\n", $fsSpaceAvailPct);
    
    # If free space is below threshhold, e-mail a warning message.
    if ($fsSpaceAvailPct < $warningThreshhold) {
            open(MAIL, "|$sendmail");
            print MAIL "To: $emailTo\n";
            print MAIL "From: $emailFrom\n";
            print MAIL "Subject: $emailSubject\n";
            print MAIL $emailBody;
            close(MAIL);
    }