#!/usr/bin/perl -w

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.

# Change 1..1 below to 1..last_test_to_print. (It may become useful if
# the test is moved to ./t subdirectory.) Remember that all the tests
# except the first are done twice--once with Storable, and once with
# Data::Dumper. The $TEST_SET_SIZE is the number of unique tests, not
# counting the trivial first test. @PERSISTENCE_MECHANISMS is an array
# containing all the supported persistence mechanisms

use vars qw($TEST_SET_SIZE @PERSISTENCE_MECHANISMS);

BEGIN
{
  $| = 1;
  $TEST_SET_SIZE = 25;
  @PERSISTENCE_MECHANISMS = qw(Data::Dumper Storable);

  # The test set is repeated once for each implementation, plus the
  # first test
  my $last_test_to_print =
    (($TEST_SET_SIZE) * ($#PERSISTENCE_MECHANISMS + 1)) + 1;

  print "1..$last_test_to_print\n";
}

END {print "not ok 1\n" unless $loaded;}

use File::Cache qw($sSUCCESS $sFAILURE);


$loaded = 1;
print "ok 1\n";

######################### End of black magic.

use strict;

my $sTEST_CACHE_KEY = "/tmp/TSTC";
my $sTEST_NAMESPACE = "TestCache";
my $sMAX_SIZE = 1000;
my $sTEST_USERNAME = "web";
my $sTEST_CACHE_DEPTH = 3;

# Run all remaining tests for each implementation
my $test_set_number = 0;

foreach my $implementation (@PERSISTENCE_MECHANISMS)
{
  $test_set_number++;
  my $test_set_start = $TEST_SET_SIZE * ($test_set_number - 1) + 2;
  my $test_set_end = $TEST_SET_SIZE * $test_set_number + 1;

  # Only do the tests if the persistence mechanism module is present
  if (eval "require $implementation")
  {
    do_tests($implementation, $test_set_start);
  }
  else
  {
    skip_tests($test_set_start, $test_set_end);
  }
}

sub skip_tests
{
  my ($start,$end) = @_;

  for (my $i = $start; $i <= $end;$i++)
  {
    print "ok $i # skip\n";
  }
}


sub do_tests
{
  my ($implementation,$test_number_start) = @_;

  print "--> Testing $implementation implementation\n";

  # Test creation of a cache object

  my $test = $test_number_start;

  my $cache1 = new File::Cache( { cache_key => $sTEST_CACHE_KEY,
                                  namespace => $sTEST_NAMESPACE,
                                  max_size => $sMAX_SIZE,
                                  auto_remove_stale => 0,
                                  username => $sTEST_USERNAME,
                                  filemode => 0770,
                                  implementation => $implementation,
                                  cache_depth => $sTEST_CACHE_DEPTH } );

  if ($cache1)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test the setting of a scalar in the cache

  $test++;

  my $seed_value = "Hello World";

  my $key = 'key1';

  my $status = $cache1->set($key, $seed_value);

  if ($status == $sSUCCESS)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }

  # Test the getting of a scalar from the cache

  $test++;

  my $val1_retrieved = $cache1->get($key);

  if ($val1_retrieved eq $seed_value)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test the setting of a blessed object from the cache

  $test++;

  my $key2 = 'key2';

  $status = $cache1->set($key2, $cache1);

  if ($status == $sSUCCESS)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }

  # Test the getting of a blessed object from the cache

  $test++;

  my $cache1_retrieved = $cache1->get($key2);

  $val1_retrieved = $cache1_retrieved->get($key);

  if ($val1_retrieved eq $seed_value)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test the getting of the scalar from a subprocess

  $test++;

  my $pid = fork( );

  if ( not defined $pid )
  {
    die( "Error forking\n" );
  }
  elsif ( $pid == 0 )
  {
    test_subprocess_get( $sTEST_CACHE_KEY,
                         $sTEST_NAMESPACE,
                         $sTEST_USERNAME,
                         $sTEST_CACHE_DEPTH,
                         $implementation,
                         $key,
                         $seed_value,
                         $test );

    exit( 1 );
  }
  else
  {
    sleep( 1 );
  }


  # Test checking the memory consumption of the cache

  $test++;

  my $size = File::Cache::SIZE($sTEST_CACHE_KEY);

  if ($size > 0)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test clearing the cache's namespace

  $test++;

  $status = $cache1->clear();

  if ($status == $sSUCCESS)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test the max_size limit
  # Intentionally add more data to the cache than fits in max_size

  $test++;

  my $string = 'abcdefghij';

  my $start_size = $cache1->size();

  $cache1->set('initial_value', $string);

  my $end_size = $cache1->size();

  my $string_size = $end_size - $start_size;

  my $cache_item = 0;

  # This should take the cache to nearly the edge

  while (($cache1->size() + $string_size) < $sMAX_SIZE)
  {
    $cache1->set("item:$cache_item", $string);
    $cache_item++;
  }

  # This should put it over the top

  $cache1->set("item:$cache_item", $string);

  if ($cache1->size > $sMAX_SIZE)
  {
    print "not ok $test\n";
  }
  else
  {
    print "ok $test\n";
  }



  # Test the getting of a scalar after the clearing of a cache

  $test++;

  my $val2_retrieved = $cache1->get($key);

  if ($val2_retrieved)
  {
    print "not ok $test\n";
  }
  else
  {
    print "ok $test\n";
  }


  # Test the setting of a scalar in the cache with a immediate timeout

  $test++;

  $status = $cache1->set($key, $seed_value, 0);

  if ($status == $sSUCCESS)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test the getting of a scalar from the cache that should have timed
  # out immediately

  $test++;

  my $val3_retrieved = $cache1->get($key);

  if ($val3_retrieved)
  {
    print "not ok $test\n";
  }
  else
  {
    print "ok $test\n";
  }


  # Test the getting of the expired scalar using get_stale

  $test++;

  my $val3_stale_retrieved = $cache1->get_stale($key);

  if ($val3_stale_retrieved)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test the setting of a scalar in the cache with a timeout in the
  # near future

  $test++;

  $status = $cache1->set($key, $seed_value, 2);

  if ($status == $sSUCCESS)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test the getting of a scalar from the cache that should not have
  # timed out yet (unless the system is *really* slow)

  $test++;

  my $val4_retrieved = $cache1->get($key);

  if ($val4_retrieved eq $seed_value)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test the getting of a scalar from the cache that should have timed out

  $test++;

  sleep(3);

  my $val5_retrieved = $cache1->get($key);

  if ($val5_retrieved)
  {
    print "not ok $test\n";
  }
  else
  {
    print "ok $test\n";
  }


  # Test purging the cache's namespace

  $test++;

  $status = $cache1->purge();

  if ($status == $sSUCCESS)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test getting the creation time of the cache entry

  $test++;

  my $timed_key = 'timed key';

  my $creation_time = time();

  my $expires_in = 1000;

  $cache1->set($timed_key, $seed_value, $expires_in);


  # Delay a bit

  sleep(2);


  # Let's expect no more than 1 second delay between the creation of
  # the cache entry and our saving of the time.

  my $cached_creation_time = $cache1->get_creation_time($timed_key);

  my $creation_time_delta = $creation_time - $cached_creation_time;

  if ($creation_time_delta <= 1)
  {
    $status = 1;
  }
  else
  {
    $status = 0;
  }

  if ($status)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test getting the expiration time of the cache entry

  $test++;

  my $expected_expiration_time =
    $cache1->get_creation_time($timed_key) + $expires_in;

  my $actual_expiration_time = $cache1->get_expiration_time($timed_key);

  $status = $expected_expiration_time == $actual_expiration_time;

  if ($status)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }



  # Test PURGING of a cache object

  $test++;

  $status = File::Cache::PURGE($sTEST_CACHE_KEY);

  if ($status == $sSUCCESS)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test the removal of a cached file

  $test++;

  $status = $sSUCCESS;

  my $remove_key = "foo";

  my $remove_value = "bar";

  $cache1->set($remove_key, $remove_value);

  $cache1->get($remove_key) eq $remove_value or
    $status = $sFAILURE;

  $cache1->remove($remove_key) or
    $status = $sFAILURE;

  if (defined $cache1->get($remove_key))
  {
    $status = $sFAILURE;
  }


  if ($status == $sSUCCESS)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test CLEARING of a cache object

  $test++;

  $status = File::Cache::CLEAR($sTEST_CACHE_KEY);

  if ($status == $sSUCCESS)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test directories not created unless needed

  $test++;

  File::Cache::CLEAR($sTEST_CACHE_KEY);

  if (-e $sTEST_CACHE_KEY)
  {
    print "not ok $test\n";
  }

  $cache1 = new File::Cache( { cache_key => $sTEST_CACHE_KEY,
                               implementation => $implementation,
                               namespace => $sTEST_NAMESPACE } );

  opendir(DIR, $sTEST_CACHE_KEY) or
    croak("Couldn't open directory $sTEST_CACHE_KEY: $!");

  my @dirents = readdir(DIR);

  closedir DIR;

  my @files = grep { $_ !~ /^(\.|\.\.|.description)$/ } @dirents;

  if (!@files)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }

  File::Cache::CLEAR($sTEST_CACHE_KEY);


  # Test the setting of a binary scalar in the cache

  $test++;

  $cache1 = new File::Cache( { cache_key => $sTEST_CACHE_KEY,
                               implementation => $implementation,
                               namespace => $sTEST_NAMESPACE } );

  # Make a string of all possible ASCII characters
  $seed_value = '';

  for (my $i = 0; $i < 256 ; $i++)
  {
    $seed_value .= chr($i);
  }

  my $binary_key = 'key1';

  $status = $cache1->set($binary_key, $seed_value);

  if ($status == $sSUCCESS)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }


  # Test the getting of a binary scalar from the cache

  $test++;

  my $val6_retrieved = $cache1->get($binary_key);

  if ($val6_retrieved eq $seed_value)
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }

  File::Cache::CLEAR($sTEST_CACHE_KEY);
}


sub test_subprocess_get
{
  my ( $cache_key, $namespace, $username, $cache_depth, $implementation,
       $key, $expected_value, $test ) = @_;

  $cache_key or
    die( 'cache_key required' );

  $namespace or
    die( 'namespace required' );

  $username or
    die( 'username required' );

  $cache_depth or
    die( 'cache_depth required' );

  $implementation or
    die( 'implementation required' );

  $key or
    die( 'key required' );

  $expected_value or
    die( 'expected_value required' );

  $test or
    die( 'test required' );

  my $cache = new File::Cache( { cache_key => $cache_key,
                                 namespace => $namespace,
                                 username => $username,
                                 implementation => $implementation,
                                 cache_depth => $cache_depth } ) or
                                   die("Couldn't create cache");

  my $value = $cache->get($key) or
    die( "Couldn't get object at $key" );

  if ( $value eq $expected_value )
  {
    print "ok $test\n";
  }
  else
  {
    print "not ok $test\n";
  }
}

1;