Skip to content
Browse files

Tidy everything using tidyall -a; config files included now

Signed-off-by: Pedro Melo <melo@simplicidade.org>
  • Loading branch information...
1 parent ecec0fc commit 22db3e91561eb177bf2198c5f97ae625f92ef924 @melo melo committed
Showing with 315 additions and 361 deletions.
  1. +25 −0 .perltidyrc
  2. +176 −167 lib/Redis.pm
  3. +3 −4 lib/Redis/Hash.pm
  4. +1 −1 lib/Redis/List.pm
  5. +5 −5 scripts/publish.pl
  6. +16 −14 scripts/redis-benchmark.pl
  7. +13 −21 t/01-basic.t
  8. +14 −26 t/02-responses.t
  9. +28 −34 t/04-pipeline.t
  10. +3 −6 t/05-nonblock.t
  11. +8 −19 t/07-reconnect.t
  12. +3 −9 t/08-unix-socket.t
  13. +5 −20 t/09-env-redis-server.t
  14. +4 −16 t/10-tie-list.t
  15. +5 −19 t/20-tie-hash.t
  16. +6 −0 tidyall.ini
View
25 .perltidyrc
@@ -0,0 +1,25 @@
+# My (almost) perfect perl tidy config file
+
+-l=120 # Max line width is 120 cols - We are not on vt100 line terminals anymore
+-i=2 # Indent level is 2 cols
+-ci=2 # Continuation indent is 2 cols
+-se # Errors to STDERR
+-vt=2 # Maximal vertical tightness
+-cti=0 # No extra indentation for closing brackets
+-pt=2 # High parenthesis tightness
+-bt=1 # High brace tightness
+-sbt=2 # High square bracket tightness
+-bbt=1 # Medium block brace tightness
+-nsfs # No space before semicolons
+-nolq # Don't outdent long quoted strings
+
+# Break before all operators
+-wbb="% + - * / x != == >= <= =~ < > | & **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x="
+
+## More tweaks
+--warning-output # Show warnings
+--maximum-consecutive-blank-lines=2 # default is 1
+--nohanging-side-comments # troublesome for commented out code
+
+# block comments may only be indented if they have some space characters before the #
+-isbc
View
343 lib/Redis.pm
@@ -56,7 +56,7 @@ sub new {
$self->{on_connect} = sub {
$_[0]->client_setname($name);
$on_conn->(@_) if $on_conn;
- }
+ }
}
if ($args{sock}) {
@@ -124,9 +124,11 @@ sub __std_cmd {
unless $self->{reconnect};
my @cmd_args = @_;
- $self->__with_reconnect(sub {
- $self->__run_cmd($command, $collect_errors, undef, $cb, @cmd_args);
- });
+ $self->__with_reconnect(
+ sub {
+ $self->__run_cmd($command, $collect_errors, undef, $cb, @cmd_args);
+ }
+ );
}
sub __with_reconnect {
@@ -135,26 +137,31 @@ sub __with_reconnect {
## Fast path, no reconnect
return $cb->() unless $self->{reconnect};
- return &try($cb, catch {
- die $_ unless ref($_) eq 'Redis::X::Reconnect';
+ return &try(
+ $cb,
+ catch {
+ die $_ unless ref($_) eq 'Redis::X::Reconnect';
- $self->__connect;
- $cb->();
- });
+ $self->__connect;
+ $cb->();
+ }
+ );
}
sub __run_cmd {
my ($self, $command, $collect_errors, $custom_decode, $cb, @args) = @_;
my $ret;
- my $wrapper = $cb && $custom_decode ? sub {
+ my $wrapper = $cb && $custom_decode
+ ? sub {
my ($reply, $error) = @_;
$cb->(scalar $custom_decode->($reply), $error);
- } : $cb || sub {
+ }
+ : $cb || sub {
my ($reply, $error) = @_;
confess "[$command] $error, " if defined $error;
$ret = $reply;
- };
+ };
$self->__send_command($command, @args);
push @{ $self->{queue} }, [$command, $wrapper, $collect_errors];
@@ -162,8 +169,10 @@ sub __run_cmd {
return 1 if $cb;
$self->wait_all_responses;
- return $custom_decode ? $custom_decode->($ret, !wantarray)
- : wantarray && ref $ret eq 'ARRAY' ? @$ret : $ret;
+ return
+ $custom_decode ? $custom_decode->($ret, !wantarray)
+ : wantarray && ref $ret eq 'ARRAY' ? @$ret
+ : $ret;
}
sub wait_all_responses {
@@ -184,7 +193,7 @@ sub quit {
return unless $self->{sock};
confess "[quit] only works in synchronous mode, "
- if @_ && ref $_[-1] eq 'CODE';
+ if @_ && ref $_[-1] eq 'CODE';
try {
$self->wait_all_responses;
@@ -204,7 +213,7 @@ sub shutdown {
$self->__is_valid_command('SHUTDOWN');
confess "[shutdown] only works in synchronous mode, "
- if @_ && ref $_[-1] eq 'CODE';
+ if @_ && ref $_[-1] eq 'CODE';
return unless $self->{sock};
@@ -220,7 +229,7 @@ sub ping {
$self->__is_valid_command('PING');
confess "[ping] only works in synchronous mode, "
- if @_ && ref $_[-1] eq 'CODE';
+ if @_ && ref $_[-1] eq 'CODE';
return unless exists $self->{sock};
@@ -241,7 +250,7 @@ sub info {
my $custom_decode = sub {
my ($reply) = @_;
return $reply if !defined $reply || ref $reply;
- return { map { split(/:/, $_, 2) } grep { /^[^#]/ } split(/\r\n/, $reply) };
+ return { map { split(/:/, $_, 2) } grep {/^[^#]/} split(/\r\n/, $reply) };
};
my $cb = @_ && ref $_[-1] eq 'CODE' ? pop : undef;
@@ -251,9 +260,11 @@ sub info {
unless $self->{reconnect};
my @cmd_args = @_;
- $self->__with_reconnect(sub {
- $self->__run_cmd('INFO', 0, $custom_decode, $cb, @cmd_args);
- });
+ $self->__with_reconnect(
+ sub {
+ $self->__run_cmd('INFO', 0, $custom_decode, $cb, @cmd_args);
+ }
+ );
}
sub keys {
@@ -276,9 +287,11 @@ sub keys {
unless $self->{reconnect};
my @cmd_args = @_;
- $self->__with_reconnect(sub {
- $self->__run_cmd('KEYS', 0, $custom_decode, $cb, @cmd_args);
- });
+ $self->__with_reconnect(
+ sub {
+ $self->__run_cmd('KEYS', 0, $custom_decode, $cb, @cmd_args);
+ }
+ );
}
@@ -321,24 +334,26 @@ sub __subscription_cmd {
$self->wait_all_responses;
my @subs = @_;
- $self->__with_reconnect(sub {
- $self->__throw_reconnect('Not connected to any server')
- unless $self->{sock};
+ $self->__with_reconnect(
+ sub {
+ $self->__throw_reconnect('Not connected to any server')
+ unless $self->{sock};
- @subs = $self->__process_unsubscribe_requests($cb, $pr, @subs)
- if $unsub;
- return unless @subs;
+ @subs = $self->__process_unsubscribe_requests($cb, $pr, @subs)
+ if $unsub;
+ return unless @subs;
- $self->__send_command($command, @subs);
+ $self->__send_command($command, @subs);
- my %cbs = map { ("${pr}message:$_" => $cb) } @subs;
- return $self->__process_subscription_changes($command, \%cbs);
- });
+ my %cbs = map { ("${pr}message:$_" => $cb) } @subs;
+ return $self->__process_subscription_changes($command, \%cbs);
+ }
+ );
}
-sub subscribe { shift->__subscription_cmd('', 0, subscribe => @_) }
-sub psubscribe { shift->__subscription_cmd('p', 0, psubscribe => @_) }
-sub unsubscribe { shift->__subscription_cmd('', 1, unsubscribe => @_) }
+sub subscribe { shift->__subscription_cmd('', 0, subscribe => @_) }
+sub psubscribe { shift->__subscription_cmd('p', 0, psubscribe => @_) }
+sub unsubscribe { shift->__subscription_cmd('', 1, unsubscribe => @_) }
sub punsubscribe { shift->__subscription_cmd('p', 1, punsubscribe => @_) }
sub __process_unsubscribe_requests {
@@ -348,7 +363,7 @@ sub __process_unsubscribe_requests {
my @subs_to_unsubscribe;
for my $sub (@unsubs) {
my $key = "${pr}message:$sub";
- my $cbs = $subs->{$key} = [grep { $_ ne $cb } @{$subs->{$key}}];
+ my $cbs = $subs->{$key} = [grep { $_ ne $cb } @{ $subs->{$key} }];
next if @$cbs;
delete $subs->{$key};
@@ -376,7 +391,7 @@ sub __process_subscription_changes {
$key .= "message:$m->[1]";
my $cb = delete $expected->{$key};
- push @{$subs->{$key}}, $cb unless $unsub;
+ push @{ $subs->{$key} }, $cb unless $unsub;
$self->{is_subscriber} = $m->[2];
}
@@ -396,7 +411,7 @@ sub __process_pubsub_msg {
return;
}
- $_->($data, $topic, $sub) for @{$subs->{$cbid}};
+ $_->($data, $topic, $sub) for @{ $subs->{$cbid} };
return 1;
@@ -472,7 +487,7 @@ sub __send_command {
warn "[SEND] $cmd ", Dumper([@_]) if $deb;
## Encode command using multi-bulk format
- my @cmd = split /_/, $cmd;
+ my @cmd = split /_/, $cmd;
my $n_elems = scalar(@_) + scalar(@cmd);
my $buf = "\*$n_elems\r\n";
for my $elem (@cmd, @_) {
@@ -567,7 +582,7 @@ sub __read_line {
sub __read_len {
my ($self, $len) = @_;
- my $data = '';
+ my $data = '';
my $offset = 0;
while ($len) {
my $bytes = read $self->{sock}, $data, $len, $offset;
@@ -686,7 +701,7 @@ sub __throw_reconnect {
}
-1; # End of Redis.pm
+1; # End of Redis.pm
__END__
@@ -766,21 +781,21 @@ __END__
Pure perl bindings for L<http://redis.io/>
-This version supports protocol 2.x (multi-bulk) or later of Redis
-available at L<https://github.com/antirez/redis/>.
+This version supports protocol 2.x (multi-bulk) or later of Redis available at
+L<https://github.com/antirez/redis/>.
This documentation lists commands which are exercised in test suite, but
additional commands will work correctly since protocol specifies enough
-information to support almost all commands with same piece of code with
-a little help of C<AUTOLOAD>.
+information to support almost all commands with same piece of code with a
+little help of C<AUTOLOAD>.
=head1 PIPELINING
-Usually, running a command will wait for a response. However, if you're
-doing large numbers of requests, it can be more efficient to use what Redis
-calls I<pipelining>: send multiple commands to Redis without waiting for a
-response, then wait for the responses that come in.
+Usually, running a command will wait for a response. However, if you're doing
+large numbers of requests, it can be more efficient to use what Redis calls
+I<pipelining>: send multiple commands to Redis without waiting for a response,
+then wait for the responses that come in.
To use pipelining, add a coderef argument as the last argument to a command
method call:
@@ -799,8 +814,7 @@ A non-pipelined (synchronous) command has been sent on the same connection
=item *
A pub/sub subscription command (one of C<subscribe>, C<unsubscribe>,
-C<psubscribe>, or C<punsubscribe>) is about to be sent on the same
-connection.
+C<psubscribe>, or C<punsubscribe>) is about to be sent on the same connection.
=item *
@@ -810,35 +824,34 @@ The L</wait_all_responses> method is called explicitly.
The coderef you supply to a pipelined command method is invoked once the
response is available. It takes two arguments, C<$reply> and C<$error>. If
-C<$error> is defined, it contains the text of an error reply sent by the
-Redis server. Otherwise, C<$reply> is the non-error reply. For almost all
-commands, that means it's C<undef>, or a defined but non-reference scalar,
-or an array ref of any of those; but see L</keys>, L</info>, and L</exec>.
+C<$error> is defined, it contains the text of an error reply sent by the Redis
+server. Otherwise, C<$reply> is the non-error reply. For almost all commands,
+that means it's C<undef>, or a defined but non-reference scalar, or an array
+ref of any of those; but see L</keys>, L</info>, and L</exec>.
Note the contrast with synchronous commands, which throw an exception on
receipt of an error reply, or return a non-error reply directly.
-The fact that pipelined commands never throw an exception can be
-particularly useful for Redis transactions; see L</exec>.
+The fact that pipelined commands never throw an exception can be particularly
+useful for Redis transactions; see L</exec>.
=head1 ENCODING
-B<This feature is deprecated and will be removed before 2.000>. You
-should start testing your code with C<< encoding => undef >> because
-that will be the new default with 2.000.
+B<This feature is deprecated and will be removed before 2.000>. You should
+start testing your code with C<< encoding => undef >> because that will be the
+new default with 2.000.
-Since Redis knows nothing about encoding, we are forcing utf-8 flag on
-all data received from Redis. This change was introduced in 1.2001
-version. B<Please note> that this encoding option severely degrades
-performance.
+Since Redis knows nothing about encoding, we are forcing utf-8 flag on all data
+received from Redis. This change was introduced in 1.2001 version. B<Please
+note> that this encoding option severely degrades performance.
-You can disable this automatic encoding by passing an option to
-L</new>: C<< encoding => undef >>.
+You can disable this automatic encoding by passing an option to L</new>: C<<
+encoding => undef >>.
-This allows us to round-trip utf-8 encoded characters correctly, but
-might be problem if you push binary junk into Redis and expect to get it
-back without utf-8 flag turned on.
+This allows us to round-trip utf-8 encoded characters correctly, but might be
+problem if you push binary junk into Redis and expect to get it back without
+utf-8 flag turned on.
=head1 METHODS
@@ -857,16 +870,16 @@ back without utf-8 flag turned on.
my $r = Redis->new( on_connect => sub { my ($redis) = @_; ... } );
my $r = Redis->new( name => 'my_connection_name' ); ## Redis 2.6.9 required
-The C<< server >> parameter specifies the Redis server we should connect
-to, via TCP. Use the 'IP:PORT' format. If no C<< server >> option is
-present, we will attempt to use the C<< REDIS_SERVER >> environment
-variable. If neither of those options are present, it defaults to
-'127.0.0.1:6379'.
+The C<< server >> parameter specifies the Redis server we should connect to,
+via TCP. Use the 'IP:PORT' format. If no C<< server >> option is present, we
+will attempt to use the C<< REDIS_SERVER >> environment variable. If neither of
+those options are present, it defaults to '127.0.0.1:6379'.
-Alternatively you can use the C<< sock >> parameter to specify the path
-of the UNIX domain socket where the Redis server is listening.
+Alternatively you can use the C<< sock >> parameter to specify the path of the
+UNIX domain socket where the Redis server is listening.
-The C<< REDIS_SERVER >> can be used for UNIX domain sockets too. The following formats are supported:
+The C<< REDIS_SERVER >> can be used for UNIX domain sockets too. The following
+formats are supported:
=over 4
@@ -888,48 +901,47 @@ tcp:127.0.0.1:11011
=back
-The C<< encoding >> parameter speficies the encoding we will use to
-decode all the data we receive and encode all the data sent to the redis
-server. Due to backwards-compatibility we default to C<< utf8 >>. To
-disable all this encoding/decoding, you must use C<< encoding => undef >>.
-B<< This is the recommended option >>.
+The C<< encoding >> parameter speficies the encoding we will use to decode all
+the data we receive and encode all the data sent to the redis server. Due to
+backwards-compatibility we default to C<< utf8 >>. To disable all this
+encoding/decoding, you must use C<< encoding => undef >>. B<< This is the
+recommended option >>.
-B<< Warning >>: this option has several problems and it is
-B<deprecated>. A future version might add other filtering options though.
+B<< Warning >>: this option has several problems and it is B<deprecated>. A
+future version might add other filtering options though.
The C<< reconnect >> option enables auto-reconnection mode. If we cannot
-connect to the Redis server, or if a network write fails, we enter retry
-mode. We will try a new connection every C<< every >> miliseconds
-(1000ms by default), up-to C<< reconnect >> seconds.
+connect to the Redis server, or if a network write fails, we enter retry mode.
+We will try a new connection every C<< every >> miliseconds (1000ms by
+default), up-to C<< reconnect >> seconds.
-Be aware that read errors will always thrown an exception, and will not
-trigger a retry until the new command is sent.
+Be aware that read errors will always thrown an exception, and will not trigger
+a retry until the new command is sent.
-If we cannot re-establish a connection after C<< reconnect >> seconds,
-an exception will be thrown.
+If we cannot re-establish a connection after C<< reconnect >> seconds, an
+exception will be thrown.
-If your Redis server requires authentication, you can use the
-C<< password >> attribute. After each established connection (at the
-start or when reconnecting), the Redis C<< AUTH >> command will be send
-to the server. If the password is wrong, an exception will be thrown and
-reconnect will be disabled.
+If your Redis server requires authentication, you can use the C<< password >>
+attribute. After each established connection (at the start or when
+reconnecting), the Redis C<< AUTH >> command will be send to the server. If the
+password is wrong, an exception will be thrown and reconnect will be disabled.
You can also provide a code reference that will be immediatly after each
-sucessfull connection. The C<< on_connect >> attribute is used to
-provide the code reference, and it will be called with the first
-parameter being the Redis object.
+sucessfull connection. The C<< on_connect >> attribute is used to provide the
+code reference, and it will be called with the first parameter being the Redis
+object.
-Starting with Redis 2.6.9, you can set a name for each connection.
-This can be very useful for debugging purposes, using the
-C<< CLIENT LIST >> command. To set a connection name, use the C<< name >>
-parameter. Please note that there are restrictions on the name you can
-set, the most important of which is, no spaces. See the
-L<CLIENT SETNAME documentation|http://redis.io/commands/client-setname>
-for all the juicy details.
+Starting with Redis 2.6.9, you can set a name for each connection. This can be
+very useful for debugging purposes, using the C<< CLIENT LIST >> command. To
+set a connection name, use the C<< name >> parameter. Please note that there
+are restrictions on the name you can set, the most important of which is, no
+spaces. See the L<CLIENT SETNAME
+documentation|http://redis.io/commands/client-setname> for all the juicy
+details.
-The C<< debug >> parameter enables debug information to STDERR,
-including all interactions with the server. You can also enable debug
-with the C<REDIS_DEBUG> environment variable.
+The C<< debug >> parameter enables debug information to STDERR, including all
+interactions with the server. You can also enable debug with the C<REDIS_DEBUG>
+environment variable.
=head2 Connection Handling
@@ -951,41 +963,41 @@ The C<ping> method does not support pipelined operation.
@clients = $r->client_list;
-Returns list of clients connected to the server. See
-L<CLIENT LIST documentation|http://redis.io/commands/client-list>
-for a description of the fields and their meaning.
+Returns list of clients connected to the server. See L<< CLIENT LIST
+documentation|http://redis.io/commands/client-list >> for a description of the
+fields and their meaning.
=head3 client_getname
my $connection_name = $r->client_getname;
-Returns the name associated with this connection. See L</client_setname>
-or the C<< name >> parameter to L</new> for ways to set this name.
+Returns the name associated with this connection. See L</client_setname> or the
+C<< name >> parameter to L</new> for ways to set this name.
=head3 client_setname
$r->client_setname('my_connection_name');
-Sets this connection name. See the
-L<CLIENT SETNAME documentation|http://redis.io/commands/client-setname>
-for restrictions on the connection name string. The most important one:
-no spaces.
+Sets this connection name. See the L<CLIENT SETNAME
+documentation|http://redis.io/commands/client-setname> for restrictions on the
+connection name string. The most important one: no spaces.
=head2 Pipeline management
=head3 wait_all_responses
-Waits until all pending pipelined responses have been received, and invokes
-the pipeline callback for each one. See L</PIPELINING>.
+Waits until all pending pipelined responses have been received, and invokes the
+pipeline callback for each one. See L</PIPELINING>.
=head2 Transaction-handling commands
-B<Warning:> the behaviour of these commands when combined with
-pipelining is still under discussion, and you should B<NOT> use them at
-the same time just now.
+B<Warning:> the behaviour of these commands when combined with pipelining is
+still under discussion, and you should B<NOT> use them at the same time just
+now.
-You can L<follow the discussion to see the open issues with this|https://github.com/melo/perl-redis/issues/17>.
+You can L<follow the discussion to see the open issues with
+this|https://github.com/melo/perl-redis/issues/17>.
=head3 multi
@@ -999,11 +1011,10 @@ You can L<follow the discussion to see the open issues with this|https://github.
my @individual_replies = $r->exec;
-C<exec> has special behaviour when run in a pipeline: the C<$reply> argument
-to the pipeline callback is an array ref whose elements are themselves
-C<[$reply, $error]> pairs. This means that you can accurately detect errors
-yielded by any command in the transaction, and without any exceptions being
-thrown.
+C<exec> has special behaviour when run in a pipeline: the C<$reply> argument to
+the pipeline callback is an array ref whose elements are themselves C<[$reply,
+$error]> pairs. This means that you can accurately detect errors yielded by
+any command in the transaction, and without any exceptions being thrown.
=head2 Commands operating on string values
@@ -1056,9 +1067,8 @@ thrown.
Note that synchronous C<keys> calls in a scalar context return the number of
matching keys (not an array ref of matching keys as you might expect). This
-does not apply in pipelined mode: assuming the server returns a list of
-keys, as expected, it is always passed to the pipeline callback as an array
-ref.
+does not apply in pipelined mode: assuming the server returns a list of keys,
+as expected, it is always passed to the pipeline callback as an array ref.
=head3 randomkey
@@ -1190,15 +1200,15 @@ See also L<Redis::List> for tie interface.
=head2 Publish/Subscribe commands
-When one of L</subscribe> or L</psubscribe> is used, the Redis object
-will enter I<PubSub> mode. When in I<PubSub> mode only commands in this
-section, plus L</quit>, will be accepted.
+When one of L</subscribe> or L</psubscribe> is used, the Redis object will
+enter I<PubSub> mode. When in I<PubSub> mode only commands in this section,
+plus L</quit>, will be accepted.
-If you plan on using PubSub and other Redis functions, you should
-use two Redis objects, one dedicated to PubSub and the other for
-regular commands.
+If you plan on using PubSub and other Redis functions, you should use two Redis
+objects, one dedicated to PubSub and the other for regular commands.
-All Pub/Sub commands receive a callback as the last parameter. This callback receives three arguments:
+All Pub/Sub commands receive a callback as the last parameter. This callback
+receives three arguments:
=over 4
@@ -1212,16 +1222,15 @@ The topic over which the message was sent.
=item *
-The subscribed topic that matched the topic for the message. With
-L</subscribe> these last two are the same, always. But with
-L</psubscribe>, this parameter tells you the pattern that matched.
+The subscribed topic that matched the topic for the message. With L</subscribe>
+these last two are the same, always. But with L</psubscribe>, this parameter
+tells you the pattern that matched.
=back
-See the L<Pub/Sub notes|http://redis.io/topics/pubsub> for more
-information about the messages you will receive on your callbacks after
-each L</subscribe>, L</unsubscribe>, L</psubscribe> and
-L</punsubscribe>.
+See the L<Pub/Sub notes|http://redis.io/topics/pubsub> for more information
+about the messages you will receive on your callbacks after each L</subscribe>,
+L</unsubscribe>, L</psubscribe> and L</punsubscribe>.
=head3 publish
@@ -1239,8 +1248,8 @@ Publishes the C<< $message >> to the C<< $topic >>.
},
);
-Subscribe one or more topics. Messages published into one of them will
-be received by Redis, and the specificed callback will be executed.
+Subscribe one or more topics. Messages published into one of them will be
+received by Redis, and the specificed callback will be executed.
=head3 unsubscribe
@@ -1253,8 +1262,8 @@ Stops receiving messages for all the topics in C<@topic_list>.
my @topic_matches = ('prefix1.*', 'prefix2.*');
$r->psubscribe(@topic_matches, sub { my ($m, $t, $s) = @_; ... });
-Subscribes a pattern of topics. All messages to topics that match the
-pattern will be delivered to the callback.
+Subscribes a pattern of topics. All messages to topics that match the pattern
+will be delivered to the callback.
=head3 punsubscribe
@@ -1275,20 +1284,20 @@ Returns true if we are in I<Pub/Sub> mode.
my $timeout = 5;
$r->wait_for_messages($timeout) while $keep_going;
-Blocks, waits for incoming messages and delivers them to the appropriate callbacks.
+Blocks, waits for incoming messages and delivers them to the appropriate
+callbacks.
-Requires a single parameter, the number of seconds to wait for messages.
-Use 0 to wait for ever. If a positive non-zero value is used, it will
-return after that ammount of seconds without a single notification.
+Requires a single parameter, the number of seconds to wait for messages. Use 0
+to wait for ever. If a positive non-zero value is used, it will return after
+that ammount of seconds without a single notification.
-Please note that the timeout is not a commitement to return control to
-the caller at most each C<timeout> seconds, but more a idle timeout,
-were control will return to the caller if Redis is idle (as in no
-messages were received during the timeout period) for more than
-C<timeout> seconds.
+Please note that the timeout is not a commitement to return control to the
+caller at most each C<timeout> seconds, but more a idle timeout, were control
+will return to the caller if Redis is idle (as in no messages were received
+during the timeout period) for more than C<timeout> seconds.
-The L</wait_for_messages> call returns the number of messages processed
-during the run.
+The L</wait_for_messages> call returns the number of messages processed during
+the run.
=head2 Persistence control commands
@@ -1335,8 +1344,8 @@ Cache Lua script, returns SHA1 digest that can be used with L</evalsha>.
my ($exists1, $exists2, ...) = $r->script_exists($scrip1_sha, $script2_sha, ...);
-Given a list of SHA1 digests, returns a list of booleans, one for each
-SHA1, that report the existence of each script in the server cache.
+Given a list of SHA1 digests, returns a list of booleans, one for each SHA1,
+that report the existence of each script in the server cache.
=head3 script_kill
@@ -1358,8 +1367,8 @@ Flush the Lua scripts cache.
my $info_hash = $r->info;
The C<info> method is unique in that it decodes the server's response into a
-hashref, if possible. This decoding happens in both synchronous and
-pipelined modes.
+hashref, if possible. This decoding happens in both synchronous and pipelined
+modes.
=head3 shutdown
View
7 lib/Redis/Hash.pm
@@ -38,7 +38,7 @@ sub FIRSTKEY {
sub NEXTKEY {
my $self = shift;
- my $key = shift @{$self->{prefix_keys}};
+ my $key = shift @{ $self->{prefix_keys} };
return unless defined $key;
my $p = $self->{prefix};
@@ -63,7 +63,7 @@ sub CLEAR {
}
-1; ## End of Redis::Hash
+1; ## End of Redis::Hash
=head1 SYNOPSYS
@@ -90,8 +90,7 @@ sub CLEAR {
Ties a Perl hash to Redis. Note that it doesn't use Redis Hashes, but
implements a fake hash using regular keys like "prefix:KEY".
-If no C<prefix> is given, it will tie the entire Redis database
-as a hash.
+If no C<prefix> is given, it will tie the entire Redis database as a hash.
Future versions will also allow you to use real Redis hash structures.
View
2 lib/Redis/List.pm
@@ -83,7 +83,7 @@ sub EXTEND {
sub DESTROY { $_[0]->quit }
-1; ## End of Redis::List
+1; ## End of Redis::List
=head1 SYNOPSYS
View
10 scripts/publish.pl
@@ -9,10 +9,10 @@
my $channel = $ARGV[0] || die "usage: $0 channel\n";
print "#$channel > ";
-while(<STDIN>) {
- chomp;
- $channel = $1 if s/\s*\#(\w+)\s*//; # remove channel from message
- my $nr = $pub->publish( $channel, $_ );
- print "#$channel $nr> ";
+while (<STDIN>) {
+ chomp;
+ $channel = $1 if s/\s*\#(\w+)\s*//; # remove channel from message
+ my $nr = $pub->publish($channel, $_);
+ print "#$channel $nr> ";
}
View
30 scripts/redis-benchmark.pl
@@ -14,17 +14,19 @@
my $i = 0;
-timethese( -5, {
- '00_ping' => sub { $r->ping },
- '10_set' => sub { $r->set( 'foo', $i++ ) },
- '11_set_r' => sub { $r->set( 'bench-' . rand(), rand() ) },
- '20_get' => sub { $r->get( 'foo' ) },
- '21_get_r' => sub { $r->get( 'bench-' . rand() ) },
- '30_incr' => sub { $r->incr( 'counter' ) },
- '30_incr_r' => sub { $r->incr( 'bench-' . rand() ) },
- '40_lpush' => sub { $r->lpush( 'mylist', 'bar' ) },
- '40_lpush' => sub { $r->lpush( 'mylist', 'bar' ) },
- '50_lpop' => sub { $r->lpop( 'mylist' ) },
- '90_h_set' => sub { $hash{ 'test' . rand() } = rand() },
- '90_h_get' => sub { my $a = $hash{ 'test' . rand() }; },
-});
+timethese(
+ -5,
+ { '00_ping' => sub { $r->ping },
+ '10_set' => sub { $r->set('foo', $i++) },
+ '11_set_r' => sub { $r->set('bench-' . rand(), rand()) },
+ '20_get' => sub { $r->get('foo') },
+ '21_get_r' => sub { $r->get('bench-' . rand()) },
+ '30_incr' => sub { $r->incr('counter') },
+ '30_incr_r' => sub { $r->incr('bench-' . rand()) },
+ '40_lpush' => sub { $r->lpush('mylist', 'bar') },
+ '40_lpush' => sub { $r->lpush('mylist', 'bar') },
+ '50_lpop' => sub { $r->lpop('mylist') },
+ '90_h_set' => sub { $hash{ 'test' . rand() } = rand() },
+ '90_h_get' => sub { my $a = $hash{ 'test' . rand() }; },
+ }
+);
View
34 t/01-basic.t
@@ -155,15 +155,9 @@ my $inter = [sort('foo', 'baz')];
is_deeply([sort $o->sinter('test-set1', 'test-set2')], $inter, 'sinter');
-ok($o->sinterstore('test-set-inter', 'test-set1', 'test-set2'),
- 'sinterstore');
-
-cmp_ok(
- $o->scard('test-set-inter'),
- '==',
- $#$inter + 1,
- 'cardinality of intersection'
-);
+ok($o->sinterstore('test-set-inter', 'test-set1', 'test-set2'), 'sinterstore');
+
+cmp_ok($o->scard('test-set-inter'), '==', $#$inter + 1, 'cardinality of intersection');
is_deeply([$o->sdiff('test-set1', 'test-set2')], ['bar'], 'sdiff');
ok($o->sdiffstore(qw( test-set-diff test-set1 test-set2 )), 'sdiffstore');
@@ -180,7 +174,7 @@ ok(scalar grep { $_ eq $first_rand } @union, 'srandmember');
my $second_rand = $o->spop('test-set-union');
ok(defined $first_rand, 'spop result is defined');
ok(scalar grep { $_ eq $second_rand } @union, 'spop');
-is($o->scard('test-set-union'), scalar(@union)-1, 'new cardinality of union');
+is($o->scard('test-set-union'), scalar(@union) - 1, 'new cardinality of union');
$o->del('test_set3');
my @test_set3 = sort qw( foo bar baz );
@@ -201,7 +195,7 @@ my $zset = 'test-zset';
$o->del($zset);
ok($o->zadd($zset, 0, 'foo'));
-ok(!$o->zadd($zset, 1, 'foo')); # 0 returned because foo is already in the set
+ok(!$o->zadd($zset, 1, 'foo')); # 0 returned because foo is already in the set
is($o->zscore($zset, 'foo'), 1);
@@ -209,8 +203,7 @@ ok($o->zincrby($zset, 1, 'foo'));
is($o->zscore($zset, 'foo'), 2);
ok($o->zincrby($zset, 1, 'bar'));
-is($o->zscore($zset, 'bar'), 1)
- ; # bar was new, so its score got set to the increment
+is($o->zscore($zset, 'bar'), 1); # bar was new, so its score got set to the increment
is($o->zrank($zset, 'bar'), 0);
is($o->zrank($zset, 'foo'), 1);
@@ -224,7 +217,7 @@ is_deeply([$o->zrange($zset, 0, 1)], [qw/bar foo/]);
is_deeply([$o->zrevrange($zset, 0, 1)], [qw/baz foo/]);
-my $withscores = {$o->zrevrange($zset, 0, 1, 'WITHSCORES')};
+my $withscores = { $o->zrevrange($zset, 0, 1, 'WITHSCORES') };
# this uglyness gets around floating point weirdness in the return (I.E. 2.1000000000000001);
my $rounded_withscores = {
@@ -232,7 +225,7 @@ my $rounded_withscores = {
keys %$withscores
};
-is_deeply($rounded_withscores, {baz => 2.1, foo => 2});
+is_deeply($rounded_withscores, { baz => 2.1, foo => 2 });
is_deeply([$o->zrangebyscore($zset, 2, 3)], [qw/foo baz/]);
@@ -292,7 +285,7 @@ is($o->hlen($hash), 4);
is_deeply([$o->hkeys($hash)], [qw/foo bar baz qux/]);
is_deeply([$o->hvals($hash)], [qw/1 2 3 4/]);
-is_deeply({$o->hgetall($hash)}, {foo => 1, bar => 2, baz => 3, qux => 4});
+is_deeply({ $o->hgetall($hash) }, { foo => 1, bar => 2, baz => 3, qux => 4 });
ok($o->del($hash)); # remove entire hash
@@ -336,21 +329,20 @@ ok(my $info = $o->info, 'info');
isa_ok($info, 'HASH', '... yields a hash');
ok(keys %$info, '... nonempty');
unlike(join("\n", keys %$info), qr/#/, '... with no comments in the keys');
-unlike(join("\n", keys %$info), qr/\n\n|\A\n|\n\z/,
- '... with no blank lines in the keys');
+unlike(join("\n", keys %$info), qr/\n\n|\A\n|\n\z/, '... with no blank lines in the keys');
## Connection handling
ok($o->ping, 'ping() is true');
ok($o->quit, 'quit');
-ok(!$o->quit, 'quit again, ok');
+ok(!$o->quit, 'quit again, ok');
ok(!$o->ping, '... but after quit() returns false');
$o = Redis->new(server => $srv);
-ok($o->shutdown(), 'shutdown() once is ok');
+ok($o->shutdown(), 'shutdown() once is ok');
ok(!$o->shutdown(), '... twice also lives, but returns false');
-ok(!$o->ping(), 'ping() will be false after shutdown()');
+ok(!$o->ping(), 'ping() will be false after shutdown()');
sleep(1);
like(
View
40 t/02-responses.t
@@ -22,49 +22,39 @@ sub r {
## -ERR responses
r('-you must die!!');
-is_deeply([$r->__read_response('cmd')], [undef, 'you must die!!'],
- 'Error response detected');
+is_deeply([$r->__read_response('cmd')], [undef, 'you must die!!'], 'Error response detected');
## +TEXT responses
my $m;
r('+all your text are belong to us');
-is_deeply([$r->__read_response('cmd')],
- ['all your text are belong to us', undef],
- 'Text response ok');
+is_deeply([$r->__read_response('cmd')], ['all your text are belong to us', undef], 'Text response ok');
## :NUMBER responses
r(':234');
-is_deeply([$r->__read_response('cmd')], [234, undef],
- 'Integer response ok');
+is_deeply([$r->__read_response('cmd')], [234, undef], 'Integer response ok');
## $SIZE PAYLOAD responses
r('$19', "Redis\r\nis\r\ngreat!\r\n");
-is_deeply([$r->__read_response('cmd')], ["Redis\r\nis\r\ngreat!\r\n", undef],
- 'Size+payload response ok');
+is_deeply([$r->__read_response('cmd')], ["Redis\r\nis\r\ngreat!\r\n", undef], 'Size+payload response ok');
r('$0', "");
-is_deeply([$r->__read_response('cmd')], ['', undef],
- 'Zero-size+payload response ok');
+is_deeply([$r->__read_response('cmd')], ['', undef], 'Zero-size+payload response ok');
r('$-1');
-is_deeply([$r->__read_response('cmd')], [undef, undef],
- 'Negative-size+payload response ok');
+is_deeply([$r->__read_response('cmd')], [undef, undef], 'Negative-size+payload response ok');
## Multi-bulk responses
my @m;
r('*4', '$5', 'Redis', ':42', '$-1', '+Cool stuff');
-cmp_deeply([$r->__read_response('cmd')],
- [['Redis', 42, undef, 'Cool stuff'], undef],
- 'Simple multi-bulk response ok');
+cmp_deeply([$r->__read_response('cmd')], [['Redis', 42, undef, 'Cool stuff'], undef], 'Simple multi-bulk response ok');
## Nested Multi-bulk responses
-r('*5', '$5', 'Redis', ':42', '*4', ':1', ':2', '$4', 'hope', '*2', ':4',
- ':5', '$-1', '+Cool stuff');
+r('*5', '$5', 'Redis', ':42', '*4', ':1', ':2', '$4', 'hope', '*2', ':4', ':5', '$-1', '+Cool stuff');
cmp_deeply(
[$r->__read_response('cmd')],
[['Redis', 42, [1, 2, 'hope', [4, 5]], undef, 'Cool stuff'], undef],
@@ -74,8 +64,7 @@ cmp_deeply(
## Nil multi-bulk responses
r('*-1');
-is_deeply([$r->__read_response('cmd')], [undef, undef],
- 'Read a NIL multi-bulk response');
+is_deeply([$r->__read_response('cmd')], [undef, undef], 'Read a NIL multi-bulk response');
## Multi-bulk responses with nested error
@@ -87,12 +76,11 @@ like(
);
r('*3', '$5', 'Redis', '-you must die!!', ':42');
-is_deeply([$r->__read_response('cmd', 1)], [
- [['Redis', undef],
- [undef, 'you must die!!'],
- [42, undef]],
- undef,
-], 'Nested errors must be collected in collect-errors mode');
+is_deeply(
+ [$r->__read_response('cmd', 1)],
+ [[['Redis', undef], [undef, 'you must die!!'], [42, undef]], undef,],
+ 'Nested errors must be collected in collect-errors mode'
+);
done_testing();
View
62 t/04-pipeline.t
@@ -27,61 +27,55 @@ sub pipeline_ok {
cmp_deeply(\@responses, \@expected_responses, $desc);
}
-pipeline_ok 'single-command pipeline', (
- [set => [foo => 'bar'], 'OK'],
-);
+pipeline_ok 'single-command pipeline', ([set => [foo => 'bar'], 'OK'],);
-pipeline_ok 'pipeline with embedded error', (
- [set => [clunk => 'eth'], 'OK'],
- [oops => [], undef, q[ERR unknown command 'OOPS']],
- [get => ['clunk'], 'eth'],
-);
+pipeline_ok 'pipeline with embedded error',
+ ([set => [clunk => 'eth'], 'OK'], [oops => [], undef, q[ERR unknown command 'OOPS']], [get => ['clunk'], 'eth'],);
-pipeline_ok 'keys in pipelined mode', (
- [keys => ['*'], bag(qw<foo clunk>)],
- [keys => [], undef, q[ERR wrong number of arguments for 'keys' command]],
-);
+pipeline_ok 'keys in pipelined mode',
+ ([keys => ['*'], bag(qw<foo clunk>)], [keys => [], undef, q[ERR wrong number of arguments for 'keys' command]],);
-pipeline_ok 'info in pipelined mode', (
+pipeline_ok 'info in pipelined mode',
+ (
[info => [], code(sub { ref $_[0] eq 'HASH' && keys %{ $_[0] } })],
- [info => [qw<oops oops>], undef,
- re(qr/^ERR (?:syntax error|wrong number of arguments for 'info' command)$/)],
-);
+ [ info => [qw<oops oops>],
+ undef,
+ re(qr/^ERR (?:syntax error|wrong number of arguments for 'info' command)$/)
+ ],
+ );
-pipeline_ok 'pipeline with multi-bulk reply', (
- [hmset => [kapow => (a => 1, b => 2, c => 3)], 'OK'],
- [hmget => [kapow => qw<c b a>], [3, 2, 1]],
-);
+pipeline_ok 'pipeline with multi-bulk reply',
+ ([hmset => [kapow => (a => 1, b => 2, c => 3)], 'OK'], [hmget => [kapow => qw<c b a>], [3, 2, 1]],);
-pipeline_ok 'large pipeline', (
+pipeline_ok 'large pipeline',
+ (
(map { [hset => [zzapp => $_ => -$_], 1] } 1 .. 5000),
[hmget => [zzapp => (1 .. 5000)], [reverse -5000 .. -1]],
[del => ['zzapp'], 1],
-);
+ );
subtest 'synchronous request with pending pipeline' => sub {
my $clunk;
is($r->get('clunk', sub { $clunk = $_[0] }), 1, 'queue a request');
- is($r->set('kapow', 'zzapp', sub {}), 1, 'queue another request');
+ is($r->set('kapow', 'zzapp', sub { }), 1, 'queue another request');
is($r->get('kapow'), 'zzapp', 'synchronous request has expected return');
- is($clunk, 'eth', 'synchronous request processes pending ones');
+ is($clunk, 'eth', 'synchronous request processes pending ones');
};
-pipeline_ok 'transaction', (
- [multi => [], 'OK'],
+pipeline_ok 'transaction',
+ (
+ [multi => [], 'OK'],
[set => ['clunk' => 'eth'], 'QUEUED'],
[rpush => ['clunk' => 'oops'], 'QUEUED'],
- [get => ['clunk'], 'QUEUED'],
- [exec => [], [
- ['OK', undef],
- [undef, 'ERR Operation against a key holding the wrong kind of value'],
- ['eth', undef],
- ]],
-);
+ [get => ['clunk'], 'QUEUED'],
+ [ exec => [],
+ [['OK', undef], [undef, 'ERR Operation against a key holding the wrong kind of value'], ['eth', undef],]
+ ],
+ );
subtest 'transaction with error and no pipeline' => sub {
is($r->multi, 'OK', 'multi');
- is($r->set('clunk', 'eth'), 'QUEUED', 'transactional SET');
+ is($r->set('clunk', 'eth'), 'QUEUED', 'transactional SET');
is($r->rpush('clunk', 'oops'), 'QUEUED', 'transactional bad RPUSH');
is($r->get('clunk'), 'QUEUED', 'transactional GET');
like(
View
9 t/05-nonblock.t
@@ -11,8 +11,7 @@ my ($c, $srv) = redis();
END { $c->() if $c }
subtest 'non-block TCP' => sub {
- ok(my $r = Redis->new(server => $srv),
- 'connected to our test redis-server via TCP');
+ ok(my $r = Redis->new(server => $srv), 'connected to our test redis-server via TCP');
## Try to read from server (nothing sent, so nothing to read)
## But kill if we block
@@ -24,12 +23,10 @@ subtest 'non-block TCP' => sub {
subtest 'non-block UNIX' => sub {
- plan skip_all =>
- 'Define ENV TEST_REDIS_SERVER_SOCK_PATH to test UNIX socket support'
+ plan skip_all => 'Define ENV TEST_REDIS_SERVER_SOCK_PATH to test UNIX socket support'
unless $ENV{TEST_REDIS_SERVER_SOCK_PATH};
- ok(my $r = Redis->new(sock => $ENV{TEST_REDIS_SERVER_SOCK_PATH}),
- 'connected to our test redis-server via UNIX');
+ ok(my $r = Redis->new(sock => $ENV{TEST_REDIS_SERVER_SOCK_PATH}), 'connected to our test redis-server via UNIX');
## Try to read from server (nothing sent, so nothing to read)
## But kill if we block
View
27 t/07-reconnect.t
@@ -14,21 +14,15 @@ END { $c->() if $c }
subtest 'Command without connection, no reconnect' => sub {
- ok(my $r = Redis->new(reconnect => 0, server => $srv),
- 'connected to our test redis-server');
+ ok(my $r = Redis->new(reconnect => 0, server => $srv), 'connected to our test redis-server');
ok($r->quit, 'close connection to the server');
- like(
- exception { $r->set(reconnect => 1) },
- qr{Not connected to any server},
- 'send ping without reconnect',
- );
+ like(exception { $r->set(reconnect => 1) }, qr{Not connected to any server}, 'send ping without reconnect',);
};
subtest 'Command without connection or timeout, with reconnect' => sub {
- ok(my $r = Redis->new(reconnect => 2, server => $srv),
- 'connected to our test redis-server');
+ ok(my $r = Redis->new(reconnect => 2, server => $srv), 'connected to our test redis-server');
ok($r->quit, 'close connection to the server');
ok($r->set(reconnect => $$), 'send command with reconnect');
@@ -38,8 +32,7 @@ subtest 'Command without connection or timeout, with reconnect' => sub {
subtest 'Reconnection discards pending commands' => sub {
- ok(my $r = Redis->new(reconnect => 2, server => $srv),
- 'connected to our test redis-server');
+ ok(my $r = Redis->new(reconnect => 2, server => $srv), 'connected to our test redis-server');
my $processed_pending = 0;
$r->dbsize(sub { $processed_pending++ });
@@ -52,8 +45,7 @@ subtest 'Reconnection discards pending commands' => sub {
subtest 'INFO commands with extra logic triggers reconnect' => sub {
- ok(my $r = Redis->new(reconnect => 2, server => $srv),
- 'connected to our test redis-server');
+ ok(my $r = Redis->new(reconnect => 2, server => $srv), 'connected to our test redis-server');
ok($r->quit, 'close connection to the server');
@@ -63,8 +55,7 @@ subtest 'INFO commands with extra logic triggers reconnect' => sub {
subtest 'KEYS commands with extra logic triggers reconnect' => sub {
- ok(my $r = Redis->new(reconnect => 2, server => $srv),
- 'connected to our test redis-server');
+ ok(my $r = Redis->new(reconnect => 2, server => $srv), 'connected to our test redis-server');
ok($r->flushdb, 'delete all keys');
ok($r->set(reconnect => $$), 'set known key');
@@ -77,8 +68,7 @@ subtest 'KEYS commands with extra logic triggers reconnect' => sub {
subtest "Bad commnands don't trigger reconnect" => sub {
- ok(my $r = Redis->new(reconnect => 2, server => $srv),
- 'connected to our test redis-server');
+ ok(my $r = Redis->new(reconnect => 2, server => $srv), 'connected to our test redis-server');
my $prev_sock = "$r->{sock}";
like(
@@ -98,8 +88,7 @@ subtest 'Reconnect code clears sockect ASAP' => sub {
subtest "Reconnect gives up after timeout" => sub {
- ok(my $r = Redis->new(reconnect => 3, server => $srv),
- 'connected to our test redis-server');
+ ok(my $r = Redis->new(reconnect => 3, server => $srv), 'connected to our test redis-server');
$c->(); ## Make sure the server is dead
my $t0 = [gettimeofday];
View
12 t/08-unix-socket.t
@@ -6,8 +6,7 @@ use Test::More;
use Test::Fatal;
use Redis;
-plan skip_all =>
- 'Define ENV TEST_REDIS_SERVER_SOCK_PATH to test UNIX socket support'
+plan skip_all => 'Define ENV TEST_REDIS_SERVER_SOCK_PATH to test UNIX socket support'
unless $ENV{TEST_REDIS_SERVER_SOCK_PATH};
my $conn = sub {
@@ -33,11 +32,7 @@ subtest 'basic tests' => sub {
is($r->get('xpto'), '42', '... and get command ok too');
is(exception { $r->quit }, undef, 'Connection closed ok');
- like(
- exception { $r->get('xpto') },
- qr!Not connected to any server!,
- 'Command failed ok, no reconnect',
- );
+ like(exception { $r->get('xpto') }, qr!Not connected to any server!, 'Command failed ok, no reconnect',);
};
@@ -45,8 +40,7 @@ subtest 'reconnect over UNIX daemon' => sub {
my $r = $conn->(reconnect => 2);
ok($r->quit, '... and connection closed ok');
- is(exception { $r->set(xpto => '43') },
- undef, 'set command via UNIX ok, reconnected fine');
+ is(exception { $r->set(xpto => '43') }, undef, 'set command via UNIX ok, reconnected fine');
is($r->get('xpto'), '43', '... and get command ok too');
};
View
25 t/09-env-redis-server.t
@@ -17,25 +17,18 @@ subtest 'REDIS_SERVER TCP' => sub {
$r->set($$ => $n);
local $ENV{REDIS_SERVER} = $srv;
- is(
- exception { $r = Redis->new },
- undef, "Direct IP/Port address on REDIS_SERVER works ($srv)",
- );
+ is(exception { $r = Redis->new }, undef, "Direct IP/Port address on REDIS_SERVER works ($srv)",);
is($r->get($$), $n, '... connected to the expected server');
$ENV{REDIS_SERVER} = "tcp:$srv";
- is(
- exception { $r = Redis->new },
- undef, 'Direct IP/Port address (with tcp prefix) on REDIS_SERVER works',
- );
+ is(exception { $r = Redis->new }, undef, 'Direct IP/Port address (with tcp prefix) on REDIS_SERVER works',);
is($r->get($$), $n, '... connected to the expected server');
};
subtest 'REDIS_SERVER UNIX' => sub {
my $srv = $ENV{TEST_REDIS_SERVER_SOCK_PATH};
- plan skip_all =>
- 'Define ENV TEST_REDIS_SERVER_SOCK_PATH to test UNIX socket support'
+ plan skip_all => 'Define ENV TEST_REDIS_SERVER_SOCK_PATH to test UNIX socket support'
unless $srv;
my $n = time();
@@ -43,19 +36,11 @@ subtest 'REDIS_SERVER UNIX' => sub {
$r->set($$ => $n);
local $ENV{REDIS_SERVER} = $srv;
- is(
- exception { $r = Redis->new },
- undef,
- 'UNIX path on REDIS_SERVER works',
- );
+ is(exception { $r = Redis->new }, undef, 'UNIX path on REDIS_SERVER works',);
is($r->get($$), $n, '... connected to the expected server');
$ENV{REDIS_SERVER} = "unix:$srv";
- is(
- exception { $r = Redis->new },
- undef,
- 'UNIX path (with unix prefix) on REDIS_SERVER works',
- );
+ is(exception { $r = Redis->new }, undef, 'UNIX path (with unix prefix) on REDIS_SERVER works',);
is($r->get($$), $n, '... connected to the expected server');
};
View
20 t/10-tie-list.t
@@ -13,8 +13,7 @@ END { $c->() if $c }
## Setup
my @my_list;
-ok(my $redis = tie(@my_list, 'Redis::List', 'my_list', server => $srv),
- 'tied to our test redis-server');
+ok(my $redis = tie(@my_list, 'Redis::List', 'my_list', server => $srv), 'tied to our test redis-server');
ok($redis->ping, 'pinged fine');
isa_ok($redis, 'Redis::List');
@@ -44,29 +43,18 @@ subtest 'list functions' => sub {
is_deeply(\@my_list, ['BAR', 'bbb'], '... resulting list as expected');
ok(push(@my_list, $v), 'push ok');
- is_deeply(
- \@my_list,
- ['BAR', 'bbb', 'foo'],
- '... resulting list as expected'
- );
+ is_deeply(\@my_list, ['BAR', 'bbb', 'foo'], '... resulting list as expected');
ok($v = pop(@my_list), 'pop ok');
is($v, 'foo', '... expected value');
is_deeply(\@my_list, ['BAR', 'bbb'], '... resulting list as expected');
ok(unshift(@my_list, $v), 'unshift ok');
- is_deeply(
- \@my_list,
- ['foo', 'BAR', 'bbb'],
- '... resulting list as expected'
- );
+ is_deeply(\@my_list, ['foo', 'BAR', 'bbb'], '... resulting list as expected');
ok(my @s = splice(@my_list, 1, 2), 'splice ok');
is_deeply([@s], ['BAR', 'bbb'], '... resulting list as expected');
- is_deeply(
- \@my_list,
- ['foo', 'BAR', 'bbb'],'... original list as expected'
- );
+ is_deeply(\@my_list, ['foo', 'BAR', 'bbb'], '... original list as expected');
};
View
24 t/20-tie-hash.t
@@ -14,8 +14,7 @@ END { $c->() if $c }
## Setup
my %my_hash;
-ok(my $redis = tie(%my_hash, 'Redis::Hash', 'my_hash', server => $srv),
- 'tied to our test redis-server');
+ok(my $redis = tie(%my_hash, 'Redis::Hash', 'my_hash', server => $srv), 'tied to our test redis-server');
ok($redis->ping, 'pinged fine');
isa_ok($redis, 'Redis::Hash');
@@ -26,18 +25,10 @@ subtest 'direct access' => sub {
cmp_deeply(\%my_hash, {}, 'empty list ok');
%my_hash = (a => 'foo', b => 'bar', c => 'baz');
- cmp_deeply(
- \%my_hash,
- {a => 'foo', b => 'bar', c => 'baz'},
- 'Set multiple values ok'
- );
+ cmp_deeply(\%my_hash, { a => 'foo', b => 'bar', c => 'baz' }, 'Set multiple values ok');
$my_hash{b} = 'BAR';
- cmp_deeply(
- \%my_hash,
- {a => 'foo', b => 'BAR', c => 'baz'},
- 'Set single value ok'
- );
+ cmp_deeply(\%my_hash, { a => 'foo', b => 'BAR', c => 'baz' }, 'Set single value ok');
is($my_hash{c}++, 'baz', 'get single value ok');
is(++$my_hash{c}, 'bbb', '... even with post/pre-increments');
@@ -50,15 +41,10 @@ subtest 'hash functions' => sub {
cmp_deeply(\@keys, bag(qw( a b c )), '... resulting list as expected');
ok(my @values = values(%my_hash), 'values ok');
- cmp_deeply(\@values, bag(qw( foo BAR bbb )),
- '... resulting list as expected');
+ cmp_deeply(\@values, bag(qw( foo BAR bbb )), '... resulting list as expected');
%my_hash = reverse %my_hash;
- cmp_deeply(
- \%my_hash,
- {foo => 'a', BAR => 'b', bbb => 'c'},
- 'reverse() worked'
- );
+ cmp_deeply(\%my_hash, { foo => 'a', BAR => 'b', bbb => 'c' }, 'reverse() worked');
};
View
6 tidyall.ini
@@ -0,0 +1,6 @@
+[PerlTidy]
+select = **/*.{pl,pm,t}
+
+[PodTidy]
+argv = --column=100
+select = **/*.{pm,pod}

0 comments on commit 22db3e9

Please sign in to comment.
Something went wrong with that request. Please try again.