├── MANIFEST.SKIP ├── t ├── pod.t ├── pod_coverage.t ├── string.t ├── db.t ├── logic.t ├── writing.t ├── geo.t ├── connect.t ├── joins.t ├── table.t ├── control.t ├── selecting.t ├── transformations.t ├── admin.t ├── aggregation.t ├── document.t └── datetime.t ├── .gitignore ├── tools ├── decode.pl └── mkproto.pl ├── Makefile.PL ├── .perltidyrc ├── .travis.yml ├── README.md ├── lib └── Rethinkdb │ ├── Query │ ├── Datum.pm │ ├── Database.pm │ └── Table.pm │ ├── Response.pm │ ├── Util.pm │ ├── Base.pm │ ├── Protocol.pm │ └── IO.pm ├── Changes └── LICENSE /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | ^\.(?!perltidyrc) 2 | .*\.old$ 3 | \.tar\.gz$ 4 | ^Makefile$ 5 | ^MYMETA\. 6 | ^blib 7 | ^pm_to_blib 8 | ^external 9 | ^tools 10 | -------------------------------------------------------------------------------- /t/pod.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_POD to enable this test (developer only!)' 4 | unless $ENV{TEST_POD}; 5 | plan skip_all => 'Test::Pod 1.14 required for this test!' 6 | unless eval 'use Test::Pod 1.14; 1'; 7 | 8 | all_pod_files_ok(); 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | blib/ 2 | .build/ 3 | _build/ 4 | cover_db/ 5 | inc/ 6 | Build 7 | !Build/ 8 | Build.bat 9 | .last_cover_stats 10 | Makefile 11 | Makefile.old 12 | MANIFEST.bak 13 | META.yml 14 | MYMETA.yml 15 | nytprof.out 16 | pm_to_blib 17 | MYMETA.json 18 | MANIFEST 19 | *.tar.gz 20 | -------------------------------------------------------------------------------- /t/pod_coverage.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_POD to enable this test (developer only!)' 4 | unless $ENV{TEST_POD}; 5 | plan skip_all => 'Test::Pod::Coverage 1.04 required for this test!' 6 | unless eval 'use Test::Pod::Coverage 1.04; 1'; 7 | 8 | all_pod_coverage_ok(); 9 | -------------------------------------------------------------------------------- /tools/decode.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use feature ':5.10'; 4 | use utf8; 5 | use strict; 6 | use warnings; 7 | 8 | use Data::Dumper; 9 | $Data::Dumper::Indent = 1; 10 | 11 | use lib qw'../google-protocolbuffers-perl/lib lib'; 12 | use Rethinkdb::Protocol; 13 | 14 | my @i = <>; 15 | my $s = join '', @i; 16 | chomp $s; 17 | my $q = Query->decode($s); 18 | 19 | my $out = Dumper $q; 20 | 21 | $out =~ s/\$VAR1 = //g; 22 | $out =~ s/bless\( //g; 23 | $out =~ s/, '[^']+' \)//g; 24 | 25 | say $out; 26 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | use 5.010001; 2 | 3 | use Config; 4 | use ExtUtils::MakeMaker; 5 | 6 | use strict; 7 | use warnings; 8 | 9 | WriteMakefile( 10 | NAME => 'Rethinkdb', 11 | VERSION_FROM => 'lib/Rethinkdb.pm', 12 | ABSTRACT => 'Pure Perl RethinkDB Driver', 13 | AUTHOR => 'Nathan Levin-Greenhaw ', 14 | LICENSE => 'artistic_2', 15 | META_MERGE => { 16 | requires => { perl => '5.010001' }, 17 | resources => { 18 | homepage => 'https://github.com/njlg/perl-rethinkdb', 19 | license => 'http://www.opensource.org/licenses/artistic-license-2.0', 20 | repository => 'https://github.com/njlg/perl-rethinkdb', 21 | bugtracker => 'https://github.com/njlg/perl-rethinkdb/issues' 22 | }, 23 | no_index => {directory => ['t']} 24 | }, 25 | test => { TESTS => 't/*.t' } 26 | ); 27 | -------------------------------------------------------------------------------- /.perltidyrc: -------------------------------------------------------------------------------- 1 | -pbp # Start with Perl Best Practices 2 | -w # Show all warnings 3 | -iob # Ignore old breakpoints 4 | #-l=0 # Allow lines to be as long as they want 5 | -l=79 # Allow lines to be as long as they want 6 | -mbl=2 # No more than 2 blank lines 7 | -i=2 # Indentation is 2 columns 8 | -ci=2 # Continuation indentation is 2 columns 9 | -vt=0 # Less vertical tightness 10 | -pt=1 # High parenthesis tightness 11 | -bt=1 # High brace tightness 12 | -sbt=1 # High square bracket tightness 13 | -isbc # Don't indent comments without leading space 14 | -ole=unix # files need to be unixy 15 | 16 | -bbb # breaks before major blocks 17 | -blbs=1 # put two spaces before each sub 18 | 19 | #-sct # Stack closing tokens when possible to avoid lines with isolated opening tokens 20 | #-sot # Stack opening tokens when possible to avoid lines with isolated opening tokens -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: perl 2 | perl: 3 | - "5.22" 4 | - "5.20" 5 | - "5.18" 6 | - "5.16" 7 | - "5.14" 8 | - "5.12" 9 | - "5.10" 10 | env: 11 | - "TEST_POD=1 TEST_ONLINE=1 HARNESS_PERL_SWITCHES=-MDevel::Cover" 12 | before_install: 13 | - source /etc/lsb-release && echo "deb http://download.rethinkdb.com/apt $DISTRIB_CODENAME main" | sudo tee /etc/apt/sources.list.d/rethinkdb.list 14 | - wget -qO- http://download.rethinkdb.com/apt/pubkey.gpg | sudo apt-key add - 15 | - sudo apt-get update 16 | - sudo apt-get install rethinkdb 17 | - perlbrew available 18 | install: 19 | - cpanm -n Test::Pod Test::Pod::Coverage 20 | - cpanm -n Devel::Cover::Report::Coveralls 21 | - cpanm -n --installdeps . 22 | before_script: 23 | - sudo rethinkdb --io-threads 2048 --daemon 24 | - until nc -z localhost 28015; do echo Waiting for RethinkDB; sleep 1; done 25 | - ulimit -S -n 2048 26 | after_success: 27 | - cover -report coveralls 28 | notifications: 29 | email: false 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # perl-rethinkdb 2 | 3 | [![Build Status](https://travis-ci.org/njlg/perl-rethinkdb.svg?branch=master)](https://travis-ci.org/njlg/perl-rethinkdb) 4 | [![Coverage Status](https://coveralls.io/repos/njlg/perl-rethinkdb/badge.svg?branch=master)](https://coveralls.io/r/njlg/perl-rethinkdb?branch=master) 5 | [![CPAN version](https://badge.fury.io/pl/Rethinkdb.svg)](https://metacpan.org/pod/Rethinkdb) 6 | 7 | A Pure-Perl RethinkDB Driver 8 | 9 | ```perl 10 | package MyApp; 11 | use Rethinkdb; 12 | 13 | r->connect->repl; 14 | r->table('agents')->get('007')->update( 15 | r->branch( 16 | r->row->attr('in_centrifuge'), 17 | {'expectation': 'death'}, 18 | {} 19 | ) 20 | )->run; 21 | ``` 22 | 23 | ## Documentation 24 | See http://njlg.info/perl-rethinkdb/ 25 | 26 | ## Notes 27 | 28 | * This version is compatible with RethinkDB 2.3.4 29 | * No authentication support yet 30 | * This is still in beta stage 31 | * For examples see the tests in `t/*.t` or see the documentation (link above) 32 | 33 | ## Todo 34 | 35 | * Add sugar syntax for `attr` (e.g. `$doc->{attr}`), `slice` (e.g. `$doc->[3..6]`), and `nth` (e.g. `$doc->[3]`) 36 | * Add sugar syntax for as many operators as possible (e.g. `+`, `-`, `/`, `*`) 37 | * Performance testing and fixes 38 | * Look into non-blocking IO 39 | -------------------------------------------------------------------------------- /t/string.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | my $conn = r->connect->repl; 9 | 10 | # match 11 | my $res 12 | = r->expr('id:0,name:mlucy,foo:bar')->match('name:(\w+)')->bracket('groups') 13 | ->nth(0)->bracket('str')->run($conn); 14 | 15 | isa_ok $res, 'Rethinkdb::Response'; 16 | is $res->type, 1, 'Correct status code'; 17 | is $res->response, 'mlucy', 'Correct number of updates'; 18 | 19 | # $res = r->expr('id:0,foo:bar')->match('name:(\w+)')->bracket('groups')->nth(0)->bracket('str')->run($conn); 20 | $res = r->expr('id:0,foo:bar')->match('name:(\w+)')->run($conn); 21 | 22 | isa_ok $res, 'Rethinkdb::Response'; 23 | is $res->type, 1, 'Correct status code'; 24 | is $res->response, undef, 'Correct number of updates'; 25 | 26 | # split 27 | $res = r->expr('foo bar bax')->split->run($conn); 28 | 29 | isa_ok $res, 'Rethinkdb::Response'; 30 | is $res->type, 1, 'Correct status code'; 31 | is_deeply $res->response, ['foo', 'bar', 'bax'], 'Correct split response'; 32 | 33 | $res = r->expr('id:0,foo:bar,stuff:good')->split(',')->run($conn); 34 | 35 | isa_ok $res, 'Rethinkdb::Response'; 36 | is $res->type, 1, 'Correct status code'; 37 | is_deeply $res->response, ['id:0', 'foo:bar', 'stuff:good'], 'Correct split response'; 38 | 39 | # upcase 40 | $res = r->expr('Sentence about LaTeX.')->upcase->run($conn); 41 | 42 | isa_ok $res, 'Rethinkdb::Response'; 43 | is $res->type, 1, 'Correct status code'; 44 | is $res->response, 'SENTENCE ABOUT LATEX.', 'Correct split response'; 45 | 46 | # downcase 47 | $res = r->expr('Sentence about LaTeX.')->downcase->run($conn); 48 | 49 | isa_ok $res, 'Rethinkdb::Response'; 50 | is $res->type, 1, 'Correct status code'; 51 | is $res->response, 'sentence about latex.', 'Correct split response'; 52 | 53 | done_testing(); 54 | -------------------------------------------------------------------------------- /lib/Rethinkdb/Query/Datum.pm: -------------------------------------------------------------------------------- 1 | package Rethinkdb::Query::Datum; 2 | use Rethinkdb::Base 'Rethinkdb::Query'; 3 | 4 | use Carp 'croak'; 5 | use Scalar::Util 'looks_like_number'; 6 | use Rethinkdb::Protocol; 7 | 8 | has 'data'; 9 | has 'datumType' => sub { Rethinkdb::Protocol->new->datum->datumType; }; 10 | 11 | sub _build { 12 | my $self = shift; 13 | my $data = $self->data; 14 | 15 | my $hash = {}; 16 | 17 | if ( !defined $data ) { 18 | $hash = { type => $self->datumType->r_null }; 19 | } 20 | elsif ( looks_like_number $data ) { 21 | $hash = { type => $self->datumType->r_num, r_num => $data }; 22 | } 23 | elsif ( !ref $data ) { 24 | $hash = { type => $self->datumType->r_str, r_str => $data }; 25 | } 26 | elsif ( ref $data eq 'Rethinkdb::_True' || ref $data eq 'Rethinkdb::_False' ) 27 | { 28 | $hash = { type => $self->datumType->r_bool, r_bool => $data == 1 }; 29 | } 30 | else { 31 | croak "Got unknown Datum: $data"; 32 | } 33 | 34 | return { type => $self->_termType->datum, datum => $hash, }; 35 | } 36 | 37 | 1; 38 | 39 | =encoding utf8 40 | 41 | =head1 NAME 42 | 43 | Rethinkdb::Query::Datum - RethinkDB Query Datum 44 | 45 | =head1 SYNOPSIS 46 | 47 | =head1 DESCRIPTION 48 | 49 | L is the smallest building block in the RethinkDB 50 | Query Language. A datum can be thought of as a primative. A datum can have the 51 | following types: C, C, C, or C. 52 | 53 | =head1 ATTRIBUTES 54 | 55 | L implements the following attributes. 56 | 57 | =head2 data 58 | 59 | my $datum = r->expr('Lorem Ipsum'); 60 | say $datum->data; 61 | 62 | The actual datum value of this instance. 63 | 64 | =head2 datumType 65 | 66 | my $datum = r->expr('Lorem Ipsum'); 67 | say $datum->datumType; 68 | 69 | The actual RQL (RethinkDB Query Language) datum type of this instance. 70 | 71 | =head1 SEE ALSO 72 | 73 | L, L 74 | 75 | =cut 76 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | 0.14 2016-07-01 2 | - bumping to v0.12 3 | - callback should be passed to run() instead of changes() 4 | - update changes callback for clarity 5 | - pass along optargs to changes for things like include_initial 6 | - preping a release 7 | - filter nested keys in without() 8 | - fix for issue #28 9 | - adding new RethinkDB v2.3.4 functionality & tests 10 | - test needs to clean itself up + test for the correct thing 11 | - updating changes for last release 12 | 13 | 0.12 2016-04-29 14 | - Fix for Issue #22 15 | - Fixing some bad tests 16 | - Tested with RethinkDB v2.3.1 17 | 18 | 0.11 2015-09-17 19 | - RethinkDB 2.1.0-1 compatibility 20 | - Geospatial functionality 21 | - `index_create` now takes all possible parameters 22 | - Deprecating `attr` in favor of `bracket` 23 | - Cleaning & formatting 24 | 25 | 0.10 2015-07-28 26 | - 2.0.4 compatibility 27 | - Cleaning & formatting 28 | 29 | 0.09 2015-03-03 30 | - Updating to 1.16.2-1 functionality 31 | - Better test coverage 32 | - Fixes issues on older versions of Perl 33 | 34 | 0.08 2015-02-28 35 | - Updating to 1.15 functionality 36 | - Improving tests for new functionality 37 | - Tested against 1.16.2-1 38 | 39 | 0.07 2014-11-01 40 | - Query `run()` now takes an optional callback function 41 | 42 | 0.06 2014-08-29 43 | - Rearranging internal API 44 | - Documenting all modules 45 | 46 | 0.05 2014-08-10 47 | - Updating API to be compatible with 1.13.3 (using JSON Protcol) 48 | 49 | 0.04 2013-11-19 50 | - Updating tests to be more reliable (e.g. not relying on order that RethinkDB 51 | returns results) 52 | 53 | 0.03 2014-08-10 54 | - Date & time features added with tests 55 | - Tidying code with new .perltidyrc 56 | - Added LINCESE file 57 | - Added Makefile.PL and MANIFEST.SKIP for building 58 | 59 | 0.02 2013-08-27 60 | - Compatible with RethinkDB 1.8 61 | - All tests passing 62 | 63 | 0.01 2013-03-19 64 | - Initial code 65 | - Compatible with RethinkDB 1.3 66 | -------------------------------------------------------------------------------- /t/db.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | # setup 9 | r->connect->repl; 10 | r->db_drop('test')->run; 11 | r->db_drop('superheroes')->run; 12 | 13 | # 14 | # db methods from main class 15 | # 16 | isa_ok r->db_create('superheroes'), 'Rethinkdb::Query', 'correct class'; 17 | my $res = r->db_create('superheroes')->run; 18 | 19 | isa_ok $res, 'Rethinkdb::Response'; 20 | is $res->type, 1, 'Correct status code'; 21 | 22 | # list the databases 23 | isa_ok r->db_list, 'Rethinkdb::Query', 'correct class'; 24 | $res = r->db_list->run; 25 | isa_ok $res, 'Rethinkdb::Response'; 26 | is $res->type, 1, 'Correct status code'; 27 | 28 | my %dbs = map { $_ => 1 } @{ $res->response }; 29 | ok $dbs{rethinkdb}, 'Db was created and listed'; 30 | ok $dbs{superheroes}, 'Db was created and listed'; 31 | 32 | # drop the database 33 | isa_ok r->db_drop('superheroes'), 'Rethinkdb::Query', 'Correct class'; 34 | $res = r->db_drop('superheroes')->run; 35 | isa_ok $res, 'Rethinkdb::Response'; 36 | is $res->type, 1, 'Correct status code'; 37 | 38 | # run list and double check the drop 39 | # (this test doesn't seem to work any more) 40 | # $res = r->db_list->run; 41 | # ok !grep {/superheroes/} @{ $res->response }, 'Db is no longer listed'; 42 | 43 | # 44 | # db class methods 45 | # 46 | isa_ok r->db('superheroes'), 'Rethinkdb::Query::Database', 'correct class'; 47 | isa_ok r->db('superheroes')->create, 'Rethinkdb::Query', 'correct class'; 48 | $res = r->db('superheroes')->create->run; 49 | 50 | isa_ok $res, 'Rethinkdb::Response'; 51 | is $res->type, 1, 'Correct status code'; 52 | 53 | # list the databases 54 | isa_ok r->db->list, 'Rethinkdb::Query', 'correct class'; 55 | $res = r->db->list->run; 56 | 57 | isa_ok $res, 'Rethinkdb::Response'; 58 | is $res->type, 1, 'Correct status code'; 59 | # (this test doesn't seem to work any more) 60 | # ok grep {/superheroes/} @{ $res->response }, 'Db was created and listed'; 61 | 62 | # drop the database 63 | isa_ok r->db('superheroes')->drop, 'Rethinkdb::Query', 'correct class'; 64 | $res = r->db('superheroes')->drop->run; 65 | isa_ok $res, 'Rethinkdb::Response'; 66 | is $res->type, 1, 'Correct status code'; 67 | 68 | # double check the drop 69 | # (this test doesn't seem to work any more) 70 | # $res = r->db->list->run; 71 | # ok !grep {/superheroes/} @{ $res->response }, 'Db is no longer listed'; 72 | 73 | done_testing(); 74 | -------------------------------------------------------------------------------- /tools/mkproto.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use feature ':5.16'; 4 | 5 | use strict; 6 | use warnings; 7 | 8 | use Data::Dumper; 9 | 10 | sub convert { 11 | my $lines = shift; 12 | 13 | my $package = []; 14 | my $sub_package = []; 15 | my $new_lines = []; 16 | my $lc = q{}; 17 | 18 | foreach my $line ( @{$lines} ) { 19 | if ( $line =~ /^(\s*)(message) (?P\w+) \{/ ) { 20 | # if ( defined $1 && $2 && $3 ) { 21 | if ( defined $1 && $2 && $3 && $3 ne 'AssocPair' ) { 22 | $lc = lcfirst $3; 23 | push @{$new_lines}, @{$sub_package}, ''; 24 | push @{$new_lines}, "package Rethinkdb::Protocol::$3;"; 25 | push @{$new_lines}, 'use Rethinkdb::Base -base;'; 26 | push @{$package}, "has '$lc' => sub { Rethinkdb::Protocol::$3->new; };"; 27 | $sub_package = []; 28 | } 29 | } 30 | elsif ( $line =~ /^(\s*)(message|enum) (?P\w+) \{/ ) { 31 | if ( defined $1 && $2 && $3 ) { 32 | $lc = lcfirst $3; 33 | push @{$new_lines}, "has '$lc' => sub { Rethinkdb::Protocol::$3->new; };"; 34 | push @{$sub_package}, '', "package Rethinkdb::Protocol::$3;", 'use Rethinkdb::Base -base;'; 35 | # push @{$sub_package}, '1;', '', "package $3;", 'use Rethinkdb::Base -base;'; 36 | } 37 | } 38 | elsif ( $line =~ /^(\s*)(?P\w+)\s*=\s*(?P\w+)/ ) { 39 | if ( defined $1 && $2 && $3 ) { 40 | $lc = lc $2; 41 | push @{$sub_package}, "has '$lc' => $3;"; 42 | } 43 | } 44 | } 45 | 46 | if( @{$sub_package} ) { 47 | push @{$new_lines}, @{$sub_package}; 48 | } 49 | 50 | my $template = join '', ; 51 | my $content = join "\n", @{$package}; 52 | $content .= join "\n", @{$new_lines}; 53 | 54 | $template =~ s/{{CONTENT}}/$content/; 55 | 56 | return $template; 57 | } 58 | 59 | sub convert_write { 60 | my $input = shift; 61 | my $output = shift; 62 | 63 | open my $file, '<', $input or die "Could not open `$input`"; 64 | my @lines = <$file>; 65 | close $file; 66 | 67 | my $content = convert \@lines; 68 | 69 | open $file, '>', $output or die "Could not open `$output`"; 70 | say $file $content; 71 | close $file; 72 | } 73 | 74 | convert_write( 'external/ql2.proto', 'lib/Rethinkdb/Protocol.pm' ); 75 | say 'Done.'; 76 | 77 | __DATA__ 78 | 79 | # DO NOT EDIT 80 | # Autogenerated by mkproto.pl 81 | 82 | package Rethinkdb::Protocol; 83 | use Rethinkdb::Base -base; 84 | 85 | {{CONTENT}} 86 | 87 | 1; 88 | 89 | =encoding utf8 90 | 91 | =head1 NAME 92 | 93 | Rethinkdb::Protocol - Rethinkdb Protocol 94 | 95 | =head1 SYNOPSIS 96 | 97 | my $p = Rethinkdb::Protocol->new; 98 | $p->term->termType->get_all; 99 | 100 | =head1 DESCRIPTION 101 | 102 | This file is automatically generated to enable this driver to serialize & 103 | deserialize RethinkDB Query Langauge messages. 104 | 105 | =head1 ATTRIBUTES 106 | 107 | L implements the following attributes. 108 | 109 | =head2 backtrace 110 | 111 | Quick access to the C section of the protocol. 112 | 113 | =head2 datum 114 | 115 | Quick access to the C section of the protocol. 116 | 117 | =head2 frame 118 | 119 | Quick access to the C section of the protocol. 120 | 121 | =head2 query 122 | 123 | Quick access to the C section of the protocol. 124 | 125 | =head2 response 126 | 127 | Quick access to the C section of the protocol. 128 | 129 | =head2 term 130 | 131 | Quick access to the C section of the protocol. 132 | 133 | =head2 versionDummy 134 | 135 | Quick access to the C section of the protocol. 136 | 137 | =head1 SEE ALSO 138 | 139 | L, L 140 | 141 | =cut 142 | -------------------------------------------------------------------------------- /lib/Rethinkdb/Response.pm: -------------------------------------------------------------------------------- 1 | package Rethinkdb::Response; 2 | use Rethinkdb::Base -base; 3 | 4 | use JSON::PP; 5 | use Rethinkdb::Protocol; 6 | 7 | has [qw{ type type_description response token error_type backtrace profile }]; 8 | 9 | sub _init { 10 | my $class = shift; 11 | my $data = shift; 12 | my $optargs = shift || {}; 13 | my $args = { type => $data->{t}, token => $data->{token}, }; 14 | 15 | my $types = { 16 | 1 => 'success_atom', 17 | 2 => 'success_sequence', 18 | 3 => 'success_partial', 19 | 4 => 'wait_complete', 20 | 16 => 'client_error', 21 | 17 => 'compile_error', 22 | 18 => 'runtime_error', 23 | }; 24 | 25 | $args->{type_description} = $types->{ $data->{t} }; 26 | 27 | my $response = []; 28 | if ( $data->{r} ) { 29 | foreach ( @{ $data->{r} } ) { 30 | push @{$response}, $_; 31 | } 32 | } 33 | 34 | # not sure about this: 35 | if ( $data->{t} == 1 ) { 36 | $response = $response->[0]; 37 | } 38 | 39 | # group the data into a hash 40 | if ( !($optargs->{group_format} && $optargs->{group_format} eq 'raw') ) { 41 | if ( ref $response eq 'HASH' 42 | && $response->{'$reql_type$'} 43 | && $response->{'$reql_type$'} eq 'GROUPED_DATA' ) 44 | { 45 | my $group = {}; 46 | 47 | foreach ( @{ $response->{data} } ) { 48 | $group->{ $_->[0] } = $_->[1]; 49 | } 50 | 51 | $response = $group; 52 | } 53 | } 54 | 55 | $args->{response} = $response; 56 | 57 | if ( $data->{b} ) { 58 | $args->{backtrace} = $data->{b}; 59 | } 60 | 61 | if ( $data->{p} ) { 62 | $args->{profile} = $data->{p}; 63 | } 64 | 65 | if ( $data->{e} ) { 66 | $args->{error_type} = $data->{e}; 67 | } 68 | 69 | return $class->new($args); 70 | } 71 | 72 | 1; 73 | 74 | =encoding utf8 75 | 76 | =head1 NAME 77 | 78 | Rethinkdb::Response - RethinkDB Response 79 | 80 | =head1 SYNOPSIS 81 | 82 | package MyApp; 83 | use Rethinkdb; 84 | 85 | my $res = r->table('marvel')->run; 86 | say $res->type; 87 | say $res->type_description; 88 | say $res->response; 89 | say $res->token; 90 | say $res->error_type; 91 | say $res->profile; 92 | say $res->backtrace; 93 | 94 | =head1 DESCRIPTION 95 | 96 | All responses from the driver come as an instance of this class. 97 | 98 | =head1 ATTRIBUTES 99 | 100 | L implements the following attributes. 101 | 102 | =head2 type 103 | 104 | my $res = r->table('marvel')->run; 105 | say $res->type; 106 | 107 | The response type code. The current response types are: 108 | 109 | 'success_atom' => 1 110 | 'success_sequence' => 2 111 | 'success_partial' => 3 112 | 'success_feed' => 5 113 | 'wait_complete' => 4 114 | 'client_error' => 16 115 | 'compile_error' => 17 116 | 'runtime_error' => 18 117 | 118 | =head2 type_description 119 | 120 | my $res = r->table('marvel')->run; 121 | say $res->type_description; 122 | 123 | The response type description (e.g. C, C). 124 | 125 | =head2 response 126 | 127 | use Data::Dumper; 128 | my $res = r->table('marvel')->run; 129 | say Dumper $res->response; 130 | 131 | The actual response value from the database. 132 | 133 | =head2 token 134 | 135 | my $res = r->table('marvel')->run; 136 | say Dumper $res->token; 137 | 138 | Each request made to the database must have a unique token. The response from 139 | the database includes that token incase further actions are required. 140 | 141 | =head2 error_type 142 | 143 | my $res = r->table('marvel')->run; 144 | say $res->error_type; 145 | 146 | If the request cause an error, this attribute will contain the error message 147 | from the database. 148 | 149 | =head2 backtrace 150 | 151 | my $res = r->table('marvel')->run; 152 | say $res->backtrace; 153 | 154 | If the request cause an error, this attribute will contain a backtrace for the 155 | error. 156 | 157 | =head2 profile 158 | 159 | my $res = r->table('marvel')->run; 160 | say $res->profile; 161 | 162 | If profiling information was requested as a global argument for a query, then 163 | this attribute will contain that profiling data. 164 | 165 | =head1 SEE ALSO 166 | 167 | L, L 168 | 169 | =cut 170 | -------------------------------------------------------------------------------- /t/logic.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | # setup 9 | my $conn = r->connect->repl; 10 | 11 | # add 12 | my $res = r->expr(2)->add(2)->run($conn); 13 | is $res->response, 4, 'Addition: Mathematical response is okay'; 14 | 15 | $res = r->expr('Foo')->add('bar')->run($conn); 16 | is $res->response, 'Foobar', 'Addition: String concatenation response is okay'; 17 | 18 | $res = r->expr( [ 'foo', 'bar' ] )->add( ['buzz'] )->run($conn); 19 | is_deeply $res->response, [ 'foo', 'bar', 'buzz' ], 20 | 'Addition: Array concatenation response is okay'; 21 | 22 | # sub 23 | $res = r->expr(4)->sub(2)->run($conn); 24 | is $res->response, 2, 'Subtraction response is okay'; 25 | 26 | # mul 27 | $res = r->expr(2)->mul(2)->run($conn); 28 | is $res->response, 4, 'Multiplication: Mathematical response is okay'; 29 | 30 | $res = r->expr( [ 'This', 'is', 'the', 'song', 'that', 'never', 'ends.' ] ) 31 | ->mul(4)->run($conn); 32 | is_deeply $res->response, 33 | [ 34 | 'This', 'is', 'the', 'song', 'that', 'never', 'ends.', 'This', 35 | 'is', 'the', 'song', 'that', 'never', 'ends.', 'This', 'is', 36 | 'the', 'song', 'that', 'never', 'ends.', 'This', 'is', 'the', 37 | 'song', 'that', 'never', 'ends.' 38 | ], 39 | 'Multiplication: Periodic response is okay'; 40 | 41 | # div 42 | $res = r->expr(2)->div(2)->run($conn); 43 | is $res->response, 1, 'Division response is okay'; 44 | 45 | # mod 46 | $res = r->expr(2)->mod(2)->run($conn); 47 | is $res->response, 0, 'Mod response is okay'; 48 | 49 | # eq 50 | $res = r->expr(2)->eq(2)->run($conn); 51 | is $res->response, r->true, 'EQ response is okay'; 52 | 53 | # ne 54 | $res = r->expr(2)->ne(2)->run($conn); 55 | is $res->response, r->false, 'NE response is okay'; 56 | 57 | # gt 58 | $res = r->expr(2)->gt(2)->run($conn); 59 | is $res->response, r->false, 'GT response is okay'; 60 | 61 | # ge 62 | $res = r->expr(2)->ge(2)->run($conn); 63 | is $res->response, r->true, 'GE response is okay'; 64 | 65 | # lt 66 | $res = r->expr(2)->lt(2)->run($conn); 67 | is $res->response, r->false, 'LT response is okay'; 68 | 69 | # le 70 | $res = r->expr(2)->le(2)->run($conn); 71 | is $res->response, r->true, 'LE response is okay'; 72 | 73 | # and 74 | $res = r->expr( r->true )->and( r->false )->run($conn); 75 | is $res->response, r->false, 'AND response is okay'; 76 | 77 | # or 78 | $res = r->expr( r->true )->or( r->false )->run($conn); 79 | is $res->response, r->true, 'OR response is okay'; 80 | 81 | # not 82 | $res = r->expr( r->true )->not->run($conn); 83 | is $res->response, r->false, 'NOT response is okay'; 84 | 85 | # and 86 | $res = r->and( r->true, r->false )->run($conn); 87 | is $res->response, r->false, 'ALL response is okay'; 88 | 89 | # or 90 | $res = r->or( r->true, r->false )->run($conn); 91 | is $res->response, r->true, 'ANY response is okay'; 92 | 93 | # random 94 | $res = r->random->run($conn); 95 | cmp_ok $res->response, '>=', 0, 'Random response is okay'; 96 | cmp_ok $res->response, '<', 1, 'Random response is okay'; 97 | 98 | $res = r->random(100)->run($conn); 99 | cmp_ok $res->response, '>=', 0, 'Random response is okay'; 100 | cmp_ok $res->response, '<', 100, 'Random response is okay'; 101 | 102 | $res = r->random( 75, 100 )->run($conn); 103 | cmp_ok $res->response, '>=', 75, 'Random response is okay'; 104 | cmp_ok $res->response, '<', 100, 'Random response is okay'; 105 | 106 | $res = r->random( 1.59, -2.24, r->true )->run($conn); 107 | cmp_ok $res->response, '>', -2.24, 'Random response is okay'; 108 | cmp_ok $res->response, '<=', 1.59, 'Random response is okay'; 109 | 110 | # round 111 | $res = r->round(12.345)->run; 112 | is $res->response, 12, 'Round response is okay'; 113 | 114 | $res = r->expr(-12.645)->round->run($conn); 115 | is $res->response, -13, 'Round response is okay'; 116 | 117 | # ceil 118 | $res = r->ceil(12.345)->run; 119 | is $res->response, 13, 'Round response is okay'; 120 | 121 | $res = r->expr(-12.645)->ceil->run($conn); 122 | is $res->response, -12, 'Round response is okay'; 123 | 124 | # floor 125 | $res = r->floor(12.345)->run; 126 | is $res->response, 12, 'Round response is okay'; 127 | 128 | $res = r->expr(-12.645)->floor->run($conn); 129 | is $res->response, -13, 'Round response is okay'; 130 | 131 | done_testing(); 132 | -------------------------------------------------------------------------------- /lib/Rethinkdb/Util.pm: -------------------------------------------------------------------------------- 1 | package Rethinkdb::Util; 2 | use Rethinkdb::Base -base; 3 | 4 | use Scalar::Util 'blessed'; 5 | use JSON::PP 'encode_json'; 6 | use Carp 'croak'; 7 | 8 | use Rethinkdb::Query::Datum; 9 | use Rethinkdb::Protocol; 10 | 11 | my $PROTOCOL = Rethinkdb::Protocol->new; 12 | my $COUNTER = 0; 13 | 14 | sub _token { 15 | return $COUNTER++; 16 | } 17 | 18 | sub _wrap_func_helper { 19 | my $node = shift; 20 | 21 | if ( !( blessed $node && $node->isa('Rethinkdb::Query') ) ) { 22 | return; 23 | } 24 | 25 | if ( blessed $node 26 | && $node->_type 27 | && $node->_type eq $PROTOCOL->term->termType->implicit_var ) 28 | { 29 | return 1; 30 | } 31 | 32 | if ( $node->args ) { 33 | foreach ( @{ $node->args } ) { 34 | if ( _wrap_func_helper($_) ) { 35 | return 1; 36 | } 37 | } 38 | } 39 | 40 | return; 41 | } 42 | 43 | sub _wrap_func { 44 | my $self = shift; 45 | my $arg = shift; 46 | my $force = shift; 47 | 48 | my $val = $self->_expr($arg); 49 | 50 | if ( _wrap_func_helper $val ) { 51 | return $self->_make_func( sub ($) { $val; } ); 52 | } 53 | elsif( $force ) { 54 | return $self->_make_func( sub ($) { $val; } ); 55 | } 56 | 57 | return $val; 58 | } 59 | 60 | sub _expr { 61 | my $self = shift; 62 | my $value = shift; 63 | 64 | if ( blessed($value) && $value->can('_build') ) { 65 | return $value; 66 | } 67 | elsif ( ref $value eq 'ARRAY' ) { 68 | return $self->_make_array($value); 69 | } 70 | elsif ( ref $value eq 'HASH' ) { 71 | return $self->_make_obj($value); 72 | } 73 | elsif ( ref $value eq 'CODE' ) { 74 | return $self->_make_func($value); 75 | } 76 | else { 77 | return Rethinkdb::Query::Datum->new( { data => $value } ); 78 | } 79 | 80 | # to croak or not? 81 | return; 82 | } 83 | 84 | # try to make expr mostly JSON 85 | sub _expr_json { 86 | my $self = shift; 87 | my $value = shift; 88 | 89 | if ( blessed($value) && $value->can('_build') ) { 90 | return $value; 91 | } 92 | 93 | my $retval; 94 | eval { $retval = encode_json $value; }; 95 | 96 | if ( !$@ && $retval ) { 97 | return Rethinkdb::Query->new( 98 | _type => $PROTOCOL->term->termType->json, 99 | args => $retval 100 | ); 101 | } 102 | elsif ( ref $value eq 'ARRAY' ) { 103 | return $self->_make_array($value); 104 | } 105 | elsif ( ref $value eq 'HASH' ) { 106 | return $self->_make_obj($value); 107 | } 108 | elsif ( ref $value eq 'CODE' ) { 109 | return $self->_make_func($value); 110 | } 111 | else { 112 | return Rethinkdb::Query::Datum->new( { data => $value } ); 113 | } 114 | 115 | # to croak or not? 116 | return; 117 | } 118 | 119 | sub _make_array { 120 | my $self = shift; 121 | my $args = @_ ? @_ > 1 ? [@_] : [ @{ $_[0] } ] : []; 122 | 123 | my $obj = Rethinkdb::Query->new( 124 | _type => $PROTOCOL->term->termType->make_array, 125 | args => $args, 126 | ); 127 | 128 | return $obj; 129 | } 130 | 131 | sub _make_obj { 132 | my $self = shift; 133 | my $optargs = @_ ? @_ > 1 ? {@_} : { %{ $_[0] } } : {}; 134 | 135 | my $obj = Rethinkdb::Query->new( 136 | _type => $PROTOCOL->term->termType->make_obj, 137 | optargs => $optargs, 138 | ); 139 | 140 | return $obj; 141 | } 142 | 143 | sub _make_func { 144 | my $self = shift; 145 | my $func = shift; 146 | 147 | my $params = []; 148 | my $prototype = prototype $func; 149 | $prototype ||= '$'; 150 | my $param_length = length $prototype; 151 | 152 | foreach ( 1 .. $param_length ) { 153 | push @{$params}, 154 | Rethinkdb::Query->new( 155 | _type => $PROTOCOL->term->termType->var, 156 | args => $_, 157 | ); 158 | } 159 | 160 | my $body = $func->( @{$params} ); 161 | my $args = $self->_make_array( [ 1 .. $param_length ] ); 162 | 163 | my $obj = Rethinkdb::Query->new( 164 | _type => $PROTOCOL->term->termType->func, 165 | args => [ $args, $body ], 166 | ); 167 | 168 | return $obj; 169 | } 170 | 171 | 1; 172 | 173 | =encoding utf8 174 | 175 | =head1 NAME 176 | 177 | Rethinkdb::Util - RethinkDB Utilities 178 | 179 | =head1 DESCRIPTION 180 | 181 | This module contains internal utilities used by the RethinkDB perl driver. 182 | 183 | =head1 SEE ALSO 184 | 185 | L, L 186 | 187 | =cut 188 | -------------------------------------------------------------------------------- /t/writing.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | # setup 9 | r->connect->repl; 10 | r->db('test')->drop->run; 11 | r->db('test')->create->run; 12 | r->db('test')->table('marvel')->create( primary_key => 'superhero' )->run; 13 | 14 | # get an empty set 15 | my $res = r->db('test')->table('marvel')->run; 16 | 17 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 18 | is $res->type, 2, 'Correct status code'; 19 | is scalar @{ $res->response }, 0, 'Correctly shows table empty'; 20 | 21 | # insert one entry 22 | $res = r->table('marvel') 23 | ->insert( { superhero => 'Iron Man', superpower => 'Arc Reactor' } )->run; 24 | 25 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 26 | is $res->type, 1, 'Correct status code'; 27 | isa_ok $res->response, 'HASH', 'Response has correct type'; 28 | is $res->response->{inserted}, 1, 'Correct number of inserted'; 29 | 30 | # these are only set if the object we inserted did not have a primary_key value: 31 | # is scalar @{$res->response->{generated_keys}}, 1, 'Response has correct number of keys'; 32 | 33 | # list table entries just to double-check 34 | $res = r->db('test')->table('marvel')->run; 35 | 36 | is scalar @{ $res->response }, 1, 'Table contains correct number of entries'; 37 | is $res->response->[0]->{superhero}, 'Iron Man', 38 | 'Table contains correct first entry'; 39 | 40 | # insert multiple entries 41 | $res = r->table('marvel')->insert( 42 | [ 43 | { superhero => 'Wolverine', superpower => 'Adamantium' }, 44 | { superhero => 'Spider-Man', superpower => 'Spidy Sense' } 45 | ] 46 | )->run; 47 | 48 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 49 | is $res->type, 1, 'Correct status code'; 50 | isa_ok $res->response, 'HASH', 'Response has correct type'; 51 | is $res->response->{inserted}, 2, 'Correct number of inserted'; 52 | 53 | # these are only set if the object we inserted idd not have a primary_key value: 54 | # is scalar @{$res->response->{generated_keys}}, 2, 'Correct number of generated keys'; 55 | 56 | # list table entries just to double-check 57 | $res = r->db('test')->table('marvel')->run; 58 | 59 | is scalar @{ $res->response }, 3, 'Table contains correct number of entries'; 60 | 61 | # should we check all the names? 62 | 63 | # insert an entry with an existing primary_key should fail 64 | $res = r->table('marvel') 65 | ->insert( { superhero => 'Iron Man', superpower => 'Arc Reactor' } )->run; 66 | 67 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 68 | is $res->response->{errors}, 1, 'Correct number of errors'; 69 | is $res->response->{inserted}, 0, 'Correct number of inserts'; 70 | 71 | $res = r->table('marvel')->insert( 72 | [ 73 | { superhero => 'Iron Man', superpower => 'Arc Reactor' }, 74 | { superhero => 'Wolverine', superpower => 'Adamantium' }, 75 | { superhero => 'Spider-Man', superpower => 'Spidy Sense' } 76 | ] 77 | )->run; 78 | 79 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 80 | is $res->response->{errors}, 3, 'Correct number of errors'; 81 | is $res->response->{inserted}, 0, 'Correct number of inserts'; 82 | 83 | # forcing an insert should work tho 84 | $res 85 | = r->table('marvel') 86 | ->insert( { superhero => 'Iron Man', superpower => 'Mach 5' }, 87 | { conflict => 'replace' } )->run; 88 | 89 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 90 | 91 | is $res->response->{errors}, 0, 'Correct number of errors'; 92 | is $res->response->{inserted}, 0, 'Correct number of inserts'; 93 | is $res->response->{replaced}, 1, 'Correct number replaced'; 94 | 95 | # forcing an insert should work with "true" value too 96 | $res 97 | = r->table('marvel') 98 | ->insert( { superhero => 'Iron Man', superpower => 'Arc Reactor' }, 99 | { conflict => 'replace' } )->run; 100 | 101 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 102 | is $res->response->{replaced}, 1, 'Correct number replaced'; 103 | 104 | # Update 105 | $res = r->table('marvel')->get('Iron Man')->update( { age => 30 } )->run; 106 | 107 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 108 | is $res->response->{replaced}, 1, 'Correct number of updates'; 109 | 110 | # TODO: 111 | # $res = r->table('marvel')->update({ age => r->row('age')->add(1) })->run; 112 | 113 | # Replace / Modify 114 | $res = r->table('marvel')->get('Iron Man') 115 | ->replace( { superhero => 'Iron Man', age => 30 } )->run; 116 | 117 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 118 | is $res->response->{replaced}, 1, 'Correct number of modified documents'; 119 | 120 | # Delete one document 121 | $res = r->table('marvel')->get('Iron Man')->delete->run; 122 | 123 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 124 | is $res->response->{deleted}, 1, 'Correct number of deleted documents'; 125 | 126 | # Delete all the documents 127 | $res = r->table('marvel')->delete->run; 128 | 129 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 130 | is $res->response->{deleted}, 2, 'Correct number of deleted documents'; 131 | 132 | # clean up 133 | r->db('test')->drop->run; 134 | 135 | done_testing(); 136 | -------------------------------------------------------------------------------- /t/geo.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | # setup 9 | my $conn = r->connect->repl; 10 | r->db('test')->drop->run; 11 | r->db('test')->create->run; 12 | r->db('test')->table_create('geo')->run; 13 | r->db('test')->table('geo')->index_create( 'location', { geo => r->true } ) 14 | ->run; 15 | 16 | # circle 17 | my $res = r->table('geo')->insert( 18 | { 19 | 'id' => 300, 20 | 'name' => 'Hayes Valley', 21 | 'neighborhood' => r->circle( [ -122.423246, 37.779388 ], 1000 ) 22 | } 23 | )->run; 24 | 25 | is $res->type, 1, 'Correct response type'; 26 | is $res->response->{inserted}, 1, 'Correct response'; 27 | 28 | # distance 29 | my $point1 = r->point( -122.423246, 37.779388 ); 30 | my $point2 = r->point( -117.220406, 32.719464 ); 31 | $res = r->distance( $point1, $point2, { unit => 'km' } )->run($conn); 32 | 33 | is $res->type, 1, 'Correct response type'; 34 | like $res->response, qr/734.125/, 'Correct response'; 35 | 36 | # fill 37 | r->table('geo')->insert( 38 | { 39 | 'id' => 201, 40 | 'rectangle' => r->line( 41 | [ -122.423246, 37.779388 ], 42 | [ -122.423246, 37.329898 ], 43 | [ -121.886420, 37.329898 ], 44 | [ -121.886420, 37.779388 ] 45 | ) 46 | } 47 | )->run; 48 | 49 | $res 50 | = r->table('geo')->get(201) 51 | ->update( { 'rectangle' => r->row->bracket('rectangle')->fill }, 52 | { non_atomic => r->true } )->run; 53 | 54 | is $res->type, 1, 'Correct response type'; 55 | is $res->response->{replaced}, 1, 'Correct response'; 56 | 57 | # geojson 58 | my $geo_json 59 | = { 'type' => 'Point', 'coordinates' => [ -122.423246, 37.779388 ] }; 60 | 61 | $res = r->table('geo')->insert( 62 | { 63 | 'id' => 'sfo', 64 | 'name' => 'San Francisco', 65 | 'location' => r->geojson($geo_json) 66 | } 67 | )->run; 68 | 69 | is $res->type, 1, 'Correct response type'; 70 | is $res->response->{inserted}, 1, 'Correct response'; 71 | 72 | # to_geojson 73 | $res = r->table('geo')->get('sfo')->bracket('location')->to_geojson->run; 74 | 75 | is $res->type, 1, 'Correct response type'; 76 | is_deeply $res->response, $geo_json, 'Correct response'; 77 | 78 | # wait on the index since these next few tests require the index to be ready 79 | r->table('geo')->index_wait('location')->run; 80 | 81 | # get_intersecting 82 | my $circle1 = r->circle( [ -122.423246, 37.770378359 ], 10, { unit => 'mi' } ); 83 | $res = r->table('geo')->get_intersecting( $circle1, { index => 'location' } ) 84 | ->run; 85 | 86 | is $res->type, 2, 'Correct response type'; 87 | is $res->response->[0]->{id}, 'sfo', 'Correct response'; 88 | 89 | # get_nearest 90 | my $secret_base = r->point( -122.422876, 37.777128 ); 91 | $res 92 | = r->table('geo') 93 | ->get_nearest( $secret_base, { index => 'location', max_dist => 5000 } ) 94 | ->run; 95 | 96 | is $res->type, 1, 'Correct response type'; 97 | is $res->response->[0]->{doc}->{id}, 'sfo', 'Correct response'; 98 | is $res->response->[0]->{dist}, '252.951509509011', 'Correct response'; 99 | 100 | # includes 101 | $point1 = r->point( -117.220406, 32.719464 ); 102 | $point2 = r->point( -117.206201, 32.725186 ); 103 | $res = r->circle( $point1, 2000 )->includes($point2)->run($conn); 104 | 105 | is $res->type, 1, 'Correct response type'; 106 | is $res->response, r->true, 'Correct response'; 107 | 108 | # intersects 109 | $point1 = r->point( -117.220406, 32.719464 ); 110 | $point2 = r->point( -117.206201, 32.725186 ); 111 | $res = r->circle( $point1, 2000 )->intersects($point2)->run($conn); 112 | 113 | is $res->type, 1, 'Correct response type'; 114 | is $res->response, r->true, 'Correct response'; 115 | 116 | # line 117 | $res = r->table('geo')->insert( 118 | { 119 | id => 101, 120 | route => r->line( [ -122.423246, 37.779388 ], [ -121.886420, 37.329898 ] ) 121 | } 122 | )->run; 123 | 124 | is $res->type, 1, 'Correct response type'; 125 | is $res->response->{inserted}, 1, 'Correct response'; 126 | 127 | # point 128 | $res = r->table('geo')->insert( 129 | { 130 | id => 1, 131 | name => 'San Francisco', 132 | location => r->point( -122.423246, 37.779388 ) 133 | } 134 | )->run; 135 | 136 | is $res->type, 1, 'Correct response type'; 137 | is $res->response->{inserted}, 1, 'Correct response'; 138 | 139 | # polygon 140 | $res = r->table('geo')->insert( 141 | { 142 | id => 102, 143 | rectangle => r->polygon( 144 | [ -122.423246, 37.779388 ], 145 | [ -122.423246, 37.329898 ], 146 | [ -121.886420, 37.329898 ], 147 | [ -121.886420, 37.779388 ] 148 | ) 149 | } 150 | )->run; 151 | 152 | is $res->type, 1, 'Correct response type'; 153 | is $res->response->{inserted}, 1, 'Correct response'; 154 | 155 | # polygon_sub 156 | my $outer_polygon = r->polygon( 157 | [ -122.4, 37.7 ], 158 | [ -122.4, 37.3 ], 159 | [ -121.8, 37.3 ], 160 | [ -121.8, 37.7 ] 161 | ); 162 | my $inner_polygon = r->polygon( 163 | [ -122.3, 37.4 ], 164 | [ -122.3, 37.6 ], 165 | [ -122.0, 37.6 ], 166 | [ -122.0, 37.4 ] 167 | ); 168 | $res = $outer_polygon->polygon_sub($inner_polygon)->run($conn); 169 | 170 | is $res->type, 1, 'Correct response type'; 171 | isa_ok $res->response->{coordinates}, 'ARRAY', 'Correct response'; 172 | is $res->response->{type}, 'Polygon', 'Correct response'; 173 | is $res->response->{'$reql_type$'}, 'GEOMETRY', 'Correct response'; 174 | 175 | # clean up 176 | r->db('test')->drop->run; 177 | 178 | done_testing(); 179 | -------------------------------------------------------------------------------- /t/connect.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | # initialization 9 | my $r = Rethinkdb->new; 10 | isa_ok $r, 'Rethinkdb'; 11 | 12 | $r = r; 13 | isa_ok $r, 'Rethinkdb'; 14 | 15 | my $conn = r->connect; 16 | isa_ok $conn, 'Rethinkdb::IO'; 17 | 18 | # connect default values 19 | is $conn->host, 'localhost'; 20 | is $conn->port, 28015; 21 | is $conn->default_db, 'test'; 22 | is $conn->auth_key, ''; 23 | is $conn->timeout, 20; 24 | 25 | # other values for connect 26 | eval { my $r = r->connect('wiggle'); } or do { 27 | like $@, qr/ERROR: Could not connect to wiggle:28015/, 28 | 'Correct host connection error message'; 29 | }; 30 | 31 | eval { my $r = r->connect( 'localhost', 48015 ); } or do { 32 | like $@, qr/ERROR: Could not connect to localhost:48015/, 33 | 'Correct host connection error message'; 34 | }; 35 | 36 | $r = r->connect( 'localhost', 28015, 'better' ); 37 | isnt $r->default_db, 'test'; 38 | is $r->default_db, 'better', 'Correct `default_db` set'; 39 | 40 | # test auth_key 41 | eval { r->connect( 'localhost', 28015, 'better', 'hiddenkey' ); } or do { 42 | like $@, qr/ERROR: Incorrect authorization key./, 43 | 'Correct `auth_key` connection error message'; 44 | }; 45 | 46 | my $r = r->connect( 'localhost', 28015, 'better', '', 100 ); 47 | is $r->timeout, 100, 'Correct timeout set'; 48 | 49 | # query without connection should throw an error 50 | eval { r->db('test')->create->run; } or do { 51 | like $@, qr/ERROR: run\(\) was not given a connection/, 52 | 'Correct error on `run` without connection'; 53 | }; 54 | 55 | # internal stuff 56 | r->connect; 57 | is r->io, undef; 58 | 59 | r->connect->repl; 60 | isa_ok r->io, 'Rethinkdb::IO'; 61 | 62 | # close connection 63 | $conn = r->connect; 64 | isa_ok $conn->close, 'Rethinkdb::IO'; 65 | is $conn->_handle, undef; 66 | 67 | $conn = r->connect; 68 | isa_ok $conn->close( noreply_wait => 0 ), 'Rethinkdb::IO'; 69 | is $conn->_handle, undef; 70 | 71 | # reconnect 72 | isa_ok $conn->reconnect, 'Rethinkdb::IO'; 73 | isa_ok $conn->_handle, 'IO::Socket::INET'; 74 | is $conn->_handle->peerport, 28015; 75 | is $conn->_handle->peerhost, '127.0.0.1'; 76 | 77 | isa_ok $conn->reconnect( noreply_wait => 0 ), 'Rethinkdb::IO'; 78 | isa_ok $conn->_handle, 'IO::Socket::INET'; 79 | is $conn->_handle->peerport, 28015; 80 | is $conn->_handle->peerhost, '127.0.0.1'; 81 | 82 | # switch default databases 83 | $conn->use('test2'); 84 | is $conn->default_db, 'test2'; 85 | 86 | $conn->use('wiggle-waggle'); 87 | is $conn->default_db, 'wiggle-waggle'; 88 | 89 | # noreply_wait 90 | my $res = $conn->noreply_wait; 91 | is $res->type_description, 'wait_complete'; 92 | 93 | # testing run parameters 94 | 95 | # profile 96 | $res 97 | = r->db('rethinkdb')->table('logs')->nth(0)->run( { profile => r->true } ); 98 | isa_ok $res->profile, 'ARRAY', 'Correctly received profile data'; 99 | 100 | # durability (no real way to test the output) 101 | r->db('test')->drop->run; 102 | r->db('test')->create->run( { durability => 'soft' } ); 103 | 104 | r->db('test')->table('battle')->create->run; 105 | r->db('test')->table('battle')->insert( 106 | [ 107 | { 108 | id => 1, 109 | superhero => 'Iron Man', 110 | target => 'Mandarin', 111 | damage_dealt => 100, 112 | }, 113 | { 114 | id => 2, 115 | superhero => 'Wolverine', 116 | target => 'Sabretooth', 117 | damage_dealt => 40, 118 | }, 119 | { 120 | id => 3, 121 | superhero => 'Iron Man', 122 | target => 'Magneto', 123 | damage_dealt => 90, 124 | }, 125 | { 126 | id => 4, 127 | superhero => 'Wolverine', 128 | target => 'Magneto', 129 | damage_dealt => 10, 130 | }, 131 | { 132 | id => 5, 133 | superhero => 'Spider-Man', 134 | target => 'Green Goblin', 135 | damage_dealt => 20, 136 | } 137 | ] 138 | )->run; 139 | 140 | # group_format 141 | $res = r->db('test')->table('battle')->group('superhero') 142 | ->run( { group_format => 'raw' } ); 143 | 144 | is $res->response->{'$reql_type$'}, 'GROUPED_DATA', 145 | 'Correct group_format response data'; 146 | isa_ok $res->response->{data}, 'ARRAY', 'Correct group_format response data'; 147 | isa_ok $res->response->{data}[0][1], 'ARRAY', 148 | 'Correct group_format response data'; 149 | 150 | # db 151 | $res = r->table('cluster_config')->run( { db => 'rethinkdb' } ); 152 | ok( 153 | $res->response->[0]->{id} eq 'auth' 154 | or $res->response->[0]->{id} eq 'heartbeat' 155 | ), 156 | 'Correct response for db change'; 157 | 158 | # array_limit (doesn't seem to change response) 159 | r->db('test')->table('battle')->run( { array_limit => 2 } ); 160 | 161 | # noreply 162 | $res = r->db('test')->table('battle')->run( { noreply => 1 } ); 163 | is $res, undef, 'Correct response for noreply'; 164 | 165 | # test a callback 166 | $res = r->db('test')->table('battle')->run( 167 | sub { 168 | my $res = shift; 169 | isa_ok $res, 'Rethinkdb::Response', 'Correct response for callback'; 170 | } 171 | ); 172 | 173 | isa_ok $res, 'Rethinkdb::Response', 'Correct response for callback return'; 174 | 175 | # check default database parameter is being used 176 | r->connect( 'localhost', 28015, 'random' . int( rand(1000) ) )->repl; 177 | $res = r->table('superheroes')->create->run; 178 | 179 | is $res->{error_type}, 4100000, 'Expected error_type'; 180 | like $res->{response}->[0], qr/Database `random[0-9]+` does not exist./; 181 | 182 | # server information 183 | $res = r->server; 184 | 185 | is $res->type, 5, 'Expected response type'; 186 | is_deeply [ sort( keys %{ $res->response->[0] } ) ], 187 | [ 'id', 'name', 'proxy' ], 'Correct response keys'; 188 | like $res->response->[0]->{id}, 189 | qr/[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}/, 190 | 'Correct response'; 191 | 192 | $conn = r->connect; 193 | $res = $conn->server; 194 | 195 | is $res->type, 5, 'Expected response type'; 196 | is_deeply [ sort( keys %{ $res->response->[0] } ) ], 197 | [ 'id', 'name', 'proxy' ], 'Correct response keys'; 198 | like $res->response->[0]->{id}, 199 | qr/[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}/, 200 | 'Correct response'; 201 | 202 | # clean up 203 | r->db('test')->drop->run; 204 | 205 | done_testing(); 206 | -------------------------------------------------------------------------------- /t/joins.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | # setup 9 | r->connect->repl; 10 | r->db('test')->drop->run; 11 | r->db('test')->create->run; 12 | r->db('test')->table('marvel')->create( primary_key => 'superhero' )->run; 13 | r->table('marvel')->insert( 14 | [ 15 | { 16 | user_id => 1, 17 | superhero => 'Iron Man', 18 | superpower => 'Arc Reactor', 19 | active => 1, 20 | age => 35, 21 | strength => 35, 22 | dc_partner => 10, 23 | dc_buddy => 'Superman', 24 | }, 25 | { 26 | user_id => 2, 27 | superhero => 'Hulk', 28 | superpower => 'Smash', 29 | active => 1, 30 | age => 35, 31 | strength => 1000, 32 | dc_partner => 11, 33 | dc_buddy => 'Martian Manhunter', 34 | }, 35 | { 36 | user_id => 3, 37 | superhero => 'Captain America', 38 | superpower => 'Super Strength', 39 | active => 1, 40 | age => 135, 41 | strength => 136, 42 | dc_partner => 12, 43 | dc_buddy => 'Batman', 44 | }, 45 | { 46 | user_id => 4, 47 | superhero => 'Thor', 48 | superpower => 'God-like powers', 49 | active => 1, 50 | age => 1035, 51 | strength => 1000, 52 | dc_partner => 13, 53 | dc_buddy => '', 54 | }, 55 | { 56 | user_id => 5, 57 | superhero => 'Hawk-Eye', 58 | superpower => 'Bow-n-arrow', 59 | active => 0, 60 | age => 35, 61 | strength => 35, 62 | dc_partner => 14, 63 | dc_buddy => '', 64 | }, 65 | { 66 | user_id => 6, 67 | superhero => 'Wasp', 68 | superpower => 'Bio-lasers', 69 | active => 0, 70 | age => 35, 71 | strength => 35, 72 | dc_partner => 15, 73 | dc_buddy => '', 74 | }, 75 | { 76 | user_id => 7, 77 | superhero => 'Ant-Man', 78 | superpower => 'Size', 79 | active => 1, 80 | age => 35, 81 | strength => 45, 82 | dc_partner => 16, 83 | dc_buddy => '', 84 | }, 85 | { 86 | user_id => 8, 87 | superhero => 'Wolverine', 88 | superpower => 'Adamantium', 89 | active => 0, 90 | age => 35, 91 | strength => 135, 92 | dc_partner => 17, 93 | dc_buddy => '', 94 | }, 95 | { 96 | user_id => 9, 97 | superhero => 'Spider-Man', 98 | superpower => 'Spidy Sense', 99 | active => 0, 100 | age => 20, 101 | strength => 20, 102 | dc_partner => 18, 103 | dc_buddy => '', 104 | }, 105 | ] 106 | )->run; 107 | 108 | r->db('test')->table('dc')->create( primary_key => 'user_id' )->run; 109 | r->db('test')->table('dc')->index_create('name')->run; 110 | r->table('dc')->insert( 111 | [ 112 | { 113 | user_id => 10, 114 | name => 'Superman', 115 | superpower => 'Alien', 116 | active => 1, 117 | age => 35, 118 | strength => 350, 119 | }, 120 | { 121 | user_id => 11, 122 | name => 'Batman', 123 | superpower => 'Cunning', 124 | active => 1, 125 | age => 35, 126 | strength => 35, 127 | }, 128 | { 129 | user_id => 12, 130 | name => 'Flash', 131 | superpower => 'Super Speed', 132 | active => 1, 133 | age => 135, 134 | strength => 15, 135 | }, 136 | { 137 | user_id => 13, 138 | name => 'Wonder Women', 139 | superpower => 'Super Stregth', 140 | active => 1, 141 | age => 1035, 142 | strength => 25, 143 | }, 144 | { 145 | user_id => 14, 146 | name => 'Green Lantern', 147 | superpower => 'Ring', 148 | active => 0, 149 | age => 35, 150 | strength => 35, 151 | }, 152 | { 153 | user_id => 15, 154 | name => 'Aquaman', 155 | superpower => 'Hydrokinesis', 156 | active => 0, 157 | age => 35, 158 | strength => 20, 159 | }, 160 | { 161 | user_id => 16, 162 | name => 'Hawkman', 163 | superpower => 'Ninth Metal', 164 | active => 1, 165 | age => 35, 166 | strength => 50, 167 | }, 168 | { 169 | user_id => 17, 170 | name => 'Martian Manhunter', 171 | superpower => 'Shapeshifting', 172 | active => 0, 173 | age => 35, 174 | strength => 75, 175 | }, 176 | ] 177 | )->run; 178 | 179 | my $res; 180 | 181 | # inner_join 182 | $res = r->table('marvel')->inner_join( 183 | r->table('dc'), 184 | sub ($$) { 185 | my ( $marvel_row, $dc_row ) = @_; 186 | return $marvel_row->bracket('strength')-> 187 | lt( $dc_row->bracket('strength') ); 188 | } 189 | )->run; 190 | 191 | is $res->type, 2, 'Correct response type'; 192 | is scalar @{ $res->response }, 20, 'Correct response'; 193 | foreach ( @{ $res->response } ) { 194 | ok $_->{left}->{strength} < $_->{right}->{strength}, 'Correct response',; 195 | } 196 | 197 | # outer_join 198 | $res = r->table('marvel')->outer_join( 199 | r->table('dc'), 200 | sub ($$) { 201 | my ( $marvel_row, $dc_row ) = @_; 202 | return $marvel_row->bracket('strength')-> 203 | lt( $dc_row->bracket('strength') ); 204 | } 205 | )->run; 206 | 207 | is $res->type, 2, 'Correct response type'; 208 | is scalar @{ $res->response }, 22, 'Correct response'; 209 | foreach ( @{ $res->response } ) { 210 | if ( $_->{right} ) { 211 | ok $_->{left}->{strength} < $_->{right}->{strength}, 'Correct response'; 212 | } 213 | } 214 | 215 | # eq_join 216 | $res = r->table('marvel')->eq_join( 'dc_partner', r->table('dc') )->run; 217 | 218 | is $res->type, 2, 'Correct response type'; 219 | is scalar @{ $res->response }, 8, 'Correct number of documents returned'; 220 | 221 | # wait for index to be available 222 | r->db('test')->table('dc')->index_wait('name')->run; 223 | 224 | # eq_join with secondary index 225 | $res = r->table('marvel') 226 | ->eq_join( 'dc_buddy', r->table('dc'), { index => 'name' } )->run; 227 | 228 | is $res->type, 2, 'Correct response type'; 229 | is scalar @{ $res->response }, 3, 'Correct number of documents returned'; 230 | 231 | # zip 232 | $res = r->table('marvel')->eq_join( 'dc_partner', r->table('dc') )->zip->run; 233 | 234 | is $res->type, 2, 'Correct response type'; 235 | is scalar @{ $res->response }, 8, 'Correct number of documents returned'; 236 | 237 | # clean up 238 | r->db('test')->drop->run; 239 | 240 | done_testing(); 241 | -------------------------------------------------------------------------------- /lib/Rethinkdb/Base.pm: -------------------------------------------------------------------------------- 1 | package Rethinkdb::Base; 2 | 3 | use strict; 4 | use warnings; 5 | use utf8; 6 | use feature (); 7 | 8 | # No imports because we get subclassed, a lot! 9 | use Carp (); 10 | 11 | # Only Perl 5.14+ requires it on demand 12 | use IO::Handle (); 13 | 14 | sub import { 15 | my $class = shift; 16 | return unless my $flag = shift; 17 | no strict 'refs'; 18 | 19 | # Base 20 | if ( $flag eq '-base' ) { $flag = $class } 21 | 22 | # Strict 23 | elsif ( $flag eq '-strict' ) { $flag = undef } 24 | 25 | # Module 26 | else { 27 | my $file = $flag; 28 | $file =~ s/::|'/\//g; 29 | require "$file.pm" unless $flag->can('new'); 30 | } 31 | 32 | # ISA 33 | if ($flag) { 34 | my $caller = caller; 35 | push @{"${caller}::ISA"}, $flag; 36 | *{"${caller}::has"} = sub { attr( $caller, @_ ) }; 37 | } 38 | 39 | # Mojo modules are strict! 40 | strict->import; 41 | warnings->import; 42 | utf8->import; 43 | feature->import(':5.10'); 44 | } 45 | 46 | sub new { 47 | my $class = shift; 48 | bless @_ ? @_ > 1 ? {@_} : { %{ $_[0] } } : {}, ref $class || $class; 49 | } 50 | 51 | # Performance is very important for something as often used as accessors, 52 | # so we optimize them by compiling our own code, don't be scared, we have 53 | # tests for every single case 54 | sub attr { 55 | my ( $class, $attrs, $default ) = @_; 56 | return unless ( $class = ref $class || $class ) && $attrs; 57 | 58 | Carp::croak 'Default has to be a code reference or constant value' 59 | if ref $default && ref $default ne 'CODE'; 60 | 61 | # Compile attributes 62 | for my $attr ( @{ ref $attrs eq 'ARRAY' ? $attrs : [$attrs] } ) { 63 | Carp::croak qq{Attribute "$attr" invalid} unless $attr =~ /^[a-zA-Z_]\w*$/; 64 | 65 | # Header (check arguments) 66 | my $code = "package $class;\nsub $attr {\n if (\@_ == 1) {\n"; 67 | 68 | # No default value (return value) 69 | unless ( defined $default ) { $code .= " return \$_[0]{'$attr'};" } 70 | 71 | # Default value 72 | else { 73 | 74 | # Return value 75 | $code .= " return \$_[0]{'$attr'} if exists \$_[0]{'$attr'};\n"; 76 | 77 | # Return default value 78 | $code .= " return \$_[0]{'$attr'} = "; 79 | $code .= ref $default eq 'CODE' ? '$default->($_[0]);' : '$default;'; 80 | } 81 | 82 | # Store value 83 | $code .= "\n }\n \$_[0]{'$attr'} = \$_[1];\n"; 84 | 85 | # Footer (return invocant) 86 | $code .= " \$_[0];\n}"; 87 | 88 | # We compile custom attribute code for speed 89 | no strict 'refs'; 90 | warn "-- Attribute $attr in $class\n$code\n\n" if $ENV{RDB_BASE_DEBUG}; 91 | Carp::croak "Rethinkdb::Base error: $@" unless eval "$code;1"; 92 | } 93 | } 94 | 95 | sub tap { 96 | my ( $self, $cb ) = @_; 97 | $_->$cb for $self; 98 | return $self; 99 | } 100 | 101 | 1; 102 | 103 | =head1 NAME 104 | 105 | Rethinkdb::Base - Minimal base class 106 | 107 | =head1 SYNOPSIS 108 | 109 | package Cat; 110 | use Rethinkdb::Base -base; 111 | 112 | has name => 'Nyan'; 113 | has [qw(birds mice)] => 2; 114 | 115 | package Tiger; 116 | use Rethinkdb::Base 'Cat'; 117 | 118 | has friend => sub { Cat->new }; 119 | has stripes => 42; 120 | 121 | package main; 122 | use Rethinkdb::Base -strict; 123 | 124 | my $mew = Cat->new(name => 'Longcat'); 125 | say $mew->mice; 126 | say $mew->mice(3)->birds(4)->mice; 127 | 128 | my $rawr = Tiger->new(stripes => 23, mice => 0); 129 | say $rawr->tap(sub { $_->friend->name('Tacgnol') })->mice; 130 | 131 | =head1 DESCRIPTION 132 | 133 | L is a simple base class. 134 | 135 | # Automatically enables "strict", "warnings", "utf8" and Perl 5.10 features 136 | use Rethinkdb::Base -strict; 137 | use Rethinkdb::Base -base; 138 | use Rethinkdb::Base 'SomeBaseClass'; 139 | 140 | All three forms save a lot of typing. 141 | 142 | # use Rethinkdb::Base -strict; 143 | use strict; 144 | use warnings; 145 | use utf8; 146 | use feature ':5.10'; 147 | use IO::Handle (); 148 | 149 | # use Rethinkdb::Base -base; 150 | use strict; 151 | use warnings; 152 | use utf8; 153 | use feature ':5.10'; 154 | use IO::Handle (); 155 | use Rethinkdb::Base; 156 | push @ISA, 'Rethinkdb::Base'; 157 | sub has { Rethinkdb::Base::attr(__PACKAGE__, @_) } 158 | 159 | # use Rethinkdb::Base 'SomeBaseClass'; 160 | use strict; 161 | use warnings; 162 | use utf8; 163 | use feature ':5.10'; 164 | use IO::Handle (); 165 | require SomeBaseClass; 166 | push @ISA, 'SomeBaseClass'; 167 | use Rethinkdb::Base; 168 | sub has { Rethinkdb::Base::attr(__PACKAGE__, @_) } 169 | 170 | =head1 FUNCTIONS 171 | 172 | L exports the following functions if imported with the C<-base> 173 | flag or a base class. 174 | 175 | =head2 has 176 | 177 | has 'name'; 178 | has [qw(name1 name2 name3)]; 179 | has name => 'foo'; 180 | has name => sub {...}; 181 | has [qw(name1 name2 name3)] => 'foo'; 182 | has [qw(name1 name2 name3)] => sub {...}; 183 | 184 | Create attributes for hash-based objects, just like the C method. 185 | 186 | =head1 METHODS 187 | 188 | L implements the following methods. 189 | 190 | =head2 new 191 | 192 | my $object = BaseSubClass->new; 193 | my $object = BaseSubClass->new(name => 'value'); 194 | my $object = BaseSubClass->new({name => 'value'}); 195 | 196 | This base class provides a basic constructor for hash-based objects. You can 197 | pass it either a hash or a hash reference with attribute values. 198 | 199 | =head2 attr 200 | 201 | $object->attr('name'); 202 | BaseSubClass->attr('name'); 203 | BaseSubClass->attr([qw(name1 name2 name3)]); 204 | BaseSubClass->attr(name => 'foo'); 205 | BaseSubClass->attr(name => sub {...}); 206 | BaseSubClass->attr([qw(name1 name2 name3)] => 'foo'); 207 | BaseSubClass->attr([qw(name1 name2 name3)] => sub {...}); 208 | 209 | Create attribute accessor for hash-based objects, an array reference can be 210 | used to create more than one at a time. Pass an optional second argument to 211 | set a default value, it should be a constant or a callback. The callback will 212 | be excuted at accessor read time if there's no set value. Accessors can be 213 | chained, that means they return their invocant when they are called with an 214 | argument. 215 | 216 | =head2 tap 217 | 218 | $object = $object->tap(sub {...}); 219 | 220 | K combinator, tap into a method chain to perform operations on an object 221 | within the chain. 222 | 223 | =head1 DEBUGGING 224 | 225 | You can set the RDB_BASE_DEBUG environment variable to get some advanced 226 | diagnostics information printed to C. 227 | 228 | RDB_BASE_DEBUG=1 229 | 230 | =head1 COPYRIGHT AND LICENSE 231 | 232 | This package was taken from the Mojolicious project. 233 | 234 | Copyright (C) 2008-2013, Sebastian Riedel. 235 | 236 | =head1 SEE ALSO 237 | 238 | L, L, L. 239 | 240 | =cut 241 | -------------------------------------------------------------------------------- /lib/Rethinkdb/Query/Database.pm: -------------------------------------------------------------------------------- 1 | package Rethinkdb::Query::Database; 2 | use Rethinkdb::Base 'Rethinkdb::Query'; 3 | 4 | use Scalar::Util 'weaken'; 5 | 6 | has [qw{ _rdb name }]; 7 | has '_type' => sub { return Rethinkdb::Protocol->new->term->termType->db; }; 8 | 9 | sub create { 10 | my $self = shift; 11 | my $name = shift || $self->name; 12 | 13 | my $q = Rethinkdb::Query->new( 14 | _rdb => $self->_rdb, 15 | _type => $self->_termType->db_create, 16 | args => $name, 17 | ); 18 | 19 | weaken $q->{_rdb}; 20 | return $q; 21 | } 22 | 23 | sub drop { 24 | my $self = shift; 25 | my $name = shift || $self->name; 26 | 27 | my $q = Rethinkdb::Query->new( 28 | _rdb => $self->_rdb, 29 | _type => $self->_termType->db_drop, 30 | args => $name, 31 | ); 32 | 33 | weaken $q->{_rdb}; 34 | return $q; 35 | } 36 | 37 | sub list { 38 | my $self = shift; 39 | 40 | my $q = Rethinkdb::Query->new( 41 | _rdb => $self->_rdb, 42 | _type => $self->_termType->db_list, 43 | ); 44 | 45 | weaken $q->{_rdb}; 46 | return $q; 47 | } 48 | 49 | sub table_create { 50 | my $self = shift; 51 | my $args = shift; 52 | my $optargs = ref $_[0] ? $_[0] : {@_}; 53 | 54 | my $q = Rethinkdb::Query->new( 55 | _parent => $self, 56 | _type => $self->_termType->table_create, 57 | args => $args, 58 | optargs => $optargs, 59 | ); 60 | 61 | return $q; 62 | } 63 | 64 | sub table_drop { 65 | my $self = shift; 66 | my $args = shift; 67 | 68 | my $q = Rethinkdb::Query->new( 69 | _parent => $self, 70 | _type => $self->_termType->table_drop, 71 | args => $args, 72 | ); 73 | 74 | return $q; 75 | } 76 | 77 | sub table_list { 78 | my $self = shift; 79 | 80 | my $q = Rethinkdb::Query->new( 81 | _parent => $self, 82 | _type => $self->_termType->table_list, 83 | ); 84 | 85 | return $q; 86 | } 87 | 88 | sub table { 89 | my $self = shift; 90 | my $name = shift; 91 | my $outdated = shift; 92 | 93 | my $optargs = {}; 94 | if ($outdated) { 95 | $optargs = { use_outdated => 1 }; 96 | } 97 | 98 | my $t = Rethinkdb::Query::Table->new( 99 | _parent => $self, 100 | _type => $self->_termType->table, 101 | name => $name, 102 | args => $name, 103 | optargs => $optargs, 104 | ); 105 | 106 | return $t; 107 | } 108 | 109 | sub grant { 110 | my $self = shift; 111 | my $user = shift; 112 | my $perms = shift; 113 | 114 | my $q = Rethinkdb::Query->new( 115 | _rdb => $self->_rdb, 116 | _type => $self->_termType->grant, 117 | args => [ $user, $perms ] 118 | ); 119 | 120 | return $q; 121 | } 122 | 123 | sub config { 124 | my $self = shift; 125 | 126 | my $q = Rethinkdb::Query->new( 127 | _parent => $self, 128 | _type => $self->_termType->config, 129 | ); 130 | 131 | return $q; 132 | } 133 | 134 | sub rebalance { 135 | my $self = shift; 136 | 137 | my $q = Rethinkdb::Query->new( 138 | _parent => $self, 139 | _type => $self->_termType->rebalance, 140 | ); 141 | 142 | return $q; 143 | } 144 | 145 | sub reconfigure { 146 | my $self = shift; 147 | my $args = shift; 148 | 149 | my $q = Rethinkdb::Query->new( 150 | _parent => $self, 151 | _type => $self->_termType->reconfigure, 152 | optargs => $args 153 | ); 154 | 155 | return $q; 156 | } 157 | 158 | sub wait { 159 | my $self = shift; 160 | 161 | my $q = Rethinkdb::Query->new( 162 | _parent => $self, 163 | _type => $self->_termType->wait, 164 | ); 165 | 166 | return $q; 167 | } 168 | 169 | 1; 170 | 171 | =encoding utf8 172 | 173 | =head1 NAME 174 | 175 | Rethinkdb::Query::Database - RethinkDB Query Database 176 | 177 | =head1 SYNOPSIS 178 | 179 | =head1 DESCRIPTION 180 | 181 | L is a type of query that represents a database. 182 | This classes contains methods to interact with a database or the underlying 183 | tables. 184 | 185 | =head1 ATTRIBUTES 186 | 187 | L implements the following attributes. 188 | 189 | =head2 name 190 | 191 | my $db = r->db('better'); 192 | say $db->name; 193 | 194 | The name of the database. 195 | 196 | =head1 METHODS 197 | 198 | =head2 create 199 | 200 | r->db('test')->create('superheroes')->run; 201 | 202 | Create a database. A RethinkDB database is a collection of tables, similar to 203 | relational databases. 204 | 205 | If successful, the operation returns an object: C<< {created => 1} >>. If a 206 | database with the same name already exists the operation returns an 207 | C. 208 | 209 | B: that you can only use alphanumeric characters and underscores for the 210 | database name. 211 | 212 | =head2 drop 213 | 214 | r->db('comics')->drop('superheroes')->run; 215 | 216 | Drop a database. The database, all its tables, and corresponding data will be 217 | deleted. 218 | 219 | If successful, the operation returns the object C<< {dropped => 1} >>. If the 220 | specified database doesn't exist a C will be returned. 221 | 222 | =head2 list 223 | 224 | r->db('sillyStuff')->list->run; 225 | 226 | List all database names in the system. The result is a list of strings. 227 | 228 | =head2 table 229 | 230 | r->db('newStuff')->table('weapons')->run; 231 | 232 | Select all documents in a table from this database. This command can be chained 233 | with other commands to do further processing on the data. 234 | 235 | =head2 table_create 236 | 237 | r->db('test')->table_create('dc_universe')->run; 238 | 239 | Create a table. A RethinkDB table is a collection of JSON documents. 240 | 241 | If successful, the operation returns an object: C<< {created => 1} >>. If a 242 | table with the same name already exists, the operation returns a 243 | C. 244 | 245 | B that you can only use alphanumeric characters and underscores for the 246 | table name. 247 | 248 | =head2 table_drop 249 | 250 | r->db('test')->table_drop('dc_universe')->run; 251 | 252 | Drop a table. The table and all its data will be deleted. 253 | 254 | If successful, the operation returns an object: C<< {dropped => 1} >>. If the 255 | specified table doesn't exist a C is returned. 256 | 257 | =head2 table_list 258 | 259 | r->db('test')->table_list->run; 260 | 261 | List all table names in a database. The result is a list of strings. 262 | 263 | =head2 grant 264 | 265 | r->db('test') 266 | ->grant( 'username', { read => r->true, write => r->false } )->run; 267 | 268 | Grant or deny access permissions for a user account on a database. 269 | 270 | =head2 config 271 | 272 | r->db('test')->config->run; 273 | 274 | Query (read and/or update) the configurations for individual databases. 275 | 276 | =head2 rebalance 277 | 278 | r->db('test')->rebalance->run; 279 | 280 | Rebalances the shards of all tables in the database. 281 | 282 | =head2 reconfigure 283 | 284 | r->db('test')->reconfigure({ shards => 2, replicas => 1 })->run; 285 | r->db('test')->reconfigure( 286 | { 287 | shards => 2, 288 | replicas => { wooster => 1, wayne => 1 }, 289 | primary_replica_tag => 'wooster' 290 | } 291 | )->run; 292 | 293 | Reconfigure all table's sharding and replication. 294 | 295 | =head2 wait 296 | 297 | r->db('test')->wait->run; 298 | 299 | Wait for all the tables in a database to be ready. A table may be 300 | temporarily unavailable after creation, rebalancing or reconfiguring. 301 | The L command blocks until the given database is fully up to date. 302 | 303 | =cut 304 | -------------------------------------------------------------------------------- /t/table.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | # setup 9 | r->connect->repl; 10 | r->db('test')->drop->run; 11 | r->db('test')->create->run; 12 | r->db('test')->table_create('geo')->run; 13 | 14 | # 15 | # db class methods for table 16 | # 17 | 18 | # db->table_create(table_name[, primary_key=None, primary_datacenter=None, cache_size=None]) 19 | isa_ok r->db('test')->table_create('dcuniverse'), 'Rethinkdb::Query', 20 | 'Correct class'; 21 | my $res = r->db('test')->table_create('dcuniverse')->run; 22 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 23 | is $res->type, 1, 'Correct status code'; 24 | 25 | # db->table_list 26 | isa_ok r->db('test')->table_list, 'Rethinkdb::Query', 'Correct class'; 27 | $res = r->db('test')->table_list->run; 28 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 29 | ok grep {/dcuniverse/} @{ $res->response }, 'Table was listed'; 30 | 31 | # db->table_drop 32 | isa_ok r->db('test')->table_drop('dcuniverse'), 'Rethinkdb::Query', 33 | 'Correct class'; 34 | $res = r->db('test')->table_drop('dcuniverse')->run; 35 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 36 | is $res->type, 1, 'Correct status code'; 37 | 38 | # check table_list to make sure table_drop worked 39 | $res = r->db('test')->table_list->run; 40 | ok !grep {/dcuniverse/} @{ $res->response }, 'Table was listed'; 41 | 42 | TODO: { 43 | local $TODO = 'Need to write tests for table parameters'; 44 | 45 | # r->db('test')->table_create('dcuniverse', { primary_key => 'name' })->run; 46 | # r->db('test')->table_create('dcuniverse', { primary_key => 'name', primary_datacenter => '' })->run; 47 | # r->db('test')->table_create('dcuniverse', { primary_key => 'name', cache_size => 500 })->run; 48 | # r->db('test')->table_create('dcuniverse', { primary_key => 'name', durability => 'soft' })->run; 49 | } 50 | 51 | # 52 | # table class methods 53 | # 54 | isa_ok r->db('test')->table('dcuniverse'), 'Rethinkdb::Query::Table', 55 | 'Correct class'; 56 | isa_ok r->db('test')->table('dcuniverse')->_rdb, 'Rethinkdb', 57 | 'Correctly has reference'; 58 | 59 | # create table 60 | isa_ok r->db('test')->table('dcuniverse')->create, 'Rethinkdb::Query', 61 | 'Correct class'; 62 | $res = r->db('test')->table('dcuniverse')->create->run; 63 | 64 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 65 | is $res->type, 1, 'Correct status code'; 66 | 67 | # create a simple secondary index 68 | $res = r->db('test')->table('dcuniverse')->index_create('alias')->run; 69 | 70 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 71 | is $res->response->{created}, 1, 'Index was created'; 72 | 73 | # list secondary index 74 | $res = r->db('test')->table('dcuniverse')->index_list->run; 75 | 76 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 77 | is_deeply $res->response, ['alias'], 'Indexes were listed'; 78 | 79 | # rename index 80 | $res = r->db('test')->table('dcuniverse')->index_rename( 'alias', 'pseudonym' ) 81 | ->run; 82 | 83 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 84 | is $res->response->{renamed}, 1, 'Index was renamed'; 85 | 86 | # index_status - for one particular index 87 | $res = r->db('test')->table('dcuniverse')->index_status('pseudonym')->run; 88 | 89 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 90 | isa_ok $res->response, 'ARRAY', 'Correct return type'; 91 | is scalar @{ $res->response }, 1, 'Correct return type'; 92 | 93 | # index_status - for all indexes on table 94 | $res = r->db('test')->table('dcuniverse')->index_status->run; 95 | 96 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 97 | isa_ok $res->response, 'ARRAY', 'Correct return type'; 98 | is scalar @{ $res->response }, 1, 'Correct return type'; 99 | 100 | # index_wait - for one particular index 101 | $res = r->db('test')->table('dcuniverse')->index_wait('pseudonym')->run; 102 | 103 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 104 | isa_ok $res->response, 'ARRAY', 'Correct return type'; 105 | is scalar @{ $res->response }, 1, 'Correct return type'; 106 | 107 | # index_wait - for all indexes on table 108 | $res = r->db('test')->table('dcuniverse')->index_wait->run; 109 | 110 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 111 | isa_ok $res->response, 'ARRAY', 'Correct return type'; 112 | is scalar @{ $res->response }, 1, 'Correct return type'; 113 | 114 | # drop secondary index 115 | $res = r->db('test')->table('dcuniverse')->index_drop('pseudonym')->run; 116 | 117 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 118 | is $res->response->{dropped}, 1, 'Index was dropped'; 119 | 120 | # create a simple index based on the field 121 | $res 122 | = r->db('test')->table('dcuniverse') 123 | ->index_create( 'alias_name', r->row->bracket('alias')->bracket('name') ) 124 | ->run; 125 | 126 | is $res->response->{created}, 1, 'Index was created'; 127 | 128 | # create a geospatial index 129 | $res = r->db('test')->table('dcuniverse') 130 | ->index_create( 'last_seen', { geo => r->true } )->run; 131 | 132 | is $res->response->{created}, 1, 'Index was created'; 133 | 134 | # create a compound index based on the fields post_id and date 135 | $res 136 | = r->db('test')->table('dcuniverse') 137 | ->index_create( 'location_and_date', 138 | [ r->row->bracket('location'), r->row->bracket('date') ] )->run; 139 | 140 | is $res->response->{created}, 1, 'Index was created'; 141 | 142 | # create a multi index 143 | $res = r->db('test')->table('dcuniverse') 144 | ->index_create( 'friends', { multi => r->true } )->run; 145 | 146 | is $res->response->{created}, 1, 'Index was created'; 147 | 148 | # create a geospatial multi index based on the field 149 | $res = r->db('test')->table('dcuniverse') 150 | ->index_create( 'cities', { multi => r->true, geo => r->true } )->run; 151 | 152 | is $res->response->{created}, 1, 'Index was created'; 153 | 154 | # create an index based on an arbitrary expression 155 | $res = r->table('dcuniverse')->index_create( 156 | 'authors', 157 | sub { 158 | my $doc = shift; 159 | return r->branch( 160 | $doc->has_fields('updated_at'), 161 | $doc->bracket('updated_at'), 162 | $doc->bracket('created_at') 163 | ); 164 | } 165 | )->run; 166 | 167 | is $res->response->{created}, 1, 'Index was created'; 168 | 169 | # create a new secondary index based on an existing one 170 | $res = r->table('dcuniverse')->index_status('authors')->nth(0) 171 | ->bracket('function')->run; 172 | $res = r->table('dcuniverse')->index_create( 'authors_bkup', $res->response ) 173 | ->run; 174 | 175 | is $res->response->{created}, 1, 'Index was created'; 176 | 177 | # changes 178 | TODO: { 179 | local $TODO = 'Need to write tests for table changes'; 180 | 181 | # r->table('dcuniverse')->changes->run(sub { 182 | # my $res = shift; 183 | # }); 184 | } 185 | 186 | # sync 187 | $res = r->table('dcuniverse')->sync->run; 188 | 189 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 190 | is $res->response->{synced}, 1, 'Index was dropped'; 191 | 192 | # drop table 193 | isa_ok r->db('test')->table('dcuniverse')->drop, 'Rethinkdb::Query', 194 | 'Correct class'; 195 | $res = r->db('test')->table('dcuniverse')->drop->run; 196 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 197 | is $res->type, 1, 'Correct status code'; 198 | 199 | TODO: { 200 | local $TODO = 'Need to write tests for table parameters'; 201 | 202 | # r->db('test')->table('dcuniverse', { primary_key => 'name' })->create->run; 203 | # r->db('test')->table('dcuniverse', { primary_key => 'name', primary_datacenter => '' })->create->run; 204 | # r->db('test')->table('dcuniverse', { primary_key => 'name', cache_size => 500 })->create->run; 205 | # r->db('test')->table('dcuniverse', { primary_key => 'name', durability => 'soft' })->create->run; 206 | } 207 | 208 | # clean up 209 | r->db('test')->drop->run; 210 | 211 | done_testing(); 212 | -------------------------------------------------------------------------------- /t/control.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | # setup 9 | my $conn = r->connect->repl; 10 | r->db('test')->drop->run; 11 | r->db('test')->create->run; 12 | r->db('test')->table('marvel')->create( primary_key => 'superhero' )->run; 13 | r->table('marvel')->insert( 14 | [ 15 | { 16 | user_id => 1, 17 | superhero => 'Iron Man', 18 | superpower => 'Arc Reactor', 19 | active => 1, 20 | age => 35, 21 | victories => 2, 22 | battles => 3, 23 | villainDefeated => 'Mandarin', 24 | outfits => 12, 25 | gadget => 'Shoulder-mounted rocket launcher' 26 | }, 27 | { 28 | user_id => 8, 29 | superhero => 'Wolverine', 30 | superpower => 'Adamantium', 31 | age => 40, 32 | victories => 12, 33 | battles => 3, 34 | villainDefeated => 'Sabretooth', 35 | outfits => 2, 36 | }, 37 | { 38 | user_id => 9, 39 | superhero => 'Spider-Man', 40 | superpower => 'Spidy Sense', 41 | age => 20, 42 | victories => 24, 43 | battles => 3, 44 | villainDefeated => 'Green Goblin', 45 | gadget => 'Web-slinger' 46 | } 47 | ] 48 | )->run; 49 | r->db('test')->table('villains')->create( primary_key => 'name' )->run; 50 | r->table('villains')->insert( 51 | [ 52 | { name => 'Mandarin', }, 53 | { name => 'Sabretooth', }, 54 | { name => 'Green Goblin' } 55 | ] 56 | )->run; 57 | 58 | my $res; 59 | 60 | # args 61 | $res = r->table('marvel')->get_all( r->args( [ 'Spider-Man', 'Wolverine' ] ), 62 | { index => 'superhero' } )->run; 63 | 64 | is $res->type, 2, 'Correct response type'; 65 | is_deeply [ sort map { $_->{superhero} } @{ $res->response } ], 66 | [ 'Spider-Man', 'Wolverine' ], 'Correct response'; 67 | 68 | # do 69 | my $res = r->do( 70 | r->table('marvel')->get('Iron Man'), 71 | sub ($) { 72 | my $ironman = shift; 73 | $ironman->bracket('superpower'); 74 | } 75 | )->run; 76 | 77 | is $res->type, 1, 'Correct response type'; 78 | is $res->response, 'Arc Reactor', 'Correct response'; 79 | 80 | # branch 81 | r->table('marvel')->map( 82 | r->branch( 83 | 84 | # r->row->bracket('victories')->gt(100), 85 | sub { shift->bracket('victories')->gt(1); }, 86 | 87 | # r->true, 88 | sub { shift->bracket('superhero')->add(' is a superhero'); }, 89 | sub { shift->bracket('superhero')->add(' is a hero'); } 90 | ) 91 | )->run; 92 | 93 | # for_each 94 | $res = r->table('marvel')->for_each( 95 | sub { 96 | my $hero = shift; 97 | return r->table('villains')->get( $hero->bracket('villainDefeated') ) 98 | ->delete; 99 | } 100 | )->run; 101 | 102 | is $res->type, 1, 'Correct response type'; 103 | is $res->response->{deleted}, 3, 'Correct response'; 104 | 105 | # error 106 | $res = r->table('marvel')->get('Iron Man')->do( 107 | sub { 108 | my $ironman = shift; 109 | r->branch( 110 | $ironman->bracket('victories')->lt( $ironman->bracket('battles') ), 111 | r->error('impossible code path'), $ironman ); 112 | } 113 | )->run; 114 | 115 | is $res->type, 18, 'Correct response type'; 116 | is $res->response->[0], 'impossible code path', 'Correct response'; 117 | 118 | # default 119 | $res = r->table('marvel')->map( 120 | sub { 121 | my $stuff = shift; 122 | $stuff->bracket('outfits')->default(0) 123 | ->add( $stuff->bracket('active')->default(0) ); 124 | } 125 | )->run; 126 | 127 | is $res->type, 2, 'Correct response type'; 128 | is_deeply [ sort { $a <=> $b } @{ $res->response } ], [ '0', '2', '13' ], 129 | 'Correct response'; 130 | 131 | $res = r->table('marvel')->map(r->row->bracket('gadget')->default)->run; 132 | 133 | is $res->type, 2, 'Correct response type'; 134 | is_deeply [ sort @{ $res->response } ], [ undef, 'Shoulder-mounted rocket launcher', 'Web-slinger' ], 135 | 'Correct response'; 136 | 137 | 138 | # expr 139 | $res = r->expr( { 'a' => 'b' } )->merge( { 'b' => [ 1, 2, 3 ] } )->run($conn); 140 | 141 | is $res->type, 1, 'Correct response type'; 142 | is_deeply $res->response, { 'a' => 'b', 'b' => [ '1', '2', '3' ] }, 143 | 'Correct response'; 144 | 145 | # js 146 | $res = r->js("'str1' + 'str2'")->run; 147 | 148 | is $res->type, 1, 'Correct response type'; 149 | is $res->response, 'str1str2', 'Correct response'; 150 | 151 | # js with function 152 | $res = r->table('marvel') 153 | ->filter( r->js('(function (row) { return row.age > 35; })') )->run($conn); 154 | 155 | is $res->type, 2, 'Correct response type'; 156 | is $res->response->[0]->{superhero}, 'Wolverine', 'Correct response type'; 157 | 158 | # js with timeout 159 | $res = r->js( 'while(true) {}', 1.3 )->run($conn); 160 | 161 | is $res->type, 18, 'Correct response type'; 162 | is $res->response->[0], 163 | 'JavaScript query `while(true) {}` timed out after 1.300 seconds.', 164 | 'Correct response'; 165 | 166 | # coerce_to 167 | $res = r->table('marvel')->coerce_to('array')->run; 168 | 169 | is $res->type, 1, 'Correct response type'; 170 | isa_ok $res->response, 'ARRAY', 'Correct response'; 171 | 172 | $res = r->expr( [ [ 'name', 'Iron Man' ], [ 'victories', 2000 ] ] ) 173 | ->coerce_to('object')->run($conn); 174 | 175 | is $res->type, 1, 'Correct response type'; 176 | isa_ok $res->response, 'HASH', 'Correct response'; 177 | 178 | $res = r->expr(1)->coerce_to('string')->run($conn); 179 | 180 | is $res->type, 1, 'Correct response type'; 181 | is $res->response, '1', 'Correct response'; 182 | 183 | # type_of 184 | $res = r->expr("foo")->type_of->run($conn); 185 | 186 | is $res->type, 1, 'Correct response type'; 187 | is $res->response, 'STRING', 'Correct response'; 188 | 189 | # info 190 | $res = r->table('marvel')->info->run($conn); 191 | 192 | is $res->type, 1, 'Correct response type'; 193 | 194 | $res->response->{db}->{id} = ''; 195 | $res->response->{id} = ''; 196 | $res->response->{doc_count_estimates} = [6]; 197 | 198 | is_deeply $res->response, 199 | { 200 | primary_key => 'superhero', 201 | db => { name => 'test', type => 'DB', id => '' }, 202 | name => 'marvel', 203 | type => 'TABLE', 204 | id => '', 205 | indexes => [], 206 | doc_count_estimates => [6] 207 | }, 208 | 'Correct response'; 209 | 210 | # json 211 | $res = r->json("[1,2,3]")->run($conn); 212 | 213 | is $res->type, 1, 'Correct response type'; 214 | is_deeply $res->response, [ '1', '2', '3' ], 'Correct response'; 215 | 216 | # http 217 | $res = r->http('http://httpbin.org/get')->run($conn); 218 | 219 | is $res->type, 1, 'Correct response type'; 220 | like $res->response->{headers}->{'User-Agent'}, qr/RethinkDB\/\d+\.\d+\.\d+/, 221 | 'Correct response'; 222 | 223 | r->db('test')->table_create('posts')->run($conn); 224 | $res 225 | = r->table('posts')->insert( r->http('http://httpbin.org/get') )->run($conn); 226 | 227 | is $res->type, 1, 'Correct response type'; 228 | is $res->response->{inserted}, 1, 'Correct response'; 229 | 230 | my $data = { player => 'Bob', game => 'tic tac toe' }; 231 | 232 | $res 233 | = r->http( 'http://httpbin.org/post', { method => 'POST', data => $data } ) 234 | ->run($conn); 235 | 236 | is $res->type, 1, 'Correct response type'; 237 | is_deeply $res->response->{form}, $data, 'Correct response'; 238 | 239 | # uuid 240 | $res = r->uuid->run; 241 | 242 | is $res->type, 1, 'Correct response type'; 243 | like $res->response, 244 | qr/[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}/, 245 | 'Correct response'; 246 | 247 | # clean up 248 | r->db('test')->drop->run; 249 | 250 | done_testing(); 251 | -------------------------------------------------------------------------------- /t/selecting.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | # setup 9 | r->connect->repl; 10 | r->db('test')->drop->run; 11 | r->db('test')->create->run; 12 | r->db('test')->table('marvel')->create( primary_key => 'superhero' )->run; 13 | r->db('test')->table('marvel')->index_create('superpower')->run; 14 | r->db('test')->table('marvel')->index_create('user_id')->run; 15 | r->table('marvel')->insert( 16 | [ 17 | { 18 | user_id => 1, 19 | superhero => 'Iron Man', 20 | superpower => 'Arc Reactor', 21 | active => 1, 22 | age => 35 23 | }, 24 | { 25 | user_id => 8, 26 | superhero => 'Wolverine', 27 | superpower => 'Adamantium', 28 | active => 0, 29 | age => 35 30 | }, 31 | { 32 | user_id => 9, 33 | superhero => 'Spider-Man', 34 | superpower => 'Spidy Sense', 35 | active => 0, 36 | age => 20 37 | } 38 | ] 39 | )->run; 40 | 41 | # two ways to do the same thing: 42 | my $res = r->db('test')->table('marvel')->run; 43 | my $res2 = r->table('marvel')->run; 44 | 45 | # everything should be the same but the tokens 46 | $res2->token( $res->token ); 47 | is_deeply $res, $res2; 48 | 49 | # fetch (possibly) out-dated results 50 | r->table('marvel')->insert( 51 | [ 52 | { 53 | user_id => 2, 54 | superhero => 'Hulk', 55 | superpower => 'Smash', 56 | active => 1, 57 | age => 35 58 | }, 59 | { 60 | user_id => 3, 61 | superhero => 'Captain America', 62 | superpower => 'Super Strength', 63 | active => 1, 64 | age => 135 65 | }, 66 | { 67 | user_id => 4, 68 | superhero => 'Thor', 69 | superpower => 'God-like powers', 70 | active => 1, 71 | age => 1035 72 | }, 73 | { 74 | user_id => 5, 75 | superhero => 'Hawk-Eye', 76 | superpower => 'Bow-n-arrow', 77 | active => 0, 78 | age => 35 79 | }, 80 | { 81 | user_id => 6, 82 | superhero => 'Wasp', 83 | superpower => 'Bio-lasers', 84 | active => 0, 85 | age => 35 86 | }, 87 | { 88 | user_id => 7, 89 | superhero => 'Ant-Man', 90 | superpower => 'Size', 91 | active => 1, 92 | age => 35 93 | }, 94 | ] 95 | )->run; 96 | 97 | # TODO: how to really test for this 98 | $res = r->db('test')->table( 'marvel', 1 )->run; 99 | $res2 = r->db('test')->table( 'marvel', r->true )->run; 100 | 101 | # everything should be the same but the tokens 102 | $res2->token( $res->token ); 103 | is_deeply $res, $res2; 104 | 105 | # get Document 106 | $res = r->table('marvel')->get('Spider-Man')->run; 107 | 108 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 109 | is $res->type, 1, 'Correct status code'; 110 | is $res->response->{superhero}, 'Spider-Man', 'Correct response'; 111 | 112 | # wait for indexes to be ready_for_reads 113 | r->table('marvel')->index_wait('superpower')->run; 114 | r->table('marvel')->index_wait('user_id')->run; 115 | 116 | # get all Documents with correct key 117 | $res 118 | = r->table('marvel')->get_all( 'Size', 'Smash', { index => 'superpower' } ) 119 | ->run; 120 | 121 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 122 | is $res->type, 2, 'Correct status code'; 123 | isa_ok $res->response, 'ARRAY', 'Correct response'; 124 | is scalar @{ $res->response }, 2, 'Correct number of documents returned'; 125 | 126 | # Select a couple items (should fail because we there is no ID key) 127 | $res = r->table('marvel')->between( 2, 7 )->run; 128 | 129 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 130 | is $res->type, 18, 'Correct status code'; 131 | is $res->response->[0], 'Index `id` was not found on table `test.marvel`.'; 132 | 133 | # Select a couple items with correct key 134 | $res = r->table('marvel')->between( 2, 7, 'user_id' )->run; 135 | 136 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 137 | is $res->type, 2, 'Correct status code'; 138 | isa_ok $res->response, 'ARRAY', 'Correct response type'; 139 | is scalar @{ $res->response }, 5, 'Correct number of documents returned'; 140 | 141 | # Select using special constants 142 | $res = r->table('marvel')->between( r->minval, 7, 'user_id' )->run; 143 | 144 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 145 | is $res->type, 2, 'Correct status code'; 146 | isa_ok $res->response, 'ARRAY', 'Correct response type'; 147 | is scalar @{ $res->response }, 6, 'Correct number of documents returned'; 148 | 149 | $res = r->table('marvel')->between( 2, r->maxval, 'user_id' )->run; 150 | 151 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 152 | is $res->type, 2, 'Correct status code'; 153 | isa_ok $res->response, 'ARRAY', 'Correct response type'; 154 | is scalar @{ $res->response }, 8, 'Correct number of documents returned'; 155 | 156 | # Select a couple items with correct key, with parameters 157 | $res = r->table('marvel')->between( 2, 7, 'user_id', 'open', 'closed' )->run; 158 | 159 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 160 | is $res->type, 2, 'Correct status code'; 161 | isa_ok $res->response, 'ARRAY', 'Correct response type'; 162 | is scalar @{ $res->response }, 5, 'Correct number of documents returned'; 163 | 164 | # Select a couple items with correct key, with parameter hash 165 | $res 166 | = r->table('marvel') 167 | ->between( 2, 7, 168 | { index => 'user_id', left_bound => 'open', right_bound => 'closed' } )->run; 169 | 170 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 171 | is $res->type, 2, 'Correct status code'; 172 | isa_ok $res->response, 'ARRAY', 'Correct response type'; 173 | is scalar @{ $res->response }, 5, 'Correct number of documents returned'; 174 | 175 | # Filter results 176 | $res = r->table('marvel')->filter( { active => 1 } )->run; 177 | 178 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 179 | is $res->type, 2, 'Correct status code'; 180 | isa_ok $res->response, 'ARRAY', 'Correct response type'; 181 | is scalar @{ $res->response }, 5, 'Correct number of documents returned'; 182 | 183 | # Filter on multiple attributes 184 | $res = r->table('marvel') 185 | ->filter( { active => 1, age => 35, superpower => 'Size' } )->run; 186 | 187 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 188 | is $res->type, 2, 'Correct status code'; 189 | isa_ok $res->response, 'ARRAY', 'Correct response type'; 190 | is scalar @{ $res->response }, 1, 'Correct number of documents returned'; 191 | is $res->response->[0]->{superhero}, 'Ant-Man', 'Correct document returned'; 192 | 193 | # Filter with EXPR predicate 194 | # $res = r->table('marvel')->filter(r->true)->run; 195 | $res = r->table('marvel')->filter( r->row->bracket('age')->gt(100) )->run; 196 | 197 | is $res->type, 2, 'Correct status code'; 198 | is_deeply [ sort { $a->{user_id} cmp $b->{user_id} } @{ $res->response } ], 199 | [ 200 | { 201 | active => '1', 202 | superhero => 'Captain America', 203 | user_id => '3', 204 | age => '135', 205 | superpower => 'Super Strength' 206 | }, 207 | { 208 | active => '1', 209 | superhero => 'Thor', 210 | user_id => '4', 211 | age => '1035', 212 | superpower => 'God-like powers' 213 | } 214 | ], 215 | 'Correct response type'; 216 | 217 | # Filter with CODE predicate 218 | $res = r->table('marvel')->filter( 219 | sub { 220 | my $hero = shift; 221 | return $hero->bracket('age')->gt(100); 222 | } 223 | )->order_by('user_id')->run; 224 | 225 | is $res->type, 1, 'Correct status code'; 226 | is_deeply $res->response, 227 | [ 228 | { 229 | active => '1', 230 | superhero => 'Captain America', 231 | user_id => '3', 232 | age => '135', 233 | superpower => 'Super Strength' 234 | }, 235 | { 236 | active => '1', 237 | superhero => 'Thor', 238 | user_id => '4', 239 | age => '1035', 240 | superpower => 'God-like powers' 241 | } 242 | ], 243 | 'Correct response type'; 244 | 245 | # clean up 246 | r->db('test')->drop->run; 247 | 248 | done_testing(); 249 | -------------------------------------------------------------------------------- /t/transformations.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | # setup 9 | my $conn = r->connect->repl; 10 | r->db('test')->drop->run; 11 | r->db('test')->create->run; 12 | r->db('test')->table('marvel')->create( primary_key => 'superhero' )->run; 13 | r->table('marvel')->insert( 14 | [ 15 | { 16 | user_id => 1, 17 | superhero => 'Iron Man', 18 | superpower => 'Arc Reactor', 19 | active => 1, 20 | age => 35, 21 | monsters => ['Wererabit'] 22 | }, 23 | { 24 | user_id => 2, 25 | superhero => 'Hulk', 26 | superpower => 'Smash', 27 | active => 1, 28 | age => 38, 29 | monsters => ['Werewolf'] 30 | }, 31 | { 32 | user_id => 3, 33 | superhero => 'Captain America', 34 | superpower => 'Super Strength', 35 | active => 1, 36 | age => 135, 37 | monsters => ['Werecat'] 38 | }, 39 | { 40 | user_id => 4, 41 | superhero => 'Thor', 42 | superpower => 'God-like powers', 43 | active => 1, 44 | age => 1035, 45 | monsters => ['Weredog'] 46 | }, 47 | { 48 | user_id => 5, 49 | superhero => 'Hawk-Eye', 50 | superpower => 'Bow-n-arrow', 51 | active => 0, 52 | age => 32, 53 | monsters => ['Werehound'] 54 | }, 55 | { 56 | user_id => 6, 57 | superhero => 'Wasp', 58 | superpower => 'Bio-lasers', 59 | active => 0, 60 | age => 29, 61 | monsters => ['Wereelephant'] 62 | }, 63 | { 64 | user_id => 7, 65 | superhero => 'Ant-Man', 66 | superpower => 'Size', 67 | active => 1, 68 | age => 34, 69 | monsters => ['Werebear'] 70 | }, 71 | { 72 | user_id => 8, 73 | superhero => 'Wolverine', 74 | superpower => 'Adamantium', 75 | active => 0, 76 | age => 40, 77 | monsters => ['Werehampster'] 78 | }, 79 | { 80 | user_id => 9, 81 | superhero => 'Spider-Man', 82 | superpower => 'Spidy Sense', 83 | active => 0, 84 | age => 20, 85 | monsters => [ 'Werepig', 'Werechicken' ] 86 | }, 87 | ] 88 | )->run; 89 | 90 | r->db('test')->table('dc')->create( primary_key => 'superhero' )->run; 91 | r->table('dc')->insert( 92 | [ 93 | { 94 | user_id => 10, 95 | superhero => '271', 96 | superpower => 'Alien', 97 | active => 1, 98 | age => 35 99 | }, 100 | { 101 | user_id => 11, 102 | superhero => 'Batman', 103 | superpower => 'Cunning', 104 | active => 1, 105 | age => 35 106 | }, 107 | { 108 | user_id => 12, 109 | superhero => 'Flash', 110 | superpower => 'Super Speed', 111 | active => 1, 112 | age => 135 113 | }, 114 | { 115 | user_id => 13, 116 | superhero => 'Wonder Women', 117 | superpower => 'Super Stregth', 118 | active => 1, 119 | age => 1035 120 | }, 121 | { 122 | user_id => 14, 123 | superhero => 'Green Lantern', 124 | superpower => 'Ring', 125 | active => 0, 126 | age => 35 127 | }, 128 | { 129 | user_id => 15, 130 | superhero => 'Aquaman', 131 | superpower => 'Hydrokinesis', 132 | active => 0, 133 | age => 35 134 | }, 135 | { 136 | user_id => 16, 137 | superhero => 'Hawkman', 138 | superpower => 'Ninth Metal', 139 | active => 1, 140 | age => 35 141 | }, 142 | { 143 | user_id => 17, 144 | superhero => 'Martian Manhunter', 145 | superpower => 'Shapeshifting', 146 | active => 0, 147 | age => 35 148 | }, 149 | ] 150 | )->run; 151 | 152 | my $res; 153 | 154 | # map 155 | $res = r->table('marvel')->map( 156 | sub { 157 | my $hero = shift; 158 | return $hero->bracket('user_id')->add( $hero->bracket('age')->mul(2) ); 159 | } 160 | )->run; 161 | 162 | is $res->type, 2, 'Correct response type'; 163 | 164 | is_deeply [ sort @{ $res->response } ], 165 | [ '2074', '273', '49', '64', '69', '71', '75', '78', '88' ], 166 | 'Correct number of documents'; 167 | 168 | # with_fields 169 | $res = r->table('marvel')->with_fields( 'superhero', 'age' )->run; 170 | 171 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 172 | is $res->type, 2, 'Correct response type'; 173 | is scalar @{ $res->response }, 9, 'Correct number of documents'; 174 | is_deeply [ sort keys %{ $res->response->[0] } ], [ 'age', 'superhero' ], 175 | 'Correct document fields'; 176 | 177 | # concat_map 178 | $res = r->table('marvel')->concat_map( 179 | sub { 180 | my $hero = shift; 181 | return $hero->bracket('monsters'); 182 | } 183 | )->run; 184 | 185 | is $res->type, 2, 'Correct response type'; 186 | is_deeply [ sort @{ $res->response } ], 187 | [ 188 | 'Werebear', 'Werecat', 'Werechicken', 'Weredog', 189 | 'Wereelephant', 'Werehampster', 'Werehound', 'Werepig', 190 | 'Wererabit', 'Werewolf', 191 | ], 192 | 'Correct document fields'; 193 | 194 | # order_by 195 | $res = r->table('marvel')->order_by('superhero')->run; 196 | 197 | isa_ok $res, 'Rethinkdb::Response', 'Correct class'; 198 | is $res->type, 1, 'Correct response type'; 199 | isa_ok $res->response, 'ARRAY', 'Correct response type'; 200 | is scalar @{ $res->response }, 9, 'Correct number of documents returned'; 201 | is_deeply [ map { $_->{superhero} } @{ $res->response } ], 202 | [ 203 | 'Ant-Man', 'Captain America', 'Hawk-Eye', 'Hulk', 204 | 'Iron Man', 'Spider-Man', 'Thor', 'Wasp', 205 | 'Wolverine' 206 | ], 207 | 'Correct order'; 208 | 209 | my $order = [ 210 | 'Spider-Man', 'Wasp', 'Hawk-Eye', 'Ant-Man', 211 | 'Iron Man', 'Hulk', 'Wolverine', 'Captain America', 212 | 'Thor' 213 | ]; 214 | 215 | # order by two attributes 216 | $res = r->table('marvel')->order_by( 'age', 'superhero' )->run; 217 | 218 | is_deeply [ map { $_->{superhero} } @{ $res->response } ], $order, 219 | 'Correct order'; 220 | 221 | # order with asc/desc 222 | $res 223 | = r->table('marvel')->order_by( r->desc('age'), r->asc('superhero') )->run; 224 | 225 | is_deeply [ map { $_->{superhero} } @{ $res->response } ], 226 | [ reverse @{$order} ], 'Correct order'; 227 | 228 | # skip 229 | $res = r->table('marvel')->order_by('superhero')->skip(7)->run; 230 | 231 | is $res->type, 1, 'Correct response type'; 232 | is $res->response->[0]->{superhero}, 'Wasp', 'Correct response'; 233 | is $res->response->[1]->{superhero}, 'Wolverine', 'Correct response'; 234 | 235 | # limit 236 | $res = r->table('marvel')->limit(2)->run; 237 | 238 | is $res->type, 2, 'Correct response type'; 239 | is scalar @{ $res->response }, 2, 'Correct number of documents'; 240 | 241 | # slice 242 | # $r->table('marvel')->order_by('strength')[5:10]->run; 243 | # $res = r->table('marvel')->order_by('superhero')->slice(1, 3)->run; 244 | $res = r->table('marvel')->slice( 5, 7 )->run; 245 | 246 | is $res->type, 2, 'Correct response type'; 247 | is scalar @{ $res->response }, 2, 'Correct number of documents'; 248 | 249 | # nth 250 | # $r->expr([1,2,3])[1]->run; 251 | # $res = r->expr([1,2,3])->nth(1)->run; 252 | $res = r->table('marvel')->nth(1)->run; 253 | 254 | is $res->type, 1, 'Correct response type'; 255 | isa_ok $res->response, 'HASH', 'Correct type of response'; 256 | 257 | # offsets_of 258 | $res = r->expr( [ 'a', 'b', 'c' ] )->offsets_of('c')->run($conn); 259 | 260 | is $res->type, 1, 'Correct response type'; 261 | is_deeply $res->response, [2], 'Correct response'; 262 | 263 | $res 264 | = r->table('marvel')->union( r->table('dc') )->order_by('popularity') 265 | ->offsets_of( r->row->bracket('superpowers')->contains('invisibility') ) 266 | ->run; 267 | 268 | # is_empty 269 | $res = r->table('marvel')->is_empty->run; 270 | 271 | is $res->type, 1, 'Correct response type'; 272 | is $res->response, r->false, 'Correct response'; 273 | 274 | # union 275 | $res = r->table('marvel')->union( r->table('dc') )->run; 276 | 277 | is $res->type, 2, 'Correct response type'; 278 | is scalar @{ $res->response }, 17, 'Correct response'; 279 | 280 | # sample 281 | $res = r->table('marvel')->sample(3)->run; 282 | 283 | is $res->type, 1, 'Correct response type'; 284 | is scalar @{ $res->response }, 3, 'Correct response'; 285 | 286 | # clean up 287 | r->db('test')->drop->run; 288 | 289 | done_testing(); 290 | -------------------------------------------------------------------------------- /lib/Rethinkdb/Protocol.pm: -------------------------------------------------------------------------------- 1 | 2 | # DO NOT EDIT 3 | # Autogenerated by mkproto.pl 4 | 5 | package Rethinkdb::Protocol; 6 | use Rethinkdb::Base -base; 7 | 8 | has 'versionDummy' => sub { Rethinkdb::Protocol::VersionDummy->new; }; 9 | has 'query' => sub { Rethinkdb::Protocol::Query->new; }; 10 | has 'frame' => sub { Rethinkdb::Protocol::Frame->new; }; 11 | has 'backtrace' => sub { Rethinkdb::Protocol::Backtrace->new; }; 12 | has 'response' => sub { Rethinkdb::Protocol::Response->new; }; 13 | has 'datum' => sub { Rethinkdb::Protocol::Datum->new; }; 14 | has 'term' => sub { Rethinkdb::Protocol::Term->new; }; 15 | package Rethinkdb::Protocol::VersionDummy; 16 | use Rethinkdb::Base -base; 17 | has 'version' => sub { Rethinkdb::Protocol::Version->new; }; 18 | has 'protocol' => sub { Rethinkdb::Protocol::Protocol->new; }; 19 | 20 | package Rethinkdb::Protocol::Version; 21 | use Rethinkdb::Base -base; 22 | has 'v0_1' => 0x3f61ba36; 23 | has 'v0_2' => 0x723081e1; 24 | has 'v0_3' => 0x5f75e83e; 25 | has 'v0_4' => 0x400c2d20; 26 | has 'v1_0' => 0x34c2bdc3; 27 | 28 | package Rethinkdb::Protocol::Protocol; 29 | use Rethinkdb::Base -base; 30 | has 'protobuf' => 0x271ffc41; 31 | has 'json' => 0x7e6970c7; 32 | 33 | package Rethinkdb::Protocol::Query; 34 | use Rethinkdb::Base -base; 35 | has 'queryType' => sub { Rethinkdb::Protocol::QueryType->new; }; 36 | 37 | package Rethinkdb::Protocol::QueryType; 38 | use Rethinkdb::Base -base; 39 | has 'start' => 1; 40 | has 'continue' => 2; 41 | has 'stop' => 3; 42 | has 'noreply_wait' => 4; 43 | has 'server_info' => 5; 44 | 45 | package Rethinkdb::Protocol::Frame; 46 | use Rethinkdb::Base -base; 47 | has 'frameType' => sub { Rethinkdb::Protocol::FrameType->new; }; 48 | 49 | package Rethinkdb::Protocol::FrameType; 50 | use Rethinkdb::Base -base; 51 | has 'pos' => 1; 52 | has 'opt' => 2; 53 | 54 | package Rethinkdb::Protocol::Backtrace; 55 | use Rethinkdb::Base -base; 56 | 57 | package Rethinkdb::Protocol::Response; 58 | use Rethinkdb::Base -base; 59 | has 'responseType' => sub { Rethinkdb::Protocol::ResponseType->new; }; 60 | has 'errorType' => sub { Rethinkdb::Protocol::ErrorType->new; }; 61 | has 'responseNote' => sub { Rethinkdb::Protocol::ResponseNote->new; }; 62 | 63 | package Rethinkdb::Protocol::ResponseType; 64 | use Rethinkdb::Base -base; 65 | has 'success_atom' => 1; 66 | has 'success_sequence' => 2; 67 | has 'success_partial' => 3; 68 | has 'wait_complete' => 4; 69 | has 'server_info' => 5; 70 | has 'client_error' => 16; 71 | has 'compile_error' => 17; 72 | has 'runtime_error' => 18; 73 | 74 | package Rethinkdb::Protocol::ErrorType; 75 | use Rethinkdb::Base -base; 76 | has 'internal' => 1000000; 77 | has 'resource_limit' => 2000000; 78 | has 'query_logic' => 3000000; 79 | has 'non_existence' => 3100000; 80 | has 'op_failed' => 4100000; 81 | has 'op_indeterminate' => 4200000; 82 | has 'user' => 5000000; 83 | has 'permission_error' => 6000000; 84 | 85 | package Rethinkdb::Protocol::ResponseNote; 86 | use Rethinkdb::Base -base; 87 | has 'sequence_feed' => 1; 88 | has 'atom_feed' => 2; 89 | has 'order_by_limit_feed' => 3; 90 | has 'unioned_feed' => 4; 91 | has 'includes_states' => 5; 92 | 93 | package Rethinkdb::Protocol::Datum; 94 | use Rethinkdb::Base -base; 95 | has 'datumType' => sub { Rethinkdb::Protocol::DatumType->new; }; 96 | 97 | package Rethinkdb::Protocol::DatumType; 98 | use Rethinkdb::Base -base; 99 | has 'r_null' => 1; 100 | has 'r_bool' => 2; 101 | has 'r_num' => 3; 102 | has 'r_str' => 4; 103 | has 'r_array' => 5; 104 | has 'r_object' => 6; 105 | has 'r_json' => 7; 106 | 107 | package Rethinkdb::Protocol::Term; 108 | use Rethinkdb::Base -base; 109 | has 'termType' => sub { Rethinkdb::Protocol::TermType->new; }; 110 | 111 | package Rethinkdb::Protocol::TermType; 112 | use Rethinkdb::Base -base; 113 | has 'datum' => 1; 114 | has 'make_array' => 2; 115 | has 'make_obj' => 3; 116 | has 'var' => 10; 117 | has 'javascript' => 11; 118 | has 'uuid' => 169; 119 | has 'http' => 153; 120 | has 'error' => 12; 121 | has 'implicit_var' => 13; 122 | has 'db' => 14; 123 | has 'table' => 15; 124 | has 'get' => 16; 125 | has 'get_all' => 78; 126 | has 'eq' => 17; 127 | has 'ne' => 18; 128 | has 'lt' => 19; 129 | has 'le' => 20; 130 | has 'gt' => 21; 131 | has 'ge' => 22; 132 | has 'not' => 23; 133 | has 'add' => 24; 134 | has 'sub' => 25; 135 | has 'mul' => 26; 136 | has 'div' => 27; 137 | has 'mod' => 28; 138 | has 'floor' => 183; 139 | has 'ceil' => 184; 140 | has 'round' => 185; 141 | has 'append' => 29; 142 | has 'prepend' => 80; 143 | has 'difference' => 95; 144 | has 'set_insert' => 88; 145 | has 'set_intersection' => 89; 146 | has 'set_union' => 90; 147 | has 'set_difference' => 91; 148 | has 'slice' => 30; 149 | has 'skip' => 70; 150 | has 'limit' => 71; 151 | has 'offsets_of' => 87; 152 | has 'contains' => 93; 153 | has 'get_field' => 31; 154 | has 'keys' => 94; 155 | has 'values' => 186; 156 | has 'object' => 143; 157 | has 'has_fields' => 32; 158 | has 'with_fields' => 96; 159 | has 'pluck' => 33; 160 | has 'without' => 34; 161 | has 'merge' => 35; 162 | has 'between_deprecated' => 36; 163 | has 'between' => 182; 164 | has 'reduce' => 37; 165 | has 'map' => 38; 166 | has 'fold' => 187; 167 | has 'filter' => 39; 168 | has 'concat_map' => 40; 169 | has 'order_by' => 41; 170 | has 'distinct' => 42; 171 | has 'count' => 43; 172 | has 'is_empty' => 86; 173 | has 'union' => 44; 174 | has 'nth' => 45; 175 | has 'bracket' => 170; 176 | has 'inner_join' => 48; 177 | has 'outer_join' => 49; 178 | has 'eq_join' => 50; 179 | has 'zip' => 72; 180 | has 'range' => 173; 181 | has 'insert_at' => 82; 182 | has 'delete_at' => 83; 183 | has 'change_at' => 84; 184 | has 'splice_at' => 85; 185 | has 'coerce_to' => 51; 186 | has 'type_of' => 52; 187 | has 'update' => 53; 188 | has 'delete' => 54; 189 | has 'replace' => 55; 190 | has 'insert' => 56; 191 | has 'db_create' => 57; 192 | has 'db_drop' => 58; 193 | has 'db_list' => 59; 194 | has 'table_create' => 60; 195 | has 'table_drop' => 61; 196 | has 'table_list' => 62; 197 | has 'config' => 174; 198 | has 'status' => 175; 199 | has 'wait' => 177; 200 | has 'reconfigure' => 176; 201 | has 'rebalance' => 179; 202 | has 'sync' => 138; 203 | has 'grant' => 188; 204 | has 'index_create' => 75; 205 | has 'index_drop' => 76; 206 | has 'index_list' => 77; 207 | has 'index_status' => 139; 208 | has 'index_wait' => 140; 209 | has 'index_rename' => 156; 210 | has 'funcall' => 64; 211 | has 'branch' => 65; 212 | has 'or' => 66; 213 | has 'and' => 67; 214 | has 'for_each' => 68; 215 | has 'func' => 69; 216 | has 'asc' => 73; 217 | has 'desc' => 74; 218 | has 'info' => 79; 219 | has 'match' => 97; 220 | has 'upcase' => 141; 221 | has 'downcase' => 142; 222 | has 'sample' => 81; 223 | has 'default' => 92; 224 | has 'json' => 98; 225 | has 'to_json_string' => 172; 226 | has 'iso8601' => 99; 227 | has 'to_iso8601' => 100; 228 | has 'epoch_time' => 101; 229 | has 'to_epoch_time' => 102; 230 | has 'now' => 103; 231 | has 'in_timezone' => 104; 232 | has 'during' => 105; 233 | has 'date' => 106; 234 | has 'time_of_day' => 126; 235 | has 'timezone' => 127; 236 | has 'year' => 128; 237 | has 'month' => 129; 238 | has 'day' => 130; 239 | has 'day_of_week' => 131; 240 | has 'day_of_year' => 132; 241 | has 'hours' => 133; 242 | has 'minutes' => 134; 243 | has 'seconds' => 135; 244 | has 'time' => 136; 245 | has 'monday' => 107; 246 | has 'tuesday' => 108; 247 | has 'wednesday' => 109; 248 | has 'thursday' => 110; 249 | has 'friday' => 111; 250 | has 'saturday' => 112; 251 | has 'sunday' => 113; 252 | has 'january' => 114; 253 | has 'february' => 115; 254 | has 'march' => 116; 255 | has 'april' => 117; 256 | has 'may' => 118; 257 | has 'june' => 119; 258 | has 'july' => 120; 259 | has 'august' => 121; 260 | has 'september' => 122; 261 | has 'october' => 123; 262 | has 'november' => 124; 263 | has 'december' => 125; 264 | has 'literal' => 137; 265 | has 'group' => 144; 266 | has 'sum' => 145; 267 | has 'avg' => 146; 268 | has 'min' => 147; 269 | has 'max' => 148; 270 | has 'split' => 149; 271 | has 'ungroup' => 150; 272 | has 'random' => 151; 273 | has 'changes' => 152; 274 | has 'args' => 154; 275 | has 'binary' => 155; 276 | has 'geojson' => 157; 277 | has 'to_geojson' => 158; 278 | has 'point' => 159; 279 | has 'line' => 160; 280 | has 'polygon' => 161; 281 | has 'distance' => 162; 282 | has 'intersects' => 163; 283 | has 'includes' => 164; 284 | has 'circle' => 165; 285 | has 'get_intersecting' => 166; 286 | has 'fill' => 167; 287 | has 'get_nearest' => 168; 288 | has 'polygon_sub' => 171; 289 | has 'minval' => 180; 290 | has 'maxval' => 181; 291 | 292 | 1; 293 | 294 | =encoding utf8 295 | 296 | =head1 NAME 297 | 298 | Rethinkdb::Protocol - Rethinkdb Protocol 299 | 300 | =head1 SYNOPSIS 301 | 302 | my $p = Rethinkdb::Protocol->new; 303 | $p->term->termType->get_all; 304 | 305 | =head1 DESCRIPTION 306 | 307 | This file is automatically generated to enable this driver to serialize & 308 | deserialize RethinkDB Query Langauge messages. 309 | 310 | =head1 ATTRIBUTES 311 | 312 | L implements the following attributes. 313 | 314 | =head2 backtrace 315 | 316 | Quick access to the C section of the protocol. 317 | 318 | =head2 datum 319 | 320 | Quick access to the C section of the protocol. 321 | 322 | =head2 frame 323 | 324 | Quick access to the C section of the protocol. 325 | 326 | =head2 query 327 | 328 | Quick access to the C section of the protocol. 329 | 330 | =head2 response 331 | 332 | Quick access to the C section of the protocol. 333 | 334 | =head2 term 335 | 336 | Quick access to the C section of the protocol. 337 | 338 | =head2 versionDummy 339 | 340 | Quick access to the C section of the protocol. 341 | 342 | =head1 SEE ALSO 343 | 344 | L, L 345 | 346 | =cut 347 | 348 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The Artistic License 2.0 2 | 3 | Copyright (c) 2000-2006, The Perl Foundation. 4 | 5 | Everyone is permitted to copy and distribute verbatim copies 6 | of this license document, but changing it is not allowed. 7 | 8 | Preamble 9 | 10 | This license establishes the terms under which a given free software 11 | Package may be copied, modified, distributed, and/or redistributed. 12 | The intent is that the Copyright Holder maintains some artistic 13 | control over the development of that Package while still keeping the 14 | Package available as open source and free software. 15 | 16 | You are always permitted to make arrangements wholly outside of this 17 | license directly with the Copyright Holder of a given Package. If the 18 | terms of this license do not permit the full use that you propose to 19 | make of the Package, you should contact the Copyright Holder and seek 20 | a different licensing arrangement. 21 | 22 | Definitions 23 | 24 | "Copyright Holder" means the individual(s) or organization(s) 25 | named in the copyright notice for the entire Package. 26 | 27 | "Contributor" means any party that has contributed code or other 28 | material to the Package, in accordance with the Copyright Holder's 29 | procedures. 30 | 31 | "You" and "your" means any person who would like to copy, 32 | distribute, or modify the Package. 33 | 34 | "Package" means the collection of files distributed by the 35 | Copyright Holder, and derivatives of that collection and/or of 36 | those files. A given Package may consist of either the Standard 37 | Version, or a Modified Version. 38 | 39 | "Distribute" means providing a copy of the Package or making it 40 | accessible to anyone else, or in the case of a company or 41 | organization, to others outside of your company or organization. 42 | 43 | "Distributor Fee" means any fee that you charge for Distributing 44 | this Package or providing support for this Package to another 45 | party. It does not mean licensing fees. 46 | 47 | "Standard Version" refers to the Package if it has not been 48 | modified, or has been modified only in ways explicitly requested 49 | by the Copyright Holder. 50 | 51 | "Modified Version" means the Package, if it has been changed, and 52 | such changes were not explicitly requested by the Copyright 53 | Holder. 54 | 55 | "Original License" means this Artistic License as Distributed with 56 | the Standard Version of the Package, in its current version or as 57 | it may be modified by The Perl Foundation in the future. 58 | 59 | "Source" form means the source code, documentation source, and 60 | configuration files for the Package. 61 | 62 | "Compiled" form means the compiled bytecode, object code, binary, 63 | or any other form resulting from mechanical transformation or 64 | translation of the Source form. 65 | 66 | 67 | Permission for Use and Modification Without Distribution 68 | 69 | (1) You are permitted to use the Standard Version and create and use 70 | Modified Versions for any purpose without restriction, provided that 71 | you do not Distribute the Modified Version. 72 | 73 | 74 | Permissions for Redistribution of the Standard Version 75 | 76 | (2) You may Distribute verbatim copies of the Source form of the 77 | Standard Version of this Package in any medium without restriction, 78 | either gratis or for a Distributor Fee, provided that you duplicate 79 | all of the original copyright notices and associated disclaimers. At 80 | your discretion, such verbatim copies may or may not include a 81 | Compiled form of the Package. 82 | 83 | (3) You may apply any bug fixes, portability changes, and other 84 | modifications made available from the Copyright Holder. The resulting 85 | Package will still be considered the Standard Version, and as such 86 | will be subject to the Original License. 87 | 88 | 89 | Distribution of Modified Versions of the Package as Source 90 | 91 | (4) You may Distribute your Modified Version as Source (either gratis 92 | or for a Distributor Fee, and with or without a Compiled form of the 93 | Modified Version) provided that you clearly document how it differs 94 | from the Standard Version, including, but not limited to, documenting 95 | any non-standard features, executables, or modules, and provided that 96 | you do at least ONE of the following: 97 | 98 | (a) make the Modified Version available to the Copyright Holder 99 | of the Standard Version, under the Original License, so that the 100 | Copyright Holder may include your modifications in the Standard 101 | Version. 102 | 103 | (b) ensure that installation of your Modified Version does not 104 | prevent the user installing or running the Standard Version. In 105 | addition, the Modified Version must bear a name that is different 106 | from the name of the Standard Version. 107 | 108 | (c) allow anyone who receives a copy of the Modified Version to 109 | make the Source form of the Modified Version available to others 110 | under 111 | 112 | (i) the Original License or 113 | 114 | (ii) a license that permits the licensee to freely copy, 115 | modify and redistribute the Modified Version using the same 116 | licensing terms that apply to the copy that the licensee 117 | received, and requires that the Source form of the Modified 118 | Version, and of any works derived from it, be made freely 119 | available in that license fees are prohibited but Distributor 120 | Fees are allowed. 121 | 122 | 123 | Distribution of Compiled Forms of the Standard Version 124 | or Modified Versions without the Source 125 | 126 | (5) You may Distribute Compiled forms of the Standard Version without 127 | the Source, provided that you include complete instructions on how to 128 | get the Source of the Standard Version. Such instructions must be 129 | valid at the time of your distribution. If these instructions, at any 130 | time while you are carrying out such distribution, become invalid, you 131 | must provide new instructions on demand or cease further distribution. 132 | If you provide valid instructions or cease distribution within thirty 133 | days after you become aware that the instructions are invalid, then 134 | you do not forfeit any of your rights under this license. 135 | 136 | (6) You may Distribute a Modified Version in Compiled form without 137 | the Source, provided that you comply with Section 4 with respect to 138 | the Source of the Modified Version. 139 | 140 | 141 | Aggregating or Linking the Package 142 | 143 | (7) You may aggregate the Package (either the Standard Version or 144 | Modified Version) with other packages and Distribute the resulting 145 | aggregation provided that you do not charge a licensing fee for the 146 | Package. Distributor Fees are permitted, and licensing fees for other 147 | components in the aggregation are permitted. The terms of this license 148 | apply to the use and Distribution of the Standard or Modified Versions 149 | as included in the aggregation. 150 | 151 | (8) You are permitted to link Modified and Standard Versions with 152 | other works, to embed the Package in a larger work of your own, or to 153 | build stand-alone binary or bytecode versions of applications that 154 | include the Package, and Distribute the result without restriction, 155 | provided the result does not expose a direct interface to the Package. 156 | 157 | 158 | Items That are Not Considered Part of a Modified Version 159 | 160 | (9) Works (including, but not limited to, modules and scripts) that 161 | merely extend or make use of the Package, do not, by themselves, cause 162 | the Package to be a Modified Version. In addition, such works are not 163 | considered parts of the Package itself, and are not subject to the 164 | terms of this license. 165 | 166 | 167 | General Provisions 168 | 169 | (10) Any use, modification, and distribution of the Standard or 170 | Modified Versions is governed by this Artistic License. By using, 171 | modifying or distributing the Package, you accept this license. Do not 172 | use, modify, or distribute the Package, if you do not accept this 173 | license. 174 | 175 | (11) If your Modified Version has been derived from a Modified 176 | Version made by someone other than you, you are nevertheless required 177 | to ensure that your Modified Version complies with the requirements of 178 | this license. 179 | 180 | (12) This license does not grant you the right to use any trademark, 181 | service mark, tradename, or logo of the Copyright Holder. 182 | 183 | (13) This license includes the non-exclusive, worldwide, 184 | free-of-charge patent license to make, have made, use, offer to sell, 185 | sell, import and otherwise transfer the Package with respect to any 186 | patent claims licensable by the Copyright Holder that are necessarily 187 | infringed by the Package. If you institute patent litigation 188 | (including a cross-claim or counterclaim) against any party alleging 189 | that the Package constitutes direct or contributory patent 190 | infringement, then this Artistic License to you shall terminate on the 191 | date that such litigation is filed. 192 | 193 | (14) Disclaimer of Warranty: 194 | THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS 195 | IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED 196 | WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR 197 | NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL 198 | LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL 199 | BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 200 | DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF 201 | ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /t/admin.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | # setup 9 | my $conn = r->connect->repl; 10 | r->db('test')->drop->run; 11 | r->db('test')->create->run; 12 | r->db('test')->table('marvel')->create( primary_key => 'superhero' )->run; 13 | r->table('marvel')->insert( 14 | [ 15 | { 16 | user_id => 1, 17 | superhero => 'Iron Man', 18 | superpower => 'Arc Reactor', 19 | active => 1, 20 | age => 35, 21 | strength => 1000, 22 | dc_buddies => [ 'Superman', 'Batman' ], 23 | }, 24 | { 25 | user_id => 2, 26 | superhero => 'Hulk', 27 | superpower => 'Smash', 28 | active => 1, 29 | age => 35, 30 | strength => 2012, 31 | dc_buddies => [ 'Superman', 'Flash' ], 32 | }, 33 | { 34 | user_id => 3, 35 | superhero => 'Captain America', 36 | superpower => 'Super Strength', 37 | active => 1, 38 | age => 135, 39 | strength => 1035, 40 | dc_buddies => [ 'Superman', 'Green Lantern' ], 41 | }, 42 | { 43 | user_id => 4, 44 | superhero => 'Thor', 45 | superpower => 'God-like powers', 46 | active => 1, 47 | age => 1035, 48 | strength => 2035, 49 | dc_buddies => [ 'Flash', 'Batman' ], 50 | }, 51 | { 52 | user_id => 5, 53 | superhero => 'Hawk-Eye', 54 | superpower => 'Bow-n-arrow', 55 | active => 0, 56 | age => 35, 57 | strength => 10, 58 | dc_buddies => [ 'Aquaman', 'Wonder Women' ], 59 | }, 60 | { 61 | user_id => 6, 62 | superhero => 'Wasp', 63 | superpower => 'Bio-lasers', 64 | active => 0, 65 | age => 35, 66 | strength => 52, 67 | dc_buddies => [ 'Superman', 'Batman' ], 68 | }, 69 | { 70 | user_id => 7, 71 | superhero => 'Ant-Man', 72 | superpower => 'Size', 73 | active => 1, 74 | age => 35, 75 | strength => 50, 76 | dc_buddies => [ 'Green Lantern', 'Aquaman' ], 77 | extra => 1, 78 | }, 79 | { 80 | user_id => 8, 81 | superhero => 'Wolverine', 82 | superpower => 'Adamantium', 83 | active => 0, 84 | age => 35, 85 | strength => 135, 86 | dc_buddies => [ 'Hawkman', 'Batman' ], 87 | extra => 1, 88 | }, 89 | { 90 | user_id => 9, 91 | superhero => 'Spider-Man', 92 | superpower => 'Spidy Sense', 93 | active => 0, 94 | age => 20, 95 | strength => 200, 96 | dc_buddies => [ 'Wonder Women', 'Martian Manhunter' ], 97 | extra => 1, 98 | } 99 | ] 100 | )->run; 101 | 102 | # create a few users 103 | r->db('rethinkdb')->table('users')->insert( 104 | [ 105 | { 106 | id => 'chatapp', 107 | password => { password => 'chatapp-secret', iterations => 1024 } 108 | }, 109 | { 110 | id => 'monitoring', 111 | password => { password => 'monitoring-secret', iterations => 1024 } 112 | }, 113 | { 114 | id => 'bob', 115 | password => { password => 'bob-secret', iterations => 1024 } 116 | } 117 | ] 118 | )->run; 119 | 120 | my $res; 121 | 122 | # grant global 123 | $res = r->grant( 'chatapp', { read => r->true, write => r->true } )->run; 124 | 125 | is $res->type, 1, 'Correct response type'; 126 | is $res->response->{granted}, 1, 'Correct response'; 127 | is_deeply [ sort keys %{ $res->response->{permissions_changes}->[0] } ], 128 | [ 'new_val', 'old_val' ], 'Correct structure returned'; 129 | is_deeply $res->response->{permissions_changes}->[0], 130 | { 131 | 'new_val' => { 'read' => r->true, 'write' => r->true }, 132 | 'old_val' => undef 133 | }, 134 | 'Correct structure returned'; 135 | 136 | $res = r->grant( 137 | 'monitoring', 138 | { 139 | read => r->true, 140 | write => r->false, 141 | connect => r->false, 142 | config => r->false 143 | } 144 | )->run; 145 | 146 | is $res->type, 1, 'Correct response type'; 147 | is $res->response->{granted}, 1, 'Correct response'; 148 | is_deeply $res->response->{permissions_changes}->[0], 149 | { 150 | 'new_val' => { 'read' => r->true, 'write' => r->false, 'connect' => r->false, 'config' => r->false }, 151 | 'old_val' => undef 152 | }, 153 | 'Correct structure returned'; 154 | 155 | # grant database 156 | $res = r->db('test')->grant( 'chatapp', { read => r->true, write => r->true } )->run; 157 | 158 | is $res->type, 1, 'Correct response type'; 159 | is $res->response->{granted}, 1, 'Correct response'; 160 | is_deeply [ sort keys %{ $res->response->{permissions_changes}->[0] } ], 161 | [ 'new_val', 'old_val' ], 'Correct structure returned'; 162 | is_deeply $res->response->{permissions_changes}->[0], 163 | { 164 | 'new_val' => { 'read' => r->true, 'write' => r->true }, 165 | 'old_val' => { 'write' => r->true, 'read' => r->true } 166 | }, 167 | 'Correct structure returned'; 168 | 169 | $res = r->db('test')->grant( 170 | 'monitoring', 171 | { 172 | read => r->true, 173 | write => r->false, 174 | connect => r->false, 175 | config => r->false 176 | } 177 | )->run; 178 | 179 | is $res->type, 1, 'Correct response type'; 180 | is $res->response->{granted}, 1, 'Correct response'; 181 | is_deeply $res->response->{permissions_changes}->[0], 182 | { 183 | 'new_val' => { 'read' => r->true, 'write' => r->false, 'connect' => r->false, 'config' => r->false }, 184 | 'old_val' => { 'read' => r->true, 'write' => r->false, 'connect' => r->false, 'config' => r->false } 185 | }, 186 | 'Correct structure returned'; 187 | 188 | # grant table 189 | $res = r->table('marvel')->grant( 'chatapp', { read => r->true, write => r->true } )->run; 190 | 191 | is $res->type, 1, 'Correct response type'; 192 | is $res->response->{granted}, 1, 'Correct response'; 193 | is_deeply [ sort keys %{ $res->response->{permissions_changes}->[0] } ], 194 | [ 'new_val', 'old_val' ], 'Correct structure returned'; 195 | is_deeply $res->response->{permissions_changes}->[0], 196 | { 197 | 'new_val' => { 'read' => r->true, 'write' => r->true }, 198 | 'old_val' => { 'write' => r->true, 'read' => r->true } 199 | }, 200 | 'Correct structure returned'; 201 | 202 | $res = r->table('marvel')->grant( 203 | 'monitoring', 204 | { 205 | read => r->true, 206 | write => r->false, 207 | connect => r->false, 208 | config => r->false 209 | } 210 | )->run; 211 | 212 | is $res->type, 1, 'Correct response type'; 213 | is $res->response->{granted}, 1, 'Correct response'; 214 | is_deeply $res->response->{permissions_changes}->[0], 215 | { 216 | 'new_val' => { 'read' => r->true, 'write' => r->false, 'connect' => r->false, 'config' => r->false }, 217 | 'old_val' => { 'read' => r->true, 'write' => r->false, 'connect' => r->false, 'config' => r->false } 218 | }, 219 | 'Correct structure returned'; 220 | 221 | 222 | # config - database 223 | $res = r->db('test')->config->run; 224 | 225 | is $res->type, 1, 'Correct response type'; 226 | is_deeply [ sort keys %{ $res->response } ], [ 'id', 'name' ], 227 | 'Correct structure returned'; 228 | 229 | # config - table 230 | $res = r->table('marvel')->config->run; 231 | 232 | is $res->type, 1, 'Correct response type'; 233 | is_deeply [ sort keys %{ $res->response } ], 234 | [ 235 | 'db', 'durability', 'id', 'indexes', 236 | 'name', 'primary_key', 'shards', 'write_acks' 237 | ], 238 | 'Correct structure returned'; 239 | 240 | # rebalance - database 241 | $res = r->db('test')->rebalance->run; 242 | 243 | is $res->type, 1, 'Correct response type'; 244 | isa_ok $res->response->{status_changes}, 'ARRAY', 'Correct structure returned'; 245 | is $res->response->{rebalanced}, 1, 'Correct structure returned'; 246 | 247 | # rebalance - table 248 | $res = r->table('marvel')->rebalance->run; 249 | 250 | is $res->type, 1, 'Correct response type'; 251 | isa_ok $res->response->{status_changes}, 'ARRAY', 'Correct structure returned'; 252 | is $res->response->{rebalanced}, 1, 'Correct structure returned'; 253 | 254 | # reconfigure - database 255 | $res 256 | = r->db('test')->reconfigure( { shards => 1, replicas => 1, dry_run => 1 } ) 257 | ->run; 258 | 259 | is $res->type, 1, 'Correct response type'; 260 | isa_ok $res->response->{config_changes}, 'ARRAY', 'Correct structure returned'; 261 | is $res->response->{reconfigured}, 0, 'Correct structure returned'; 262 | 263 | $res = r->db('test')->reconfigure( { shards => 1, replicas => 1 } )->run; 264 | 265 | is $res->type, 1, 'Correct response type'; 266 | isa_ok $res->response->{config_changes}, 'ARRAY', 'Correct structure returned'; 267 | is $res->response->{reconfigured}, 1, 'Correct structure returned'; 268 | 269 | # reconfigure - table 270 | $res = r->table('marvel') 271 | ->reconfigure( { shards => 1, replicas => 1, dry_run => 1 } )->run; 272 | 273 | is $res->type, 1, 'Correct response type'; 274 | isa_ok $res->response->{config_changes}, 'ARRAY', 'Correct structure returned'; 275 | is $res->response->{reconfigured}, 0, 'Correct structure returned'; 276 | 277 | $res = r->table('marvel')->reconfigure( { shards => 1, replicas => 1 } )->run; 278 | 279 | is $res->type, 1, 'Correct response type'; 280 | isa_ok $res->response->{config_changes}, 'ARRAY', 'Correct structure returned'; 281 | is $res->response->{reconfigured}, 1, 'Correct structure returned'; 282 | 283 | # status 284 | $res = r->table('marvel')->status->run; 285 | 286 | is $res->type, 1, 'Correct response type'; 287 | isa_ok $res->response->{shards}, 'ARRAY', 'Correct structure returned'; 288 | is $res->response->{db}, 'test', 'Correct structure returned'; 289 | is $res->response->{name}, 'marvel', 'Correct structure returned'; 290 | is_deeply $res->response->{status}, 291 | { 292 | ready_for_reads => r->true, 293 | ready_for_outdated_reads => r->true, 294 | all_replicas_ready => r->true, 295 | ready_for_writes => r->true 296 | }, 297 | 'Correct structure returned'; 298 | 299 | # wait - database 300 | $res = r->db('test')->wait->run; 301 | 302 | is $res->type, 1, 'Correct response type'; 303 | is $res->response->{ready}, 1, 'Correct response type'; 304 | 305 | # wait - table 306 | $res = r->table('marvel')->wait->run; 307 | 308 | is $res->type, 1, 'Correct response type'; 309 | is $res->response->{ready}, 1, 'Correct response type'; 310 | 311 | # clean up 312 | r->db('test')->drop->run; 313 | r->db('rethinkdb')->table('users')->get('chatapp')->delete->run; 314 | r->db('rethinkdb')->table('users')->get('monitoring')->delete->run; 315 | r->db('rethinkdb')->table('users')->get('bob')->delete->run; 316 | 317 | done_testing(); 318 | -------------------------------------------------------------------------------- /t/aggregation.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | # setup 9 | my $conn = r->connect->repl; 10 | r->db('test')->drop->run; 11 | r->db('test')->create->run; 12 | r->db('test')->table('marvel')->create( primary_key => 'superhero' )->run; 13 | r->table('marvel')->insert( 14 | [ 15 | { 16 | user_id => 1, 17 | superhero => 'Iron Man', 18 | superpower => 'Arc Reactor', 19 | active => 1, 20 | age => 35, 21 | strength => 1000, 22 | dc_buddies => [ 'Superman', 'Batman' ], 23 | }, 24 | { 25 | user_id => 2, 26 | superhero => 'Hulk', 27 | superpower => 'Smash', 28 | active => 1, 29 | age => 35, 30 | strength => 2012, 31 | dc_buddies => [ 'Superman', 'Flash' ], 32 | }, 33 | { 34 | user_id => 3, 35 | superhero => 'Captain America', 36 | superpower => 'Super Strength', 37 | active => 1, 38 | age => 135, 39 | strength => 1035, 40 | dc_buddies => [ 'Superman', 'Green Lantern' ], 41 | }, 42 | { 43 | user_id => 4, 44 | superhero => 'Thor', 45 | superpower => 'God-like powers', 46 | active => 1, 47 | age => 1035, 48 | strength => 2035, 49 | dc_buddies => [ 'Flash', 'Batman' ], 50 | }, 51 | { 52 | user_id => 5, 53 | superhero => 'Hawk-Eye', 54 | superpower => 'Bow-n-arrow', 55 | active => 0, 56 | age => 35, 57 | strength => 10, 58 | dc_buddies => [ 'Aquaman', 'Wonder Women' ], 59 | }, 60 | { 61 | user_id => 6, 62 | superhero => 'Wasp', 63 | superpower => 'Bio-lasers', 64 | active => 0, 65 | age => 35, 66 | strength => 52, 67 | dc_buddies => [ 'Superman', 'Batman' ], 68 | }, 69 | { 70 | user_id => 7, 71 | superhero => 'Ant-Man', 72 | superpower => 'Size', 73 | active => 1, 74 | age => 35, 75 | strength => 50, 76 | dc_buddies => [ 'Green Lantern', 'Aquaman' ], 77 | extra => 1, 78 | }, 79 | { 80 | user_id => 8, 81 | superhero => 'Wolverine', 82 | superpower => 'Adamantium', 83 | active => 0, 84 | age => 35, 85 | strength => 135, 86 | dc_buddies => [ 'Hawkman', 'Batman' ], 87 | extra => 1, 88 | }, 89 | { 90 | user_id => 9, 91 | superhero => 'Spider-Man', 92 | superpower => 'Spidy Sense', 93 | active => 0, 94 | age => 20, 95 | strength => 200, 96 | dc_buddies => [ 'Wonder Women', 'Martian Manhunter' ], 97 | extra => 1, 98 | } 99 | ] 100 | )->run; 101 | 102 | r->db('test')->table('dc')->create( primary_key => 'superhero' )->run; 103 | r->table('dc')->insert( 104 | [ 105 | { 106 | user_id => 10, 107 | superhero => 'Superman', 108 | superpower => 'Alien', 109 | active => 1, 110 | age => 35 111 | }, 112 | { 113 | user_id => 11, 114 | superhero => 'Batman', 115 | superpower => 'Cunning', 116 | active => 1, 117 | age => 35 118 | }, 119 | { 120 | user_id => 12, 121 | superhero => 'Flash', 122 | superpower => 'Super Speed', 123 | active => 1, 124 | age => 135 125 | }, 126 | { 127 | user_id => 13, 128 | superhero => 'Wonder Women', 129 | superpower => 'Super Stregth', 130 | active => 1, 131 | age => 1035 132 | }, 133 | { 134 | user_id => 14, 135 | superhero => 'Green Lantern', 136 | superpower => 'Ring', 137 | active => 0, 138 | age => 35 139 | }, 140 | { 141 | user_id => 15, 142 | superhero => 'Aquaman', 143 | superpower => 'Hydrokinesis', 144 | active => 0, 145 | age => 35 146 | }, 147 | { 148 | user_id => 16, 149 | superhero => 'Hawkman', 150 | superpower => 'Ninth Metal', 151 | active => 1, 152 | age => 35 153 | }, 154 | { 155 | user_id => 17, 156 | superhero => 'Martian Manhunter', 157 | superpower => 'Shapeshifting', 158 | active => 0, 159 | age => 35 160 | }, 161 | ] 162 | )->run; 163 | 164 | # group 165 | $res = r->table('marvel')->group('age')->avg('strength')->run; 166 | 167 | is $res->type, 1, 'Correct response type'; 168 | is_deeply $res->response, 169 | { 170 | '1035' => '2035', 171 | '35' => '543.166666666667', 172 | '135' => '1035', 173 | '20' => '200', 174 | }, 175 | 'Correct response'; 176 | 177 | # group by more than one field (we have to use `group_format=>'raw'`) 178 | $res = r->table('marvel')->group( 'age', 'active' ) 179 | ->run( { group_format => 'raw' } ); 180 | 181 | is_deeply $res->response->{data}->[0][0], [ 20, 0 ]; 182 | is $res->response->{data}->[0][1][0]->{superhero}, 'Spider-Man'; 183 | 184 | # group using a function 185 | $res = r->table('marvel')->group( 186 | sub { 187 | my $row = shift; 188 | return $row->pluck( 'age', 'active' ); 189 | } 190 | )->run( { group_format => 'raw' } ); 191 | 192 | is_deeply $res->response->{data}->[0][0], { age => 20, active => 0 }; 193 | is $res->response->{data}->[0][1][0]->{superhero}, 'Spider-Man'; 194 | 195 | # group `multi=true` 196 | # r.table('games2').group(r.row['matches'].keys(), multi=True).run() 197 | $res = r->table('marvel') 198 | ->group( r->row->bracket('dc_buddies'), { multi => r->true } )->run; 199 | 200 | is $#{ $res->response->{Batman} }, 3, 'Correct `multi=true` response'; 201 | 202 | # ungroup 203 | $res = r->table('marvel')->group('age')->avg('strength')->ungroup->run; 204 | 205 | is_deeply [ sort keys %{ $res->response->[0] } ], [ 'group', 'reduction' ]; 206 | 207 | # reduce 208 | $res = r->table('marvel')->map( r->row->bracket('age') )->reduce( 209 | sub ($$) { 210 | my ( $acc, $val ) = @_; 211 | $acc->add($val); 212 | } 213 | )->default(0)->run; 214 | 215 | is $res->type, 1, 'Correct response type'; 216 | is $res->response, '1400', 'Correct response'; 217 | 218 | # fold 219 | $res = r->table('marvel')->fold( 220 | 0, 221 | sub ($$) { 222 | my ( $acc, $row ) = @_; 223 | return $acc->add( $row->attr('age') ); 224 | } 225 | )->run; 226 | 227 | is $res->type, 1, 'Correct response type'; 228 | is $res->response, '1400', 'Correct response'; 229 | 230 | $res = r->table('marvel')->fold( 231 | [], 232 | sub ($$) { 233 | my ( $acc, $row ) = @_; 234 | return $acc->append( $row->attr('age') ); 235 | } 236 | )->run; 237 | 238 | is $res->type, 1, 'Correct response type'; 239 | is_deeply $res->response, [ 135, 35, 35, 35, 35, 1035, 35, 20, 35 ], 240 | 'Correct response'; 241 | 242 | $res = r->table('marvel')->fold( 243 | 0, 244 | sub ($$) { 245 | my ( $acc, $row ) = @_; 246 | return $acc->add(1); 247 | }, 248 | sub ($$$) { 249 | my ( $acc, $row, $newAcc ) = @_; 250 | return r->branch( $acc->mod(2)->eq(0), [$row], [] ); 251 | } 252 | )->run; 253 | 254 | is $res->type, 2, 'Correct response type'; 255 | is_deeply [ map { $_->{superhero} } @{ $res->response } ], 256 | [ 'Captain America', 'Ant-Man', 'Hawk-Eye', 'Wasp', 'Iron Man' ], 257 | 'Correct response'; 258 | 259 | # count 260 | $res = r->table('marvel')->count->run; 261 | 262 | is $res->type, 1, 'Correct response type'; 263 | is $res->response, '9', 'Correct response'; 264 | 265 | # count (with parameter) 266 | $res = r->table('marvel')->concat_map( 267 | sub { 268 | my $row = shift; 269 | $row->bracket('dc_buddies'); 270 | } 271 | )->count('Batman')->run; 272 | 273 | is $res->type, 1, 'Correct response type'; 274 | is $res->response, '4', 'Correct response'; 275 | 276 | $res = r->table('marvel')->count( 277 | sub { 278 | my $hero = shift; 279 | $hero->bracket('dc_buddies')->contains('Batman'); 280 | } 281 | )->run; 282 | 283 | is $res->type, 1, 'Correct response type'; 284 | is $res->response, '4', 'Correct response'; 285 | 286 | # sum 287 | $res = r->expr( [ 3, 5, 7 ] )->sum->run($conn); 288 | 289 | is $res->response, 15, 'Correct response'; 290 | 291 | # sum - document attributes 292 | $res = r->table('marvel')->sum('age')->run; 293 | 294 | is $res->response, 1400, 'Correct response'; 295 | 296 | # sum - documents based on function 297 | $res = r->table('marvel')->sum( 298 | sub { 299 | my $row = shift; 300 | return $row->bracket('strength')->mul( $row->bracket('active') ); 301 | } 302 | )->run; 303 | 304 | is $res->response, 6132, 'Correct response'; 305 | 306 | # avg 307 | $res = r->expr( [ 3, 5, 7 ] )->avg->run($conn); 308 | 309 | is $res->response, 5, 'Correct response'; 310 | 311 | # avg - document attributes 312 | $res = r->table('marvel')->avg('age')->run; 313 | 314 | is substr( $res->response, 0, 7 ), '155.555', 'Correct response'; 315 | 316 | # avg - documents based on function 317 | $res = r->table('marvel')->avg( 318 | sub { 319 | my $row = shift; 320 | return $row->bracket('strength')->mul( $row->bracket('active') ); 321 | } 322 | )->run; 323 | 324 | is substr( $res->response, 0, 7 ), '681.333', 'Correct response'; 325 | 326 | # min 327 | $res = r->expr( [ 3, 5, 7 ] )->min->run($conn); 328 | 329 | is $res->response, 3, 'Correct response'; 330 | 331 | # min - document attributes 332 | $res = r->table('marvel')->min('age')->run; 333 | is $res->response->{age}, 20, 'Correct response'; 334 | 335 | # min - documents based on function 336 | $res = r->table('marvel')->min( 337 | sub { 338 | my $row = shift; 339 | return $row->bracket('strength')->mul( $row->bracket('active') ); 340 | } 341 | )->run; 342 | 343 | is $res->response->{age}, 20, 'Correct response'; 344 | 345 | # max 346 | $res = r->expr( [ 3, 5, 7 ] )->max->run($conn); 347 | 348 | is $res->response, 7, 'Correct response'; 349 | 350 | # max - document attributes 351 | $res = r->table('marvel')->max('age')->run; 352 | is $res->response->{age}, 1035, 'Correct response'; 353 | 354 | # max - documents based on function 355 | $res = r->table('marvel')->max( 356 | sub { 357 | my $row = shift; 358 | return $row->bracket('strength')->mul( $row->bracket('active') ); 359 | } 360 | )->run; 361 | 362 | is $res->response->{age}, 1035, 'Correct response'; 363 | 364 | # distinct (on table) 365 | $res = r->table('marvel')->distinct->run; 366 | 367 | is $res->type, 2, 'Correct response type'; 368 | is scalar @{ $res->response }, 9, 'Correct response'; 369 | 370 | # distinct (on query) 371 | $res = r->expr( [ 1, 1, 1, 1, 1, 2, 3 ] )->distinct->run($conn); 372 | 373 | is $res->type, 1, 'Correct response type'; 374 | is scalar @{ $res->response }, 3, 'Correct response'; 375 | 376 | # contains 377 | $res = r->table('marvel')->get('Iron Man')->bracket('dc_buddies') 378 | ->contains('Superman')->run; 379 | 380 | is $res->type, 1, 'Correct response type'; 381 | is $res->response, r->true, 'Correct response value'; 382 | 383 | $res = r->table('marvel')->filter( 384 | sub { 385 | my $hero = shift; 386 | return r->expr( [ 'Smash', 'Size' ] ) 387 | ->contains( $hero->bracket('superpower') ); 388 | } 389 | )->bracket('superhero')->run; 390 | 391 | is_deeply sort $res->response, [ 'Ant-Man', 'Hulk' ], 392 | 'Correct filter & contains response'; 393 | 394 | # clean up 395 | r->db('test')->drop->run; 396 | 397 | done_testing(); 398 | -------------------------------------------------------------------------------- /t/document.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | # setup 9 | my $conn = r->connect->repl; 10 | r->db('test')->drop->run; 11 | r->db('test')->create->run; 12 | r->db('test')->table('marvel')->create( primary_key => 'superhero' )->run; 13 | r->table('marvel')->insert( 14 | [ 15 | { 16 | user_id => 1, 17 | superhero => 'Iron Man', 18 | superpower => 'Arc Reactor', 19 | active => 1, 20 | age => 35, 21 | villians => { count => 5 } 22 | }, 23 | { 24 | user_id => 2, 25 | superhero => 'Hulk', 26 | superpower => 'Smash', 27 | active => 1, 28 | age => 35, 29 | villians => { count => 6 } 30 | }, 31 | { 32 | user_id => 3, 33 | superhero => 'Captain America', 34 | superpower => 'Super Strength', 35 | active => 1, 36 | age => 135, 37 | villians => { count => 7 } 38 | }, 39 | { 40 | user_id => 4, 41 | superhero => 'Thor', 42 | superpower => 'God-like powers', 43 | active => 1, 44 | age => 1035, 45 | villians => { count => 8 } 46 | }, 47 | { 48 | user_id => 5, 49 | superhero => 'Hawk-Eye', 50 | superpower => 'Bow-n-arrow', 51 | active => 0, 52 | age => 35, 53 | villians => { count => 9 } 54 | }, 55 | { 56 | user_id => 6, 57 | superhero => 'Wasp', 58 | superpower => 'Bio-lasers', 59 | active => 0, 60 | age => 35, 61 | villians => { count => 5 } 62 | }, 63 | { 64 | user_id => 7, 65 | superhero => 'Ant-Man', 66 | superpower => 'Size', 67 | active => 1, 68 | age => 35, 69 | villians => { count => 10 } 70 | }, 71 | { 72 | user_id => 8, 73 | superhero => 'Wolverine', 74 | superpower => 'Adamantium', 75 | active => 0, 76 | age => 35, 77 | villians => { count => 1 } 78 | }, 79 | { 80 | user_id => 9, 81 | superhero => 'Spider-Man', 82 | superpower => 'Spidy Sense', 83 | active => 0, 84 | age => 20, 85 | villians => { count => 2 } 86 | }, 87 | ] 88 | )->run; 89 | r->db('test')->table('loadouts')->create( primary_key => 'kit' )->run; 90 | r->table('loadouts')->insert( 91 | { 92 | kit => 'alienInvasionKit', 93 | equipment => [ 'alienHelm', 'alienArmour', 'alienBoots' ] 94 | } 95 | )->run; 96 | r->db('test')->table('prizes')->create( primary_key => 'status' )->run; 97 | r->table('prizes')->insert( { status => 'winner', name => 'Hulk' } )->run; 98 | 99 | my $res; 100 | 101 | # row 102 | $res = r->table('marvel')->filter( r->row->bracket('age')->gt(50) )->run; 103 | 104 | is $res->type, 2, 'Correct response type'; 105 | is scalar @{ $res->response }, 2, 'Correct number of documents'; 106 | 107 | $res = r->table('marvel') 108 | ->filter( r->row->bracket('villians')->bracket('count')->ge(10) )->run; 109 | 110 | is $res->type, 2, 'Correct response type'; 111 | is scalar @{ $res->response }, 1, 'Correct number of documents'; 112 | is $res->response->[0]->{superhero}, 'Ant-Man', 'Correct document'; 113 | 114 | $res = r->expr( [ 1, 2, 3 ] )->map( r->row->add(1) )->run($conn); 115 | 116 | is $res->type, 1, 'Correct response type'; 117 | is_deeply $res->response, [ '2', '3', '4' ], 'Correct response'; 118 | 119 | $res = r->table('marvel')->filter( 120 | sub ($) { 121 | my $doc = shift; 122 | return $doc->bracket('superhero')->eq 123 | ( r->table('prizes')->nth(0)->bracket('name') ); 124 | } 125 | )->run; 126 | 127 | is $res->type, 2, 'Correct response type'; 128 | is_deeply $res->response->[0]->{superhero}, 'Hulk', 'Correct response'; 129 | 130 | # replace one document 131 | $res = r->table('marvel')->get('Iron Man') 132 | ->replace( { superhero => 'Iron Man', age => 30 } )->run; 133 | 134 | isa_ok $res, 'Rethinkdb::Response'; 135 | is $res->type, 1, 'Correct response type'; 136 | is $res->response->{replaced}, 1, 'Correct number of updates'; 137 | 138 | # merge to documents 139 | $res = r->table('marvel')->get('Iron Man') 140 | ->merge( r->table('loadouts')->get('alienInvasionKit') )->run; 141 | 142 | isa_ok $res, 'Rethinkdb::Response'; 143 | is $res->type, 1, 'Correct response type'; 144 | is_deeply [ sort keys %{ $res->response } ], 145 | [ 'age', 'equipment', 'kit', 'superhero' ], 146 | 'Correct merged document attribute'; 147 | 148 | # check for an attribute (that doesn't exist) 149 | $res = r->table('marvel')->get('Iron Man')->has_fields('active_status')->run; 150 | 151 | isa_ok $res, 'Rethinkdb::Response'; 152 | is $res->type, 1, 'Correct response type'; 153 | is $res->response, r->false, 'Correct response'; 154 | 155 | # check for an attribute (that does exist) 156 | $res = r->table('marvel')->get('Iron Man')->has_fields('age')->run; 157 | 158 | isa_ok $res, 'Rethinkdb::Response'; 159 | is $res->type, 1, 'Correct response type'; 160 | is $res->response, r->true, 'Correct response'; 161 | 162 | # get one attribute value 163 | $res = r->table('marvel')->get('Iron Man')->bracket('age')->run; 164 | 165 | isa_ok $res, 'Rethinkdb::Response'; 166 | is $res->type, 1, 'Correct response type'; 167 | is $res->response, 30, 'Correct response'; 168 | 169 | # prep for next test: 170 | r->table('marvel')->get('Iron Man')->update( 171 | { 172 | equipment => [ 'oldBoots', 'oldHelm' ], 173 | stuff => { laserCannons => 2, missels => 12 }, 174 | reactorState => 'medium', 175 | reactorPower => 4500, 176 | personalVictoriesList => [ 'Fing Fang Foom', 'Iron Monger', 'Mandarin', ], 177 | } 178 | )->run; 179 | 180 | # append a value 181 | $res = r->table('marvel')->get('Iron Man')->bracket('equipment') 182 | ->append('newBoots')->run; 183 | 184 | is $res->type, 1, 'Correct response type'; 185 | is_deeply $res->response, [ 'oldBoots', 'oldHelm', 'newBoots' ]; 186 | 187 | # prepend a value 188 | $res = r->table('marvel')->get('Iron Man')->bracket('equipment') 189 | ->prepend('newHelm')->run; 190 | 191 | is $res->type, 1, 'Correct response type'; 192 | is_deeply $res->response, [ 'newHelm', 'oldBoots', 'oldHelm' ]; 193 | 194 | # get the difference between to arrays 195 | $res = r->table('marvel')->get('Iron Man')->bracket('equipment') 196 | ->difference( ['oldBoots'] )->run; 197 | 198 | is $res->type, 1, 'Correct response type'; 199 | is_deeply $res->response, ['oldHelm']; 200 | 201 | # Add a value to an array and return it as a set (an array with distinct values). 202 | $res = r->table('marvel')->get('Iron Man')->bracket('equipment') 203 | ->set_insert( ['newBoots'] )->run; 204 | 205 | is $res->type, 1, 'Correct response type'; 206 | is_deeply $res->response, [ 'oldBoots', 'oldHelm', 'newBoots' ]; 207 | 208 | # Add a several values to an array and return it as a set (an array with distinct values) 209 | $res = r->table('marvel')->get('Iron Man')->bracket('equipment') 210 | ->set_union( [ 'newBoots', 'arc_reactor' ] )->run; 211 | 212 | is $res->type, 1, 'Correct response type'; 213 | is_deeply $res->response, [ 'oldBoots', 'oldHelm', 'newBoots', 'arc_reactor' ]; 214 | 215 | # Intersect two arrays returning values that occur in both of them as a set (an array with distinct values). 216 | $res = r->table('marvel')->get('Iron Man')->bracket('equipment') 217 | ->set_intersection( [ 'newBoots', 'arc_reactor', 'oldBoots' ] )->run; 218 | 219 | is $res->type, 1, 'Correct response type'; 220 | is_deeply $res->response, ['oldBoots']; 221 | 222 | # Remove the elements of one array from another and return them as a set (an array with distinct values). 223 | $res = r->table('marvel')->get('Iron Man')->bracket('equipment') 224 | ->set_difference( [ 'newBoots', 'arc_reactor', 'oldBoots' ] )->run; 225 | 226 | is $res->type, 1, 'Correct response type'; 227 | is_deeply $res->response, ['oldHelm']; 228 | 229 | # get_field 230 | $res = r->table('marvel')->get('Iron Man')->get_field('reactorState')->run; 231 | 232 | is $res->type, 1, 'Correct response type'; 233 | is $res->response, 'medium', 'Correct response'; 234 | 235 | $res = r->table('marvel')->get_field('superpower')->run; 236 | 237 | is $res->type, 2, 'Correct response type'; 238 | is_deeply [ sort @{ $res->response } ], 239 | [ 240 | 'Adamantium', 'Bio-lasers', 'Bow-n-arrow', 'God-like powers', 241 | 'Size', 'Smash', 'Spidy Sense', 'Super Strength', 242 | ], 243 | 'Correct response'; 244 | 245 | # bracket 246 | $res = r->table('marvel')->get('Iron Man')->bracket('reactorState')->run; 247 | 248 | is $res->type, 1, 'Correct response type'; 249 | is $res->response, 'medium', 'Correct response'; 250 | 251 | $res = r->table('marvel')->bracket('superpower')->run; 252 | 253 | is $res->type, 2, 'Correct response type'; 254 | is_deeply [ sort @{ $res->response } ], 255 | [ 256 | 'Adamantium', 'Bio-lasers', 'Bow-n-arrow', 'God-like powers', 257 | 'Size', 'Smash', 'Spidy Sense', 'Super Strength', 258 | ], 259 | 'Correct response'; 260 | 261 | # attr - depercated 262 | $res = r->table('marvel')->get('Iron Man')->attr('reactorState')->run; 263 | 264 | is $res->type, 1, 'Correct response type'; 265 | is $res->response, 'medium', 'Correct response'; 266 | 267 | $res = r->table('marvel')->attr('superpower')->run; 268 | 269 | is $res->type, 2, 'Correct response type'; 270 | is_deeply [ sort @{ $res->response } ], 271 | [ 272 | 'Adamantium', 'Bio-lasers', 'Bow-n-arrow', 'God-like powers', 273 | 'Size', 'Smash', 'Spidy Sense', 'Super Strength', 274 | ], 275 | 'Correct response'; 276 | 277 | # Plucks out one or more attributes from either an object or a sequence of 278 | # objects (projection). 279 | $res = r->table('marvel')->get('Iron Man') 280 | ->pluck( 'reactorState', 'reactorPower' )->run; 281 | 282 | is $res->type, 1, 'Correct response type'; 283 | is_deeply $res->response, { reactorState => 'medium', reactorPower => 4500, }, 284 | 'Correct response'; 285 | 286 | # The opposite of pluck; takes an object or a sequence of objects, and removes 287 | # all attributes except for the ones specified. 288 | $res = r->table('marvel')->get('Iron Man') 289 | ->without( 'personalVictoriesList', 'equipment', 'stuff' )->run; 290 | 291 | is $res->type, 1, 'Correct response type'; 292 | is_deeply $res->response, 293 | { 294 | reactorState => 'medium', 295 | reactorPower => 4500, 296 | age => 30, 297 | superhero => 'Iron Man', 298 | }, 299 | 'Correct response'; 300 | 301 | 302 | # remove nested key(s) 303 | $res 304 | = r->table('marvel')->get('Iron Man') 305 | ->without( 'personalVictoriesList', 'equipment', 306 | { stuff => { laserCannons => r->true } } )->run; 307 | 308 | is $res->type, 1, 'Correct response type'; 309 | is_deeply $res->response, 310 | { 311 | reactorState => 'medium', 312 | reactorPower => 4500, 313 | age => 30, 314 | superhero => 'Iron Man', 315 | stuff => { missels => 12 }, 316 | }, 317 | 'Correct response'; 318 | 319 | 320 | # Insert a value in to an array at a given index. Returns the modified array. 321 | $res = r->expr( [ 'Iron Man', 'Spider-Man' ] )->insert_at( 1, 'Hulk' ) 322 | ->run($conn); 323 | 324 | is $res->type, 1, 'Correct response type'; 325 | is_deeply $res->response, [ 'Iron Man', 'Hulk', 'Spider-Man', ], 326 | 'Correct response type'; 327 | 328 | # Insert several values in to an array at a given index. 329 | # Returns the modified array. 330 | $res = r->expr( [ 'Iron Man', 'Spider-Man' ] ) 331 | ->splice_at( 1, [ 'Hulk', 'Thor' ] )->run($conn); 332 | 333 | is $res->type, 1, 'Correct response type'; 334 | is_deeply $res->response, [ 'Iron Man', 'Hulk', 'Thor', 'Spider-Man', ], 335 | 'Correct response type'; 336 | 337 | # Remove an element from an array at a given index. Returns the modified array. 338 | $res = r->expr( [ 'Iron Man', 'Spider-Man' ] )->delete_at(1)->run($conn); 339 | 340 | is $res->type, 1, 'Correct response type'; 341 | is_deeply $res->response, ['Iron Man'], 'Correct response type'; 342 | 343 | # same but use a starting and ending index 344 | $res 345 | = r->expr( [ 'Iron Man', 'Hulk', 'Thor', 'Spider-Man' ] )->delete_at( 1, 3 ) 346 | ->run($conn); 347 | 348 | is $res->type, 1, 'Correct response type'; 349 | is_deeply $res->response, [ 'Iron Man', 'Spider-Man' ], 350 | 'Correct response type'; 351 | 352 | # Change a value in an array at a given index. Returns the modified array. 353 | $res 354 | = r->expr( [ 'Iron Man', 'Bruce Banner', 'Thor' ] )->change_at( 1, 'Hulk' ) 355 | ->run($conn); 356 | 357 | is $res->type, 1, 'Correct response type'; 358 | is_deeply $res->response, [ 'Iron Man', 'Hulk', 'Thor' ], 359 | 'Correct response type'; 360 | 361 | # Return an array containing all of the object's keys. 362 | $res = r->table('marvel')->get('Iron Man')->keys->run; 363 | 364 | is $res->type, 1, 'Correct response type'; 365 | is_deeply $res->response, 366 | [ 367 | 'age', 'equipment', 368 | 'personalVictoriesList', 'reactorPower', 369 | 'reactorState', 'stuff', 370 | 'superhero' 371 | ], 372 | 'Correct keys'; 373 | 374 | # Return an array containing all of an object's values. values() guarantees 375 | # the values will come out in the same order as keys. 376 | $res = r->table('marvel')->get('Iron Man')->values->run; 377 | 378 | is $res->type, 1, 'Correct response type'; 379 | is_deeply $res->response, 380 | [ 381 | 30, 382 | [ 'oldBoots', 'oldHelm' ], 383 | [ 'Fing Fang Foom', 'Iron Monger', 'Mandarin' ], 384 | 4500, 'medium', { 'laserCannons' => 2, 'missels' => 12 }, 385 | 'Iron Man' 386 | ], 387 | 'Correct keys'; 388 | 389 | # literal 390 | r->table('marvel')->get('Iron Man')->update( 391 | { 392 | gear => { 393 | boots => 'rocket mach 2', 394 | reactor => 'triangular', 395 | left_arm => 'laser' 396 | } 397 | } 398 | )->run; 399 | 400 | $res = r->table('marvel')->get('Iron Man')->update( 401 | { 402 | gear => r->literal( 403 | { 404 | boots => 'rocket mach 3', 405 | reactor => 'square', 406 | shoulder => 'rocket launcher' 407 | } 408 | ) 409 | } 410 | )->run; 411 | 412 | is $res->type, 1, 'Correct response type'; 413 | is $res->response->{replaced}, 1, 'Correct response type'; 414 | 415 | # object 416 | $res = r->object( [ 'id', 5, 'data', [ 'foo', 'bar' ] ] )->run($conn); 417 | 418 | is $res->type, 1, 'Correct response type'; 419 | is $res->response->{id}, 5, 'Correct response type'; 420 | is_deeply $res->response->{data}, [ 'foo', 'bar' ], 'Correct response type'; 421 | 422 | # clean up 423 | r->db('test')->drop->run; 424 | 425 | done_testing(); 426 | -------------------------------------------------------------------------------- /lib/Rethinkdb/Query/Table.pm: -------------------------------------------------------------------------------- 1 | package Rethinkdb::Query::Table; 2 | use Rethinkdb::Base 'Rethinkdb::Query'; 3 | 4 | use Carp qw'croak carp'; 5 | use Scalar::Util 'weaken'; 6 | 7 | use Rethinkdb::Protocol; 8 | use Rethinkdb::Util; 9 | 10 | has [qw{ _rdb name }]; 11 | 12 | # primary_key = None 13 | # datacenter = None 14 | # durability = hard|soft 15 | # cache_size = '1024MB' 16 | sub create { 17 | my $self = shift; 18 | my $optargs = ref $_[0] ? $_[0] : {@_}; 19 | 20 | my $q = Rethinkdb::Query->new( 21 | _rdb => $self->_rdb, 22 | _type => $self->_termType->table_create, 23 | args => $self->name, 24 | optargs => $optargs, 25 | ); 26 | 27 | weaken $q->{_rdb}; 28 | return $q; 29 | } 30 | 31 | sub drop { 32 | my $self = shift; 33 | 34 | my $q = Rethinkdb::Query->new( 35 | _rdb => $self->_rdb, 36 | _type => $self->_termType->table_drop, 37 | args => $self->name, 38 | ); 39 | 40 | weaken $q->{_rdb}; 41 | return $q; 42 | } 43 | 44 | sub index_create { 45 | my $self = shift; 46 | my $args = shift; 47 | my $optargs = ref $_[0] ? $_[0] : {@_}; 48 | 49 | if ( ref $optargs ne 'HASH' ) { 50 | $args = [ $args, Rethinkdb::Util->_wrap_func($optargs) ]; 51 | $optargs = undef; 52 | } 53 | elsif ( $optargs->{'$reql_type$'} ) { 54 | $args = [ $args, $optargs ]; 55 | $optargs = undef; 56 | } 57 | 58 | my $q = Rethinkdb::Query->new( 59 | _parent => $self, 60 | _type => $self->_termType->index_create, 61 | args => $args, 62 | optargs => $optargs, 63 | ); 64 | 65 | return $q; 66 | } 67 | 68 | sub index_drop { 69 | my $self = shift; 70 | my $index = shift; 71 | 72 | my $q = Rethinkdb::Query->new( 73 | _parent => $self, 74 | _type => $self->_termType->index_drop, 75 | args => $index 76 | ); 77 | 78 | return $q; 79 | } 80 | 81 | sub index_list { 82 | my $self = shift; 83 | 84 | my $q = Rethinkdb::Query->new( 85 | _parent => $self, 86 | _type => $self->_termType->index_list, 87 | ); 88 | 89 | return $q; 90 | } 91 | 92 | sub index_rename { 93 | my $self = shift; 94 | my $args = [@_]; 95 | 96 | my $q = Rethinkdb::Query->new( 97 | _parent => $self, 98 | _type => $self->_termType->index_rename, 99 | args => $args 100 | ); 101 | 102 | return $q; 103 | } 104 | 105 | sub index_status { 106 | my $self = shift; 107 | my $indices = [@_]; 108 | 109 | my $q = Rethinkdb::Query->new( 110 | _parent => $self, 111 | _type => $self->_termType->index_status, 112 | args => $indices, 113 | ); 114 | 115 | return $q; 116 | } 117 | 118 | sub index_wait { 119 | my $self = shift; 120 | my $indices = [@_]; 121 | 122 | my $q = Rethinkdb::Query->new( 123 | _parent => $self, 124 | _type => $self->_termType->index_wait, 125 | args => $indices, 126 | ); 127 | 128 | return $q; 129 | } 130 | 131 | sub changes { 132 | my $self = shift; 133 | my $params = shift; 134 | 135 | my $q = Rethinkdb::Query->new( 136 | _parent => $self, 137 | _type => $self->_termType->changes, 138 | optargs => $params, 139 | ); 140 | 141 | return $q; 142 | } 143 | 144 | sub insert { 145 | my $self = shift; 146 | my $args = shift; 147 | my $params = shift; 148 | 149 | my $q = Rethinkdb::Query->new( 150 | _parent => $self, 151 | _type => $self->_termType->insert, 152 | args => Rethinkdb::Util->_expr_json($args), 153 | optargs => $params, 154 | ); 155 | 156 | return $q; 157 | } 158 | 159 | sub sync { 160 | my $self = shift; 161 | 162 | my $q = Rethinkdb::Query->new( 163 | _parent => $self, 164 | _type => $self->_termType->sync, 165 | ); 166 | 167 | return $q; 168 | } 169 | 170 | # get a document by primary key 171 | # TODO: key can be other things besides string 172 | sub get { 173 | my $self = shift; 174 | my ($key) = @_; 175 | 176 | my $q = Rethinkdb::Query->new( 177 | _parent => $self, 178 | _type => $self->_termType->get, 179 | args => $key, 180 | ); 181 | 182 | return $q; 183 | } 184 | 185 | # Get all documents where the given value matches the value of the requested index 186 | sub get_all { 187 | my $self = shift; 188 | 189 | # extract values 190 | my $values = \@_; 191 | my $params = {}; 192 | 193 | if ( ref $values->[0] eq 'ARRAY' ) { 194 | ( $values, $params ) = @{$values}; 195 | } 196 | 197 | if ( ref $values->[ $#{$values} ] eq 'HASH' ) { 198 | $params = pop @{$values}; 199 | } 200 | 201 | if ( !$params->{index} ) { 202 | $params->{index} = 'id'; 203 | } 204 | 205 | my $q = Rethinkdb::Query->new( 206 | _parent => $self, 207 | _type => $self->_termType->get_all, 208 | args => $values, 209 | optargs => $params, 210 | ); 211 | 212 | return $q; 213 | } 214 | 215 | sub between { 216 | my $self = shift; 217 | my ( $lower, $upper, $index, $left_bound, $right_bound ) = @_; 218 | 219 | my $optargs = {}; 220 | if ( ref $index ) { 221 | $optargs = $index; 222 | } 223 | else { 224 | $optargs->{index} = $index || 'id'; 225 | 226 | if ($left_bound) { 227 | $optargs->{left_bound} = $left_bound; 228 | } 229 | 230 | if ($right_bound) { 231 | $optargs->{right_bound} = $right_bound; 232 | } 233 | } 234 | 235 | my $q = Rethinkdb::Query->new( 236 | _parent => $self, 237 | _type => $self->_termType->between, 238 | args => [ $lower, $upper ], 239 | optargs => $optargs, 240 | ); 241 | 242 | return $q; 243 | } 244 | 245 | sub get_intersecting { 246 | my $self = shift; 247 | my $args = shift; 248 | my $optargs = shift; 249 | 250 | my $q = Rethinkdb::Query->new( 251 | _parent => $self, 252 | _type => $self->_termType->get_intersecting, 253 | args => $args, 254 | optargs => $optargs, 255 | ); 256 | 257 | return $q; 258 | } 259 | 260 | sub get_nearest { 261 | my $self = shift; 262 | my $args = shift; 263 | my $optargs = shift; 264 | 265 | my $q = Rethinkdb::Query->new( 266 | _parent => $self, 267 | _type => $self->_termType->get_nearest, 268 | args => $args, 269 | optargs => $optargs, 270 | ); 271 | 272 | return $q; 273 | } 274 | 275 | sub grant { 276 | my $self = shift; 277 | my $user = shift; 278 | my $perms = shift; 279 | 280 | my $q = Rethinkdb::Query->new( 281 | _rdb => $self->_rdb, 282 | _type => $self->_termType->grant, 283 | args => [ $user, $perms ] 284 | ); 285 | 286 | return $q; 287 | } 288 | 289 | sub config { 290 | my $self = shift; 291 | 292 | my $q = Rethinkdb::Query->new( 293 | _parent => $self, 294 | _type => $self->_termType->config, 295 | ); 296 | 297 | return $q; 298 | } 299 | 300 | sub rebalance { 301 | my $self = shift; 302 | 303 | my $q = Rethinkdb::Query->new( 304 | _parent => $self, 305 | _type => $self->_termType->rebalance, 306 | ); 307 | 308 | return $q; 309 | } 310 | 311 | sub reconfigure { 312 | my $self = shift; 313 | my $args = shift; 314 | 315 | my $q = Rethinkdb::Query->new( 316 | _parent => $self, 317 | _type => $self->_termType->reconfigure, 318 | optargs => $args 319 | ); 320 | 321 | return $q; 322 | } 323 | 324 | sub status { 325 | my $self = shift; 326 | 327 | my $q = Rethinkdb::Query->new( 328 | _parent => $self, 329 | _type => $self->_termType->status, 330 | ); 331 | 332 | return $q; 333 | } 334 | 335 | sub wait { 336 | my $self = shift; 337 | 338 | my $q = Rethinkdb::Query->new( 339 | _parent => $self, 340 | _type => $self->_termType->wait, 341 | ); 342 | 343 | return $q; 344 | } 345 | 346 | 1; 347 | 348 | =encoding utf8 349 | 350 | =head1 NAME 351 | 352 | Rethinkdb::Query::Table - RethinkDB Query Table 353 | 354 | =head1 SYNOPSIS 355 | 356 | =head1 DESCRIPTION 357 | 358 | L is a type of query that represents a table in a 359 | database. This classes contains methods to interact with said table. 360 | 361 | =head1 ATTRIBUTES 362 | 363 | L implements the following attributes. 364 | 365 | =head2 name 366 | 367 | my $table = r->db('comics')->table('superheros'); 368 | say $table->name; 369 | 370 | The name of the table. 371 | 372 | =head1 METHODS 373 | 374 | L implements the following methods. 375 | 376 | =head2 create 377 | 378 | r->db('test')->table('dc_universe')->create->run; 379 | 380 | Create this table. A RethinkDB table is a collection of JSON documents. 381 | 382 | If successful, the operation returns an object: C<< {created => 1} >>. If a 383 | table with the same name already exists, the operation returns a 384 | C. 385 | 386 | B that you can only use alphanumeric characters and underscores for the 387 | table name. 388 | 389 | =head2 drop 390 | 391 | r->db('test')->table('dc_universe')->drop->run(conn) 392 | 393 | Drop this table. The table and all its data will be deleted. 394 | 395 | If successful, the operation returns an object: C<< {dropped => 1} >>. If the 396 | specified table doesn't exist a C is returned. 397 | 398 | =head2 index_create 399 | 400 | r->table('comments')->index_create('post_id')->run; 401 | 402 | Create a new secondary index on a table. 403 | 404 | =head2 index_drop 405 | 406 | r->table('dc')->index_drop('code_name')->run; 407 | 408 | Delete a previously created secondary index of this table. 409 | 410 | =head2 index_list 411 | 412 | r->table('marvel')->index_list->run; 413 | 414 | List all the secondary indexes of this table. 415 | 416 | =head2 index_rename 417 | 418 | r->table('marvel')->index_rename('heroId', 'awesomeId')->run; 419 | 420 | Rename an existing secondary index on a table. If the optional argument 421 | C is specified as C, a previously existing index with the new 422 | name will be deleted and the index will be renamed. If C is C 423 | (the default) an error will be raised if the new index name already exists. 424 | 425 | =head2 index_status 426 | 427 | r->table('test')->index_status->run; 428 | r->table('test')->index_status('timestamp')->run; 429 | 430 | Get the status of the specified indexes on this table, or the status of all 431 | indexes on this table if no indexes are specified. 432 | 433 | =head2 index_wait 434 | 435 | r->table('test')->index_wait->run; 436 | r->table('test')->index_wait('timestamp')->run; 437 | 438 | Wait for the specified indexes on this table to be ready, or for all indexes on 439 | this table to be ready if no indexes are specified. 440 | 441 | =head2 changes 442 | 443 | my $stream = r->table('games')->changes->run(sub { 444 | my ($response) = @_; 445 | say Dumper $response; 446 | }); 447 | 448 | Return an infinite stream of objects representing changes to a table. Whenever 449 | an C, C, C or C is performed on the table, an 450 | object of the form C<< {'old_val' => ..., 'new_val' => ...} >> will be appended 451 | to the stream. For an C, C will be C, and for a 452 | C, C will be C. 453 | 454 | =head2 insert 455 | 456 | r->table('posts')->insert({ 457 | id => 1, 458 | title => 'Lorem ipsum', 459 | content => 'Dolor sit amet' 460 | })->run; 461 | 462 | Insert documents into a table. Accepts a single document or an array of 463 | documents. 464 | 465 | =head2 sync 466 | 467 | L ensures that writes on a given table are written to permanent storage. 468 | Queries that specify soft durability C<< {durability => 'soft'} >> do not give 469 | such guarantees, so sync can be used to ensure the state of these queries. A 470 | call to sync does not return until all previous writes to the table are 471 | persisted. 472 | 473 | =head2 get 474 | 475 | r->table('posts')->get('a9849eef-7176-4411-935b-79a6e3c56a74')->run; 476 | 477 | Get a document by primary key. 478 | 479 | If no document exists with that primary key, L will return C. 480 | 481 | =head2 get_all 482 | 483 | r->table('marvel')->get_all('man_of_steel', { index => 'code_name' })->run; 484 | 485 | Get all documents where the given value matches the value of the requested 486 | index. 487 | 488 | =head2 between 489 | 490 | r->table('marvel')->between(10, 20)->run; 491 | 492 | Get all documents between two keys. Accepts three optional arguments: C, 493 | C, and C. If C is set to the name of a 494 | secondary index, L will return all documents where that index's value 495 | is in the specified range (it uses the primary key by default). C 496 | or C may be set to open or closed to indicate whether or not to 497 | include that endpoint of the range (by default, C is closed and 498 | C is open). 499 | 500 | =head2 get_intersecting 501 | 502 | r->table('geo') 503 | ->get_intersecting( 504 | r->circle( [ -122.423246, 37.770378359 ], 10, { unit => 'mi' } ), 505 | { index => 'location' } )->run; 506 | 507 | Get all documents where the given geometry object intersects the geometry 508 | object of the requested geospatial index. 509 | 510 | =head2 get_nearest 511 | 512 | r->table('geo')->get_nearest( 513 | r->point( -122.422876, 37.777128 ), 514 | { index => 'location', max_dist => 5000 } 515 | )->run; 516 | 517 | Get all documents where the specified geospatial index is within a certain 518 | distance of the specified point (default 100 kilometers). 519 | 520 | =head2 grant 521 | 522 | r->table('marvel') 523 | ->grant( 'username', { read => r->true, write => r->false } )->run; 524 | 525 | Grant or deny access permissions for a user account on a table. 526 | 527 | =head2 config 528 | 529 | r->table('marvel')->config->run; 530 | 531 | Query (read and/or update) the configurations for individual tables. 532 | 533 | =head2 rebalance 534 | 535 | r->table('marvel')->rebalance->run; 536 | 537 | Rebalances the shards of a table. 538 | 539 | =head2 reconfigure 540 | 541 | r->table('marvel')->reconfigure({ shards => 2, replicas => 1 })->run; 542 | r->table('marvel')->reconfigure( 543 | { 544 | shards => 2, 545 | replicas => { wooster => 1, wayne => 1 }, 546 | primary_replica_tag => 'wooster' 547 | } 548 | )->run; 549 | 550 | Reconfigure a table's sharding and replication. 551 | 552 | =head2 status 553 | 554 | r->table('marvel')->status->run; 555 | 556 | Return the status of a table. The return value is an object providing 557 | information about the table's shards, replicas and replica readiness states 558 | 559 | =head2 wait 560 | 561 | r->table('marvel')->wait->run; 562 | 563 | Wait for a table to be ready. A table may be temporarily unavailable 564 | after creation, rebalancing or reconfiguring. The L command 565 | blocks until the given table is fully up to date. 566 | 567 | =cut 568 | -------------------------------------------------------------------------------- /lib/Rethinkdb/IO.pm: -------------------------------------------------------------------------------- 1 | package Rethinkdb::IO; 2 | use Rethinkdb::Base -base; 3 | 4 | no warnings 'recursion'; 5 | 6 | use Carp 'croak'; 7 | use IO::Socket::INET; 8 | use JSON::PP; 9 | 10 | use Rethinkdb::Protocol; 11 | use Rethinkdb::Response; 12 | 13 | has host => 'localhost'; 14 | has port => 28_015; 15 | has default_db => 'test'; 16 | has auth_key => q{}; 17 | has timeout => 20; 18 | has [ '_rdb', '_handle', '_callbacks', '_responder' ]; 19 | has '_protocol' => sub { Rethinkdb::Protocol->new; }; 20 | 21 | sub connect { 22 | my $self = shift; 23 | 24 | $self->{_handle} = IO::Socket::INET->new( 25 | PeerHost => $self->host, 26 | PeerPort => $self->port, 27 | Reuse => 1, 28 | Timeout => $self->timeout, 29 | ) 30 | or croak 'ERROR: Could not connect to ' . $self->host . q{:} . $self->port; 31 | 32 | $self->_handle->send( pack 'L<', 33 | $self->_protocol->versionDummy->version->v0_3 ); 34 | $self->_handle->send( 35 | ( pack 'L<', length $self->auth_key ) . $self->auth_key ); 36 | 37 | $self->_handle->send( pack 'L<', 38 | $self->_protocol->versionDummy->protocol->json ); 39 | 40 | my $response; 41 | my $char = q{}; 42 | do { 43 | $self->_handle->recv( $char, 1 ); 44 | $response .= $char; 45 | } while ( $char ne "\0" ); 46 | 47 | # trim string 48 | $response =~ s/^\s//; 49 | $response =~ s/\s$//; 50 | 51 | if ( $response =~ /^ERROR/ ) { 52 | croak $response; 53 | } 54 | 55 | $self->_callbacks( {} ); 56 | 57 | return $self; 58 | } 59 | 60 | sub close { 61 | my $self = shift; 62 | my $args = ref $_[0] ? $_[0] : {@_}; 63 | 64 | if ( $self->_handle ) { 65 | if ( !defined $args->{noreply_wait} || !$args->{noreply_wait} ) { 66 | $self->noreply_wait; 67 | } 68 | 69 | $self->_handle->close; 70 | $self->_handle(undef); 71 | } 72 | 73 | $self->_callbacks( {} ); 74 | 75 | return $self; 76 | } 77 | 78 | sub reconnect { 79 | my $self = shift; 80 | my $args = ref $_[0] ? $_[0] : {@_}; 81 | 82 | return $self->close($args)->connect; 83 | } 84 | 85 | # put the handle into main package 86 | sub repl { 87 | my $self = shift; 88 | my $package = caller || 'main'; 89 | 90 | no strict 'refs'; 91 | ${$package . '::_rdb_io'} = $self; 92 | return $self; 93 | } 94 | 95 | sub use { 96 | my $self = shift; 97 | my $db = shift; 98 | 99 | $self->default_db($db); 100 | return $self; 101 | } 102 | 103 | sub noreply_wait { 104 | my $self = shift; 105 | 106 | return $self->_send( 107 | { 108 | type => $self->_protocol->query->queryType->noreply_wait, 109 | token => Rethinkdb::Util::_token(), 110 | } 111 | ); 112 | } 113 | 114 | sub server { 115 | my $self = shift; 116 | 117 | return $self->_send( 118 | { 119 | type => $self->_protocol->query->queryType->server_info, 120 | token => Rethinkdb::Util::_token(), 121 | } 122 | ); 123 | } 124 | 125 | sub _start { 126 | my $self = shift; 127 | my ( $query, $args, $callback ) = @_; 128 | 129 | my $q = { 130 | type => $self->_protocol->query->queryType->start, 131 | token => Rethinkdb::Util::_token(), 132 | query => $query->_build 133 | }; 134 | 135 | if ( ref $callback eq 'CODE' ) { 136 | $self->_callbacks->{ $q->{token} } = $callback; 137 | } 138 | 139 | # add our database 140 | if ( !$args->{db} ) { 141 | $args->{db} = $self->default_db; 142 | } 143 | 144 | return $self->_send( $q, $args ); 145 | } 146 | 147 | sub _encode { 148 | my $self = shift; 149 | my $data = shift; 150 | my $args = shift || {}; 151 | 152 | # only QUERY->START needs these: 153 | if ( $data->{type} == 1 ) { 154 | $data = $self->_encode_recurse($data); 155 | push @{$data}, _simple_encode_hash($args); 156 | } 157 | else { 158 | $data = [ $data->{type} ]; 159 | } 160 | 161 | return encode_json $data; 162 | } 163 | 164 | # temporarily: clean up global optional arguments 165 | sub _simple_encode_hash { 166 | my $data = shift; 167 | my $json = {}; 168 | 169 | foreach ( keys %{$data} ) { 170 | $json->{$_} = _simple_encode( $data->{$_} ); 171 | } 172 | 173 | if ( $json->{db} ) { 174 | $json->{db} = Rethinkdb::IO->_encode_recurse( 175 | Rethinkdb::Query::Database->new( 176 | name => $json->{db}, 177 | args => $json->{db}, 178 | )->_build 179 | ); 180 | } 181 | 182 | return $json; 183 | } 184 | 185 | sub _simple_encode { 186 | my $data = shift; 187 | 188 | if ( ref $data eq 'Rethinkdb::_True' ) { 189 | return JSON::PP::true; 190 | } 191 | elsif ( ref $data eq 'Rethinkdb::_False' ) { 192 | return JSON::PP::false; 193 | } 194 | 195 | return $data; 196 | } 197 | 198 | sub _encode_recurse { 199 | my $self = shift; 200 | my $data = shift; 201 | my $json = []; 202 | 203 | if ( $data->{datum} ) { 204 | my $val = q{}; 205 | if ( defined $data->{datum}->{r_bool} ) { 206 | if ( $data->{datum}->{r_bool} ) { 207 | return JSON::PP::true; 208 | } 209 | else { 210 | return JSON::PP::false; 211 | } 212 | } 213 | elsif ( defined $data->{datum}->{type} 214 | && $data->{datum}->{type} == $self->_protocol->datum->datumType->r_null ) 215 | { 216 | return JSON::PP::null; 217 | } 218 | else { 219 | foreach ( keys %{ $data->{datum} } ) { 220 | if ( $_ ne 'type' ) { 221 | return $data->{datum}->{$_}; 222 | } 223 | } 224 | } 225 | } 226 | 227 | if ( $data->{type} ) { 228 | push @{$json}, $data->{type}; 229 | } 230 | 231 | if ( $data->{query} ) { 232 | push @{$json}, $self->_encode_recurse( $data->{query} ); 233 | } 234 | 235 | if ( $data->{args} ) { 236 | my $args = []; 237 | foreach ( @{ $data->{args} } ) { 238 | push @{$args}, $self->_encode_recurse($_); 239 | } 240 | 241 | push @{$json}, $args; 242 | } 243 | 244 | if ( $data->{optargs} && ref $data->{optargs} eq 'HASH' ) { 245 | push @{$json}, $self->_encode_recurse( $data->{optargs} ); 246 | } 247 | elsif ( $data->{optargs} ) { 248 | my $args = {}; 249 | foreach ( @{ $data->{optargs} } ) { 250 | $args->{ $_->{key} } = $self->_encode_recurse( $_->{val} ); 251 | } 252 | 253 | if ( $data->{type} == $self->_protocol->term->termType->make_obj ) { 254 | return $args; 255 | } 256 | 257 | push @{$json}, $args; 258 | } 259 | 260 | return $json; 261 | } 262 | 263 | sub _decode { 264 | my $self = shift; 265 | my $data = shift; 266 | my $decode = decode_json $data; 267 | 268 | $decode->{r} = $self->_clean( $decode->{r} ); 269 | return $decode; 270 | } 271 | 272 | # converts JSON::PP::Boolean in an array to our Booleans 273 | sub _clean { 274 | my $self = shift; 275 | my $data = shift; 276 | my $clean = []; 277 | 278 | if ( ref $data eq 'ARRAY' ) { 279 | foreach ( @{$data} ) { 280 | push @{$clean}, $self->_real_cleaner($_); 281 | } 282 | 283 | return $clean; 284 | } 285 | elsif ( ref $data eq 'HASH' ) { 286 | foreach ( keys %{$data} ) { 287 | $data->{$_} = $self->_real_cleaner( $data->{$_} ); 288 | } 289 | 290 | return $data; 291 | } 292 | 293 | return $data; 294 | } 295 | 296 | sub _real_cleaner { 297 | my $self = shift; 298 | my $data = shift; 299 | my $retval; 300 | 301 | if ( ref $data eq 'JSON::PP::Boolean' ) { 302 | if ($data) { 303 | $retval = $self->_rdb->true; 304 | } 305 | else { 306 | $retval = $self->_rdb->false; 307 | } 308 | } 309 | elsif ( ref $data eq 'ARRAY' ) { 310 | $retval = $self->_clean($data); 311 | } 312 | elsif ( ref $data eq 'HASH' ) { 313 | $retval = $self->_clean($data); 314 | } 315 | else { 316 | $retval = $data; 317 | } 318 | 319 | return $retval; 320 | } 321 | 322 | sub _send { 323 | my $self = shift; 324 | my $query = shift; 325 | my $args = shift || {}; 326 | 327 | if ( $ENV{RDB_DEBUG} ) { 328 | use feature ':5.10'; 329 | use Data::Dumper; 330 | $Data::Dumper::Indent = 1; 331 | say {*STDERR} 'SENDING:'; 332 | say {*STDERR} Dumper $query; 333 | } 334 | 335 | my $token; 336 | my $length; 337 | 338 | my $serial = $self->_encode( $query, $args ); 339 | my $header = pack 'QL<', $query->{token}, length $serial; 340 | 341 | if ( $ENV{RDB_DEBUG} ) { 342 | say 'SENDING:'; 343 | say {*STDERR} Dumper $serial; 344 | } 345 | 346 | # send message 347 | $self->_handle->send( $header . $serial ); 348 | 349 | # noreply should just return 350 | if ( $args->{noreply} ) { 351 | return; 352 | } 353 | 354 | # receive message 355 | my $data = q{}; 356 | 357 | $self->_handle->recv( $token, 8 ); 358 | $token = unpack 'Q<', $token; 359 | 360 | $self->_handle->recv( $length, 4 ); 361 | $length = unpack 'L<', $length; 362 | 363 | # if we couldn't unpack a length, say it is zero 364 | $length ||= 0; 365 | 366 | my $_data; 367 | do { 368 | $self->_handle->recv( $_data, 4096 ); 369 | $data = $data . $_data; 370 | } until ( length($data) eq $length ); 371 | 372 | # decode RQL data 373 | my $res_data = $self->_decode($data); 374 | $res_data->{token} = $token; 375 | 376 | # handle partial response 377 | if ( $res_data->{t} == 3 ) { 378 | if ( $self->_callbacks->{$token} ) { 379 | my $res = Rethinkdb::Response->_init( $res_data, $args ); 380 | 381 | if ( $ENV{RDB_DEBUG} ) { 382 | say {*STDERR} 'RECEIVED:'; 383 | say {*STDERR} Dumper $res; 384 | } 385 | 386 | # send what we have 387 | $self->_callbacks->{$token}->($res); 388 | 389 | # fetch more 390 | return $self->_send( 391 | { 392 | type => $self->_protocol->query->queryType->continue, 393 | token => $token 394 | } 395 | ); 396 | } 397 | else { 398 | if ( $ENV{RDB_DEBUG} ) { 399 | say {*STDERR} 'RECEIVED:'; 400 | say {*STDERR} Dumper $res_data; 401 | } 402 | 403 | # fetch the rest of the data if partial 404 | my $more = $self->_send( 405 | { 406 | type => $self->_protocol->query->queryType->continue, 407 | token => $token 408 | } 409 | ); 410 | 411 | push @{ $res_data->{r} }, @{ $more->response }; 412 | $res_data->{t} = $more->type; 413 | } 414 | } 415 | 416 | # put data in response 417 | my $res = Rethinkdb::Response->_init( $res_data, $args ); 418 | 419 | if ( $ENV{RDB_DEBUG} ) { 420 | say {*STDERR} 'RECEIVED:'; 421 | say {*STDERR} Dumper $res_data; 422 | say {*STDERR} Dumper $res; 423 | } 424 | 425 | # if there is callback return data to that 426 | if ( $self->_callbacks->{$token} ) { 427 | my $cb = $self->_callbacks->{$token}; 428 | delete $self->_callbacks->{$token}; 429 | return $cb->($res); 430 | } 431 | 432 | return $res; 433 | } 434 | 435 | 1; 436 | 437 | =encoding utf8 438 | 439 | =head1 NAME 440 | 441 | Rethinkdb::IO - RethinkDB IO 442 | 443 | =head1 SYNOPSIS 444 | 445 | package MyApp; 446 | use Rethinkdb::IO; 447 | 448 | my $io = Rethinkdb::IO->new->connect; 449 | $io->use('marvel'); 450 | $io->close; 451 | 452 | =head1 DESCRIPTION 453 | 454 | This module handles communicating with the RethinkDB Database. 455 | 456 | =head1 ATTRIBUTES 457 | 458 | L implements the following attributes. 459 | 460 | =head2 host 461 | 462 | my $io = Rethinkdb::IO->new->connect; 463 | my $host = $io->host; 464 | $io->host('r.example.com'); 465 | 466 | The C attribute returns or sets the current host name that 467 | L is currently set to use. 468 | 469 | =head2 port 470 | 471 | my $io = Rethinkdb::IO->new->connect; 472 | my $port = $io->port; 473 | $io->port(1212); 474 | 475 | The C attribute returns or sets the current port number that 476 | L is currently set to use. 477 | 478 | =head2 default_db 479 | 480 | my $io = Rethinkdb::IO->new->connect; 481 | my $port = $io->default_db; 482 | $io->default_db('marvel'); 483 | 484 | The C attribute returns or sets the current database name that 485 | L is currently set to use. 486 | 487 | =head2 auth_key 488 | 489 | my $io = Rethinkdb::IO->new->connect; 490 | my $port = $io->auth_key; 491 | $io->auth_key('setec astronomy'); 492 | 493 | The C attribute returns or sets the current authentication key that 494 | L is currently set to use. 495 | 496 | =head2 timeout 497 | 498 | my $io = Rethinkdb::IO->new->connect; 499 | my $timeout = $io->timeout; 500 | $io->timeout(60); 501 | 502 | The C attribute returns or sets the timeout length that 503 | L is currently set to use. 504 | 505 | =head1 METHODS 506 | 507 | L inherits all methods from L and implements 508 | the following methods. 509 | 510 | =head2 connect 511 | 512 | my $io = Rethinkdb::IO->new; 513 | $io->host('rdb.example.com'); 514 | $io->connect->repl; 515 | 516 | The C method initiates the connection to the RethinkDB database. 517 | 518 | =head2 close 519 | 520 | my $io = Rethinkdb::IO->new; 521 | $io->host('rdb.example.com'); 522 | $io->connect; 523 | $io->close; 524 | 525 | The C method closes the current connection to the RethinkDB database. 526 | 527 | =head2 reconnect 528 | 529 | my $io = Rethinkdb::IO->new; 530 | $io->host('rdb.example.com'); 531 | $io->connect; 532 | $io->reconnect; 533 | 534 | The C method closes and reopens a connection to the RethinkDB 535 | database. 536 | 537 | =head2 repl 538 | 539 | my $io = Rethinkdb::IO->new; 540 | $io->host('rdb.example.com'); 541 | $io->connect->repl; 542 | 543 | The C method caches the current connection in to the main program so that 544 | it is available to for all L queries without specifically specifying 545 | one. 546 | 547 | =head2 use 548 | 549 | my $io = Rethinkdb::IO->new; 550 | $io->use('marven'); 551 | $io->connect; 552 | 553 | The C method sets the default database name to use for all queries that 554 | use this connection. 555 | 556 | =head2 noreply_wait 557 | 558 | my $io = Rethinkdb::IO->new; 559 | $io->noreply_wait; 560 | 561 | The C method will tell the database to wait until all "no reply" 562 | have executed before responding. 563 | 564 | =head2 server 565 | 566 | my $conn = r->connect; 567 | $conn->server; 568 | 569 | Return information about the server being used by this connection. 570 | 571 | The server command returns either two or three fields: 572 | 573 | =over 574 | 575 | =item C: the UUID of the server the client is connected to. 576 | 577 | =item C: a boolean indicating whether the server is a L. 578 | 579 | =item C: the server name. If proxy is C<< r->true >>, this field will not 580 | be returned. 581 | 582 | =back 583 | 584 | =head1 SEE ALSO 585 | 586 | L, L 587 | 588 | =cut 589 | -------------------------------------------------------------------------------- /t/datetime.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | 3 | plan skip_all => 'set TEST_ONLINE to enable this test' 4 | unless $ENV{TEST_ONLINE}; 5 | 6 | use Rethinkdb; 7 | 8 | # setup 9 | my $conn = r->connect->repl; 10 | r->db('test')->drop->run; 11 | r->db('test')->create->run; 12 | r->db('test')->table('marvel')->create( primary_key => 'superhero' )->run; 13 | r->table('marvel')->insert( 14 | [ 15 | { 16 | user_id => 1, 17 | superhero => 'Iron Man', 18 | superpower => 'Arc Reactor', 19 | active => 1, 20 | age => 35, 21 | villians => { count => 5 }, 22 | birthdate => r->iso8601('1986-01-06T10:01:00-08:00'), 23 | }, 24 | { 25 | user_id => 2, 26 | superhero => 'Hulk', 27 | superpower => 'Smash', 28 | active => 1, 29 | age => 35, 30 | villians => { count => 6 }, 31 | birthdate => r->iso8601('1986-02-18T18:05:00-08:00'), 32 | }, 33 | { 34 | user_id => 3, 35 | superhero => 'Captain America', 36 | superpower => 'Super Strength', 37 | active => 1, 38 | age => 135, 39 | villians => { count => 7 }, 40 | birthdate => r->iso8601('1986-03-05T06:08:00-08:00'), 41 | }, 42 | { 43 | user_id => 4, 44 | superhero => 'Thor', 45 | superpower => 'God-like powers', 46 | active => 1, 47 | age => 1035, 48 | villians => { count => 8 }, 49 | birthdate => r->iso8601('1986-04-17T08:10:00-08:00'), 50 | }, 51 | { 52 | user_id => 5, 53 | superhero => 'Hawk-Eye', 54 | superpower => 'Bow-n-arrow', 55 | active => 0, 56 | age => 35, 57 | villians => { count => 9 }, 58 | birthdate => r->iso8601('1986-05-09T08:12:00-08:00'), 59 | }, 60 | { 61 | user_id => 6, 62 | superhero => 'Wasp', 63 | superpower => 'Bio-lasers', 64 | active => 0, 65 | age => 35, 66 | villians => { count => 5 }, 67 | birthdate => r->iso8601('1986-06-14T08:30:00-08:00'), 68 | }, 69 | { 70 | user_id => 7, 71 | superhero => 'Ant-Man', 72 | superpower => 'Size', 73 | active => 1, 74 | age => 35, 75 | villians => { count => 10 }, 76 | birthdate => r->iso8601('1986-07-06T07:17:00-08:00'), 77 | }, 78 | { 79 | user_id => 8, 80 | superhero => 'Wolverine', 81 | superpower => 'Adamantium', 82 | active => 0, 83 | age => 35, 84 | villians => { count => 1 }, 85 | birthdate => r->iso8601('1986-08-10T08:35:04-08:00'), 86 | }, 87 | { 88 | user_id => 9, 89 | superhero => 'Spider-Man', 90 | superpower => 'Spidy Sense', 91 | active => 0, 92 | age => 20, 93 | villians => { count => 2 }, 94 | birthdate => r->iso8601('1986-09-04T08:55:03-08:00'), 95 | }, 96 | { 97 | user_id => 10, 98 | superhero => 'Quicksilver', 99 | superpower => 'Superhuman Speed', 100 | active => 0, 101 | age => 20, 102 | villians => { count => 2 }, 103 | birthdate => r->iso8601('1986-10-04T08:55:03-08:00'), 104 | }, 105 | { 106 | user_id => 11, 107 | superhero => 'Scarlet Witch', 108 | superpower => 'Chaos Magic', 109 | active => 0, 110 | age => 20, 111 | villians => { count => 2 }, 112 | birthdate => r->iso8601('1986-11-04T08:55:03-08:00'), 113 | }, 114 | { 115 | user_id => 12, 116 | superhero => 'Vision', 117 | superpower => 'Density Control', 118 | active => 0, 119 | age => 20, 120 | villians => { count => 2 }, 121 | birthdate => r->iso8601('1986-12-04T08:55:03-08:00'), 122 | }, 123 | ] 124 | )->run; 125 | 126 | my $res; 127 | 128 | # now 129 | $res = r->table('marvel')->insert( { superhero => 'Bob', joined => r->now, } ) 130 | ->run; 131 | 132 | is $res->type, 1, 'Correct response type'; 133 | is $res->response->{inserted}, 1, 'Correct response'; 134 | 135 | # time 136 | $res = r->table('marvel')->get('Bob') 137 | ->update( { birthdate1 => r->time( 1986, 11, 3, 'Z' ) } )->run; 138 | 139 | is $res->type, 1, 'Correct response type'; 140 | is $res->response->{replaced}, 1, 'Correct response'; 141 | 142 | # epoch_time 143 | $res = r->table('marvel')->get('Bob') 144 | ->update( { birthdate2 => r->epoch_time(531360000) } )->run; 145 | 146 | is $res->type, 1, 'Correct response type'; 147 | is $res->response->{replaced}, 1, 'Correct response'; 148 | 149 | # iso8601 150 | $res = r->table('marvel')->get('Bob') 151 | ->update( { birthdate => r->iso8601('1986-11-03T08:30:00-07:00') } )->run; 152 | 153 | is $res->type, 1, 'Correct response type'; 154 | is $res->response->{replaced}, 1, 'Correct response'; 155 | 156 | # in_timezone 157 | $res = r->iso8601('1986-11-03T08:30:00-07:00')->in_timezone('-08:00') 158 | ->hours->run($conn); 159 | 160 | is $res->type, 1, 'Correct response type'; 161 | is $res->response, 7, 'Correct response'; 162 | 163 | # timezone 164 | $res = r->table("marvel")->filter( 165 | sub { 166 | my $hero = shift; 167 | $hero->bracket('birthdate')->timezone->eq('-07:00'); 168 | } 169 | )->run; 170 | 171 | is $res->type, 2, 'Correct response type'; 172 | is scalar @{ $res->response }, 1, 'Correct response'; 173 | is $res->response->[0]->{superhero}, 'Bob', 'Correct response'; 174 | 175 | # during 176 | $res 177 | = r->table('marvel') 178 | ->filter( r->row->bracket('birthdate') 179 | ->during( r->time( 1986, 12, 1, 'Z' ), r->time( 1986, 12, 10, 'Z' ) ) ) 180 | ->run; 181 | 182 | is $res->type, 2, 'Correct response type'; 183 | is scalar @{ $res->response }, 1, 'Correct response'; 184 | 185 | $res = r->table('marvel')->filter( 186 | r->row->bracket('birthdate')->during( 187 | r->time( 1986, 12, 1, 'Z' ), 188 | r->time( 1986, 12, 10, 'Z' ), 189 | { left_bound => "open", right_bound => "closed" } 190 | ) 191 | )->run; 192 | 193 | is $res->type, 2, 'Correct response type'; 194 | is scalar @{ $res->response }, 1, 'Correct response'; 195 | 196 | # date 197 | $res = r->table('marvel')->filter( 198 | sub { 199 | my $hero = shift; 200 | $hero->bracket('birthdate')->date->eq( r->now->date ); 201 | } 202 | )->run; 203 | 204 | is $res->type, 2, 'Correct response type'; 205 | is_deeply $res->response, [], 'Correct response'; 206 | 207 | # time_of_day 208 | $res = r->table('marvel')->filter( 209 | sub { 210 | my $hero = shift; 211 | $hero->bracket('birthdate')->time_of_day->ge( 12 * 60 * 60 ); 212 | } 213 | )->run; 214 | 215 | is $res->type, 2, 'Correct response type'; 216 | is @{$res->response}, 1, 'Correct response'; 217 | is $res->response->[0]->{superhero}, 'Hulk', 'Correct response'; 218 | 219 | # year 220 | $res = r->table('marvel')->filter( 221 | sub { 222 | my $hero = shift; 223 | $hero->bracket('birthdate')->year->eq(1986); 224 | } 225 | )->run; 226 | 227 | is $res->type, 2, 'Correct response type'; 228 | is scalar @{ $res->response }, 13, 'Correct response'; 229 | 230 | # month 231 | $res = r->table('marvel')->filter( 232 | sub { 233 | my $hero = shift; 234 | $hero->bracket('birthdate')->month->eq(12); 235 | } 236 | )->run; 237 | 238 | is $res->type, 2, 'Correct response type'; 239 | is scalar @{ $res->response }, 1, 'Correct response'; 240 | 241 | # month / january 242 | $res = r->table('marvel')->filter( 243 | sub { 244 | my $hero = shift; 245 | $hero->bracket('birthdate')->month->eq( r->january ); 246 | } 247 | )->run; 248 | 249 | is $res->type, 2, 'Correct response type'; 250 | is scalar @{ $res->response }, 1, 'Correct response'; 251 | 252 | # month / february 253 | $res = r->table('marvel')->filter( 254 | sub { 255 | my $hero = shift; 256 | $hero->bracket('birthdate')->month->eq( r->february ); 257 | } 258 | )->run; 259 | 260 | is $res->type, 2, 'Correct response type'; 261 | is scalar @{ $res->response }, 1, 'Correct response'; 262 | 263 | # month / march 264 | $res = r->table('marvel')->filter( 265 | sub { 266 | my $hero = shift; 267 | $hero->bracket('birthdate')->month->eq( r->march ); 268 | } 269 | )->run; 270 | 271 | is $res->type, 2, 'Correct response type'; 272 | is scalar @{ $res->response }, 1, 'Correct response'; 273 | 274 | # month / april 275 | $res = r->table('marvel')->filter( 276 | sub { 277 | my $hero = shift; 278 | $hero->bracket('birthdate')->month->eq( r->april ); 279 | } 280 | )->run; 281 | 282 | is $res->type, 2, 'Correct response type'; 283 | is scalar @{ $res->response }, 1, 'Correct response'; 284 | 285 | # month / may 286 | $res = r->table('marvel')->filter( 287 | sub { 288 | my $hero = shift; 289 | $hero->bracket('birthdate')->month->eq( r->may ); 290 | } 291 | )->run; 292 | 293 | is $res->type, 2, 'Correct response type'; 294 | is scalar @{ $res->response }, 1, 'Correct response'; 295 | 296 | # month / june 297 | $res = r->table('marvel')->filter( 298 | sub { 299 | my $hero = shift; 300 | $hero->bracket('birthdate')->month->eq( r->june ); 301 | } 302 | )->run; 303 | 304 | is $res->type, 2, 'Correct response type'; 305 | is scalar @{ $res->response }, 1, 'Correct response'; 306 | 307 | # month / july 308 | $res = r->table('marvel')->filter( 309 | sub { 310 | my $hero = shift; 311 | $hero->bracket('birthdate')->month->eq( r->july ); 312 | } 313 | )->run; 314 | 315 | is $res->type, 2, 'Correct response type'; 316 | is scalar @{ $res->response }, 1, 'Correct response'; 317 | 318 | # month / august 319 | $res = r->table('marvel')->filter( 320 | sub { 321 | my $hero = shift; 322 | $hero->bracket('birthdate')->month->eq( r->august ); 323 | } 324 | )->run; 325 | 326 | is $res->type, 2, 'Correct response type'; 327 | is scalar @{ $res->response }, 1, 'Correct response'; 328 | 329 | # month / september 330 | $res = r->table('marvel')->filter( 331 | sub { 332 | my $hero = shift; 333 | $hero->bracket('birthdate')->month->eq( r->september ); 334 | } 335 | )->run; 336 | 337 | is $res->type, 2, 'Correct response type'; 338 | is scalar @{ $res->response }, 1, 'Correct response'; 339 | 340 | # month / november 341 | $res = r->table('marvel')->filter( 342 | sub { 343 | my $hero = shift; 344 | $hero->bracket('birthdate')->month->eq( r->november ); 345 | } 346 | )->run; 347 | 348 | is $res->type, 2, 'Correct response type'; 349 | is scalar @{ $res->response }, 2, 'Correct response'; 350 | 351 | # month / december 352 | $res = r->table('marvel')->filter( 353 | sub { 354 | my $hero = shift; 355 | $hero->bracket('birthdate')->month->eq( r->december ); 356 | } 357 | )->run; 358 | 359 | is $res->type, 2, 'Correct response type'; 360 | is scalar @{ $res->response }, 1, 'Correct response'; 361 | 362 | # month / december 363 | $res = r->table('marvel')->filter( 364 | sub { 365 | my $hero = shift; 366 | $hero->bracket('birthdate')->month->eq( r->december ); 367 | } 368 | )->run; 369 | 370 | is $res->type, 2, 'Correct response type'; 371 | is scalar @{ $res->response }, 1, 'Correct response'; 372 | 373 | # day 374 | $res = r->table('marvel')->filter( 375 | sub { 376 | my $hero = shift; 377 | $hero->bracket('birthdate')->day->eq(4); 378 | } 379 | )->run; 380 | 381 | is $res->type, 2, 'Correct response type'; 382 | is scalar @{ $res->response }, 4, 'Correct response'; 383 | 384 | # day_of_week 385 | $res = r->table('marvel')->filter( 386 | sub { 387 | my $hero = shift; 388 | $hero->bracket('birthdate')->day_of_week->eq(2); 389 | } 390 | )->run; 391 | 392 | is $res->type, 2, 'Correct response type'; 393 | is scalar @{ $res->response }, 2, 'Correct response'; 394 | 395 | # day_of_week / monday 396 | $res = r->table('marvel')->filter( 397 | sub { 398 | my $hero = shift; 399 | $hero->bracket('birthdate')->day_of_week->eq( r->monday ); 400 | } 401 | )->run; 402 | 403 | is $res->type, 2, 'Correct response type'; 404 | is scalar @{ $res->response }, 2, 'Correct response'; 405 | 406 | # day_of_week / tuesday 407 | $res = r->table('marvel')->filter( 408 | sub { 409 | my $hero = shift; 410 | $hero->bracket('birthdate')->day_of_week->eq( r->tuesday ); 411 | } 412 | )->run; 413 | 414 | is $res->type, 2, 'Correct response type'; 415 | is scalar @{ $res->response }, 2, 'Correct response'; 416 | 417 | # day_of_week / wednesday 418 | $res = r->table('marvel')->filter( 419 | sub { 420 | my $hero = shift; 421 | $hero->bracket('birthdate')->day_of_week->eq( r->wednesday ); 422 | } 423 | )->run; 424 | 425 | is $res->type, 2, 'Correct response type'; 426 | is scalar @{ $res->response }, 1, 'Correct response'; 427 | 428 | # day_of_week / thursday 429 | $res = r->table('marvel')->filter( 430 | sub { 431 | my $hero = shift; 432 | $hero->bracket('birthdate')->day_of_week->eq( r->thursday ); 433 | } 434 | )->run; 435 | 436 | is $res->type, 2, 'Correct response type'; 437 | is scalar @{ $res->response }, 3, 'Correct response'; 438 | 439 | # day_of_week / friday 440 | $res = r->table('marvel')->filter( 441 | sub { 442 | my $hero = shift; 443 | $hero->bracket('birthdate')->day_of_week->eq( r->friday ); 444 | } 445 | )->run; 446 | 447 | is $res->type, 2, 'Correct response type'; 448 | is scalar @{ $res->response }, 1, 'Correct response'; 449 | 450 | # day_of_week / saturday 451 | $res = r->table('marvel')->filter( 452 | sub { 453 | my $hero = shift; 454 | $hero->bracket('birthdate')->day_of_week->eq( r->saturday ); 455 | } 456 | )->run; 457 | 458 | is $res->type, 2, 'Correct response type'; 459 | is scalar @{ $res->response }, 2, 'Correct response'; 460 | 461 | # day_of_week / sunday 462 | $res = r->table('marvel')->filter( 463 | sub { 464 | my $hero = shift; 465 | $hero->bracket('birthdate')->day_of_week->eq( r->sunday ); 466 | } 467 | )->run; 468 | 469 | is $res->type, 2, 'Correct response type'; 470 | is scalar @{ $res->response }, 2, 'Correct response'; 471 | 472 | # day_of_year 473 | $res = r->table('marvel') 474 | ->filter( r->row->bracket('birthdate')->day_of_year->eq(308) )->run; 475 | 476 | is $res->type, 2, 'Correct response type'; 477 | is scalar @{ $res->response }, 1, 'Correct response'; 478 | 479 | # hours 480 | $res = r->table('marvel')->filter( r->row->bracket('birthdate')->hours->lt(7) ) 481 | ->run; 482 | 483 | is $res->type, 2, 'Correct response type'; 484 | is scalar @{ $res->response }, 1, 'Correct response'; 485 | 486 | # minutes 487 | $res = r->table('marvel') 488 | ->filter( r->row->bracket('birthdate')->minutes->lt(10) )->run; 489 | 490 | is $res->type, 2, 'Correct response type'; 491 | is scalar @{ $res->response }, 3, 'Correct response'; 492 | 493 | # seconds 494 | $res 495 | = r->table('marvel')->filter( r->row->bracket('birthdate')->seconds->gt(1) ) 496 | ->run; 497 | 498 | is $res->type, 2, 'Correct response type'; 499 | is scalar @{ $res->response }, 5, 'Correct response'; 500 | 501 | # to_iso8601 502 | $res = r->time( 1986, 11, 3, 'Z' )->to_iso8601->run($conn); 503 | 504 | is $res->type, 1, 'Correct response type'; 505 | is $res->response, '1986-11-03T00:00:00+00:00', 'Correct response'; 506 | 507 | # to_epoch_time 508 | $res = r->time( 1986, 11, 3, 'Z' )->to_epoch_time->run($conn); 509 | 510 | is $res->type, 1, 'Correct response type'; 511 | is $res->response, '531360000', 'Correct response'; 512 | 513 | # clean up 514 | r->db('test')->drop->run; 515 | 516 | done_testing(); 517 | --------------------------------------------------------------------------------