File Coverage

blib/lib/Plack/Middleware/Debug/Redis.pm
Criterion Covered Total %
statement 38 43 88.3
branch 8 18 44.4
condition 5 14 35.7
subroutine 7 8 87.5
pod 1 1 100.0
total 59 84 70.2


line stmt bran cond sub pod time code
1             package Plack::Middleware::Debug::Redis;
2              
3             # ABSTRACT: Extend Plack::Middleware::Debug with Redis panels
4              
5 2     2   45235 use strict;
  2         7  
  2         89  
6 2     2   12 use warnings;
  2         7  
  2         68  
7 2     2   13 use Carp ();
  2         4  
  2         80  
8 2     2   67 use Redis 1.955;
  2         20  
  2         74  
9 2     2   13 use Plack::Util::Accessor qw/instance password db reconnect every debug redis/;
  2         10  
  2         29  
10              
11             our $VERSION = '0.03'; # VERSION
12             our $AUTHORITY = 'cpan:CHIM'; # AUTHORITY
13              
14             sub redis_connect {
15 2     2 1 4 my ($self, $args) = @_;
16              
17 2     0   15 my $croak = sub { Carp::croak $_[0] };
  0         0  
18              
19 2   50     18 my %options = (
      50        
      50        
20             debug => $self->debug || 0,
21             reconnect => $self->reconnect || 10,
22             every => $self->every || 100,
23             );
24              
25 2 50       462 $options{password} = $self->password if $self->password;
26              
27 2         27 my $instance = $self->_parse_instance($self->instance);
28              
29 2 50       8 if ($instance->{unix}) {
30 0 0 0     0 $croak->("Nonexistent redis socket ($instance->{thru})!") unless -e $instance->{thru} && -S _;
31             }
32              
33 2 50       9 $options{ $instance->{unix} ? 'sock' : 'server' } = $instance->{thru};
34              
35 2   50     17 $self->db($self->db || 0);
36              
37 2         27 my $_handle;
38 2         4 eval { $_handle = Redis->new(%options) };
  2         17  
39 2 50       11 $croak->("Cannot get redis handle: $@") if $@;
40              
41 2         17 $self->redis($_handle);
42             }
43              
44             sub _parse_instance {
45 2     2   20 my ($self, $instance) = @_;
46              
47 2         7 my $params = { unix => 0, thru => '127.0.0.1:6379' };
48              
49             # slightly improved piece of code from Redis.pm by Pedro Melo (cpan:MELO)
50 2 50       10 CHANCE: {
51 2         3 last CHANCE unless $instance;
52              
53 2 50       8 if ($instance =~ m,^(unix:)?(/.+)$,i) {
54 0         0 $params->{thru} = $2;
55 0         0 $params->{unix} = 1;
56 0         0 last CHANCE;
57             }
58 2 50       18 if ($instance =~ m,^((tcp|inet):)?(.+)$,i) {
59 2         9 my ($server, $port) = ($3, undef);
60 2         64 ($server, $port) = split /:/, $server;
61 2 50 33     27 $params->{thru} = lc($server) . ':' . (($port && ($port > 0 && $port <= 65535)) ? $port : '6379');
62             }
63             }
64              
65 2         5 $params;
66             }
67              
68             1; # End of Plack::Middleware::Debug::Redis
69              
70             __END__