lib/Zing/Store/Mysql.pm

package Zing::Store::Mysql;

use 5.014;

use strict;
use warnings;

use registry 'Zing::Types';
use routines;

use Data::Object::Class;
use Data::Object::ClassHas;

extends 'Zing::Store';

our $VERSION = '0.03'; # VERSION

# ATTRIBUTES

has client => (
  is => 'ro',
  isa => 'InstanceOf["DBI::db"]',
  new => 1,
);

fun new_client($self) {
  my $dbname = $ENV{ZING_DBNAME} || 'zing';
  my $dbhost = $ENV{ZING_DBHOST} || 'localhost';
  my $dbport = $ENV{ZING_DBPORT} || '3306';
  my $dbuser = $ENV{ZING_DBUSER} || 'root';
  my $dbpass = $ENV{ZING_DBPASS};
  require DBI; DBI->connect(
    join(';',
      "dbi:mysql:database=$dbname",
      $dbhost ? join('=', 'host', $dbhost) : (),
      $dbport ? join('=', 'port', $dbport) : (),
    ),
    $dbuser, $dbpass,
    {
      AutoCommit => 1,
      PrintError => 0,
      RaiseError => 1
    }
  );
}

has meta => (
  is => 'ro',
  isa => 'Str',
  new => 1,
);

fun new_meta($self) {
  require Zing::ID; Zing::ID->new->string
}

has table => (
  is => 'ro',
  isa => 'Str',
  new => 1,
);

fun new_table($self) {
  $ENV{ZING_DBZONE} || 'entities'
}

# BUILDERS

fun new_encoder($self) {
  require Zing::Encoder::Dump; Zing::Encoder::Dump->new;
}

fun BUILD($self) {
  my $client = $self->client;
  my $table = $self->table;
  local $@; eval {
    $client->do(qq{
      create table if not exists `$table` (
        `id` int not null auto_increment primary key,
        `key` varchar(255) not null,
        `value` mediumtext not null,
        `index` int default 0,
        `meta` varchar(255) null
      ) engine = innodb
    });
  }
  unless (defined(do{
    local $@;
    local $client->{RaiseError} = 0;
    local $client->{PrintError} = 0;
    eval {
      $client->do(qq{
        select 1 from `$table` where 1 = 1
      })
    }
  }));
  return $self;
}

fun DESTROY($self) {
  $self->client->disconnect;
  return $self;
}

# METHODS

my $retries = 10;

method drop(Str $key) {
  my $table = $self->table;
  my $client = $self->client;
  my $sth = $client->prepare(
    qq{delete from `$table` where `key` = ?}
  );
  $sth->execute($key);
  return $sth->rows > 0 ? 1 : 0;
}

method keys(Str $query) {
  $query =~ s/\*/%/g;
  my $table = $self->table;
  my $client = $self->client;
  my $data = $client->selectall_arrayref(
    qq{select distinct(`key`) from `$table` where `key` like ?},
    {},
    $query,
  );
  return [map $$_[0], @$data];
}

method lpull(Str $key) {
  my $table = $self->table;
  my $client = $self->client;
  for my $attempt (1..$retries) {
    local $@; eval {
      my $sth = $client->prepare(
        qq{
          update `$table` set `meta` = ? where `id` = (
            select `s1`.`id` from (
              select `s0`.`id` from `$table` `s0`
              where `s0`.`key` = ? and `s0`.`meta` is null
              order by `s0`.`index` asc limit 1
            ) as `s1`
          )
        }
      );
      $sth->execute($self->meta, $key);
    };
    if ($@) {
      die $@ if $attempt == $retries;
    }
    else {
      last;
    }
  }
  my $data = $client->selectrow_arrayref(
    qq{
      select `id`, `value`
      from `$table` where `meta` = ? and `key` = ? order by `index` asc limit 1
    },
    {},
    $self->meta, $key,
  );
  if ($data) {
    my $sth = $client->prepare(
      qq{delete from `$table` where `id` = ?}
    );
    $sth->execute($data->[0]);
  }
  return $data ? $self->decode($data->[1]) : undef;
}

