File Coverage

blib/lib/Rethinkdb.pm

Criterion	Covered	Total	%
statement	41	329	12.4
branch	0	22	0.0
condition	0	13	0.0
subroutine	13	86	15.1
pod	63	63	100.0
total	117	513	22.8

package Rethinkdb;
use Rethinkdb::Base -base;

use Carp 'croak';
use Scalar::Util 'weaken';

use Rethinkdb::IO;
use Rethinkdb::Protocol;
use Rethinkdb::Query::Database;
use Rethinkdb::Query::Table;
use Rethinkdb::Query;
use Rethinkdb::Util;

our $VERSION = '0.14';

# this is set only when connect->repl()
has 'io';
has 'term' => sub { Rethinkdb::Protocol->new->term; };

sub import {
  my $class   = shift;
  my $package = caller;

  no strict;
  *{"$package\::r"} = \&r;

  return;
}

sub r {
  my $package = caller;
  my $self;

  if ($package::_rdb_io) {
    $self = __PACKAGE__->new( io => $package::_rdb_io );
    $self->io->_rdb($self);
  }
  else {
    $self = __PACKAGE__->new;
  }

  return $self;
}

sub connect {
  my $self     = shift;
  my $host     = shift || 'localhost';
  my $port     = shift || 28015;
  my $db       = shift || 'test';
  my $auth_key = shift || '';
  my $timeout  = shift || 20;

  my $io = Rethinkdb::IO->new(
    _rdb       => $self,
    host       => $host,
    port       => $port,
    default_db => $db,
    auth_key   => $auth_key,
    timeout    => $timeout
  );

  weaken $io->{_rdb};
  return $io->connect;
}

sub server {
  my $self = shift;

  return $self->io->server;
}

# DATABASES

sub db_create {
  my $self = shift;
  my $args = shift;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->db_create,
    args  => $args,
  );

  weaken $q->{_rdb};
  return $q;
}

sub db_drop {
  my $self = shift;
  my $args = shift;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->db_drop,
    args  => $args
  );

  weaken $q->{_rdb};
  return $q;
}

sub db_list {
  my $self = shift;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->db_list,
  );

  weaken $q->{_rdb};
  return $q;
}

sub db {
  my $self = shift;
  my $name = shift;

  my $db = Rethinkdb::Query::Database->new(
    _rdb => $self,
    name => $name,
    args => $name,
  );

  weaken $db->{_rdb};
  return $db;
}

# TABLE

sub table {
  my $self     = shift;
  my $name     = shift;
  my $outdated = shift;

  my $optargs = {};
  if ($outdated) {
    $optargs = { use_outdated => 1 };
  }

  my $t = Rethinkdb::Query::Table->new(
    _rdb    => $self,
    _type   => $self->term->termType->table,
    name    => $name,
    args    => $name,
    optargs => $optargs,
  );

  weaken $t->{_rdb};
  return $t;
}

# DOCUMENT MANIPULATION

sub row {
  my $self = shift;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->implicit_var,
  );

  weaken $q->{_rdb};
  return $q;
}

sub literal {
  my $self = shift;
  my $args = ref $_[0] ? $_[0] : {@_};

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->literal,
    args  => $args,
  );

  return $q;
}

sub object {
  my $self = shift;
  my $args = ref $_[0] ? $_[0] : {@_};

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->object,
    args  => $args,
  );

  return $q;
}

# MATH AND LOGIC

sub and {
  my $self = shift;
  my $args = \@_;

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->and,
    args  => $args,
  );

  return $q;
}

sub or {
  my $self = shift;
  my $args = \@_;

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->or,
    args  => $args,
  );

  return $q;
}

sub random {
  my $self    = shift;
  my $args    = [@_];
  my $optargs = {};

  if ( ref $args->[2] eq 'HASH' ) {
    $optargs = $args->[2];
  }
  elsif ( scalar @{$args} > 2 and $args->[2] ) {
    $optargs->{float} = r->true;
  }

  # only keep the first two elements
  $args = [ splice @{$args}, 0, 2 ];

  my $q = Rethinkdb::Query->new(
    _type   => $self->term->termType->random,
    args    => $args,
    optargs => $optargs,
  );

  return $q;
}

# DATES AND TIMES

sub now {
  my $self = shift;

  my $q = Rethinkdb::Query->new( _type => $self->term->termType->now );

  return $q;
}

sub time {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->time,
    args  => $args
  );

  return $q;
}

sub epoch_time {
  my $self = shift;
  my $args = shift;

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->epoch_time,
    args  => $args
  );

  return $q;
}

sub iso8601 {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->iso8601,
    args  => $args
  );

  return $q;
}

sub monday {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->monday,
    args  => $args
  );

  return $q;
}

sub tuesday {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->tuesday,
    args  => $args
  );

  return $q;
}

sub wednesday {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->wednesday,
    args  => $args
  );

  return $q;
}

sub thursday {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->thursday,
    args  => $args
  );

  return $q;
}

sub friday {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->friday,
    args  => $args
  );

  return $q;
}

sub saturday {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->saturday,
    args  => $args
  );

  return $q;
}

sub sunday {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->sunday,
    args  => $args
  );

  return $q;
}

sub january {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->january,
    args  => $args
  );

  return $q;
}

sub february {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->february,
    args  => $args
  );

  return $q;
}

sub march {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->march,
    args  => $args
  );

  return $q;
}

sub april {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->april,
    args  => $args
  );

  return $q;
}

sub may {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->may,
    args  => $args
  );

  return $q;
}

sub june {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->june,
    args  => $args
  );

  return $q;
}

sub july {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->july,
    args  => $args
  );

  return $q;
}

sub august {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->august,
    args  => $args
  );

  return $q;
}

sub september {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->september,
    args  => $args
  );

  return $q;
}

sub october {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->october,
    args  => $args
  );

  return $q;
}

sub november {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->november,
    args  => $args
  );

  return $q;
}

sub december {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->december,
    args  => $args
  );

  return $q;
}

# CONTROL STRUCTURES

sub args {
  my $self = shift;
  my $args = [@_];

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->args,
    args  => $args
  );

  return $q;
}

# TODO: figure out why the arguments have to be reversed here
sub do {
  my $self = shift;
  my ( $one, $two ) = @_;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->funcall,
    args => [ $two, $one ],
  );

  weaken $q->{_rdb};
  return $q;
}

sub branch {
  my $self = shift;
  my ( $predicate, $true, $false ) = @_;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->branch,
    args => [ $predicate, $true, $false ],
  );

  weaken $q->{_rdb};
  return $q;
}

sub error {
  my $self = shift;
  my ($message) = @_;

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->error,
    args  => $message,
  );

  return $q;
}

sub expr {
  my $self  = shift;
  my $value = shift;

  return Rethinkdb::Util->_expr($value);
}

sub js {
  my $self    = shift;
  my $args    = shift;
  my $timeout = shift;

  my $optargs = {};
  if ($timeout) {
    $optargs = { timeout => $timeout };
  }

  my $q = Rethinkdb::Query->new(
    _rdb    => $self,
    _type   => $self->term->termType->javascript,
    args    => $args,
    optargs => $optargs,
  );

  weaken $q->{_rdb};
  return $q;
}

sub json {
  my $self  = shift;
  my $value = shift;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->json,
    args  => $value,
  );

  weaken $q->{_rdb};
  return $q;
}

sub http {
  my $self    = shift;
  my $value   = shift;
  my $optargs = shift;

  my $q = Rethinkdb::Query->new(
    _rdb    => $self,
    _type   => $self->term->termType->http,
    args    => $value,
    optargs => $optargs,
  );

  weaken $q->{_rdb};
  return $q;
}

sub uuid {
  my $self  = shift;
  my $value = shift;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->uuid,
    args  => $value,
  );

  weaken $q->{_rdb};
  return $q;
}

# GEO

sub circle {
  my $self    = shift;
  my $point   = shift;
  my $radius  = shift;
  my $optargs = shift;

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->circle,
    args    => [ $point, $radius ],
    optargs => $optargs,
  );

  return $q;
}

sub distance {
  my $self    = shift;
  my $point1  = shift;
  my $point2  = shift;
  my $optargs = shift;

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->distance,
    args    => [ $point1, $point2 ],
    optargs => $optargs,
  );

  return $q;
}

sub geojson {
  my $self = shift;
  my $args = shift;

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->geojson,
    args  => $args,
  );

  return $q;
}

sub line {
  my $self = shift;
  my $args = \@_;

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->line,
    args  => $args,
  );

  return $q;
}

sub point {
  my $self = shift;
  my $args = \@_;

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->point,
    args  => $args,
  );

  return $q;
}

sub polygon {
  my $self = shift;
  my $args = \@_;

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->polygon,
    args  => $args,
  );

  return $q;
}


# MISC

sub asc {
  my $self = shift;
  my $name = shift;

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->asc,
    args  => $name,
  );

  return $q;
}

sub desc {
  my $self = shift;
  my $name = shift;

  my $q = Rethinkdb::Query->new(
    _type => $self->term->termType->desc,
    args  => $name,
  );

  return $q;
}

sub wait {
  my $self = shift;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->wait,
  );

  return $q;
}

sub minval {
  my $self = shift;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->minval,
  );

  return $q;
}

sub maxval {
  my $self = shift;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->maxval,
  );

  return $q;
}

sub round {
  my $self = shift;
  my $args = shift;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->round,
    args  => $args
  );

  return $q;
}

sub ceil {
  my $self = shift;
  my $args = shift;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->ceil,
    args  => $args
  );

  return $q;
}

sub floor {
  my $self = shift;
  my $args = shift;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->floor,
    args  => $args
  );

  return $q;
}

sub grant {
  my $self  = shift;
  my $user  = shift;
  my $perms = shift;

  my $q = Rethinkdb::Query->new(
    _rdb  => $self,
    _type => $self->term->termType->grant,
    args => [ $user, $perms ]
  );

  return $q;
}

sub true  { return Rethinkdb::_True->new; }
sub false { return Rethinkdb::_False->new; }

package Rethinkdb::_True;

use overload
  '""'   => sub {'true'},
  'bool' => sub {1},
  'eq'   => sub { $_[1] eq 'true' ? 1 : 0; },
  '=='   => sub { $_[1] == 1 ? 1 : 0; },
  fallback => 1;

sub new { return bless {}, $_[0] }

package Rethinkdb::_False;

use overload
  '""'   => sub {'false'},
  'bool' => sub {0},
  'eq'   => sub { $_[1] eq 'false' ? 1 : 0; },
  '=='   => sub { $_[1] == 0 ? 1 : 0; },
  fallback => 1;

sub new { return bless {}, $_[0] }

1;

__END__