Timing is everything

My file synchroniser needs to know when a file was last modified, in order to decide if this version is newer than the version it's being compared with. Perl provides a very convenient stat() function that includes this, along with a variety of other information.

All we need do is...

use File::stat;

then...

my $StatusBlock = stat($Entry)
or die "Couldn't stat $Entry: $!";
my $LastModified = $StatusBlock->mtime;
print MASTERFILE "$Entry | $LastModified\n";

The first line creates a hash for the file information, the second is a crude handler for any errors, the third extracts the number of seconds since the epoch at which the file was modified and the last prints the file name and the date to my work file.

This is a nice example of Perl's power to simplify something that would otherwise require a lot of code. What's more, it's easy to understand, which is a massive advantage when maintenance is required. Having spent far too long puzzling over obscure code in the wee small hours with frantic managers breathing heavily in my ear, 'easy to understand' seems very good to me.
:

Progress in Perl

I always find 'silent' programmes especially irritating. There's nothing worse than starting a process and then watching a frozen screen in the hope of seeing some sign of progress. This is especially irritating with CLI programmes - you just don't know if it's busy, crashed or plain confused.

I've been working on a directory synchroniser recently and this very issue, of letting the user know that something is happening, came up. There are all sorts of ways to solve it. Simple but inelegant solutions include filling the screen with lines of detail showing what's going on, printing a single dot for each pass through the programme's loop, even writing a copious log and sneeringly advising the user to tail -f the file. Then there are the pretty, but complicated solutions, all of which tend to be a variation on the progress bar theme. Beside taking a lot of effort, these tend to impose a significant run-time overhead and, for a simple little job such as my synchroniser project, seem like massive overkill.

There is, however, one very neat and simple CLI solution: use a spinner. Although GUI spinners can be complicated, in text mode Perl, they are almost laughably trivial, although I don't recall seeing this approach described anywhere. The slight spin (ouch!) on my approach, is that I needed the progress to be shown in a sub-routine that calls itself recursively, but that's quite easy with some global variables.

I only needed three variables to implement the spinner. I defined them with the vars package, as the routines that will use them are in packages outside the main script...

use vars qw/
@Spinner
$ProgressCount
$BackSpace
/;

@Spinner is a simple array for the characters that make up the spinning wheel, $ProgressCount is an integer that decides which character to display and $BackSpace is, as its name suggests, the delete backwards character.

Then, still in the main script, I only had to initialise them...

@Spinner = ('!', '/', '-', '\\', '!', '/', '-', '\\');
$ProgressCount = 0;
$BackSpace = "\010";

The spinner characters are pretty obvious, except that you need to remember to escape the backslash, to avoid any parsing problems. The progress counter is set to 0 when we begin, although it could be any valid index into the spinner array. The backspace value should work equally well for Windows and Unix systems, although I've only tested it on Windows XP and Apple OS-X so far.

Finally, to use the spinner, you only need three lines, at the point where you're showing the progress...

print $::BackSpace . $::Spinner[$::ProgressCount];
if( $::ProgressCount++ > 6 ) { $::ProgressCount = 0; }
$=1;

The first line backspaces over whatever was there, then shows the currently selected character. The second line increments the progress counter and checks it hasn't got too big. If it has, it resets it. The third line forces Perl to flush the print buffer, thus making sure that we see the progress as it occurs. If you don't do this, you could end up with nothing apparently happening, which rather negates the point of this excercise.

By the way, the syntax '$::varname' just points 'varname' at the calling $main, in this case, our control script.
:

The when and the wherefor

Dates in Perl are a pretty big subject but the essence can be reduced to two simple rules: use 'localtime' to retrieve Perl's internal date block and then use 'sprintf' to format the retrieved date. The following subroutine returns the current date and time in the format 'dd-MMM-yy hh:mm' (e.g. 23-DEC-05 15:35)...

sub FormatCurrentDateAndTime
{
my $V_CURRENT = localtime;
my $V_SECOND = substr($V_CURRENT, 17, 2);
my $V_MINUTE = substr($V_CURRENT, 14, 2);
my $V_HOUR = substr($V_CURRENT, 11, 2);
my $V_DAY = substr($V_CURRENT, 8, 2);
my $V_MONTH = uc(substr($V_CURRENT, 4, 3));
my $V_YEAR = substr($V_CURRENT, 20, 4);

# -------------------------------
# And Format the output string...
# -------------------------------
$V_ID_STRING = sprintf("%02d-%s-%02d_%02d:%02d",
$V_DAY,
$V_MONTH,
$V_YEAR,
$V_HOUR,
$V_MINUTE);
TraceScript $Debug,
"MakeDateTimeID",
"Generated id is [" . $V_ID_STRING . "]";

return $V_ID_STRING;
}

The above code is very simple. Calling localtime without an argument gets the current date and time which is then sliced up into the named variables. Sprintf is then called to reformat the value the way we want it. The TraceScript call gives the clue that this particular example is being used to generate a unique ID.
:

Getting at the bits

One place that Perl scores very highly is reading complex file formats. A really useful built-in function for this purpose is split(). This takes a divider and a string, whose length is only limited by Perl's string handling limit. The divider is in the form of a regular expression, so it can be as complicated as you wish. Split() returns an array, with each piece of the original string as an element, broken up according to the regex and the divider(s) removed. Say, for example, you wrote ...