method lpush(Str $key, HashRef $val) {
  my $table = $self->table;
  my $client = $self->client;
  my $sth = $client->prepare(
    qq{
      insert into `$table` (`key`, `value`, `index`) values (?, ?, (
        select ifnull(min(`s0`.`index`), 0) - 1
        from `$table` `s0` where `s0`.`key` = ?
      ))
    }
  );
  for my $attempt (1..$retries) {
    local $@; eval {
      $sth->execute($key, $self->encode($val), $key);
    };
    if ($@) {
      die $@ if $attempt == $retries;
    }
    else {
      last;
    }
  }
  return $sth->rows;
}

method read(Str $key) {
  my $table = $self->table;
  my $client = $self->client;
  my $data = $client->selectrow_arrayref(
    qq{
      select `value` from `$table`
      where `key` = ? order by `id` desc limit 1
    },
    {},
    $key,
  );
  return $data ? $data->[0] : undef;
}

method recv(Str $key) {
  my $data = $self->read($key);
  return $data ? $self->decode($data) : $data;
}

method rpull(Str $key) {
  my $table = $self->table;
  my $client = $self->client;
  for my $attempt (1..$retries) {
    local $@; eval {
      my $sth = $client->prepare(
        qq{
          update `$table` set `meta` = ? where `id` = (
            select `s1`.`id` from (
              select `s0`.`id` from `$table` `s0`
              where `s0`.`key` = ? and `s0`.`meta` is null
              order by `s0`.`index` desc limit 1
            ) as `s1`
          )
        }
      );
      $sth->execute($self->meta, $key);
    };
    if ($@) {
      die $@ if $attempt == $retries;
    }
    else {
      last;
    }
  }
  my $data = $client->selectrow_arrayref(
    qq{
      select `id`, `value`
      from `$table` where `meta` = ? and `key` = ? order by `index` desc limit 1
    },
    {},
    $self->meta, $key,
  );
  if ($data) {
    my $sth = $client->prepare(
      qq{delete from `$table` where `id` = ?}
    );
    $sth->execute($data->[0]);
  }
  return $data ? $self->decode($data->[1]) : undef;
}

method rpush(Str $key, HashRef $val) {
  my $table = $self->table;
  my $client = $self->client;
  my $sth = $client->prepare(
    qq{
      insert into `$table` (`key`, `value`, `index`) values (?, ?, (
        select ifnull(max(`s0`.`index`), 0) + 1
        from `$table` `s0` where `s0`.`key` = ?
      ))
    }
  );
  for my $attempt (1..$retries) {
    local $@; eval {
      $sth->execute($key, $self->encode($val), $key);
    };
    if ($@) {
      die $@ if $attempt == $retries;
    }
    else {
      last;
    }
  }
  return $sth->rows;
}

method send(Str $key, HashRef $val) {
  my $set = $self->encode($val);
  $self->write($key, $set);
  return 'OK';
}

method size(Str $key) {
  my $table = $self->table;
  my $client = $self->client;
  my $data = $client->selectrow_arrayref(
    qq{select count(`key`) from `$table` where `key` = ?},
    {},
    $key,
  );
  return $data->[0];
}

method slot(Str $key, Int $pos) {
  my $table = $self->table;
  my $client = $self->client;
  my $data = $client->selectrow_arrayref(
    qq{
      select `value` from `$table`
      where `key` = ? order by `index` asc limit ?, 1
    },
    {},
    $key, $pos
  );
  return $data ? $self->decode($data->[0]) : undef;
}

method test(Str $key) {
  my $table = $self->table;
  my $client = $self->client;
  my $data = $client->selectrow_arrayref(
    qq{select count(`id`) from `$table` where `key` = ?},
    {},
    $key,
  );
  return $data->[0] ? 1 : 0;
}

method write(Str $key, Str $data) {
  my $table = $self->table;
  my $client = $self->client;
  $client->prepare(
    qq{delete from `$table` where `key` = ?}
  )->execute($key);
  $client->prepare(
    qq{insert into `$table` (`key`, `value`) values (?, ?)}
  )->execute($key, $data);
  return $self;
}

