File Coverage

blib/lib/Async/Redis/URI.pm
Criterion Covered Total %
statement 74 78 94.8
branch 37 46 80.4
condition 7 9 77.7
subroutine 16 16 100.0
pod 2 12 16.6
total 136 161 84.4


line stmt bran cond sub pod time code
1             package Async::Redis::URI;
2              
3 2     2   142814 use strict;
  2         4  
  2         74  
4 2     2   9 use warnings;
  2         4  
  2         87  
5 2     2   36 use 5.018;
  2         7  
6              
7             # URL decode
8             sub _decode {
9 18     18   27 my ($str) = @_;
10 18 50       28 return unless defined $str;
11 18         25 $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
  3         11  
12 18         37 return $str;
13             }
14              
15             sub new {
16 20     20 0 62 my ($class, %args) = @_;
17 20         79 return bless \%args, $class;
18             }
19              
20             sub parse {
21 26     26 1 177514 my ($class, $uri_string) = @_;
22              
23 26 100 100     119 return undef unless defined $uri_string && $uri_string ne '';
24              
25 24         77 my %parsed = (
26             host => 'localhost',
27             port => 6379,
28             database => 0,
29             tls => 0,
30             is_unix => 0,
31             );
32              
33             # Handle unix socket: redis+unix://[:password@]/path[?query]
34 24 100       119 if ($uri_string =~ m{^(redis\+unix)://(?:(?::([^@]*))?@)?(/[^?]+)(?:\?(.*))?$}) {
35 7         18 $parsed{scheme} = $1;
36 7 100 66     21 $parsed{password} = _decode($2) if defined $2 && $2 ne '';
37 7         14 $parsed{path} = $3;
38 7         10 $parsed{is_unix} = 1;
39              
40             # Remove host/port for unix sockets
41 7         10 delete $parsed{host};
42 7         9 delete $parsed{port};
43              
44             # Parse query string
45 7 100       26 if (defined $4) {
46 4         14 my %query;
47 4         13 for my $pair (split /&/, $4) {
48 5         11 my ($k, $v) = split /=/, $pair, 2;
49 5         39 $query{$k} = _decode($v);
50             }
51 4 50       16 $parsed{database} = $query{db} if exists $query{db};
52             }
53              
54 7         15 return $class->new(%parsed);
55             }
56              
57             # Standard URI: redis[s]://[user:pass@]host[:port][/database]
58 17 100       69 unless ($uri_string =~ m{^(rediss?)://(.+)$}) {
59 4         28 die "Invalid Redis URI: must start with redis://, rediss://, or redis+unix://";
60             }
61              
62 13         26 my $scheme = $1;
63 13         22 my $rest = $2;
64              
65 13         25 $parsed{scheme} = $scheme;
66 13 100       22 $parsed{tls} = 1 if $scheme eq 'rediss';
67              
68             # Split userinfo from host
69 13         15 my ($userinfo, $hostinfo);
70 13 100       31 if ($rest =~ /^([^@]*)@(.+)$/) {
71 7         26 $userinfo = $1;
72 7         9 $hostinfo = $2;
73             } else {
74 6         10 $hostinfo = $rest;
75             }
76              
77             # Parse userinfo: empty, :password, user:password, or just user
78 13 100 66     31 if (defined $userinfo && $userinfo ne '') {
79 7 100       19 if ($userinfo =~ /^:(.*)$/) {
    50          
80             # :password (no username)
81 2         5 $parsed{password} = _decode($1);
82             } elsif ($userinfo =~ /^([^:]*):(.*)$/) {
83             # user:password
84 5         11 $parsed{username} = _decode($1);
85 5         8 $parsed{password} = _decode($2);
86             } else {
87             # just username
88 0         0 $parsed{username} = _decode($userinfo);
89             }
90             }
91              
92             # Parse hostinfo: host[:port][/database]
93 13 50       73 if ($hostinfo =~ m{^([^:/]+)(?::(\d+))?(?:/(\d+))?$}) {
    0          
94 13         22 $parsed{host} = $1;
95 13 100       27 $parsed{port} = int($2) if defined $2;
96 13 100       23 $parsed{database} = int($3) if defined $3;
97             } elsif ($hostinfo =~ m{^([^:/]+)(?::(\d+))?/?$}) {
98             # host:port with trailing slash but no database
99 0         0 $parsed{host} = $1;
100 0 0       0 $parsed{port} = int($2) if defined $2;
101             } else {
102 0         0 die "Invalid Redis URI format: cannot parse host from '$hostinfo'";
103             }
104              
105             # Validate we got a host
106 13 50       20 die "Invalid Redis URI: empty host" unless $parsed{host};
107              
108 13         47 return $class->new(%parsed);
109             }
110              
111             # Accessors
112 4     4 0 39 sub scheme { shift->{scheme} }
113 6     6 0 23 sub host { shift->{host} }
114 7     7 0 19 sub port { shift->{port} }
115 6     6 0 20 sub path { shift->{path} }
116 15     15 0 46 sub database { shift->{database} }
117 12     12 0 42 sub username { shift->{username} }
118 13     13 0 43 sub password { shift->{password} }
119 9     9 0 25 sub tls { shift->{tls} }
120 8     8 0 24 sub is_unix { shift->{is_unix} }
121              
122             # Convert to hash suitable for Async::Redis->new()
123             sub to_hash {
124 5     5 1 15 my ($self) = @_;
125 5         4 my %hash;
126              
127 5 100       9 if ($self->is_unix) {
128 3         6 $hash{path} = $self->path;
129             } else {
130 2         3 $hash{host} = $self->host;
131 2         3 $hash{port} = $self->port;
132             }
133              
134 5 100       10 $hash{database} = $self->database if $self->database;
135 5 100       8 $hash{username} = $self->username if defined $self->username;
136 5 100       9 $hash{password} = $self->password if defined $self->password;
137 5 100       7 $hash{tls} = 1 if $self->tls;
138              
139 5         17 return %hash;
140             }
141              
142             1;
143              
144             __END__