Anyway, first I'd like to introduce the concept of an Artificial System Clock (ASC). For an introduction to the ASC concept, please visit http://www.timechannels.com.

In a language like Java, you implement this by making a class that has a method on it, perhaps called getSystemDate(). This method looks at some kind of global, static variable for the current "state" of the ASC. By default, it's Off, and in the Off state the getSystemDate() method returns the current, real date-time. But if you set the global state variable to On, and provide a specific date-time value, then the getSystemDate() method returns that specific date-time.

You then go through your code base, and everywhere that you are obtaining the date-time directly, you replace it with a call to this getSystemDate() method.

Once you do this, you have an ASC. You have effectively tricked your whole application into thinking that it is a different date-time, without having to alter the server's clock, and this is enormously valuable for testing purposes.

I would like to solicit professional opinions on how I went about implementing the ASC/TimeChannels client software for Perl.

Here is the implementing class I wrote for Perl:

#!/usr/bin/perl 
 
# This is the TimeChannels Artificial System Clock implementation clas
+s for Perl. 
# Everywhere in your application codebase that obtains the date/time d
+irectly, replace with a call 
# to the getSystemDate() sub in this file. 
#  
# For simple unit-testing, you can call setToStaticTestState() and pas
+s it a specific date-time value. 
#  
# For system, integration, acpt testing, call setToTestState() and pas
+s it a specific channel id you have setup in 
# the TimeChannels.com control panel. 
#  
# Return to normal time by calling setToProductionState() 
#  
# NOTE:  Requires LWP bundle in order to work. 
# Use this line: 
# 
#   perl -MCPAN -e 'install Bundle::LWP' 
# 
# to install it. 
 
package TimeChannels; 
require LWP::UserAgent; 
use strict; 
use Time::Local; 
 
my $tcURL = "http://www.timechannels.com/GetChannel"; 
my $tcURLms = "http://www.timechannels.com/GetChannelMS"; 
my $tcAscState = "TimeChannels.state.Production"; 
my $tcChannel = "0"; 
my $tcAscDateTime = 0; 
my $tcServiceURL = "http://www.timechannels.com/GetChannel"; 
my $tcMillisecondMode = "false"; 
 
sub getState { 
  return $tcAscState; 
} 
 
sub setToProductionState { 
  $tcAscState = "TimeChannels.state.Production"; 
} 
 
sub setToStaticTestState { 
  my ($parm1, $parm2) = @_; 
  $tcAscState = "TimeChannels.state.TestDate"; 
  $tcAscDateTime = $parm2; 
} 
 
sub setToTestState { 
  my ($parm1, $parm2) = @_; 
  $tcAscState = "TimeChannels.state.TestChannel"; 
  $tcChannel = $parm2; 
} 
 
sub setToMillisecondMode { 
  $tcMillisecondMode = "true"; 
  $tcServiceURL = $tcURLms; 
} 
 
sub setToStandardMode { 
  $tcMillisecondMode = "false"; 
  $tcServiceURL = $tcURL; 
} 
 
sub getSystemDate { 
  if ($tcAscState eq "TimeChannels.state.Production") { 
    return time; 
  } 
 
  if ($tcAscState eq "TimeChannels.state.TestDate") { 
    return $tcAscDateTime; 
  } 
 
  if ($tcAscState eq "TimeChannels.state.TestChannel") { 
    return TimeChannels->getChannelFromTimeChannelsService(); 
  } 
 
  return time; 
} 
 
 
sub getChannelFromTimeChannelsService { 
  my $url = $tcServiceURL . '?channel=' . $tcChannel; 
  use LWP::Simple; 
  my $channelValue = get $url;   
  die "Could not get date-time channel from $url" unless defined $chan
+nelValue; 
  my $retVal = time; 
 
  if ($tcMillisecondMode eq "true") { 
    $retVal = (1 * $channelValue) / 1000; 
  } 
  else { 
    my $year = substr($channelValue, 0, 4); 
    my $month = (1 * substr($channelValue, 5, 2)) - 1; 
    my $day = 1* substr($channelValue, 8, 2); 
    my $hour = 1 * substr($channelValue, 11, 2); 
    my $minute = 1 * substr($channelValue, 14, 2); 
    my $ampm = substr($channelValue, 17, 2); 
 
    if ($ampm eq "PM") { 
      $hour += 12; 
    } 
 
    $retVal = timelocal(0, $minute, $hour, $day, $month, $year); 
  } 
 
  return $retVal; 
}
[download]

How does this look to you? It tests out fine, and I will post the testing/sample usage code soon. But I know next to nothing about Perl, and I would be grateful if anyone with more Perl experience than me would take a look and let me know if you see any potential issues.

Many thanks to all who reply.

John