1;

=encoding utf8

=head1 NAME

Zing::Store::Mysql - Mysql Storage

=cut

=head1 ABSTRACT

Mysql Storage Abstraction

=cut

=head1 SYNOPSIS

  use Test::DB::Mysql;
  use Zing::Encoder::Dump;
  use Zing::Store::Mysql;

  my $testdb = Test::DB::Mysql->new;
  my $store = Zing::Store::Mysql->new(
    client => $testdb->create->dbh,
    encoder => Zing::Encoder::Dump->new
  );

  # $store->drop;

=cut

=head1 DESCRIPTION

This package provides a MySQL-specific storage adapter for use with data
persistence abstractions. The L</client> attribute accepts a L<DBI> object
configured to connect to a L<DBD::mysql> backend. The C<ZING_DBNAME>
environment variable can be used to specify the database name (defaults to
"zing"). The C<ZING_DBHOST> environment variable can be used to specify the
database host (defaults to "localhost"). The C<ZING_DBPORT> environment
variable can be used to specify the database port (defaults to "3306"). The
C<ZING_DBUSER> environment variable can be used to specify the database
username (defaults to "root"). The C<ZING_DBPASS> environment variable can
be used to specify the database password. The C<ZING_DBZONE> environment
variable can be used to specify the database table name (defaults to
"entities").

=cut

=head1 INHERITS

This package inherits behaviors from:

L<Zing::Store>

=cut

=head1 LIBRARIES

This package uses type constraints from:

L<Zing::Types>

=cut

=head1 ATTRIBUTES

This package has the following attributes:

=cut

=head2 client

  client(InstanceOf["DBI::db"])

This attribute is read-only, accepts C<(InstanceOf["DBI::db"])> values, and is optional.

=cut

=head1 METHODS

This package implements the following methods:

=cut

=head2 decode

  decode(Str $data) : HashRef

The decode method decodes the JSON data provided and returns the data as a hashref.

=over 4

=item decode example #1

  # given: synopsis

  $store->decode('{"status"=>"ok"}');

=back

=cut

=head2 drop

  drop(Str $key) : Int

The drop method removes (drops) the item from the datastore.

=over 4

=item drop example #1

  # given: synopsis

  $store->drop('zing:main:global:model:temp');

=back

=cut

=head2 encode

  encode(HashRef $data) : Str

The encode method encodes and returns the data provided as JSON.

=over 4

=item encode example #1

  # given: synopsis

  $store->encode({ status => 'ok' });

=back

=cut

=head2 keys

  keys(Str @keys) : ArrayRef[Str]

The keys method returns a list of keys under the namespace of the datastore or
provided key.

=over 4

=item keys example #1

  # given: synopsis

  my $keys = $store->keys('zing:main:global:model:temp');

=back

=over 4

=item keys example #2

  # given: synopsis

  $store->send('zing:main:global:model:temp', { status => 'ok' });

  my $keys = $store->keys('zing:main:global:model:temp');

=back

=cut

=head2 lpull

  lpull(Str $key) : Maybe[HashRef]

The lpull method pops data off of the top of a list in the datastore.

=over 4

=item lpull example #1

  # given: synopsis

  $store->lpull('zing:main:global:model:items');

=back

=over 4

=item lpull example #2

  # given: synopsis

  $store->rpush('zing:main:global:model:items', { status => 'ok' });

  $store->lpull('zing:main:global:model:items');

=back

=cut

=head2 lpush

  lpush(Str $key, HashRef $val) : Int

The lpush method pushed data onto the top of a list in the datastore.

=over 4

=item lpush example #1

  # given: synopsis

  $store->lpush('zing:main:global:model:items', { status => '1' });

=back

=over 4

=item lpush example #2

  # given: synopsis

  $store->lpush('zing:main:global:model:items', { status => '0' });

  $store->lpush('zing:main:global:model:items', { status => '0' });

=back

=cut

