view release on metacpan or  search on metacpan

t/001basic.t  view on Meta::CPAN

 new
 replace
 reset
 servers
 set
 start
 stats
 stop
 version
) );
}

# Obtain port and create config
my $port = anyport();
ok( $port, "Check whether we have a port to work on" );
my $config = "127.0.0.1:$port";

# Create a cache object
my $memcached_class = $ENV{CACHE_MEMCACHED} || 'Cache::Memcached';
$cache = $class->new(
  data            => $config,
  memcached_class => $memcached_class,
);
isa_ok( $cache,$class, "Check whether object ok" );

# Start the server, skip further tests if failed
SKIP: {
skip( "Memcached server not started", 169 ) if !$cache->start;
sleep 2; # let the server warm up
diag("\nStarted memcached server");

# Check version info
my $versions = $cache->version;
my $version  = $versions->{$config};
ok( $version, "Check whether version information available" );

# Show warning if memcached version questionable
my $pid = $cache->stats->{$config}->{pid};
diag( <<DIAG ) if $version lt '1.1.12';

\b\b******************** please UPGRADE memcached server software ******************
\b\b* Please note that some tests have been known to fail on memcached server      *
\b\b* versions below 1.1.12, most notable 1.1.11.                                  *
\b\b*                                                                              *
\b\b* Please upgrade your memcached server software to at least version 1.1.12!    *
\b\b********************************************************************************
DIAG

# Do this before and after a reset
TEST:
foreach my $reset ( 0 .. 1 ) {

    # Check the backend servers
    my @server = $cache->servers;
    is_deeply( \@server, [$config],
      "Check if all memcached backend servers accounted for from a list" );
    my $servers = $cache->servers;
    is_deeply( $servers, { $config => undef },
      "Check if all memcached backend servers accounted for from a hash ref" );

    # Check whether backend servers all alive
    my @dead = $cache->dead;
    is( scalar @dead, 0, "Check that all servers are alive from a list" );
    my $dead = $cache->dead;
    is_deeply( $dead, {}, "Check that all servers are alive from a hash ref" );

    # Check group names
    my @group_name = $cache->group_names;
    is_deeply( \@group_name, ['group'],
      "Check that all group names accounted for from a list" );
    my $group_names = $cache->group_names;
    is_deeply( $group_names, { group => undef },
      "Check that all group names accounted for from a hash ref" );

    # No key, no ID
    my $value = 'value';
    ok( $cache->set($value), "Check if simple setting works" );
    is( $cache->get,$value, "Check if simple getting works" );
    ok( $cache->delete, "Check if simple delete works" );
    ok( !defined $cache->get, "Check if simple getting fails" );

    # No key, but ID given
    foreach my $param (
      [ [ qw(foo foo) ], [qw(bar bar) ] ],
      [ [ qw(id foo value foo) ], [ qw(id bar value bar) ] ],
      ) {
        ok( $cache->set( @{ $param->[0] } ), "Check if setting with ID works" );
        ok( $cache->set( @{ $param->[1] } ), "Check if setting with ID works" );

        my $got = $cache->get_multi( [ qw(foo bar) ] );
        diag( Data::Dumper::Dumper($got) ) if
          !is_deeply( $got,{ foo => 'foo', bar => 'bar' },
            "Check whether get_multi with ID's works" );

        is( $cache->flush_all, 1, "Check if flushing works" );
        sleep 1; # give flush time to work through

        $got = $cache->get_multi( qw(foo bar) );
        diag( Data::Dumper::Dumper($got) ) if
          !is_deeply( $got,{},
            "Check whether get_multi with ID's fails" );

        # Remove flushed elements anyway for final stats
        $cache->delete($_) foreach qw(foo bar);
    }

    # Check version dependency
    my $version = do { no strict; $VERSION };
    ok( $version, "Check whether there was a version for the module itself" );
    ok( $cache->set($value), "Simple value for version / namespace check" );
    is( $cache->get( version => $version ), $value,
      "Check if simple getting with version works" );
    ok( !defined $cache->get( version => 'foo' ),
      "Check if simple getting with version fails" );

    # Check namespace dependency
    my $namespace = $cache->namespace;
    is( $namespace, $>, "Check whether there was a default namespace" );
    is( $cache->get( namespace => $namespace ), $value,
      "Check if simple getting with namespace works" );
    ok( !defined $cache->get( namespace => 'foo' ),
      "Check if simple getting with namespace fails" );

    # Check expiration
    ok( $cache->set( value => $value, expiration => '3' ),