Tie-Redis
view release on metacpan or search on metacpan
This software is copyright (c) 2011 by David Leadbeater.
This program is free software. It comes without any warranty, to the extent
permitted by applicable law. You can redistribute it and/or modify it under the
terms of the Beer-ware license revision 42.
"THE BEER-WARE LICENSE" (Revision 42):
David Leadbeater wrote this file. As long as you retain this notice you
can do whatever you want with this stuff. If we meet some day, and you think
this stuff is worth it, you can buy me a beer in return.
LICENSE
MANIFEST
META.yml
Makefile.PL
README
TODO
dist.ini
lib/Tie/Redis.pm
lib/Tie/Redis/Attribute.pm
lib/Tie/Redis/Connection.pm
lib/Tie/Redis/Hash.pm
lib/Tie/Redis/List.pm
lib/Tie/Redis/Scalar.pm
t/01.load.t
t/02.hash.t
t/03.list.t
t/04.attr.t
t/05.attr-subclass.t
t/06.error.t
t/Redis.pm
t/redis.conf.base
t/release-pod-coverage.t
t/release-pod-syntax.t
---
abstract: 'Connect perl data structures to Redis'
author:
- 'David Leadbeater <dgl@dgl.cx>'
build_requires: {}
configure_requires:
ExtUtils::MakeMaker: 6.30
dynamic_config: 0
generated_by: 'Dist::Zilla version 4.300021, CPAN::Meta::Converter version 2.120921'
license: unrestricted
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: Tie-Redis
requires:
IO::Socket::IP: 0
PadWalker: 1.0
Protocol::Redis: 1.0
resources:
bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Tie-Redis
repository: git://github.com/dgl/Tie-Redis
version: 0.26
Makefile.PL view on Meta::CPAN
use strict;
use warnings;
use ExtUtils::MakeMaker 6.30;
my %WriteMakefileArgs = (
"ABSTRACT" => "Connect perl data structures to Redis",
"AUTHOR" => "David Leadbeater <dgl\@dgl.cx>",
"BUILD_REQUIRES" => {},
"CONFIGURE_REQUIRES" => {
"ExtUtils::MakeMaker" => "6.30"
},
"DISTNAME" => "Tie-Redis",
"EXE_FILES" => [],
"LICENSE" => "unrestricted",
"NAME" => "Tie::Redis",
"PREREQ_PM" => {
"IO::Socket::IP" => 0,
"PadWalker" => "1.0",
"Protocol::Redis" => "1.0"
},
"VERSION" => "0.26",
"test" => {
"TESTS" => "t/*.t"
}
);
unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) {
my $br = delete $WriteMakefileArgs{BUILD_REQUIRES};
my $pp = $WriteMakefileArgs{PREREQ_PM};
for my $mod ( keys %$br ) {
if ( exists $pp->{$mod} ) {
$pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod};
}
else {
$pp->{$mod} = $br->{$mod};
}
}
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
unless eval { ExtUtils::MakeMaker->VERSION(6.52) };
WriteMakefile(%WriteMakefileArgs);
This archive contains the distribution Tie-Redis,
version 0.26:
Connect perl data structures to Redis
This software is copyright (c) 2011 by David Leadbeater.
This program is free software. It comes without any warranty, to the extent
permitted by applicable law. You can redistribute it and/or modify it under the
terms of the Beer-ware license revision 42.
- Tie::Redis::Set
- Maybe would be nicer to use Set::Object for this?
- Tie::Redis::Zset
- Write a Tie::Redis::Util with set() and zset()
name = Tie-Redis
version = 0.26
author = David Leadbeater <dgl@dgl.cx>
license = Beerware
copyright_year = 2011
copyright_holder = David Leadbeater
[@Classic]
[@Git]
[PodWeaver]
[Prereqs]
IO::Socket::IP = 0
Protocol::Redis = 1.0
PadWalker = 1.0
[MetaResources]
bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=Tie-Redis
bugtracker.mailto = bug-tie-redis@rt.cpan.org
repository.url = git://github.com/dgl/Tie-Redis
repository.web = https://github.com/dgl/Tie-Redis
repository.type = git
lib/Tie/Redis.pm view on Meta::CPAN
package Tie::Redis;
{
$Tie::Redis::VERSION = '0.26';
}
# ABSTRACT: Connect perl data structures to Redis
use strict;
use Carp ();
use Tie::Redis::Connection;
use Tie::Redis::Hash;
use Tie::Redis::List;
use Tie::Redis::Scalar;
sub TIEHASH {
my($class, %args) = @_;
my $serialize = delete $args{serialize};
my $conn = Tie::Redis::Connection->new(%args);
Carp::croak "Unable to connect to Redis server: $!" unless $conn;
bless {
_conn => $conn,
serialize => $class->_serializer($serialize),
}, $class;
}
sub _serializer {
my($self, $serialize) = @_;
my %serializers = (
json => [
sub { require JSON },
\&JSON::to_json,
\&JSON::from_json
],
storable => [
sub { require Storable },
\&Storable::nfreeze,
\&Storaable::thaw
],
msgpack => [
sub { require Data::MessagePack },
sub { unshift @_, "Data::MessagePack"; goto &Data::MessagePack::pack },
sub { unshift @_, "Data::MessagePack"; goto &Data::MessagePack::unpack }
],
);
my $serializer = $serializers{$serialize || ''} || [undef, (sub {
Carp::croak("No serializer specified for Tie::Redis; unable to handle nested structures");
}) x 2];
# Load; will error if required module isn't present
$serializer->[0] && $serializer->[0]->();
return $serializer;
}
sub _cmd {
my($self, $cmd, @args) = @_;
if($self->{prefix} && defined $args[0]) {
$args[0] = "$self->{prefix}$args[0]";
}
$self->{_conn}->$cmd(@args);
}
sub STORE {
my($self, $key, $value) = @_;
if(!ref $value) {
$self->_cmd(set => $key, $value);
} elsif(ref $value eq 'HASH') {
# TODO: Should pipeline somehow
$self->_cmd("multi");
$self->_cmd(del => $key);
$self->_cmd(hmset => $key,
map +($_ => $value->{$_}), keys %$value);
$self->_cmd("exec");
$self->{_type_cache}->{$key} = 'hash';
} elsif(ref $value eq 'ARRAY') {
$self->_cmd("multi");
$self->_cmd(del => $key);
for my $v(@$value) {
$self->_cmd(rpush => $key, $v);
}
$self->_cmd("exec");
$self->{_type_cache}->{$key} = 'list';
} elsif(ref $value) {
$self->_cmd(set => $key, $self->{serialize}->[1]->($value));
}
}
sub FETCH {
my($self, $key) = @_;
my $type = exists $self->{_type_cache}->{$key}
? $self->{_type_cache}->{$key}
: $self->_cmd(type => $key);
if($type eq 'hash') {
tie my %h, "Tie::Redis::Hash", redis => $self, key => $key;
return \%h;
} elsif($type eq 'list') {
tie my @l, "Tie::Redis::List", redis => $self, key => $key;
return \@l;
} elsif($type eq 'set') {
die "Sets yet to be implemented...";
} elsif($type eq 'zset') {
die "Zsets yet to be implemented...";
} elsif($type eq 'string') {
$self->_cmd(get => $key);
} else {
return undef;
}
}
sub FIRSTKEY {
my($self) = @_;
my $keys = $self->_cmd(keys => "*");
$self->{keys} = $keys;
$self->NEXTKEY;
}
sub NEXTKEY {
my($self) = @_;
shift @{$self->{keys}};
}
sub EXISTS {
my($self, $key) = @_;
$self->_cmd(exists => $key);
}
sub DELETE {
my($self, $key) = @_;
$self->_cmd(del => $key);
}
sub CLEAR {
my($self, $key) = @_;
if($self->{prefix}) {
$self->_cmd(del => $self->_cmd(keys => "*"));
} else {
$self->_cmd("flushdb");
}
}
sub SCALAR {
my($self) = @_;
$self->_cmd("dbsize");
}
1;
__END__
=pod
=head1 NAME
Tie::Redis - Connect perl data structures to Redis
=head1 VERSION
version 0.26
=head1 SYNOPSIS
use Tie::Redis;
tie my %r, "Tie::Redis";
$r{foo} = 42;
print $r{foo}; # 42, persistently
=head1 DESCRIPTION
This allows basic access to Redis from Perl using tie, so it looks just like a
a hash or array.
B<Please> think carefully before using this, the tie interface has quite a
performance overhead and the error handling is not that great. Using
L<AnyEvent::Redis> or L<Redis> directly is recommended.
=head2 General usage
L<Tie::Redis> provides an interface to the top level Redis "hash table";
depending on the type of key you access this then returns a value tied to
L<Tie::Redis::Hash>, L<Tie::Redis::List>, L<Tie::Redis::Scalar> or a set type
(unfortunately, these aren't yet implemented).
If an error occurs these types will throw an exception, therefore you may want
to surround your Redis accessing code with an C<eval> block (or use
L<Try::Tiny>).
=head2 Issues
There are some cases where Redis and Perl types do not match, for example empty
lists in Redis have a type of "none", therefore if you empty a list and then
try to access it again it will no longer be an array reference.
Autovivification currently doesn't correctly work, I believe some of this may
be fixable but haven't yet fully investigated.
=head1 SEE ALSO
=over 4
=item * L<App::redisp>
A redis shell in Perl and the main reason I wrote this
module.
=item * L<Tie::Redis::Attributes>
An experimental attribute based interface.
=item * L<Redis>
Another Redis API.
=back
=head1 AUTHOR
David Leadbeater <dgl@dgl.cx>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by David Leadbeater.
This program is free software. It comes without any warranty, to the extent
permitted by applicable law. You can redistribute it and/or modify it under the
terms of the Beer-ware license revision 42.
=cut
lib/Tie/Redis/Attribute.pm view on Meta::CPAN
package Tie::Redis::Attribute;
{
$Tie::Redis::Attribute::VERSION = '0.26';
}
# ABSTRACT: Variable attribute based interface to Tie::Redis
use 5.010001; # >= 5.10.1
use strict;
use warnings;
use Attribute::Handlers;
use Tie::Redis;
use PadWalker qw(var_name);
no warnings 'redefine';
sub import {
my($class) = @_;
my $pkg = caller;
eval qq{
sub ${pkg}::Redis :ATTR(VAR) {
unshift \@_, \$class;
goto &_do_tie;
}
1
} or die;
}
sub _do_tie {
my($class, $ref, $data) = @_[0, 3, 5];
return if tied $ref; # Already applied
if($data && !ref $data) {
# Attribute::Handlers couldn't make into perl, warn rather than do
# something surprising.
require Carp;
Carp::croak "Invalid attribute";
}
my $type = ref $ref;
my %args = ref $data ? @$data : ();
if(!exists $args{key}) {
my $sigil = {
ARRAY => '@',
HASH => '%'
}->{$type};
# Find where we were actually called from, ignoring attributes and
# Attribute::Handlers.
my $c = 1;
$c++ while((caller $c)[3] =~ /^(?:attributes|Attribute::Handlers)::/);
# The first part of the key is either the name of the subroutine if this is
# within sub scope else the package name.
my $pkg = (caller $c+1)[0];
my $sub = (caller $c+1)[3] || $pkg;
# Now we want a unique name for it
my $name = var_name($c, $ref);
if(!$name) {
# Maybe package variable?
no strict 'refs';
for my $glob(values %{"${pkg}::"}) {
next unless ref \$glob eq 'GLOB';
if(*$glob{$type} && *$glob{$type} == $ref) {
$name = $sigil . ($glob =~ /::([^:]+)$/)[0];
}
}
}
if(!$name) {
require Carp;
local $Carp::CarpLevel = $c;
Carp::croak "Can't automatically work out a name";
}
if($pkg eq 'main') {
# DWIM..., hopefully not *too* magical
($pkg) = $0 =~ m{(?:^|/)([^/]+)$};
$sub =~ s/^main(::|$)/${pkg}$1/;
}
$args{key} = "autoattr:${sub}::${name}";
}
if($type eq 'HASH') {
tie %$ref, "Tie::Redis::" . ucfirst lc $type,
redis => $class->server(%args), %args;
} elsif($type eq 'ARRAY') {
tie @$ref, "Tie::Redis::" . ucfirst lc $type,
redis => $class->server(%args), %args;
} else {
die "Only hashes and arrays are supported";
}
}
sub server {
my($class, %args) = @_;
state %server;
$server{($args{host}||"") . ":" . ($args{port}||"")}
||= Tie::Redis::Connection->new(%args);
}
1;
=pod
=head1 NAME
Tie::Redis::Attribute - Variable attribute based interface to Tie::Redis
=head1 VERSION
version 0.26
=head1 SYNOPSIS
use Tie::Redis::Attribute;
my %hash : Redis; # %hash now magically resides in a redis instance
=head1 DESCRIPTION
This is an B<experimental> module that implements attribute based tying for
Redis.
Currently tying of arrays or hashes is supported.
=head1 OPTIONS
Options may be specified using perl list syntax within the C<Redis(...)>
attribute.
However note that L<attributes> cannot use lexical variables, so C<my %p :
Redis(host => $host)> will unfortunately not work if C<$host> is lexical.
=over 4
=item * key
The key to use, if this isn't provided a key is invented based on the package
name and variable name. This means for some simple purposes you may not need to
specify a key.
For example:
our @queue : Redis(key => "my-queue");
=back
Other options are as per L<Tie::Redis>'s constructor (prefix) and
L<AnyEvent::Redis> (host, port, encoding).
=head1 METHODS
=head2 server
You may subclass this and define a C<server> method that returns an instance of
L<Tie::Redis>. Due to the I<tricky> nature of attributes it is recommended to
B<not> define an C<import> method in your subclass other than the one provided
by this class.
=head1 SEE ALSO
L<Tie::Redis>, L<Attribute::Tie>, L<Attribute::TieClasses>.
=head1 AUTHOR
David Leadbeater <dgl@dgl.cx>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by David Leadbeater.
This program is free software. It comes without any warranty, to the extent
permitted by applicable law. You can redistribute it and/or modify it under the
terms of the Beer-ware license revision 42.
=cut
__END__
lib/Tie/Redis/Connection.pm view on Meta::CPAN
package Tie::Redis::Connection;
{
$Tie::Redis::Connection::VERSION = '0.26';
}
# ABSTRACT: Connection to Redis
use strict;
use warnings;
use IO::Socket::IP;
use Protocol::Redis;
use Carp ();
use constant DEBUG => $ENV{TIE_REDIS_DEBUG};
use constant PR_CLASS => eval { require Protocol::Redis::XS; 1 }
? "Protocol::Redis::XS" : "Protocol::Redis";
our $AUTOLOAD;
sub new {
my($class, %args) = @_;
my $host = delete $args{host} || 'localhost';
my $port = delete $args{port} || 6379;
if (my $encoding = $args{encoding}) {
$args{encoding} = Encode::find_encoding($encoding);
Carp::croak qq{Encoding "$encoding" not found} unless ref $args{encoding};
}
bless {
_sock => (IO::Socket::IP->new("$host:$port") || return),
_pr => PR_CLASS->new(api => 1),
host => $host,
port => $port,
%args,
}, $class;
}
sub DESTROY {
close shift->{_sock};
}
sub AUTOLOAD {
my $self = shift;
(my $method = $AUTOLOAD) =~ s/.*:://;
$self->_cmd($method, @_);
}
sub _cmd {
my($self, $cmd, @args) = @_;
warn "TR>> $cmd @args\n" if DEBUG;
$self->{_sock}->syswrite(
$self->{_pr}->encode({type => "*", data => [
map +{ type => '$', data => $_ }, $cmd, @args
]})
) or return;
my $message;
do {
$self->{_sock}->sysread(my $buf, 8192) or return;
$self->{_pr}->parse($buf);
$message = $self->{_pr}->get_message;
} while not $message;
if($message->{type} eq '*') {
warn "TR<< ", (join " ", map $_->{data}, @{$message->{data}}), "\n" if DEBUG;
my @data = map $_->{data}, @{$message->{data}};
wantarray ? @data : \@data;
} elsif($message->{type} eq '-') {
Carp::croak "$cmd: " . $message->{data};
} else {
warn "TR<< $message->{data}\n" if DEBUG;
$message->{data};
}
}
1;
__END__
=pod
=head1 NAME
Tie::Redis::Connection - Connection to Redis
=head1 VERSION
version 0.26
=head1 AUTHOR
David Leadbeater <dgl@dgl.cx>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by David Leadbeater.
This program is free software. It comes without any warranty, to the extent
permitted by applicable law. You can redistribute it and/or modify it under the
terms of the Beer-ware license revision 42.
=cut
lib/Tie/Redis/Hash.pm view on Meta::CPAN
package Tie::Redis::Hash;
{
$Tie::Redis::Hash::VERSION = '0.26';
}
# ABSTRACT: Connect a Redis hash to a Perl hash
sub TIEHASH {
my($class, %args) = @_;
return bless {
redis => $args{redis},
key => $args{key}
};
}
sub _cmd {
my($self, $cmd, @args) = @_;
return $self->{redis}->_cmd($cmd, $self->{key}, @args);
}
sub FETCH {
my($self, $key) = @_;
$self->_cmd(hget => $key);
}
sub STORE {
my($self, $key, $value) = @_;
$self->_cmd(hset => $key, $value);
}
sub FIRSTKEY {
my($self) = @_;
$self->{keys} = $self->_cmd("hkeys");
$self->NEXTKEY;
}
sub NEXTKEY {
my($self) = @_;
shift @{$self->{keys}};
}
sub EXISTS {
my($self, $key) = @_;
$self->_cmd(hexists => $key);
}
sub DELETE {
my($self, $key) = @_;
my $val = $self->_cmd(hget => $key);
$self->_cmd(hdel => $key);
$val;
}
sub CLEAR {
my($self) = @_;
# technically should keep the hash around, this will do for now, rather
# than doing three commands...
$self->_cmd("del");
}
sub SCALAR {
my($self) = @_;
$self->_cmd("hlen");
}
1;
__END__
=pod
=head1 NAME
Tie::Redis::Hash - Connect a Redis hash to a Perl hash
=head1 VERSION
version 0.26
=head1 SYNOPSIS
=head1 AUTHOR
David Leadbeater <dgl@dgl.cx>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by David Leadbeater.
This program is free software. It comes without any warranty, to the extent
permitted by applicable law. You can redistribute it and/or modify it under the
terms of the Beer-ware license revision 42.
=cut
lib/Tie/Redis/List.pm view on Meta::CPAN
package Tie::Redis::List;
{
$Tie::Redis::List::VERSION = '0.26';
}
# ABSTRACT: Connect a Redis list to a Perl array
sub TIEARRAY {
my($class, %args) = @_;
bless \%args, $class;
}
sub _cmd {
my($self, $cmd, @args) = @_;
return $self->{redis}->_cmd($cmd, $self->{key}, @args);
}
sub FETCH {
my($self, $i) = @_;
$self->_cmd(lindex => $i);
}
sub FETCHSIZE {
my($self) = @_;
$self->_cmd("llen");
}
sub PUSH {
my($self, @elements) = @_;
$self->_cmd(rpush => $_) for @elements;
}
sub EXTEND {
}
sub STORE {
my($self, $index, $value) = @_;
my $len = $self->_cmd("llen");
if($index >= $len) {
while($index > $len) {
$self->_cmd(rpush => "");
$len++;
}
$self->_cmd(rpush => $value);
} else {
$self->_cmd(lset => $index, $value);
}
}
sub POP {
my($self) = @_;
$self->_cmd("rpop");
}
sub SHIFT {
my($self) = @_;
$self->_cmd("lpop");
}
sub UNSHIFT {
my($self, $value) = @_;
$self->_cmd(lpush => $value);
}
sub SPLICE {
my($self, $offset, $length, @list) = @_;
my @items = $length == 0 ? () : $self->_cmd(lrange => $offset, $length - 1);
$self->_cmd(ltrim => $offset, $offset + $length - 1) if $length > 0;
# XXX
}
sub CLEAR {
my($self) = @_;
$self->_cmd("del");
}
1;
__END__
=pod
=head1 NAME
Tie::Redis::List - Connect a Redis list to a Perl array
=head1 VERSION
version 0.26
=head1 SYNOPSIS
=head1 AUTHOR
David Leadbeater <dgl@dgl.cx>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by David Leadbeater.
This program is free software. It comes without any warranty, to the extent
permitted by applicable law. You can redistribute it and/or modify it under the
terms of the Beer-ware license revision 42.
=cut
lib/Tie/Redis/Scalar.pm view on Meta::CPAN
package Tie::Redis::Scalar;
{
$Tie::Redis::Scalar::VERSION = '0.26';
}
# Consider using overload instead of this maybe, could then implement things
# like ++ in terms of Redis commands.
sub TIESCALAR {
my($class, %args) = @_;
bless \%args, $class;
}
sub _cmd {
my($self, $cmd, @args) = @_;
return $self->{redis}->_cmd($cmd, $self->{key}, @args);
}
sub FETCH {
my($self) = @_;
$self->_cmd("get");
}
sub STORE {
my($self, $value) = @_;
$self->_cmd("set", $value);
}
1;
__END__
=pod
=head1 NAME
Tie::Redis::Scalar
=head1 VERSION
version 0.26
=head1 SYNOPSIS
=head1 NAME
Tie::Redis::Scalar - Connect a Redis key to a Perl scalar
=head1 VERSION
version 0.26
=head1 AUTHOR
David Leadbeater <dgl@dgl.cx>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by David Leadbeater.
This program is free software. It comes without any warranty, to the extent
permitted by applicable law. You can redistribute it and/or modify it under the
terms of the Beer-ware license revision 42.
=cut
t/01.load.t view on Meta::CPAN
use Test::More;
use_ok "Tie::Redis";
done_testing;
t/02.hash.t view on Meta::CPAN
use Test::More;
use Tie::Redis;
use t::Redis;
test_redis {
my($port) = @_;
plan tests => 3;
# Use two connections, to ensure we aren't caching locally (very unlikely, we
# don't cache yet).
tie my %r_w, "Tie::Redis", port => $port;
tie my %r_r, "Tie::Redis", port => $port;
# Top level scalar value
$r_w{foo} = 42;
is $r_r{foo}, 42;
# Hash value
$r_w{hash} = { a => 16 };
is $r_r{hash}{a}, 16;
is_deeply [keys %{$r_r{hash}}], ["a"];
};
t/03.list.t view on Meta::CPAN
use Test::More;
use Tie::Redis;
use t::Redis;
test_redis {
my($port) = @_;
plan tests => 3 + 10;
# Use two connections, to ensure we aren't caching locally (very unlikely, we
# don't cache yet).
tie my %r_w, "Tie::Redis", port => $port;
tie my %r_r, "Tie::Redis", port => $port;
# List
$r_w{list} = [1];
is scalar @{$r_r{list}}, 1;
$r_w{list} = [1 .. 10];
is_deeply $r_r{list}, [ 1 .. 10];
is shift @{$r_r{list}}, $_ for 1 .. 10;
is $r_r{list}, undef; # Empty lists become none in Redis
};
t/04.attr.t view on Meta::CPAN
use t::Redis;
use Test::More;
BEGIN {
plan skip_all => "Needs Perl >= 5.10.1" unless $^V >= v5.10.1;
}
test_redis {
my($port) = @_;
plan tests => 2;
use_ok "Tie::Redis::Attribute";
tie my %r, "Tie::Redis", port => $port;
my %special : Redis(port => $port);
for(1 .. 100) {
$special{$_} = rand;
}
is_deeply \%special, $r{(keys %r)[0]};
};
t/05.attr-subclass.t view on Meta::CPAN
use t::Redis;
use Test::More;
BEGIN {
plan skip_all => "Needs Perl >= 5.10.1" unless $^V >= v5.10.1;
}
our $port;
BEGIN {
package My::RedisSubclass;
use parent "Tie::Redis::Attribute";
sub server {
my($class, %args) = @_;
return Tie::Redis::Connection->new(port => $port);
}
}
BEGIN {
My::RedisSubclass->import;
}
test_redis {
($port) = @_;
plan tests => 1;
tie my %r, "Tie::Redis", port => $port;
my %special : Redis;
for(1 .. 100) {
$special{$_} = rand;
}
is_deeply \%special, $r{(keys %r)[0]};
};
t/06.error.t view on Meta::CPAN
use Test::More tests => 1;
use Tie::Redis;
eval {
tie my %r, "Tie::Redis", port => 3; # hopefully nothing running here..
my $x = $r{a};
};
like $@, qr/Unable to connect to Redis server:/;
package t::Redis;
use strict;
use Test::TCP;
use Test::More;
use FindBin;
use base qw(Exporter);
our @EXPORT = qw(test_redis);
sub test_redis(&;$) {
my $cb = shift;
my $args = shift;
chomp(my $redis_server = `which redis-server`);
unless ($redis_server && -e $redis_server && -x _) {
plan skip_all => 'redis-server not found in your PATH';
}
test_tcp
server => sub {
my $port = shift;
rewrite_redis_conf($port);
exec "redis-server", "t/redis.conf";
},
client => sub {
my $port = shift;
$cb->($port);
};
}
sub rewrite_redis_conf {
my $port = shift;
my $dir = $FindBin::Bin;
open my $in, "<", "t/redis.conf.base" or die $!;
open my $out, ">", "t/redis.conf" or die $!;
while (<$in>) {
s/__PORT__/$port/;
s/__DIR__/$dir/;
print $out $_;
}
}
END { unlink $_ for "t/redis.conf", "t/dump.rdb" }
1;
t/redis.conf.base view on Meta::CPAN
# Redis configuration file example
# By default Redis does not run as a daemon. Use 'yes' if you need it.
# Note that Redis will write a pid file in /var/run/redis.pid when daemonized.
daemonize no
# When run as a daemon, Redis write a pid file in /var/run/redis.pid by default.
# You can specify a custom pid file location here.
pidfile /var/run/redis.pid
# Accept connections on the specified port, default is 6379
port __PORT__
# If you want you can bind a single interface, if the bind option is not
# specified all the interfaces will listen for connections.
#
# bind 127.0.0.1
# Close the connection after a client is idle for N seconds (0 to disable)
timeout 300
# Save the DB on disk:
#
# save <seconds> <changes>
#
# Will save the DB if both the given number of seconds and the given
# number of write operations against the DB occurred.
#
# In the example below the behaviour will be to save:
# after 900 sec (15 min) if at least 1 key changed
# after 300 sec (5 min) if at least 10 keys changed
# after 60 sec if at least 10000 keys changed
save 900 1
save 300 10
save 60 10000
# The filename where to dump the DB
dbfilename dump.rdb
# For default save/load DB in/from the working directory
# Note that you must specify a directory not a file name.
dir __DIR__
# Set server verbosity to 'debug'
# it can be one of:
# debug (a lot of information, useful for development/testing)
# notice (moderately verbose, what you want in production probably)
# warning (only very important / critical messages are logged)
loglevel debug
# Specify the log file name. Also 'stdout' can be used to force
# the demon to log on the standard output. Note that if you use standard
# output for logging but daemonize, logs will be sent to /dev/null
logfile stdout
# Set the number of databases. The default database is DB 0, you can select
# a different one on a per-connection basis using SELECT <dbid> where
# dbid is a number between 0 and 'databases'-1
databases 16
################################# REPLICATION #################################
# Master-Slave replication. Use slaveof to make a Redis instance a copy of
# another Redis server. Note that the configuration is local to the slave
# so for example it is possible to configure the slave to save the DB with a
# different interval, or to listen to another port, and so on.
# slaveof <masterip> <masterport>
################################## SECURITY ###################################
# Require clients to issue AUTH <PASSWORD> before processing any other
# commands. This might be useful in environments in which you do not trust
# others with access to the host running redis-server.
#
# This should stay commented out for backward compatibility and because most
# people do not need auth (e.g. they run their own servers).
# requirepass foobared
################################### LIMITS ####################################
# Set the max number of connected clients at the same time. By default there
# is no limit, and it's up to the number of file descriptors the Redis process
# is able to open. The special value '0' means no limts.
# Once the limit is reached Redis will close all the new connections sending
# an error 'max number of clients reached'.
# maxclients 128
# Don't use more memory than the specified amount of bytes.
# When the memory limit is reached Redis will try to remove keys with an
# EXPIRE set. It will try to start freeing keys that are going to expire
# in little time and preserve keys with a longer time to live.
# Redis will also try to remove objects from free lists if possible.
#
# If all this fails, Redis will start to reply with errors to commands
# that will use more memory, like SET, LPUSH, and so on, and will continue
# to reply to most read-only commands like GET.
#
# WARNING: maxmemory can be a good idea mainly if you want to use Redis as a
# 'state' server or cache, not as a real DB. When Redis is used as a real
# database the memory usage will grow over the weeks, it will be obvious if
# it is going to use too much memory in the long run, and you'll have the time
# to upgrade. With maxmemory after the limit is reached you'll start to get
# errors for write operations, and this may even lead to DB inconsistency.
# maxmemory <bytes>
t/release-pod-coverage.t view on Meta::CPAN
#!perl
BEGIN {
unless ($ENV{RELEASE_TESTING}) {
require Test::More;
Test::More::plan(skip_all => 'these tests are for release candidate testing');
}
}
use Test::More;
eval "use Test::Pod::Coverage 1.08";
plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage"
if $@;
eval "use Pod::Coverage::TrustPod";
plan skip_all => "Pod::Coverage::TrustPod required for testing POD coverage"
if $@;
all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' });
t/release-pod-syntax.t view on Meta::CPAN
#!perl
BEGIN {
unless ($ENV{RELEASE_TESTING}) {
require Test::More;
Test::More::plan(skip_all => 'these tests are for release candidate testing');
}
}
use Test::More;
eval "use Test::Pod 1.41";
plan skip_all => "Test::Pod 1.41 required for testing POD" if $@;
all_pod_files_ok();
( run in 1.424 second using v1.01-cache-2.11-cpan-283623ac599 )