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

package Postgredis;

use Mojo::Pg;
use v5.20;
use experimental 'signatures';
use strict;

our $VERSION=0.01;

sub new {
    my $s = shift;
    my @a = @_;
    my %args;
    %args = ( namespace => $_[0] ) if @_==1;
    bless \%args, $s;
}

sub namespace($s,$new=undef) {
    $s->{namespace} = $new if @_==2;
    $s->{namespace};
}

sub _pg($s) {
    state $db;
    return $db if defined($db);
    $db = Mojo::Pg->new;
    $ENV{PG_CONNECT_STR} and do { $db = $db->from_string( $ENV{PG_CONNECT_STR} ) };
    $ENV{PG_CONNECT_DSN} and do { $db = $db->dsn($ENV{PG_CONNECT_DSN}) };
    $db;
}

sub pg($s) { $s->_pg->db; }

sub _create_tables($s) {
    my $table = $s->namespace;
    $s->_query(<
    create table $table (
        k varchar not null primary key,
        v jsonb
    )
DONE
    $s->_query(<
    create table $table\_sorted (
        k varchar not null,
        v jsonb not null,
        score real not null,
    primary key (k, v)
    )
DONE
    $s->_query(<
    create index on $table\_sorted (k,score)
DONE
}

sub _drop_tables($s) {
    my $table = $s->namespace;
    $s->_query("drop table if exists $table");
    $s->_query("drop table if exists $table\_sorted");
}

sub _tables_exist($s) {
    my $res = $s->_query(q[select 1 from information_schema.tables where table_name = ?],
		$s->namespace);
	return $res->rows > 0;
}

sub _query($s,$str, @more) {
    my $namespace = $s->namespace;
    $str =~ s/\bredis\b/$namespace/;
    $str =~ s/\bredis_sorted\b/$namespace\_sorted/;
    return $s->pg->query($str, @more);
}

sub maybe_init($s) {
	$s->flushdb unless $s->_tables_exist;
    $s;
}

sub flushdb($s) {
    $s->_drop_tables if $s->_tables_exist;
    $s->_create_tables;
    return $s;
}

sub default_ttl { }

sub set($s,$key,$value) {
  my $res;
  $res = $s->_query("update redis set v = ?::jsonb where k = ?", { json => $value }, $key);
  return 1 if $res->rows > 0;
  $s->_query("insert into redis (k, v) values (?,?::jsonb)", $key, { json => $value } );
  return 1;
}

sub get($s,$k) {
    return $s->_query("select v from redis where k=?",$k)->expand->array->[0];
}

sub del($s,$k) {
    $s->_query("delete from redis where k=?",$k);
}

sub keys($s,$pat) {
    $pat =~ s/\*/%/g;
    return $s->_query("select k from redis where k like ?",$pat)->arrays->flatten;
}

sub exists($s,$k) {
    my $got = $s->_query("select * from redis where k=?",$k);
    return $got->rows > 0;
}

sub hset($s,$key,$hkey,$value) {
    my $res = $s->_query("select v from redis where k = ?", $key)->expand;
    my $json = $res->rows ? $res->hash->{v} : {};
    $json->{$hkey} = $value;
    $res = $s->_query("update redis set v = ?::jsonb where k = ?",{json=>$json},$key);
    return 1 if $res->rows > 0;
    $res = $s->_query("insert into redis (k, v) values (?,?::jsonb)",$key, {json=>$json});
    return 1;
}

sub hdel($s,$key,$hkey) {
    my $json = $s->_query("select v from redis where k = ?", $key)->expand->hash->{v};
    exists($json->{$hkey}) or return 0;
    delete $json->{$hkey} or return 0;
    $s->_query("update redis set v = ?::jsonb where k = ?",{json=>$json},$key);
}

sub hget($s,$key,$hkey) {
    my $json = $s->_query("select v from redis where k = ?", $key)->expand->hash->{v};
    return $json->{$hkey};
}

sub hgetall($s,$key) {
    my $res = $s->_query("select v from redis where k = ?", $key)->expand;
    return {} unless $res->rows;
    return $res->hash->{v};
}

sub sadd($s,$key,$value) {
    $s->hset($key,$value,1);
}

sub srem($s,$key,$value) {
    my $json = $s->_query("select v from redis where k = ?", $key)->expand->hashes;
    $json &&= $json->[0]{v};
    delete $json->{$value};
    $s->_query("update redis set v = ?::jsonb where k = ?",{json=>$json},$key);
    return 1;
}

sub smembers($s,$k) {
    my $j = $s->hgetall($k);
    return [ CORE::keys(%$j) ]
}

sub incr($s,$k) {
    my $exists = $s->_query("select 1 from pg_class where relname = ?", $k);
    $k =~ /^[a-z0-9:_]+$/ or die "bad sequence name $k";
    unless ($exists->rows) {
        $s->_query("create sequence $k start 1");
    }
    my $next = $s->_query("select nextval(?)",$k)->arrays->flatten;
    return $next->[0];
}

sub zadd($s,$key,$val,$score) {
    $s->_query("insert into redis_sorted (k,score,v) values (?,?,?::jsonb)",
        $key, $score,{ json => $val });
}

sub zscore($s,$key,$val) {
    return $s->_query("select score from redis_sorted where k = ? and v = ?::jsonb",
        $key, { json => $val })->array->[0];
}

sub zrem($s,$key,$val) {
    $s->_query("delete from redis_sorted where k = ? and v = ?::jsonb", $key, { json => $val } );
}

sub zrangebyscore($s,$key,$min,$max) {
    return $s->_query("select v from redis_sorted where k = ? and score >= ?
        and score <= ? order by score, v::text", $key, $min, $max)
    ->expand->arrays->flatten;
}

1;

=head1 NAME

Postgredis -- PostgreSQL and Redis mashup!

=head1 SYNOPSIS

     my $db = Postgredis->new('test');
     $db->set(favorite_color => "blue");
     $db->hset("joe", name => "Joe", age => 50 );

=head1 DESCRIPTION

Postgredis is an experimental implementation of a subset of the
Redis primitives using Postgres as a backend.

The interface provides methods corresponding to Redis commands
which are translated into SQL queries on two tables.  The
two tables are a key-value table and a key-sortkey-value
table.  The values use the native JSON datatype in Postgres.
For this, postgres 9.4 or higher is required.

=head1 METHODS

Most of the methods are self explanatory -- see L for
further descriptions.

=head2 Database operations

    maybe_init($s)
    flushdb($s)

=head2 Key operations

    set($s,$key,$value)
    get($s,$k)
    del($s,$k)
    keys($s,$pat)
    exists($s,$k)

=head2 Hash operations

    hset($s,$key,$hkey,$value)
    hdel($s,$key,$hkey)
    hget($s,$key,$hkey)
    hgetall($s,$key)

=head2 Set operations

    sadd($s,$key,$value)
    srem($s,$key,$value)
    smembers($s,$k)

=head2 Sorted set operations

    zadd($s,$key,$val,$score)
    zscore($s,$key,$val)
    zrem($s,$key,$val)
    zrangebyscore($s,$key,$min,$max)

=head2 String operations

    incr($s,$k)

=head1 MOTIVATION

The Redis primitives provide flexible representations of loosely structured data,
but indexing and querying the data can be a challenge.  PostgreSQL provides
robust persistent data storage with flexible options for indexing and querying,
but relational schema design may be costly and insufficiently flexible.
Postgres as a backend is a compromise between the two.

=head1 SEE ALSO

L, L

=head1 AUTHOR

Brian Duggan C

=cut