=head2 recv

  recv(Str $key) : Maybe[HashRef]

The recv method fetches and returns data from the datastore by its key.

=over 4

=item recv example #1

  # given: synopsis

  $store->recv('zing:main:global:model:temp');

=back

=over 4

=item recv example #2

  # given: synopsis

  $store->send('zing:main:global:model:temp', { status => 'ok' });

  $store->recv('zing:main:global:model:temp');

=back

=cut

=head2 rpull

  rpull(Str $key) : Maybe[HashRef]

The rpull method pops data off of the bottom of a list in the datastore.

=over 4

=item rpull example #1

  # given: synopsis

  $store->rpull('zing:main:global:model:items');

=back

=over 4

=item rpull example #2

  # given: synopsis

  $store->rpush('zing:main:global:model:items', { status => 1 });
  $store->rpush('zing:main:global:model:items', { status => 2 });

  $store->rpull('zing:main:global:model:items');

=back

=cut

=head2 rpush

  rpush(Str $key, HashRef $val) : Int

The rpush method pushed data onto the bottom of a list in the datastore.

=over 4

=item rpush example #1

  # given: synopsis

  $store->rpush('zing:main:global:model:items', { status => 'ok' });

=back

=over 4

=item rpush example #2

  # given: synopsis

  $store->rpush('zing:main:global:model:items', { status => 'ok' });

  $store->rpush('zing:main:global:model:items', { status => 'ok' });

=back

=cut

=head2 send

  send(Str $key, HashRef $val) : Str

The send method commits data to the datastore with its key and returns truthy.

=over 4

=item send example #1

  # given: synopsis

  $store->send('zing:main:global:model:temp', { status => 'ok' });

=back

=cut

=head2 size

  size(Str $key) : Int

The size method returns the size of a list in the datastore.

=over 4

=item size example #1

  # given: synopsis

  my $size = $store->size('zing:main:global:model:items');

=back

=over 4

=item size example #2

  # given: synopsis

  $store->rpush('zing:main:global:model:items', { status => 'ok' });

  my $size = $store->size('zing:main:global:model:items');

=back

=cut

=head2 slot

  slot(Str $key, Int $pos) : Maybe[HashRef]

The slot method returns the data from a list in the datastore by its index.

=over 4

=item slot example #1

  # given: synopsis

  my $model = $store->slot('zing:main:global:model:items', 0);

=back

=over 4

=item slot example #2

  # given: synopsis

  $store->rpush('zing:main:global:model:items', { status => 'ok' });

  my $model = $store->slot('zing:main:global:model:items', 0);

=back

=cut

=head2 test

  test(Str $key) : Int

The test method returns truthy if the specific key (or datastore) exists.

=over 4

=item test example #1

  # given: synopsis

  $store->rpush('zing:main:global:model:items', { status => 'ok' });

  $store->test('zing:main:global:model:items');

=back

=over 4

=item test example #2

  # given: synopsis

  $store->drop('zing:main:global:model:items');

  $store->test('zing:main:global:model:items');

=back

=cut

=head1 AUTHOR

Al Newkirk, C<awncorp@cpan.org>

=head1 LICENSE

Copyright (C) 2011-2019, Al Newkirk, et al.

This is free software; you can redistribute it and/or modify it under the terms
of the The Apache License, Version 2.0, as elucidated in the L<"license
file"|https://github.com/iamalnewkirk/zing-store-mysql/blob/master/LICENSE>.

=head1 PROJECT

L<Wiki|https://github.com/iamalnewkirk/zing-store-mysql/wiki>

L<Project|https://github.com/iamalnewkirk/zing-store-mysql>

L<Initiatives|https://github.com/iamalnewkirk/zing-store-mysql/projects>

L<Milestones|https://github.com/iamalnewkirk/zing-store-mysql/milestones>

L<Contributing|https://github.com/iamalnewkirk/zing-store-mysql/blob/master/CONTRIBUTE.md>

L<Issues|https://github.com/iamalnewkirk/zing-store-mysql/issues>

=cut
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)