@Result = split(/:/, "apples:oranges:pears"

then @Result would contain the elements

apples
oranges
pears

with the dividing ':' discarded. The following, real life, example is for extracting the required item from a comma-delimited list, such as a line in a CSV file...

sub GetCsvElement
{
my @V_ARRAY;
my $P_ELEMENT = $_[0];
my $P_SOURCE_STRING = $_[1];
my $V_RESULT;

# -----------------------------------
# Drop the elements into our array...
# -----------------------------------
@V_ARRAY = split (/,/, $P_SOURCE_STRING);

# ----------------------------------------------------------------
# Arrays are zero based so we pick one less than the passed value!
# ----------------------------------------------------------------
$V_RESULT = trim $V_ARRAY[--$P_ELEMENT];

# ----------------------------
# Return the requested item...
# ----------------------------
return $V_RESULT;
}

Remember, because you're using a regular expression to define the delimiter, you can process multiple types of line or even lines with more than one delimiter.
:

Perl sans frontiers

I often want to retrieve results from an external process within a Perl script. In theory, this is easy. All you need to do is something like...

$Result = `ls *.sql`

...which works perfectly well on any Unix (or Linux) system. The problem is that it doesn't work at all on Windows so, if you want your programme to be fully portable, you need a workaround. My solution is to use the one common feature on both Windows and Unix, the redirection character (>).

Say I want to run a SQL query (because this is something I do frequently, I have a subroutine for it)...

# =======================================
# Runs an SQL file, returning the result.
# ---------------------------------------
# $_[0] is the connection string.
# $_[1] is the file to run.
# $_[2] is a file to write the result to.
# ---------------------------------------
# (This last is necessary because the ``
# syntax does not work in Windows.)
# =======================================
sub RunSqlQuery
{
my $V_COMMAND = "sqlplus "
. $C_SQLPLUS_FLAGS
. " "
. $_[0]
." \@"
. $_[1]
. " >"
. $_[2];
my $V_RESULT;

# --------------------------------
# Run the command created above...
# --------------------------------
system $V_COMMAND;

# ---------------------------------
# Get the result back from the file
# and send it up the call chain...
# ---------------------------------
$V_RESULT = ReadResultFile $_[2];
return $V_RESULT;
}

Now the above piece of code will work, unaltered, on both Windows and Unix. Then all we need to get at the result is a matching sub-routine to read the file...

# ===============================================
# Reads a file in which a result has been placed.
# -----------------------------------------------
# $_[0] name of the file to read.
# -----------------------------------------------
# This is one of the workarounds made necessary
# because the syntax "VAR=`command`" does not
# work in Windows the same as it does in Unix.
# ===============================================
sub ReadResultFile
{
my $V_BUFFER;
open(H_SQL_FILE, "<$_[0]") or die "FAILURE: Cannot open " . $_[0];
read H_SQL_FILE, $V_BUFFER, 65535;
close H_SQL_FILE;
return $V_BUFFER;
}

The size limit of 65535 bytes is completely arbitrary and can be altered to meet the specific requirements of the application.
:

What's your name?

I really like how easy Perl makes things. Take filename handling. I don't know about you but I spend a lot of time breaking filenames apart and reforming them. Perl turns it into a doddle and a quick sub-routine makes it even easier...

# ==================================================
# Gets a specified component from a given file name.
# --------------------------------------------------
# $_[0] Component to extract: 'PATH', 'FILE' or 'EXT'
# $_[1] Full file name to extract from
# --------------------------------------------------
# Returns the base filename
# Examples...
# GetPathComponent "FILE", "\anypath\Test1.scr"
# returns "Test1"
# GetPathComponent "PATH", "\anypath\Test1.scr"
# returns "\anypath\"
# GetPathComponent "EXT", "\anypath\Test1.scr"
# returns ".scr"
# --------------------------------------------------
# $C_LOCAL_OS must be set to use with DOS filenames.
# $C_EXTENSION_PATTERN must be set to a valid
# pattern for the extension before calling this
# routine. A typical value is \\..*? which will
# work for both DOS and Unix.
# ==================================================
sub GetPathComponent
{
my $P_COMPONENT = $_[0];
my $P_FULL_NAME = $_[1];
my $P_OS_NAME = $_[2];
my $V_BASE_NAME;
my $V_PATH_NAME;
my $V_FILE_EXT;

# -----------------------------------------------------
# DOS uses the escape character (\) as a path seperator
# which defeats the fileparse function, so convert any
# escape character to a forward slash first...
# -----------------------------------------------------
if( $C_LOCAL_OS eq "DOS" ) { $TESTVAL =~ s/\\/\//g; }

# -----------------------------------------
# The fileparse sub does the actual work...
# -----------------------------------------
($V_BASE_NAME, $V_PATH_NAME, $V_FILE_EXT)
= fileparse($P_FULL_NAME, $C_EXTENSION_PATTERN);

# -----------------------------------------------------
# Return the requested component (or die if invalid)...
# -----------------------------------------------------
if($P_COMPONENT eq "PATH") { return($V_PATH_NAME); }
elsif($P_COMPONENT eq "FILE") { return($V_BASE_NAME); }
elsif($P_COMPONENT eq "EXT") { return($V_FILE_EXT); }
else {die "Invalid component ["
. $P_COMPONENT
. "] specified in GetPathComponent" }
}

Simple, isn't it? I could have treated the return value from fileparse() as an array but I prefer to use descriptive filenames wherever possible. I'm funny that way.
: