File Coverage

blib/lib/Postgredis.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package Postgredis;
2              
3 1     1   21801 use Mojo::Pg;
  0            
  0            
4             use v5.20;
5             use experimental 'signatures';
6             use strict;
7              
8             our $VERSION=0.02;
9              
10             sub new {
11             my $s = shift;
12             my @a = @_;
13             my %args;
14             %args = ( namespace => $_[0] ) if @_==1;
15             bless \%args, $s;
16             }
17              
18             sub namespace($s,$new=undef) {
19             $s->{namespace} = $new if @_==2;
20             $s->{namespace};
21             }
22              
23             sub _pg($s) {
24             state $db;
25             return $db if defined($db);
26             $db = Mojo::Pg->new;
27             $ENV{PG_CONNECT_STR} and do { $db = $db->from_string( $ENV{PG_CONNECT_STR} ) };
28             $ENV{PG_CONNECT_DSN} and do { $db = $db->dsn($ENV{PG_CONNECT_DSN}) };
29             $db;
30             }
31              
32             sub pg($s) { $s->_pg->db; }
33              
34             sub _create_tables($s) {
35             my $table = $s->namespace;
36             $s->_query(<
37             create table $table (
38             k varchar not null primary key,
39             v jsonb
40             )
41             DONE
42             $s->_query(<
43             create table $table\_sorted (
44             k varchar not null,
45             v jsonb not null,
46             score real not null,
47             primary key (k, v)
48             )
49             DONE
50             $s->_query(<
51             create index on $table\_sorted (k,score)
52             DONE
53             }
54              
55             sub _drop_tables($s) {
56             my $table = $s->namespace;
57             $s->_query("drop table if exists $table");
58             $s->_query("drop table if exists $table\_sorted");
59             }
60              
61             sub _tables_exist($s) {
62             my $res = $s->_query(q[select 1 from information_schema.tables where table_name = ?],
63             $s->namespace);
64             return $res->rows > 0;
65             }
66              
67             sub _query($s,$str, @more) {
68             my $namespace = $s->namespace;
69             $str =~ s/\bredis\b/$namespace/;
70             $str =~ s/\bredis_sorted\b/$namespace\_sorted/;
71             return $s->pg->query($str, @more);
72             }
73              
74             sub maybe_init($s) {
75             $s->flushdb unless $s->_tables_exist;
76             $s;
77             }
78              
79             sub flushdb($s) {
80             $s->_drop_tables if $s->_tables_exist;
81             $s->_create_tables;
82             return $s;
83             }
84              
85             sub default_ttl { }
86              
87             sub set($s,$key,$value) {
88             my $res;
89             $res = $s->_query("update redis set v = ?::jsonb where k = ?", { json => $value }, $key);
90             return 1 if $res->rows > 0;
91             $s->_query("insert into redis (k, v) values (?,?::jsonb)", $key, { json => $value } );
92             return 1;
93             }
94              
95             sub get($s,$k) {
96             return $s->_query("select v from redis where k=?",$k)->expand->array->[0];
97             }
98              
99             sub del($s,$k) {
100             $s->_query("delete from redis where k=?",$k);
101             }
102              
103             sub keys($s,$pat) {
104             $pat =~ s/\*/%/g;
105             return $s->_query("select k from redis where k like ?",$pat)->arrays->flatten;
106             }
107              
108             sub exists($s,$k) {
109             my $got = $s->_query("select * from redis where k=?",$k);
110             return $got->rows > 0;
111             }
112              
113             sub hset($s,$key,$hkey,$value) {
114             my $res = $s->_query("select v from redis where k = ?", $key)->expand;
115             my $json = $res->rows ? $res->hash->{v} : {};
116             $json->{$hkey} = $value;
117             $res = $s->_query("update redis set v = ?::jsonb where k = ?",{json=>$json},$key);
118             return 1 if $res->rows > 0;
119             $res = $s->_query("insert into redis (k, v) values (?,?::jsonb)",$key, {json=>$json});
120             return 1;
121             }
122              
123             sub hdel($s,$key,$hkey) {
124             my $json = $s->_query("select v from redis where k = ?", $key)->expand->hash->{v};
125             exists($json->{$hkey}) or return 0;
126             delete $json->{$hkey} or return 0;
127             $s->_query("update redis set v = ?::jsonb where k = ?",{json=>$json},$key);
128             }
129              
130             sub hget($s,$key,$hkey) {
131             my $json = $s->_query("select v from redis where k = ?", $key)->expand->hash->{v};
132             return $json->{$hkey};
133             }
134              
135             sub hgetall($s,$key) {
136             my $res = $s->_query("select v from redis where k = ?", $key)->expand;
137             return {} unless $res->rows;
138             return $res->hash->{v};
139             }
140              
141             sub sadd($s,$key,$value) {
142             $s->hset($key,$value,1);
143             }
144              
145             sub srem($s,$key,$value) {
146             my $json = $s->_query("select v from redis where k = ?", $key)->expand->hashes;
147             $json &&= $json->[0]{v};
148             delete $json->{$value};
149             $s->_query("update redis set v = ?::jsonb where k = ?",{json=>$json},$key);
150             return 1;
151             }
152              
153             sub smembers($s,$k) {
154             my $j = $s->hgetall($k);
155             return [ CORE::keys(%$j) ]
156             }
157              
158             sub incr($s,$k) {
159             my $exists = $s->_query("select 1 from pg_class where relname = ?", $k);
160             $k =~ /^[a-z0-9:_]+$/ or die "bad sequence name $k";
161             unless ($exists->rows) {
162             $s->_query("create sequence $k start 1");
163             }
164             my $next = $s->_query("select nextval(?)",$k)->arrays->flatten;
165             return $next->[0];
166             }
167              
168             sub zadd($s,$key,$score,$val) {
169             $s->_query("insert into redis_sorted (k,score,v) values (?,?,?::jsonb)",
170             $key, $score,{ json => $val });
171             }
172              
173             sub zscore($s,$key,$val) {
174             return $s->_query("select score from redis_sorted where k = ? and v = ?::jsonb",
175             $key, { json => $val })->array->[0];
176             }
177              
178             sub zrem($s,$key,$val) {
179             $s->_query("delete from redis_sorted where k = ? and v = ?::jsonb", $key, { json => $val } );
180             }
181              
182             sub zrangebyscore($s,$key,$min,$max) {
183             return $s->_query("select v from redis_sorted where k = ? and score >= ?
184             and score <= ? order by score, v::text", $key, $min, $max)
185             ->expand->arrays->flatten;
186             }
187              
188             1;
189              
190             =head1 NAME
191              
192             Postgredis -- PostgreSQL and Redis mashup!
193              
194             =head1 SYNOPSIS
195              
196             my $db = Postgredis->new('test');
197             $db->set(favorite_color => "blue");
198             $db->hset("joe", name => "Joe", age => 50 );
199              
200             =head1 DESCRIPTION
201              
202             Postgredis is an experimental implementation of a subset of the
203             Redis primitives using Postgres as a backend.
204              
205             The interface provides methods corresponding to Redis commands
206             which are translated into SQL queries on two tables. The
207             two tables are a key-value table and a key-sortkey-value
208             table. The values use the native JSON datatype in Postgres.
209             For this, postgres 9.4 or higher is required.
210              
211             =head1 METHODS
212              
213             Most of the methods are self explanatory -- see L for
214             further descriptions.
215              
216             =head2 Database operations
217              
218             maybe_init($s)
219             flushdb($s)
220              
221             =head2 Key operations
222              
223             set($s,$key,$value)
224             get($s,$k)
225             del($s,$k)
226             keys($s,$pat)
227             exists($s,$k)
228              
229             =head2 Hash operations
230              
231             hset($s,$key,$hkey,$value)
232             hdel($s,$key,$hkey)
233             hget($s,$key,$hkey)
234             hgetall($s,$key)
235              
236             =head2 Set operations
237              
238             sadd($s,$key,$value)
239             srem($s,$key,$value)
240             smembers($s,$k)
241              
242             =head2 Sorted set operations
243              
244             zadd($s,$key,$val,$score)
245             zscore($s,$key,$val)
246             zrem($s,$key,$val)
247             zrangebyscore($s,$key,$min,$max)
248              
249             =head2 String operations
250              
251             incr($s,$k)
252              
253             =head1 MOTIVATION
254              
255             The Redis primitives provide flexible representations of loosely structured data,
256             but indexing and querying the data can be a challenge. PostgreSQL provides
257             robust persistent data storage with flexible options for indexing and querying,
258             but relational schema design may be costly and insufficiently flexible.
259             Postgres as a backend is a compromise between the two.
260              
261             =head1 SEE ALSO
262              
263             L, L
264              
265             =head1 AUTHOR
266              
267             Brian Duggan C
268              
269             =cut