├── .github └── workflows │ └── ci.yml ├── .gitignore ├── .perltidyrc ├── Changes ├── MANIFEST.SKIP ├── Makefile.PL ├── README.md ├── cpanfile ├── examples ├── cache.pl ├── chat.pl └── twitter.pl ├── lib └── Mojo │ ├── Redis.pm │ └── Redis │ ├── Cache.pm │ ├── Connection.pm │ ├── Cursor.pm │ ├── Database.pm │ └── PubSub.pm └── t ├── 00-project.t ├── benchmark.t ├── cache-offline.t ├── cache.t ├── connection-auth.t ├── connection-lost.t ├── connection-sentinel.t ├── connection-unix.t ├── connection.t ├── cursor.t ├── db.t ├── geo.t ├── keyspace-listen.t ├── method-coverage.t ├── pipelining.t ├── pubsub-reconnect.t ├── pubsub.t ├── redis.t ├── scripting.t ├── txn.t └── xread.t /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: ci 2 | on: 3 | pull_request: 4 | push: 5 | branches: 6 | - "**" 7 | jobs: 8 | perl: 9 | name: "Perl ${{matrix.perl}}, Redis ${{matrix.redis}}" 10 | strategy: 11 | matrix: 12 | os: ["ubuntu-latest"] 13 | perl: ["5.32"] 14 | redis: ["5", "latest"] 15 | runs-on: "${{matrix.os}}" 16 | steps: 17 | - uses: actions/checkout@v2 18 | - name: Setup redis 19 | uses: shogo82148/actions-setup-redis@v1 20 | with: 21 | redis-version: ${{ matrix.redis }} 22 | auto-start: true 23 | - uses: shogo82148/actions-setup-perl@v1 24 | with: 25 | perl-version: "${{matrix.perl}}" 26 | - run: redis-cli --version 27 | - run: perl -V 28 | - name: Fix ExtUtils::MakeMaker for Perl 5.16 29 | run: cpanm -n App::cpanminus ExtUtils::MakeMaker 30 | - name: Install dependencies 31 | run: | 32 | cpanm -n Test::CPAN::Changes Test::Pod::Coverage Test::Pod Test::Spelling 33 | cpanm -n --installdeps . 34 | - name: Run tests 35 | run: prove -l t/*.t 36 | env: 37 | HARNESS_OPTIONS: j4 38 | TEST_ONLINE: "redis://127.0.0.1:${{steps.setup.outputs.redis-port}}" 39 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ~$ 2 | *.bak 3 | *.old 4 | *.swp 5 | /blib/ 6 | /cover_db 7 | /inc/ 8 | /local 9 | /Makefile 10 | /Makefile.old 11 | /MANIFEST$ 12 | /MANIFEST.bak 13 | /META* 14 | /MYMETA* 15 | /pm_to_blib 16 | -------------------------------------------------------------------------------- /.perltidyrc: -------------------------------------------------------------------------------- 1 | -pbp # Start with Perl Best Practices 2 | -w # Show all warnings 3 | -iob # Ignore old breakpoints 4 | -l=120 # 120 characters per line 5 | -mbl=2 # No more than 2 blank lines 6 | -i=2 # Indentation is 2 columns 7 | -ci=2 # Continuation indentation is 2 columns 8 | -vt=0 # Less vertical tightness 9 | -pt=2 # High parenthesis tightness 10 | -bt=2 # High brace tightness 11 | -sbt=2 # High square bracket tightness 12 | -isbc # Don't indent comments without leading space 13 | -wn # Opening and closing containers to be "welded" together 14 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for perl distribution Mojo-Redis 2 | 3 | 3.29 2022-02-23T14:56:18+0900 4 | - Fix use of "defined" in unit test 5 | 6 | 3.28 2022-02-21T15:40:56+0900 7 | - Add channel to Mojo::Redis::PubSub::listen() callback 8 | 9 | 3.27 2021-11-20T10:51:49+0900 10 | - Add experimental "subscribe" and "psubscribe" events to Mojo::Redis::PubSub 11 | - Fix examples for set and expire #62 12 | - Fix handling "psubscribe" response from Redis #63 13 | - Fix sending database requests after connecting to sentinel server #64 14 | - Fix only passing on (p)message messages to listen handlers #67 15 | - Remove experimental write_q() method, and replaced it with write() 16 | - Remove the ->multi_p(@promises) syntax #68 #70 17 | Contributor: Jan "Yenya" Kasprzak 18 | 19 | 3.26 2021-03-01T09:01:51+0900 20 | - Avoid circular reference in redis response parser 21 | Contributor: Dan Book 22 | 23 | 3.25 2020-10-02T10:21:30+0900 24 | - Fix handling undef() in _process_...() methods #56 25 | - Fix some leaks in Mojo::Redis::PubSub 26 | - Add Mojo::Redis::PubSub->notify_p() 27 | 28 | 3.24 2019-05-07T22:25:50+0700 29 | - Fix PubSub->keyspace_listen() #42 30 | 31 | 3.23 2019-05-04T21:12:25+0700 32 | - Fix compatibility with Mojolicious 8.15 #46 33 | 34 | 3.22 2019-04-24T12:32:18+0700 35 | - Forgot to update protocol parser for Mojo::Redis::Cache after 3.21 #43 36 | - Fix broken link in Mojo::Redis::Connection #44 37 | Contributor: Mohammad S Anwar 38 | 39 | 3.21 2019-04-16T09:58:44+0700 40 | - Changed default protocol parser to Protocol::Redis::XS #43 41 | 42 | 3.20 2019-04-04T10:31:03+0700 43 | - Use Protocol::Redis::Faster instead of Protocol::Redis #38 44 | - Only decode data from bulk string responses #40 45 | - Fix allowing custom URL object with userinfo in constructor #41 46 | 47 | 3.19 2019-01-31T13:03:11+0900 48 | - Add support for encoding and decoding of JSON messages in Mojo::Redis::PubSub 49 | 50 | 3.18 2019-01-31T12:39:46+0900 51 | - Add reconnect logic for Mojo::Redis::PubSub #37 52 | - Add CAVEATS for Protocol::Redis::XS #38 53 | - Changed default protocol to Protocol::Redis #38 54 | - Updated documentation to use nicer variable names 55 | 56 | 3.17 2018-12-17T19:03:43+0900 57 | - Made connection-lost.t more robust 58 | - Add xread_structured() method 59 | - Add failing test for xread and Protocol::Redis::XS 60 | 61 | 3.16 2018-12-14T19:39:18+0900 62 | - Fix $db object from reconnecting #33 63 | 64 | 3.15 2018-12-13T08:24:10+0900 65 | - Fix connection-lost.t in other languages #30 66 | - Bumped Mojolicious version for Mojo::Promise support #32 67 | 68 | 3.14 2018-12-12T23:10:30+0900 69 | - Fix fork-safity for the blocking connection #28 70 | - Fix connection-lost.t in other languages #29 71 | 72 | 3.13 2018-12-11T14:44:45+0900 73 | - Fix rejecting promises when connection is lost #24 74 | - Fix connection.t when using a remote server #25 75 | - Fix cursor.t to use TEST_ONLINE #26 #27 76 | Contributor: Alexander Karelas 77 | 78 | 3.12 2018-12-07T12:04:19+0900 79 | - Add support for negative cache expire for serving stale data 80 | - Add destructor to Connection object to clean up connections 81 | - Add "close" event to Connection object 82 | 83 | 3.11 2018-08-17T00:01:33+0200 84 | - Fix invalid Makefile.PL 85 | 86 | 3.10 2018-08-16T23:41:10+0200 87 | - Add cluster commands #5 88 | - Add basic support for sentinel #13 89 | 90 | 3.09 2018-08-09T15:32:24+0200 91 | - Improved documentation for Cache 92 | 93 | 3.08 2018-08-02T15:37:32+0800 94 | - Add benchmark test #3 95 | - Fix cache() need to use Protocol::Redis because of binary data 96 | - Fix GEOPOS return value 97 | - Fix only decode response data if defined #19 98 | - Fix do not create new connection objects during global destruction 99 | - Improved return values in documentation 100 | 101 | 3.07 2018-07-12T09:59:05+0800 102 | - Add support for sending custom commands #18 103 | - Fix documentation issues 104 | - Will not enqueue connections if url() has changed 105 | 106 | 3.06 2018-07-11T11:00:01+0800 107 | - Fix processing exec() result 108 | - Improved example applications and add references from the POD 109 | 110 | 3.05 2018-07-11T10:24:59+0800 111 | - Fix holding $db in memory when issuing commands and returning promises 112 | - Add info_structured() method to Mojo::Redis::Database 113 | - Add example of Mojolicious application using Mojo::Redis::Cache 114 | 115 | 3.04 2018-07-11T09:24:09+0800 116 | - Add server commands #4 117 | - Add stream commands #6 118 | - Add support for keyspace notifications #10 119 | - Documented how pipelining works #7 120 | 121 | 3.03 2018-07-05T11:45:01+0800 122 | - Add eval(), evalsha() and script() #8 123 | - Cannot have a custom class for transactions #14 124 | 125 | 3.02 2018-07-01T18:24:37+0900 126 | - Add Mojo::Redis::Cache->memomize_p() 127 | - Add examples/twitter.pl 128 | - Add UTF-8 encoding as default and allow encoding to be changed #1 129 | - Add documentation for events #2 130 | - Add support for connecting to unix socket #12 131 | - Add support for offline cache #15 132 | - Add support for refreshing cache #16 133 | 134 | 3.01 2018-06-28T15:22:47+0900 135 | - Add Mojo::Redis::Cache 136 | - Add examples/chat.pl 137 | 138 | 3.00 2018-06-28T10:11:24+0900 139 | - Started on a new version to replace Mojo::Redis2 and the old Mojo::Redis 140 | - Mojo::Redis as EXPERIMENTAL 141 | - Add connection pool 142 | - Add Mojo::Redis::Cursor 143 | - Add Mojo::Redis::Database 144 | - Add Mojo::Redis::PubSub 145 | - Add Mojo::Redis::Transaction 146 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | # Avoid version control files. 2 | \bRCS\b 3 | \bCVS\b 4 | \bSCCS\b 5 | ,v$ 6 | \B\.svn\b 7 | \B\.git\b 8 | \B\.gitignore\b 9 | \b_darcs\b 10 | \B\.cvsignore$ 11 | 12 | # Avoid VMS specific MakeMaker generated files 13 | \bDescrip.MMS$ 14 | \bDESCRIP.MMS$ 15 | \bdescrip.mms$ 16 | 17 | # Avoid Makemaker generated and utility files. 18 | \bMANIFEST\.bak 19 | \bMakefile$ 20 | \bblib/ 21 | \bMakeMaker-\d 22 | \bpm_to_blib\.ts$ 23 | \bpm_to_blib$ 24 | \bblibdirs\.ts$ # 6.18 through 6.25 generated this 25 | \b_eumm/ # 7.05_05 and above 26 | 27 | # Avoid Module::Build generated and utility files. 28 | \bBuild$ 29 | \b_build/ 30 | \bBuild.bat$ 31 | \bBuild.COM$ 32 | \bBUILD.COM$ 33 | \bbuild.com$ 34 | 35 | # and Module::Build::Tiny generated files 36 | \b_build_params$ 37 | 38 | # Avoid temp and backup files. 39 | ~$ 40 | \.old$ 41 | \#$ 42 | \b\.# 43 | \.bak$ 44 | \.tmp$ 45 | \.# 46 | \.rej$ 47 | \..*\.sw.?$ 48 | 49 | # Avoid OS-specific files/dirs 50 | # Mac OSX metadata 51 | \B\.DS_Store 52 | # Mac OSX SMB mount metadata files 53 | \B\._ 54 | 55 | # Avoid Devel::Cover and Devel::CoverX::Covered files. 56 | \bcover_db\b 57 | \bcovered\b 58 | 59 | # Avoid prove files 60 | \B\.prove$ 61 | 62 | # Avoid MYMETA files 63 | ^MYMETA\. 64 | #!end included /usr/local/Cellar/perl/5.24.1/lib/perl5/5.24.1/ExtUtils/MANIFEST.SKIP 65 | 66 | \.swp$ 67 | ^local/ 68 | ^\.github 69 | ^\.pls_cache 70 | ^\.vstags 71 | ^MANIFEST\.SKIP 72 | ^README\.pod 73 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | # Generated by git-ship. See 'git-ship --man' for help or https://github.com/jhthorsen/app-git-ship 2 | use utf8; 3 | use ExtUtils::MakeMaker; 4 | my %WriteMakefileArgs = ( 5 | NAME => 'Mojo::Redis', 6 | AUTHOR => 'Jan Henning Thorsen ', 7 | LICENSE => 'artistic_2', 8 | ABSTRACT_FROM => 'lib/Mojo/Redis.pm', 9 | VERSION_FROM => 'lib/Mojo/Redis.pm', 10 | EXE_FILES => [qw()], 11 | OBJECT => '', 12 | BUILD_REQUIRES => {}, 13 | TEST_REQUIRES => {'Test::More' => '0.88'}, 14 | PREREQ_PM => {'Mojolicious' => '8.50', 'Protocol::Redis::Faster' => '0.002', 'perl' => '5.016'}, 15 | META_MERGE => { 16 | 'dynamic_config' => 0, 17 | 'meta-spec' => {version => 2}, 18 | 'resources' => { 19 | bugtracker => {web => 'https://github.com/jhthorsen/mojo-redis/issues'}, 20 | homepage => 'https://github.com/jhthorsen/mojo-redis', 21 | repository => { 22 | type => 'git', 23 | url => 'https://github.com/jhthorsen/mojo-redis.git', 24 | web => 'https://github.com/jhthorsen/mojo-redis', 25 | }, 26 | }, 27 | 'x_contributors' => ['Jan Henning Thorsen ', 'Dan Book '], 28 | }, 29 | test => {TESTS => (-e 'META.yml' ? 't/*.t' : 't/*.t xt/*.t')}, 30 | ); 31 | 32 | unless (eval { ExtUtils::MakeMaker->VERSION('6.63_03') }) { 33 | my $test_requires = delete $WriteMakefileArgs{TEST_REQUIRES}; 34 | @{$WriteMakefileArgs{PREREQ_PM}}{keys %$test_requires} = values %$test_requires; 35 | } 36 | 37 | WriteMakefile(%WriteMakefileArgs); 38 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # NAME 2 | 3 | Mojo::Redis - Redis driver based on Mojo::IOLoop 4 | 5 | # SYNOPSIS 6 | 7 | ## Blocking 8 | 9 | use Mojo::Redis; 10 | my $redis = Mojo::Redis->new; 11 | $redis->db->set(foo => 42); 12 | $redis->db->expire(foo => 600); 13 | warn $redis->db->get('foo'); 14 | 15 | ## Promises 16 | 17 | $redis->db->get_p("mykey")->then(sub { 18 | print "mykey=$_[0]\n"; 19 | })->catch(sub { 20 | warn "Could not fetch mykey: $_[0]"; 21 | })->wait; 22 | 23 | ## Pipelining 24 | 25 | Pipelining is built into the API by sending a lot of commands and then use 26 | ["all" in Mojo::Promise](https://metacpan.org/pod/Mojo%3A%3APromise#all) to wait for all the responses. 27 | 28 | Mojo::Promise->all( 29 | $db->set_p($key, 10), 30 | $db->incrby_p($key, 9), 31 | $db->incr_p($key), 32 | $db->get_p($key), 33 | $db->incr_p($key), 34 | $db->get_p($key), 35 | )->then(sub { 36 | @res = map {@$_} @_; 37 | })->wait; 38 | 39 | # DESCRIPTION 40 | 41 | [Mojo::Redis](https://metacpan.org/pod/Mojo%3A%3ARedis) is a Redis driver that use the [Mojo::IOLoop](https://metacpan.org/pod/Mojo%3A%3AIOLoop), which makes it 42 | integrate easily with the [Mojolicious](https://metacpan.org/pod/Mojolicious) framework. 43 | 44 | It tries to mimic the same interface as [Mojo::Pg](https://metacpan.org/pod/Mojo%3A%3APg), [Mojo::mysql](https://metacpan.org/pod/Mojo%3A%3Amysql) and 45 | [Mojo::SQLite](https://metacpan.org/pod/Mojo%3A%3ASQLite), but the methods for talking to the database vary. 46 | 47 | This module is in no way compatible with the 1.xx version of `Mojo::Redis` 48 | and this version also tries to fix a lot of the confusing methods in 49 | `Mojo::Redis2` related to pubsub. 50 | 51 | This module is currently EXPERIMENTAL, and bad design decisions will be fixed 52 | without warning. Please report at 53 | [https://github.com/jhthorsen/mojo-redis/issues](https://github.com/jhthorsen/mojo-redis/issues) if you find this module 54 | useful, annoying or if you simply find bugs. Feedback can also be sent to 55 | `jhthorsen@cpan.org`. 56 | 57 | # EVENTS 58 | 59 | ## connection 60 | 61 | $cb = $redis->on(connection => sub { my ($redis, $connection) = @_; }); 62 | 63 | Emitted when [Mojo::Redis::Connection](https://metacpan.org/pod/Mojo%3A%3ARedis%3A%3AConnection) connects to the Redis. 64 | 65 | # ATTRIBUTES 66 | 67 | ## encoding 68 | 69 | $str = $redis->encoding; 70 | $redis = $redis->encoding("UTF-8"); 71 | 72 | The value of this attribute will be passed on to 73 | ["encoding" in Mojo::Redis::Connection](https://metacpan.org/pod/Mojo%3A%3ARedis%3A%3AConnection#encoding) when a new connection is created. This 74 | means that updating this attribute will not change any connection that is 75 | in use. 76 | 77 | Default value is "UTF-8". 78 | 79 | ## max\_connections 80 | 81 | $int = $redis->max_connections; 82 | $redis = $redis->max_connections(5); 83 | 84 | Maximum number of idle database handles to cache for future use, defaults to 85 | 5\. (Default is subject to change) 86 | 87 | ## protocol\_class 88 | 89 | $str = $redis->protocol_class; 90 | $redis = $redis->protocol_class("Protocol::Redis::XS"); 91 | 92 | Default to [Protocol::Redis::XS](https://metacpan.org/pod/Protocol%3A%3ARedis%3A%3AXS) if the optional module is available and at 93 | least version 0.06, or falls back to [Protocol::Redis::Faster](https://metacpan.org/pod/Protocol%3A%3ARedis%3A%3AFaster). 94 | 95 | ## pubsub 96 | 97 | $pubsub = $redis->pubsub; 98 | 99 | Lazy builds an instance of [Mojo::Redis::PubSub](https://metacpan.org/pod/Mojo%3A%3ARedis%3A%3APubSub) for this object, instead of 100 | returning a new instance like ["db"](#db) does. 101 | 102 | ## url 103 | 104 | $url = $redis->url; 105 | $redis = $redis->url(Mojo::URL->new("redis://localhost/3")); 106 | 107 | Holds an instance of [Mojo::URL](https://metacpan.org/pod/Mojo%3A%3AURL) that describes how to connect to the Redis server. 108 | 109 | # METHODS 110 | 111 | ## db 112 | 113 | $db = $redis->db; 114 | 115 | Returns an instance of [Mojo::Redis::Database](https://metacpan.org/pod/Mojo%3A%3ARedis%3A%3ADatabase). 116 | 117 | ## cache 118 | 119 | $cache = $redis->cache(%attrs); 120 | 121 | Returns an instance of [Mojo::Redis::Cache](https://metacpan.org/pod/Mojo%3A%3ARedis%3A%3ACache). 122 | 123 | ## cursor 124 | 125 | $cursor = $redis->cursor(@command); 126 | 127 | Returns an instance of [Mojo::Redis::Cursor](https://metacpan.org/pod/Mojo%3A%3ARedis%3A%3ACursor) with 128 | ["command" in Mojo::Redis::Cursor](https://metacpan.org/pod/Mojo%3A%3ARedis%3A%3ACursor#command) set to the arguments passed. See 129 | ["new" in Mojo::Redis::Cursor](https://metacpan.org/pod/Mojo%3A%3ARedis%3A%3ACursor#new). for possible commands. 130 | 131 | ## new 132 | 133 | $redis = Mojo::Redis->new("redis://localhost:6379/1"); 134 | $redis = Mojo::Redis->new(Mojo::URL->new->host("/tmp/redis.sock")); 135 | $redis = Mojo::Redis->new(\%attrs); 136 | $redis = Mojo::Redis->new(%attrs); 137 | 138 | Object constructor. Can coerce a string into a [Mojo::URL](https://metacpan.org/pod/Mojo%3A%3AURL) and set ["url"](#url) 139 | if present. 140 | 141 | # AUTHORS 142 | 143 | Jan Henning Thorsen - `jhthorsen@cpan.org` 144 | 145 | Dan Book - `grinnz@grinnz.com` 146 | 147 | # COPYRIGHT AND LICENSE 148 | 149 | Copyright (C) 2018, Jan Henning Thorsen. 150 | 151 | This program is free software, you can redistribute it and/or modify it under 152 | the terms of the Artistic License version 2.0. 153 | -------------------------------------------------------------------------------- /cpanfile: -------------------------------------------------------------------------------- 1 | # You can install this projct with curl -L http://cpanmin.us | perl - https://github.com/jhthorsen/mojo-redis/archive/master.tar.gz 2 | requires "perl" => "5.016"; 3 | requires "Mojolicious" => "8.50"; 4 | requires "Protocol::Redis::Faster" => "0.002"; 5 | 6 | test_requires "Test::More" => "0.88"; 7 | -------------------------------------------------------------------------------- /examples/cache.pl: -------------------------------------------------------------------------------- 1 | #/usr/bin/env perl 2 | use Mojolicious::Lite -signatures; 3 | 4 | use Mojo::Redis; 5 | 6 | helper redis => sub { state $r = Mojo::Redis->new }; 7 | 8 | helper cache => sub { 9 | my $c = shift; 10 | return $c->stash->{'redis.cache'} ||= $c->redis->cache->refresh($c->param('_refresh')); 11 | }; 12 | 13 | helper get_redis_stats_p => sub { 14 | my ($c, $section) = @_; 15 | return $c->redis->db->info_structured_p($section ? ($section) : ()); 16 | }; 17 | 18 | get '/stats' => sub { 19 | my $c = shift->render_later; 20 | 21 | $c->cache->memoize_p($c, get_redis_stats_p => [$c->param('section')])->then(sub { 22 | $c->render(json => shift); 23 | })->catch(sub { 24 | $c->reply_exception(shift); 25 | }); 26 | }; 27 | 28 | app->start; 29 | -------------------------------------------------------------------------------- /examples/chat.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use Mojolicious::Lite -signatures; 3 | 4 | use lib 'lib'; 5 | use Mojo::Redis; 6 | 7 | helper redis => sub { state $r = Mojo::Redis->new }; 8 | 9 | get '/' => 'chat'; 10 | 11 | websocket '/socket' => sub ($c) { 12 | my $pubsub = $c->redis->pubsub; 13 | my $cb = $pubsub->listen('chat:example' => sub ($pubsub, $msg) { $c->send($msg) }); 14 | 15 | $c->inactivity_timeout(3600); 16 | $c->on(finish => sub { $pubsub->unlisten('chat:example' => $cb) }); 17 | $c->on(message => sub ($c, $msg) { $pubsub->notify('chat:example' => $msg) }); 18 | }; 19 | 20 | app->start; 21 | 22 | __DATA__ 23 | @@ chat.html.ep 24 | 25 | 26 | 27 | Mojo::Redis Chat Example 28 | 29 | 30 | 31 | 43 | 44 | 45 |
46 |

Mojo::Redis Chat Example

47 |
48 | 52 | 53 |
54 |

Messages

55 | 
Connecting...
56 |
57 | %= javascript begin 58 | var formEl = document.getElementsByTagName("form")[0]; 59 | var inputEl = formEl.message; 60 | var messagesEl = document.getElementById("messages"); 61 | var ws = new WebSocket("<%= url_for('socket')->to_abs %>"); 62 | var id = Math.round(Math.random() * 1000); 63 | 64 | var hms = function() { 65 | var d = new Date(); 66 | return [d.getHours(), d.getMinutes(), d.getSeconds()].map(function(v) { 67 | return v < 10 ? "0" + v : v; 68 | }).join(":"); 69 | }; 70 | 71 | formEl.addEventListener("submit", function(e) { 72 | e.preventDefault(); 73 | if (inputEl.value.length) ws.send(hms() + " <" + id + "> " + inputEl.value); 74 | inputEl.value = ""; 75 | }); 76 | 77 | ws.onopen = function(e) { 78 | inputEl.disabled = false; 79 | document.getElementsByTagName("button")[0].disabled = false; 80 | messagesEl.innerHTML = hms() + " <server> Connected."; 81 | }; 82 | 83 | ws.onmessage = function(e) { 84 | messagesEl.innerHTML = e.data.replace(/" + messagesEl.innerHTML; 85 | }; 86 | % end 87 | 88 | 89 | -------------------------------------------------------------------------------- /examples/twitter.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use Mojolicious::Lite -signatures; 3 | 4 | use lib 'lib'; 5 | use Mojo::Redis; 6 | 7 | helper redis => sub { state $r = Mojo::Redis->new }; 8 | 9 | get '/' => sub ($c) { 10 | return $c->render('login') unless my $username = $c->session('username'); 11 | return $c->redirect_to(profile => {username => $username}); 12 | }, 13 | 'index'; 14 | 15 | get '/logout' => sub ($c) { 16 | delete $c->session->{$_} for qw(uid username); 17 | $c->redirect_to('index'); 18 | }; 19 | 20 | get '/:username', sub ($c) { 21 | my $db = $c->redis->db; 22 | my $username = $c->stash('username'); 23 | my $logged_in = my $uid; 24 | 25 | $c->stash(logged_in => $username eq $c->session('username') // ''); 26 | $c->render_later; 27 | $db->hget_p('twitter_clone:users' => $username)->then(sub { 28 | $uid = shift or die $c->reply->not_found; 29 | })->then(sub { 30 | my $page = $c->param('page') || 1; 31 | my $items_per_page = 20; 32 | my $start = ($page - 1) * $items_per_page; 33 | $db->lrange_p("twitter_clone:posts:$uid", $start, $start + $items_per_page); 34 | })->then(sub { 35 | my $post_ids = shift; 36 | Mojo::Promise->all(map { $db->hgetall_p("twitter_clone:post:$_") } @$post_ids); 37 | })->then(sub { 38 | $c->render(posts => [map { $_->[0] } @_]); 39 | })->catch(sub { 40 | $c->reply->exception(shift) unless $c->stash('status'); 41 | }); 42 | }, 'profile'; 43 | 44 | post '/:username/add-post', sub ($c) { 45 | my $v = $c->validation; 46 | my $uid = $c->session('uid') or return $c->redirect_to('index'); 47 | 48 | $v->required('message'); 49 | return $c->render('profile', status => 400, posts => [], error => 'Missing input.', logged_in => 1) 50 | unless $v->is_valid; 51 | 52 | $c->render_later; 53 | my $db = $c->redis->db; 54 | my $post_id; 55 | $db->incr_p('twitter_clone:next_post_id')->then(sub { 56 | $post_id = shift; 57 | $db->hmset_p("twitter_clone:post:$post_id", uid => $uid, time => time, body => $v->param('message')); 58 | })->then(sub { 59 | Mojo::Promise->all( 60 | $db->lpush_p("twitter_clone:posts:$uid", $post_id), 61 | $db->lpush_p("twitter_clone:timeline", $post_id), 62 | $db->ltrim_p("twitter_clone:timeline", 0, 1000), 63 | ); 64 | })->then(sub { 65 | $c->redirect_to('profile'); 66 | })->catch(sub { 67 | $c->reply->exception(shift) unless $c->stash('status'); 68 | }); 69 | }, 'add_post'; 70 | 71 | post '/login', sub ($c) { 72 | my $v = $c->validation; 73 | 74 | $v->csrf_protect; 75 | $v->required('password'); 76 | $v->required('username'); 77 | return $c->render(status => 400, error => 'Missing input.') unless $v->is_valid; 78 | 79 | $c->render_later; 80 | my $db = $c->redis->db; 81 | $db->hget_p('twitter_clone:users' => $v->param('username'))->then(sub { 82 | my $uid = shift; 83 | die $c->render(status => 400, error => 'Invalid username or password.') unless $uid; 84 | $c->session(uid => $uid, username => $v->param('username')); 85 | return $db->hget_p("twitter_clone:user:$uid", 'password'); 86 | })->then(sub { 87 | my $password = shift; 88 | die $c->render(status => 400, error => 'Invalid username or password.') 89 | if !$password 90 | or $password ne $v->param('password'); 91 | $c->redirect_to(profile => {username => $v->param('username')}); 92 | })->catch(sub { 93 | $c->reply->exception(shift) unless $c->stash('status'); 94 | }); 95 | }, 'login'; 96 | 97 | Mojo::IOLoop->next_tick(\&add_dummy_user); 98 | app->defaults(layout => 'default'); 99 | app->secrets([$ENV{MOJO_TWITTER_CLONE_SECRET} || rand(1000)]); 100 | app->start; 101 | 102 | sub add_dummy_user { 103 | my $db = app->redis->db; 104 | my $uid; 105 | 106 | $db->hget_p('twitter_clone:users' => 'batgirl')->then(sub { 107 | die "--> User batgirl already added.\n" if $uid = shift; 108 | })->then(sub { 109 | $db->incr_p('twitter_clone:next_user_id'); 110 | })->then(sub { 111 | $uid = shift; 112 | 113 | # Password should not be in plain text! 114 | Mojo::Promise->all( 115 | $db->hmset_p("twitter_clone:user:$uid", username => 'batgirl', password => 's3cret'), 116 | $db->hset_p('twitter_clone:users', batgirl => $uid), 117 | ); 118 | })->then(sub { 119 | warn "--> User batgirl added.\n"; 120 | })->catch(sub { 121 | warn $_[0]; 122 | }); 123 | } 124 | 125 | __DATA__ 126 | @@ login.html.ep 127 |

Login

128 |

A dummy user has been added, so no need to change the form inputs.

129 | %= form_for 'login', begin 130 | 134 | 138 | % if (my $error = stash 'error') { 139 |

<%= $error %>

140 | % } 141 | 142 | % end 143 | @@ profile.html.ep 144 |

<%= $username %>

145 | % if ($logged_in) { 146 | %= form_for 'add_post', begin 147 | 151 | % if (my $error = stash 'error') { 152 |

<%= $error %>

153 | % } 154 | 155 | % end 156 | % } 157 |
    158 | % for my $post (@$posts) { 159 |
  • 160 | <%= scalar localtime $post->{time} %> 161 |
    <%= $post->{body} %>
    162 |
    • 163 | % } 164 |
165 | @@ layouts/default.html.ep 166 | 167 | 168 | 169 | Design and implementation of a simple Twitter clone using Perl and the Redis key-value store 170 | 171 | 172 | 173 | 192 | 193 | 194 |
<%= content %>
195 | 196 | 197 | -------------------------------------------------------------------------------- /lib/Mojo/Redis.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Redis; 2 | use Mojo::Base 'Mojo::EventEmitter'; 3 | 4 | use Mojo::URL; 5 | use Mojo::Redis::Connection; 6 | use Mojo::Redis::Cache; 7 | use Mojo::Redis::Cursor; 8 | use Mojo::Redis::Database; 9 | use Mojo::Redis::PubSub; 10 | use Scalar::Util 'blessed'; 11 | 12 | our $VERSION = '3.29'; 13 | 14 | $ENV{MOJO_REDIS_URL} ||= 'redis://localhost:6379'; 15 | 16 | has encoding => 'UTF-8'; 17 | has max_connections => 5; 18 | 19 | has protocol_class => do { 20 | my $class = $ENV{MOJO_REDIS_PROTOCOL}; 21 | $class ||= eval { require Protocol::Redis::XS; Protocol::Redis::XS->VERSION('0.06'); 'Protocol::Redis::XS' }; 22 | $class ||= 'Protocol::Redis::Faster'; 23 | eval "require $class; 1" or die $@; 24 | $class; 25 | }; 26 | 27 | has pubsub => sub { 28 | my $self = shift; 29 | my $pubsub = Mojo::Redis::PubSub->new(redis => $self); 30 | Scalar::Util::weaken($pubsub->{redis}); 31 | return $pubsub; 32 | }; 33 | 34 | has url => sub { Mojo::URL->new($ENV{MOJO_REDIS_URL}) }; 35 | 36 | sub cache { Mojo::Redis::Cache->new(redis => shift, @_) } 37 | sub cursor { Mojo::Redis::Cursor->new(redis => shift, command => [@_ ? @_ : (scan => 0)]) } 38 | sub db { Mojo::Redis::Database->new(redis => shift) } 39 | 40 | sub new { 41 | my $class = shift; 42 | return $class->SUPER::new(@_) unless @_ % 2 and ref $_[0] ne 'HASH'; 43 | my $url = shift; 44 | $url = Mojo::URL->new($url) unless blessed $url and $url->isa('Mojo::URL'); 45 | return $class->SUPER::new(url => $url, @_); 46 | } 47 | 48 | sub _connection { 49 | my ($self, %args) = @_; 50 | 51 | $args{ioloop} ||= Mojo::IOLoop->singleton; 52 | my $conn = Mojo::Redis::Connection->new( 53 | encoding => $self->encoding, 54 | protocol => $self->protocol_class->new(api => 1), 55 | url => $self->url->clone, 56 | %args 57 | ); 58 | 59 | Scalar::Util::weaken($self); 60 | $conn->on(connect => sub { $self->emit(connection => $_[0]) }); 61 | $conn; 62 | } 63 | 64 | sub _blocking_connection { 65 | my $self = shift->_fork_safety; 66 | 67 | # Existing connection 68 | my $conn = $self->{blocking_connection}; 69 | return $conn->encoding($self->encoding) if $conn and $conn->is_connected; 70 | 71 | # New connection 72 | return $self->{blocking_connection} = $self->_connection(ioloop => $conn ? $conn->ioloop : Mojo::IOLoop->new); 73 | } 74 | 75 | sub _dequeue { 76 | my $self = shift->_fork_safety; 77 | 78 | # Exsting connection 79 | while (my $conn = shift @{$self->{queue} || []}) { return $conn->encoding($self->encoding) if $conn->is_connected } 80 | 81 | # New connection 82 | return $self->_connection; 83 | } 84 | 85 | sub _enqueue { 86 | my ($self, $conn) = @_; 87 | my $queue = $self->{queue} ||= []; 88 | push @$queue, $conn if $conn->is_connected and $conn->url eq $self->url and $conn->ioloop eq Mojo::IOLoop->singleton; 89 | shift @$queue while @$queue > $self->max_connections; 90 | } 91 | 92 | sub _fork_safety { 93 | my $self = shift; 94 | delete @$self{qw(blocking_connection pid queue)} unless ($self->{pid} //= $$) eq $$; # Fork-safety 95 | $self; 96 | } 97 | 98 | 1; 99 | 100 | =encoding utf8 101 | 102 | =head1 NAME 103 | 104 | Mojo::Redis - Redis driver based on Mojo::IOLoop 105 | 106 | =head1 SYNOPSIS 107 | 108 | =head2 Blocking 109 | 110 | use Mojo::Redis; 111 | my $redis = Mojo::Redis->new; 112 | $redis->db->set(foo => 42); 113 | $redis->db->expire(foo => 600); 114 | warn $redis->db->get('foo'); 115 | 116 | =head2 Promises 117 | 118 | $redis->db->get_p("mykey")->then(sub { 119 | print "mykey=$_[0]\n"; 120 | })->catch(sub { 121 | warn "Could not fetch mykey: $_[0]"; 122 | })->wait; 123 | 124 | =head2 Pipelining 125 | 126 | Pipelining is built into the API by sending a lot of commands and then use 127 | L to wait for all the responses. 128 | 129 | Mojo::Promise->all( 130 | $db->set_p($key, 10), 131 | $db->incrby_p($key, 9), 132 | $db->incr_p($key), 133 | $db->get_p($key), 134 | $db->incr_p($key), 135 | $db->get_p($key), 136 | )->then(sub { 137 | @res = map {@$_} @_; 138 | })->wait; 139 | 140 | =head1 DESCRIPTION 141 | 142 | L is a Redis driver that use the L, which makes it 143 | integrate easily with the L framework. 144 | 145 | It tries to mimic the same interface as L, L and 146 | L, but the methods for talking to the database vary. 147 | 148 | This module is in no way compatible with the 1.xx version of C 149 | and this version also tries to fix a lot of the confusing methods in 150 | C related to pubsub. 151 | 152 | This module is currently EXPERIMENTAL, and bad design decisions will be fixed 153 | without warning. Please report at 154 | L if you find this module 155 | useful, annoying or if you simply find bugs. Feedback can also be sent to 156 | C. 157 | 158 | =head1 EVENTS 159 | 160 | =head2 connection 161 | 162 | $cb = $redis->on(connection => sub { my ($redis, $connection) = @_; }); 163 | 164 | Emitted when L connects to the Redis. 165 | 166 | =head1 ATTRIBUTES 167 | 168 | =head2 encoding 169 | 170 | $str = $redis->encoding; 171 | $redis = $redis->encoding("UTF-8"); 172 | 173 | The value of this attribute will be passed on to 174 | L when a new connection is created. This 175 | means that updating this attribute will not change any connection that is 176 | in use. 177 | 178 | Default value is "UTF-8". 179 | 180 | =head2 max_connections 181 | 182 | $int = $redis->max_connections; 183 | $redis = $redis->max_connections(5); 184 | 185 | Maximum number of idle database handles to cache for future use, defaults to 186 | 5. (Default is subject to change) 187 | 188 | =head2 protocol_class 189 | 190 | $str = $redis->protocol_class; 191 | $redis = $redis->protocol_class("Protocol::Redis::XS"); 192 | 193 | Default to L if the optional module is available and at 194 | least version 0.06, or falls back to L. 195 | 196 | =head2 pubsub 197 | 198 | $pubsub = $redis->pubsub; 199 | 200 | Lazy builds an instance of L for this object, instead of 201 | returning a new instance like L does. 202 | 203 | =head2 url 204 | 205 | $url = $redis->url; 206 | $redis = $redis->url(Mojo::URL->new("redis://localhost/3")); 207 | 208 | Holds an instance of L that describes how to connect to the Redis server. 209 | 210 | =head1 METHODS 211 | 212 | =head2 db 213 | 214 | $db = $redis->db; 215 | 216 | Returns an instance of L. 217 | 218 | =head2 cache 219 | 220 | $cache = $redis->cache(%attrs); 221 | 222 | Returns an instance of L. 223 | 224 | =head2 cursor 225 | 226 | $cursor = $redis->cursor(@command); 227 | 228 | Returns an instance of L with 229 | L set to the arguments passed. See 230 | L. for possible commands. 231 | 232 | =head2 new 233 | 234 | $redis = Mojo::Redis->new("redis://localhost:6379/1"); 235 | $redis = Mojo::Redis->new(Mojo::URL->new->host("/tmp/redis.sock")); 236 | $redis = Mojo::Redis->new(\%attrs); 237 | $redis = Mojo::Redis->new(%attrs); 238 | 239 | Object constructor. Can coerce a string into a L and set L 240 | if present. 241 | 242 | =head1 AUTHORS 243 | 244 | Jan Henning Thorsen - C 245 | 246 | Dan Book - C 247 | 248 | =head1 COPYRIGHT AND LICENSE 249 | 250 | Copyright (C) 2018, Jan Henning Thorsen. 251 | 252 | This program is free software, you can redistribute it and/or modify it under 253 | the terms of the Artistic License version 2.0. 254 | 255 | =cut 256 | -------------------------------------------------------------------------------- /lib/Mojo/Redis/Cache.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Redis::Cache; 2 | use Mojo::Base -base; 3 | 4 | use Mojo::JSON; 5 | use Scalar::Util 'blessed'; 6 | use Storable (); 7 | use Time::HiRes (); 8 | 9 | use constant OFFLINE => $ENV{MOJO_REDIS_CACHE_OFFLINE}; 10 | 11 | has connection => sub { 12 | OFFLINE ? shift->_offline_connection : shift->redis->_dequeue->encoding(undef); 13 | }; 14 | has deserialize => sub { \&Storable::thaw }; 15 | has default_expire => 600; 16 | has namespace => 'cache:mojo:redis'; 17 | has refresh => 0; 18 | has redis => sub { Carp::confess('redis is required in constructor') }; 19 | has serialize => sub { \&Storable::freeze }; 20 | 21 | sub compute_p { 22 | my $compute = pop; 23 | my $self = shift; 24 | my $key = join ':', $self->namespace, shift; 25 | my $expire = shift || $self->default_expire; 26 | 27 | my $p = $self->refresh ? Mojo::Promise->new->resolve : $self->connection->write_p(GET => $key); 28 | return $p->then(sub { 29 | my $data = $_[0] ? $self->deserialize->(shift) : undef; 30 | return $self->_maybe_compute_p($key, $expire, $compute, $data) if $expire < 0; 31 | return $self->_compute_p($key, $expire, $compute) unless $data; 32 | return $data->[0]; 33 | }); 34 | } 35 | 36 | sub memoize_p { 37 | my ($self, $obj, $method) = (shift, shift, shift); 38 | my $args = ref $_[0] eq 'ARRAY' ? shift : []; 39 | my $expire = shift || $self->default_expire; 40 | my $key = join ':', '@M' => (ref($obj) || $obj), $method, Mojo::JSON::encode_json($args); 41 | 42 | return $self->compute_p($key, $expire, sub { $obj->$method(@$args) }); 43 | } 44 | 45 | sub _compute_p { 46 | my ($self, $key, $expire, $compute) = @_; 47 | 48 | my $set = sub { 49 | my $data = shift; 50 | my @set 51 | = $expire < 0 52 | ? $self->serialize->([$data, _time() + -$expire]) 53 | : ($self->serialize->([$data]), PX => 1000 * $expire); 54 | $self->connection->write_p(SET => $key => @set)->then(sub {$data}); 55 | }; 56 | 57 | my $data = $compute->(); 58 | return (blessed $data and $data->can('then')) ? $data->then(sub { $set->(@_) }) : $set->($data); 59 | } 60 | 61 | sub _maybe_compute_p { 62 | my ($self, $key, $expire, $compute, $data) = @_; 63 | 64 | # Nothing in cache 65 | return $self->_compute_p($key => $expire, $compute)->then(sub { ($_[0], {computed => 1}) }) unless $data; 66 | 67 | # No need to refresh cache 68 | return ($data->[0], {expired => 0}) if $data->[1] and _time() < $data->[1]; 69 | 70 | # Try to refresh, but use old data on error 71 | my $p = Mojo::Promise->new; 72 | eval { 73 | $self->_compute_p($key => $expire, $compute)->then( 74 | sub { $p->resolve(shift, {computed => 1, expired => 1}) }, 75 | sub { $p->resolve($data->[0], {error => $_[0], expired => 1}) }, 76 | ); 77 | } or do { 78 | $p->resolve($data->[0], {error => $@, expired => 1}); 79 | }; 80 | 81 | return $p; 82 | } 83 | 84 | sub _offline_connection { 85 | state $c = eval <<'HERE' or die $@; 86 | package Mojo::Redis::Connection::Offline; 87 | use Mojo::Base 'Mojo::Redis::Connection'; 88 | our $STORE = {}; # Meant for internal use only 89 | 90 | sub write_p { 91 | my ($conn, $op, $key) = (shift, shift, shift); 92 | 93 | if ($op eq 'SET') { 94 | $STORE->{$conn->url}{$key} = [$_[0], defined $_[2] ? $_[2] + Mojo::Redis::Cache::_time() * 1000 : undef]; 95 | return Mojo::Promise->new->resolve('OK'); 96 | } 97 | else { 98 | my $val = $STORE->{$conn->url}{$key} || []; 99 | my $expired = $val->[1] && $val->[1] < Mojo::Redis::Cache::_time() * 1000; 100 | delete $STORE->{$conn->url}{$key} if $expired; 101 | return Mojo::Promise->new->resolve($expired ? undef : $val->[0]); 102 | } 103 | } 104 | 105 | 'Mojo::Redis::Connection::Offline'; 106 | HERE 107 | my $redis = shift->redis; 108 | return $c->new(url => $redis->url); 109 | } 110 | 111 | sub _time { Time::HiRes::time() } 112 | 113 | 1; 114 | 115 | =encoding utf8 116 | 117 | =head1 NAME 118 | 119 | Mojo::Redis::Cache - Simple cache interface using Redis 120 | 121 | =head1 SYNOPSIS 122 | 123 | use Mojo::Redis; 124 | 125 | my $redis = Mojo::Redis->new; 126 | my $cache = $redis->cache; 127 | 128 | # Cache and expire the data after 60.7 seconds 129 | $cache->compute_p("some:key", 60.7, sub { 130 | my $p = Mojo::Promise->new; 131 | Mojo::IOLoop->timer(0.1 => sub { $p->resolve("some data") }); 132 | return $p; 133 | })->then(sub { 134 | my $some_key = shift; 135 | }); 136 | 137 | # Cache and expire the data after default_expire() seconds 138 | $cache->compute_p("some:key", sub { 139 | return {some => "data"}; 140 | })->then(sub { 141 | my $some_key = shift; 142 | }); 143 | 144 | # Call $obj->get_some_slow_data() and cache the return value 145 | $cache->memoize_p($obj, "get_some_slow_data")->then(sub { 146 | my $data = shift; 147 | }); 148 | 149 | # Call $obj->get_some_data_by_id({id => 42}) and cache the return value 150 | $cache->memoize_p($obj, "get_some_data_by_id", [{id => 42}])->then(sub { 151 | my $data = shift; 152 | }); 153 | 154 | See L 155 | for example L application. 156 | 157 | =head1 DESCRIPTION 158 | 159 | L provides a simple interface for caching data in the 160 | Redis database. There is no "check if exists", "get" or "set" methods in this 161 | class. Instead, both L and L will fetch the value 162 | from Redis, if the given compute function / method has been called once, and 163 | the cached data is not expired. 164 | 165 | If you need to check if the value exists, then you can manually look up the 166 | the key using L. 167 | 168 | =head1 ENVIRONMENT VARIABLES 169 | 170 | =head2 MOJO_REDIS_CACHE_OFFLINE 171 | 172 | Set C to 1 if you want to use this cache without a 173 | real Redis backend. This can be useful in unit tests. 174 | 175 | =head1 ATTRIBUTES 176 | 177 | =head2 connection 178 | 179 | $conn = $cache->connection; 180 | $cache = $cache->connection(Mojo::Redis::Connection->new); 181 | 182 | Holds a L object. 183 | 184 | =head2 default_expire 185 | 186 | $num = $cache->default_expire; 187 | $cache = $cache->default_expire(600); 188 | 189 | Holds the default expire time for cached data. 190 | 191 | =head2 deserialize 192 | 193 | $cb = $cache->deserialize; 194 | $cache = $cache->deserialize(\&Mojo::JSON::decode_json); 195 | 196 | Holds a callback used to deserialize data from Redis. 197 | 198 | =head2 namespace 199 | 200 | $str = $cache->namespace; 201 | $cache = $cache->namespace("cache:mojo:redis"); 202 | 203 | Prefix for the cache key. 204 | 205 | =head2 redis 206 | 207 | $conn = $cache->redis; 208 | $cache = $cache->redis(Mojo::Redis->new); 209 | 210 | Holds a L object used to create the connection to talk with Redis. 211 | 212 | =head2 refresh 213 | 214 | $bool = $cache->refresh; 215 | $cache = $cache->refresh(1); 216 | 217 | Will force the cache to be computed again if set to a true value. 218 | 219 | =head2 serialize 220 | 221 | $cb = $cache->serialize; 222 | $cache = $cache->serialize(\&Mojo::JSON::encode_json); 223 | 224 | Holds a callback used to serialize before storing the data in Redis. 225 | 226 | =head1 METHODS 227 | 228 | =head2 compute_p 229 | 230 | $promise = $cache->compute_p($key => $expire => $compute_function); 231 | $promise = $cache->compute_p($key => $expire => sub { return "data" }); 232 | $promise = $cache->compute_p($key => $expire => sub { return Mojo::Promise->new }); 233 | 234 | This method will store the return value from the C<$compute_function> the 235 | first time it is called and pass the same value to L. 236 | C<$compute_function> will not be called the next time, if the C<$key> is 237 | still present in Redis, but instead the cached value will be passed on to 238 | L. 239 | 240 | C<$key> will be prefixed by L resulting in "namespace:some-key". 241 | 242 | C<$expire> is the number of seconds before the cache should expire, and will 243 | default to L unless passed in. The last argument is a 244 | callback used to calculate cached value. 245 | 246 | C<$expire> can also be a negative number. This will result in serving old cache 247 | in the case where the C<$compute_function> fails. An example usecase would be 248 | if you are fetching Twitter updates for your website, but instead of throwing 249 | an exception if Twitter is down, you will serve old data instead. Note that the 250 | fulfilled promise will get two variables passed in: 251 | 252 | $promise->then(sub { my ($data, $info) = @_ }); 253 | 254 | C<$info> is a hash and can have these keys: 255 | 256 | =over 2 257 | 258 | =item * computed 259 | 260 | Will be true if the C<$compute_function> was called successfully and C<$data> 261 | is fresh. 262 | 263 | =item * expired 264 | 265 | Will be true if C<$data> is expired. If this key is present and false, it will 266 | indicate that the C<$data> is within the expiration period. The C key 267 | can be found together with both L and L. 268 | 269 | =item * error 270 | 271 | Will hold a string if the C<$compute_function> failed. 272 | 273 | =back 274 | 275 | Negative C<$expire> is currently EXPERIMENTAL, but unlikely to go away. 276 | 277 | =head2 memoize_p 278 | 279 | $promise = $cache->memoize_p($obj, $method_name, \@args, $expire); 280 | $promise = $cache->memoize_p($class, $method_name, \@args, $expire); 281 | 282 | L behaves the same way as L, but has a convenient 283 | interface for calling methods on an object. One of the benefits is that you 284 | do not have to come up with your own cache key. This method is pretty much 285 | the same as: 286 | 287 | $promise = $cache->compute_p( 288 | join(":", $cache->namespace, "@M", ref($obj), $method_name, serialize(\@args)), 289 | $expire, 290 | sub { return $obj->$method_name(@args) } 291 | ); 292 | 293 | See L regarding C<$expire>. 294 | 295 | =head1 SEE ALSO 296 | 297 | L 298 | 299 | =cut 300 | -------------------------------------------------------------------------------- /lib/Mojo/Redis/Connection.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Redis::Connection; 2 | use Mojo::Base 'Mojo::EventEmitter'; 3 | 4 | use File::Spec::Functions 'file_name_is_absolute'; 5 | use Mojo::IOLoop; 6 | use Mojo::Promise; 7 | 8 | use constant DEBUG => $ENV{MOJO_REDIS_DEBUG}; 9 | use constant CONNECT_TIMEOUT => $ENV{MOJO_REDIS_CONNECT_TIMEOUT} || 10; 10 | use constant SENTINELS_CONNECT_TIMEOUT => $ENV{MOJO_REDIS_SENTINELS_CONNECT_TIMEOUT} || CONNECT_TIMEOUT; 11 | 12 | has encoding => sub { Carp::confess('encoding is required in constructor') }; 13 | has ioloop => sub { Carp::confess('ioloop is required in constructor') }; 14 | has protocol => sub { Carp::confess('protocol is required in constructor') }; 15 | has url => sub { Carp::confess('url is required in constructor') }; 16 | 17 | sub DESTROY { 18 | my $self = shift; 19 | $self->disconnect if defined $self->{pid} and $self->{pid} == $$; 20 | } 21 | 22 | sub disconnect { 23 | my $self = shift; 24 | $self->_reject_queue; 25 | $self->{stream}->close if $self->{stream}; 26 | $self->{gone_away} = 1; 27 | return $self; 28 | } 29 | 30 | sub is_connected { $_[0]->{stream} && !$_[0]->{gone_away} ? 1 : 0 } 31 | 32 | sub write { 33 | my $self = shift; 34 | push @{$self->{write}}, [$self->_encode(@_)]; 35 | $self->is_connected ? $self->_write : $self->_connect; 36 | return $self; 37 | } 38 | 39 | sub write_p { 40 | my $self = shift; 41 | my $p = Mojo::Promise->new->ioloop($self->ioloop); 42 | push @{$self->{write}}, [$self->_encode(@_), $p]; 43 | $self->is_connected ? $self->_write : $self->_connect; 44 | return $p; 45 | } 46 | 47 | sub _connect { 48 | my $self = shift; 49 | return $self if $self->{id}; # Connecting 50 | 51 | # Cannot reuse a connection because of transaction state and other state 52 | return $self->_reject_queue('Redis server has gone away') if $self->{gone_away}; 53 | 54 | my $url = $self->{master_url} || $self->url; 55 | return $self->_discover_master if !$self->{master_url} and $url->query->param('sentinel'); 56 | 57 | Scalar::Util::weaken($self); 58 | delete $self->{master_url}; # Make sure we forget master_url so we can reconnect 59 | $self->protocol->on_message($self->_parse_message_cb); 60 | $self->{id} = $self->ioloop->client( 61 | $self->_connect_args($url, {port => 6379, timeout => CONNECT_TIMEOUT}), 62 | sub { 63 | return unless $self; 64 | my ($loop, $err, $stream) = @_; 65 | my $close_cb = $self->_on_close_cb; 66 | return $self->$close_cb($err) if $err; 67 | 68 | $stream->timeout(0); 69 | $stream->on(close => $close_cb); 70 | $stream->on(error => $close_cb); 71 | $stream->on(read => $self->_on_read_cb); 72 | 73 | unshift @{$self->{write}}, [$self->_encode(SELECT => $url->path->[0])] if length $url->path->[0]; 74 | unshift @{$self->{write}}, [$self->_encode(AUTH => $url->password)] if length $url->password; 75 | $self->{pid} = $$; 76 | $self->{stream} = $stream; 77 | $self->emit('connect'); 78 | $self->_write; 79 | } 80 | ); 81 | 82 | warn "[@{[$self->_id]}] CONNECTING $url (blocking=@{[$self->_is_blocking]})\n" if DEBUG; 83 | return $self; 84 | } 85 | 86 | sub _connect_args { 87 | my ($self, $url, $defaults) = @_; 88 | my %args = (address => $url->host || 'localhost'); 89 | 90 | if (file_name_is_absolute $args{address}) { 91 | $args{path} = delete $args{address}; 92 | } 93 | else { 94 | $args{port} = $url->port || $defaults->{port}; 95 | } 96 | 97 | $args{timeout} = $defaults->{timeout} || CONNECT_TIMEOUT; 98 | return \%args; 99 | } 100 | 101 | sub _discover_master { 102 | my $self = shift; 103 | my $url = $self->url->clone; 104 | my $sentinels = $url->query->every_param('sentinel'); 105 | my $timeout = $url->query->param('sentinel_connect_timeout') || SENTINELS_CONNECT_TIMEOUT; 106 | 107 | $url->host_port(shift @$sentinels); 108 | $self->url->query->param(sentinel => [@$sentinels, $url->host_port]); # Round-robin sentinel list 109 | $self->protocol->on_message($self->_parse_message_cb); 110 | $self->{id} = $self->ioloop->client( 111 | $self->_connect_args($url, {port => 16379, timeout => $timeout}), 112 | sub { 113 | my ($loop, $err, $stream) = @_; 114 | return unless $self; 115 | return $self->_discover_master if $err; 116 | 117 | $stream->timeout(0); 118 | $stream->on(close => sub { $self->_discover_master unless $self->{master_url} }); 119 | $stream->on(error => sub { $self->_discover_master }); 120 | $stream->on(read => $self->_on_read_cb); 121 | 122 | $self->{stream} = $stream; 123 | my $p = Mojo::Promise->new->ioloop($self->ioloop); 124 | unshift @{$self->{write}}, undef; # prevent _write() from writing commands 125 | unshift @{$self->{write}}, [$self->_encode(SENTINEL => 'get-master-addr-by-name', $self->url->host), $p]; 126 | unshift @{$self->{write}}, [$self->_encode(AUTH => $url->password)] if length $url->password; 127 | 128 | $self->{write_lock} = 1; 129 | $p->then( 130 | sub { 131 | my $host_port = shift; 132 | delete $self->{id}; 133 | delete $self->{write_lock}; 134 | return $self->_discover_master unless ref $host_port and @$host_port == 2; 135 | $self->{master_url} = $self->url->clone->host($host_port->[0])->port($host_port->[1]); 136 | $self->{stream}->close; 137 | $self->_connect; 138 | }, 139 | sub { $self->_discover_master }, 140 | ); 141 | 142 | $self->_write; 143 | } 144 | ); 145 | 146 | warn "[@{[$self->_id]}] SENTINEL DISCOVERY $url (blocking=@{[$self->_is_blocking]})\n" if DEBUG; 147 | return $self; 148 | } 149 | 150 | sub _encode { 151 | my $self = shift; 152 | my $encoding = $self->encoding; 153 | return $self->protocol->encode({ 154 | type => '*', data => [map { +{type => '$', data => $encoding ? Mojo::Util::encode($encoding, $_) : $_} } @_] 155 | }); 156 | } 157 | 158 | sub _id { $_[0]->{id} || '0' } 159 | 160 | sub _is_blocking { shift->ioloop eq Mojo::IOLoop->singleton ? 0 : 1 } 161 | 162 | sub _on_close_cb { 163 | my $self = shift; 164 | 165 | Scalar::Util::weaken($self); 166 | return sub { 167 | return unless $self; 168 | my ($stream, $err) = @_; 169 | delete $self->{$_} for qw(id stream); 170 | $self->{gone_away} = 1; 171 | $self->_reject_queue($err); 172 | $self->emit('close') if @_ == 1; 173 | warn qq([@{[$self->_id]}] @{[$err ? "ERROR $err" : "CLOSED"]}\n) if $self and DEBUG; 174 | }; 175 | } 176 | 177 | sub _on_read_cb { 178 | my $self = shift; 179 | 180 | Scalar::Util::weaken($self); 181 | return sub { 182 | return unless $self; 183 | my ($stream, $chunk) = @_; 184 | do { local $_ = $chunk; s!\r\n!\\r\\n!g; warn "[@{[$self->_id]}] >>> ($_)\n" } if DEBUG; 185 | $self->protocol->parse($chunk); 186 | }; 187 | } 188 | 189 | sub _parse_message_cb { 190 | my $self = shift; 191 | 192 | Scalar::Util::weaken($self); 193 | return sub { 194 | my ($protocol, @messages) = @_; 195 | my $encoding = $self->encoding; 196 | $self->_write unless $self->{write_lock}; 197 | 198 | my $unpack = sub { 199 | my @res; 200 | 201 | while (my $m = shift @_) { 202 | if ($m->{type} eq '-') { 203 | return $m->{data}, undef; 204 | } 205 | elsif ($m->{type} eq ':') { 206 | push @res, 0 + $m->{data}; 207 | } 208 | elsif ($m->{type} eq '*' and ref $m->{data} eq 'ARRAY') { 209 | my ($err, $res) = __SUB__->(@{$m->{data}}); 210 | return $err if defined $err; 211 | push @res, $res; 212 | } 213 | 214 | # Only bulk string replies can contain binary-safe encoded data 215 | elsif ($m->{type} eq '$' and $encoding and defined $m->{data}) { 216 | push @res, Mojo::Util::decode($encoding, $m->{data}); 217 | } 218 | else { 219 | push @res, $m->{data}; 220 | } 221 | } 222 | 223 | return undef, \@res; 224 | }; 225 | 226 | my ($err, $res) = $unpack->(@messages); 227 | my $p = shift @{$self->{waiting} || []}; 228 | return $p ? $p->reject($err) : $self->emit(error => $err) unless $res; 229 | return $p ? $p->resolve($res->[0]) : $self->emit(response => $res->[0]); 230 | }; 231 | } 232 | 233 | sub _reject_queue { 234 | my ($self, $err) = @_; 235 | state $default = 'Premature connection close'; 236 | for my $p (@{delete $self->{waiting} || []}) { $p and $p->reject($err || $default) } 237 | for my $i (@{delete $self->{write} || []}) { $i->[1] and $i->[1]->reject($err || $default) } 238 | return $self; 239 | } 240 | 241 | sub _write { 242 | my $self = shift; 243 | 244 | while (my $op = shift @{$self->{write}}) { 245 | my $loop = $self->ioloop; 246 | do { local $_ = $op->[0]; s!\r\n!\\r\\n!g; warn "[@{[$self->_id]}] <<< ($_)\n" } if DEBUG; 247 | push @{$self->{waiting}}, $op->[1]; 248 | $self->{stream}->write($op->[0]); 249 | } 250 | } 251 | 252 | 1; 253 | 254 | =encoding utf8 255 | 256 | =head1 NAME 257 | 258 | Mojo::Redis::Connection - Low level connection class for talking to Redis 259 | 260 | =head1 SYNOPSIS 261 | 262 | use Mojo::Redis::Connection; 263 | 264 | my $conn = Mojo::Redis::Connection->new( 265 | ioloop => Mojo::IOLoop->singleton, 266 | protocol => Protocol::Redis::Faster->new(api => 1), 267 | url => Mojo::URL->new("redis://localhost"), 268 | ); 269 | 270 | $conn->write_p("GET some_key")->then(sub { print "some_key=$_[0]" })->wait; 271 | 272 | =head1 DESCRIPTION 273 | 274 | L is a low level driver for writing and reading data 275 | from a Redis server. 276 | 277 | You probably want to use L instead of this class. 278 | 279 | =head1 EVENTS 280 | 281 | =head2 close 282 | 283 | $cb = $conn->on(close => sub { my ($conn) = @_; }); 284 | 285 | Emitted when the connection to the redis server gets closed. 286 | 287 | =head2 connect 288 | 289 | $cb = $conn->on(connect => sub { my ($conn) = @_; }); 290 | 291 | Emitted right after a connection is established to the Redis server, but 292 | after the AUTH and SELECT commands are queued. 293 | 294 | =head2 error 295 | 296 | $cb = $conn->on(error => sub { my ($conn, $error) = @_; }); 297 | 298 | Emitted if there's a connection error or the Redis server emits an error, and 299 | there's not a promise to handle the message. 300 | 301 | =head2 response 302 | 303 | $cb = $conn->on(response => sub { my ($conn, $res) = @_; }); 304 | 305 | Emitted when receiving a message from the Redis server. 306 | 307 | =head1 ATTRIBUTES 308 | 309 | =head2 encoding 310 | 311 | $str = $conn->encoding; 312 | $conn = $conn->encoding("UTF-8"); 313 | 314 | Holds the character encoding to use for data from/to Redis. Set to C 315 | to disable encoding/decoding data. Without an encoding set, Redis expects and 316 | returns bytes. See also L. 317 | 318 | =head2 ioloop 319 | 320 | $loop = $conn->ioloop; 321 | $conn = $conn->ioloop(Mojo::IOLoop->new); 322 | 323 | Holds an instance of L. 324 | 325 | =head2 protocol 326 | 327 | $protocol = $conn->protocol; 328 | $conn = $conn->protocol(Protocol::Redis::XS->new(api => 1)); 329 | 330 | Holds a protocol object, such as L that is used to 331 | generate and parse Redis messages. 332 | 333 | =head2 url 334 | 335 | $url = $conn->url; 336 | $conn = $conn->url(Mojo::URL->new->host("/tmp/redis.sock")->path("/5")); 337 | $conn = $conn->url("redis://localhost:6379/1"); 338 | 339 | =head1 METHODS 340 | 341 | =head2 disconnect 342 | 343 | $conn = $conn->disconnect; 344 | 345 | Used to disconnect from the Redis server. 346 | 347 | =head2 is_connected 348 | 349 | $bool = $conn->is_connected; 350 | 351 | True if a connection to the Redis server is established. 352 | 353 | =head2 write 354 | 355 | $conn = $conn->write(@command_and_args); 356 | 357 | Used to write a message to the redis server. Calling this method should result 358 | in either a L or L event. 359 | 360 | This is useful in the a 361 | 362 | =head2 write_p 363 | 364 | $promise = $conn->write_p(@command_and_args); 365 | 366 | Will write a command to the Redis server and establish a connection if not 367 | already connected and returns a L. 368 | 369 | =head1 SEE ALSO 370 | 371 | L 372 | 373 | =cut 374 | -------------------------------------------------------------------------------- /lib/Mojo/Redis/Cursor.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Redis::Cursor; 2 | use Mojo::Base 'Mojo::EventEmitter'; 3 | 4 | use Carp qw(confess croak); 5 | 6 | has connection => sub { shift->redis->_dequeue }; 7 | sub command { $_[0]->{command} } 8 | sub finished { !!$_[0]->{finished} } 9 | has redis => sub { confess 'redis is required in constructor' }; 10 | 11 | sub again { 12 | my $self = shift; 13 | $self->{finished} = 0; 14 | $self->command->[$self->{cursor_pos_in_command}] = 0; 15 | return $self; 16 | } 17 | 18 | sub all { 19 | my $cb = ref $_[-1] eq 'CODE' ? pop : undef; 20 | my $self = shift->again; # Reset cursor 21 | my $conn = $cb ? $self->connection : $self->redis->_blocking_connection; 22 | my @res; 23 | 24 | # Blocking 25 | unless ($cb) { 26 | my $err; 27 | while (my $p = $self->_next_p($conn)) { 28 | $p->then(sub { push @res, @{$_[0] || []} })->catch(sub { $err = shift })->wait; 29 | croak $err if $err; 30 | } 31 | return $self->{process}->($self, \@res); 32 | } 33 | 34 | # Non-blocking 35 | $self->_next_p($conn)->then(sub { 36 | push @res, @{$_[0]}; 37 | return $self->$cb('', $self->{process}->($self, \@res)) if $self->{finished}; 38 | return $self->_next_p($conn)->then(__SUB__); 39 | })->catch(sub { $self->$cb($_[0], []) }); 40 | 41 | return $self; 42 | } 43 | 44 | sub all_p { 45 | my $self = shift->again; # Reset cursor 46 | my $conn = $self->connection; 47 | my @res; 48 | 49 | return $self->_next_p($conn)->then(sub { 50 | push @res, @{$_[0]}; 51 | return $self->{process}->($self, \@res) if $self->{finished}; 52 | return $self->_next_p($conn)->then(__SUB__); 53 | }); 54 | } 55 | 56 | sub next { 57 | my $cb = ref $_[-1] eq 'CODE' ? pop : undef; 58 | my $self = shift; 59 | 60 | # Cursor is exhausted 61 | return $cb ? $self->tap($cb, '', undef) : undef 62 | unless my $p = $self->_next_p($cb ? $self->connection : $self->redis->_blocking_connection); 63 | 64 | # Blocking 65 | unless ($cb) { 66 | my ($err, $res); 67 | $p->then(sub { $res = $self->{process}->($self, shift) })->catch(sub { $err = shift })->wait; 68 | croak $err if $err; 69 | return $res; 70 | } 71 | 72 | # Non-blocking 73 | $p->then(sub { $self->$cb('', $self->{process}->($self, shift)) })->catch(sub { $self->$cb(shift, undef) }); 74 | return $self; 75 | } 76 | 77 | sub next_p { 78 | my $self = shift; 79 | return $self->_next_p($self->connection)->then(sub { $self->{process}->($self, shift) }); 80 | } 81 | 82 | sub new { 83 | my $self = shift->SUPER::new(@_); 84 | my $cmd = $self->command; 85 | 86 | $cmd->[0] ||= 'unknown'; 87 | $self->{process} = __PACKAGE__->can(lc "_process_$cmd->[0]") or confess "Unknown cursor command: @$cmd"; 88 | 89 | if ($cmd->[0] eq 'keys') { 90 | @$cmd = (scan => 0, $cmd->[1] ? (match => $cmd->[1]) : ()); 91 | } 92 | elsif ($cmd->[0] eq 'smembers') { 93 | @$cmd = (sscan => $cmd->[1], 0); 94 | } 95 | elsif ($cmd->[0] =~ /^(hgetall|hkeys)/) { 96 | @$cmd = (hscan => $cmd->[1], 0); 97 | } 98 | 99 | $self->{cursor_pos_in_command} = $cmd->[0] =~ /^scan$/i ? 1 : 2; 100 | return $self; 101 | } 102 | 103 | sub _next_p { 104 | my ($self, $conn) = @_; 105 | return undef if $self->{finished}; 106 | 107 | my $cmd = $self->command; 108 | return $conn->write_p(@$cmd)->then(sub { 109 | my $res = shift; 110 | $cmd->[$self->{cursor_pos_in_command}] = $res->[0] // 0; 111 | $self->{finished} = 1 unless $res->[0]; 112 | return $res->[1]; 113 | }); 114 | } 115 | 116 | sub _process_hgetall { +{@{$_[1]}} } 117 | sub _process_hkeys { my %h = @{$_[1]}; return [keys %h]; } 118 | sub _process_hscan { $_[1] } 119 | sub _process_keys { $_[1] } 120 | sub _process_scan { $_[1] } 121 | sub _process_smembers { $_[1] } 122 | sub _process_sscan { $_[1] } 123 | sub _process_zscan { $_[1] } 124 | 125 | sub DESTROY { 126 | my $self = shift; 127 | return unless (my $redis = $self->{redis}) && (my $conn = $self->{connection}); 128 | $redis->_enqueue($conn); 129 | } 130 | 131 | 1; 132 | 133 | =encoding utf8 134 | 135 | =head1 NAME 136 | 137 | Mojo::Redis::Cursor - Iterate the results from SCAN, SSCAN, HSCAN and ZSCAN 138 | 139 | =head1 SYNOPSIS 140 | 141 | use Mojo::Redis; 142 | my $redis = Mojo::Redis->new; 143 | my $cursor = $redis->cursor(hkeys => 'redis:scan_test:hash'); 144 | my $keys = $cursor->all; 145 | 146 | =head1 DESCRIPTION 147 | 148 | L provides methods for iterating over the result from 149 | the Redis commands SCAN, SSCAN, HSCAN and ZSCAN. 150 | 151 | See L for more information. 152 | 153 | =head1 ATTRIBUTES 154 | 155 | =head2 command 156 | 157 | $array_ref = $cursor->command; 158 | 159 | The current command used to get data from Redis. This need to be set in the 160 | constructor, but reading it out might not reflect the value put in. Examples: 161 | 162 | $r->new(command => [hgetall => "foo*"]); 163 | # $r->command == [hscan => "foo*", 0] 164 | 165 | $r->new(command => [SSCAN => "foo*"]) 166 | # $r->command == [SSCAN => "foo*", 0] 167 | 168 | Also, calling L will change the value of L. Example: 169 | 170 | $r->new(command => ["keys"]); 171 | # $r->command == [scan => 0] 172 | $r->next; 173 | # $r->command == [scan => 42] 174 | 175 | =head2 connection 176 | 177 | $conn = $cursor->connection; 178 | $cursor = $cursor->connection(Mojo::Redis::Connection->new); 179 | 180 | Holds a L object. 181 | 182 | =head2 finished 183 | 184 | $bool = $cursor->finished; 185 | 186 | True after calling L or if L has iterated the whole list of members. 187 | 188 | =head2 redis 189 | 190 | $conn = $cursor->connection; 191 | $cursor = $cursor->connection(Mojo::Redis::Connection->new); 192 | 193 | Holds a L object used to create the connections to talk with Redis. 194 | 195 | =head1 METHODS 196 | 197 | =head2 again 198 | 199 | $cursor->again; 200 | 201 | Used to reset the cursor and make L start over. 202 | 203 | =head2 all 204 | 205 | $res = $cursor->all; 206 | $cursor = $cursor->all(sub { my ($cursor, $res) = @_ }); 207 | 208 | Used to return all members. C<$res> is an array ref of strings, except when 209 | using the command "hgetall". 210 | 211 | =head2 all_p 212 | 213 | $promise = $cursor->all_p->then(sub { my $res = shift }); 214 | 215 | Same as L but returns a L. 216 | 217 | =head2 new 218 | 219 | $cursor = Mojo::Redis::Cursor->new(command => [...], redis => Mojo::Redis->new); 220 | 221 | Used to construct a new object. L and L is required as input. 222 | 223 | Here are some examples of the differnet commands that are supported: 224 | 225 | # Custom cursor commands 226 | $cursor = $cursor->cursor(hscan => 0, match => '*', count => 100); 227 | $cursor = $cursor->cursor(scan => 0, match => '*', count => 100); 228 | $cursor = $cursor->cursor(sscan => 0, match => '*', count => 100); 229 | $cursor = $cursor->cursor(zscan => 0, match => '*', count => 100); 230 | 231 | # Convenient cursor commands 232 | $cursor = $cursor->cursor(hgetall => "some:hash:key"); 233 | $cursor = $cursor->cursor(hkeys => "some:hash:key"); 234 | $cursor = $cursor->cursor(keys => "some:key:pattern*"); 235 | $cursor = $cursor->cursor(smembers => "some:set:key"); 236 | 237 | The convenient commands are alternatives to L, 238 | L, L and 239 | L. 240 | 241 | =head2 next 242 | 243 | $res = $cursor->next; 244 | $cursor = $cursor->next(sub { my ($cursor, $err, $res) = @_ }); 245 | 246 | Used to return a chunk of members. C<$res> is an array ref of strings, except 247 | when using the command "hgetall". C<$res> will also be C when the 248 | cursor is exhausted and L will be true. 249 | 250 | =head2 next_p 251 | 252 | $promise = $cursor->next_p; 253 | 254 | Same as L but returns a L. 255 | 256 | =head1 SEE ALSO 257 | 258 | L. 259 | 260 | =cut 261 | -------------------------------------------------------------------------------- /lib/Mojo/Redis/Database.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Redis::Database; 2 | use Mojo::Base -base; 3 | 4 | use Scalar::Util 'blessed'; 5 | 6 | our @BASIC_COMMANDS = ( 7 | 'append', 'bgrewriteaof', 'bgsave', 'bitcount', 8 | 'bitfield', 'bitop', 'bitpos', 'client', 9 | 'cluster', 'config', 'command', 'dbsize', 10 | 'debug', 'decr', 'decrby', 'del', 11 | 'dump', 'echo', 'eval', 'evalsha', 12 | 'exists', 'expire', 'expireat', 'flushall', 13 | 'flushdb', 'geoadd', 'geohash', 'geopos', 14 | 'geodist', 'georadius', 'georadiusbymember', 'get', 15 | 'getbit', 'getrange', 'getset', 'hdel', 16 | 'hexists', 'hget', 'hgetall', 'hincrby', 17 | 'hincrbyfloat', 'hkeys', 'hlen', 'hmget', 18 | 'hmset', 'hset', 'hsetnx', 'hstrlen', 19 | 'hvals', 'info', 'incr', 'incrby', 20 | 'incrbyfloat', 'keys', 'lastsave', 'lindex', 21 | 'linsert', 'llen', 'lpop', 'lpush', 22 | 'lpushx', 'lrange', 'lrem', 'lset', 23 | 'ltrim', 'memory', 'mget', 'move', 24 | 'mset', 'msetnx', 'object', 'persist', 25 | 'pexpire', 'pexpireat', 'pttl', 'pfadd', 26 | 'pfcount', 'pfmerge', 'ping', 'psetex', 27 | 'publish', 'randomkey', 'readonly', 'readwrite', 28 | 'rename', 'renamenx', 'role', 'rpop', 29 | 'rpoplpush', 'rpush', 'rpushx', 'restore', 30 | 'sadd', 'save', 'scard', 'script', 31 | 'sdiff', 'sdiffstore', 'set', 'setbit', 32 | 'setex', 'setnx', 'setrange', 'sinter', 33 | 'sinterstore', 'sismember', 'slaveof', 'slowlog', 34 | 'smembers', 'smove', 'sort', 'spop', 35 | 'srandmember', 'srem', 'strlen', 'sunion', 36 | 'sunionstore', 'time', 'touch', 'ttl', 37 | 'type', 'unlink', 'xadd', 'xrange', 38 | 'xrevrange', 'xlen', 'xread', 'xreadgroup', 39 | 'xpending', 'zadd', 'zcard', 'zcount', 40 | 'zincrby', 'zinterstore', 'zlexcount', 'zpopmax', 41 | 'zpopmin', 'zrange', 'zrangebylex', 'zrangebyscore', 42 | 'zrank', 'zrem', 'zremrangebylex', 'zremrangebyrank', 43 | 'zremrangebyscore', 'zrevrange', 'zrevrangebylex', 'zrevrangebyscore', 44 | 'zrevrank', 'zscore', 'zunionstore', 45 | ); 46 | 47 | our @BLOCKING_COMMANDS = ('blpop', 'brpop', 'brpoplpush', 'bzpopmax', 'bzpopmin'); 48 | 49 | has redis => sub { Carp::confess('redis is required in constructor') }; 50 | 51 | __PACKAGE__->_add_method('bnb,p' => $_) for @BASIC_COMMANDS; 52 | __PACKAGE__->_add_method('nb,p' => $_) for @BLOCKING_COMMANDS; 53 | __PACKAGE__->_add_method('bnb' => qw(_exec EXEC)); 54 | __PACKAGE__->_add_method('bnb' => qw(_discard DISCARD)); 55 | __PACKAGE__->_add_method('bnb' => qw(_multi MULTI)); 56 | __PACKAGE__->_add_method('bnb,p' => "${_}_structured", $_) for qw(info xread); 57 | __PACKAGE__->_add_method('bnb,p' => $_) for qw(unwatch watch); 58 | 59 | sub call { 60 | my $cb = ref $_[-1] eq 'CODE' ? pop : undef; 61 | my $self = shift; 62 | my $p = $self->connection($cb ? 0 : 1)->write_p(@_); 63 | 64 | # Non-blocking 65 | if ($cb) { 66 | $p->then(sub { $self->$cb('', @_) })->catch(sub { $self->$cb(shift, undef) }); 67 | return $self; 68 | } 69 | 70 | # Blocking 71 | my ($err, @res); 72 | $p->then(sub { @res = @_ })->catch(sub { $err = shift })->wait; 73 | die $err if $err; 74 | return @res; 75 | } 76 | 77 | sub call_p { 78 | my $self = shift; 79 | return $self->connection->write_p(@_)->then(sub { $self = undef; @_ }); 80 | } 81 | 82 | sub exec { delete $_[0]->{txn}; shift->_exec(@_) } 83 | 84 | sub exec_p { 85 | my $self = shift; 86 | delete $self->{txn}; 87 | return $self->connection->write_p('EXEC'); 88 | } 89 | 90 | sub discard { delete $_[0]->{txn}; shift->_discard(@_) } 91 | 92 | sub discard_p { 93 | my $self = shift; 94 | delete $self->{txn}; 95 | return $self->connection->write_p('DISCARD'); 96 | } 97 | 98 | sub multi { 99 | $_[0]->{txn} = ref $_[-1] eq 'CODE' ? 'default' : 'blocking'; 100 | return shift->_multi(@_); 101 | } 102 | 103 | sub multi_p { 104 | my ($self, @p) = @_; 105 | Carp::croak('multi_p(@promises) syntax is not supported anymore. Use promise chaining instead.') 106 | if @p; 107 | $self->{txn} = 'default'; 108 | return $self->connection->write_p('MULTI'); 109 | } 110 | 111 | sub _add_method { 112 | my ($class, $types, $method, $op) = @_; 113 | my $caller = caller; 114 | my $process = $caller->can(lc "_process_$method"); 115 | 116 | $op ||= uc $method; 117 | 118 | for my $type (split /,/, $types) { 119 | Mojo::Util::monkey_patch( 120 | $caller, 121 | $type eq 'p' ? "${method}_p" : $method, 122 | $class->can("_generate_${type}_method")->($class, $op, $process) 123 | ); 124 | } 125 | } 126 | 127 | sub connection { 128 | my $self = shift; 129 | 130 | # Back compat: $self->connection(Mojo::Redis::Connection->new); 131 | $self->{_conn_dequeue} = shift if blessed $_[0] and $_[0]->isa('Mojo::Redis::Connection'); 132 | 133 | my $method = $_[0] ? '_blocking_connection' : '_dequeue'; 134 | return $self->{"_conn$method"} ||= $self->redis->$method; 135 | } 136 | 137 | sub _generate_bnb_method { 138 | my ($class, $op, $process) = @_; 139 | 140 | return sub { 141 | my $cb = ref $_[-1] eq 'CODE' ? pop : undef; 142 | my $self = shift; 143 | 144 | my $p = $self->connection($cb ? 0 : 1)->write_p($op, @_); 145 | $p = $p->then(sub { $self->$process(@_) }) if $process; 146 | 147 | # Non-blocking 148 | if ($cb) { 149 | $p->then(sub { $self->$cb('', @_) })->catch(sub { $self->$cb(shift, undef) }); 150 | return $self; 151 | } 152 | 153 | # Blocking 154 | my ($err, $res); 155 | $p->then(sub { $res = shift })->catch(sub { $err = shift })->wait; 156 | die $err if defined $err; 157 | return $res; 158 | }; 159 | } 160 | 161 | sub _generate_nb_method { 162 | my ($class, $op, $process) = @_; 163 | 164 | return sub { 165 | my ($self, $cb) = (shift, pop); 166 | $self->connection->write_p(@_)->then(sub { $self->$cb('', $process ? $self->$process(@_) : @_) }) 167 | ->catch(sub { $self->$cb(shift, undef) }); 168 | return $self; 169 | }; 170 | } 171 | 172 | sub _generate_p_method { 173 | my ($class, $op, $process) = @_; 174 | 175 | return sub { 176 | my $self = shift; 177 | $self->connection->write_p($op => @_)->then(sub { 178 | return $process ? $self->$process(@_) : @_; 179 | }); 180 | }; 181 | } 182 | 183 | sub _process_geopos { 184 | ref $_[1] eq 'ARRAY' ? [map { ref $_ ? +{lng => $_->[0], lat => $_->[1]} : undef } @{$_[1]}] : $_[1]; 185 | } 186 | sub _process_blpop { ref $_[1] eq 'ARRAY' ? reverse @{$_[1]} : $_[1] } 187 | sub _process_brpop { ref $_[1] eq 'ARRAY' ? reverse @{$_[1]} : $_[1] } 188 | sub _process_hgetall { ref $_[1] eq 'ARRAY' ? +{@{$_[1]}} : $_[1] } 189 | 190 | sub _process_info_structured { 191 | my $self = shift; 192 | my $section = {}; 193 | my %res; 194 | 195 | for (split /\r\n/, $_[0]) { 196 | if (/^\#\s+(\S+)/) { 197 | $section = $res{lc $1} = {}; 198 | } 199 | elsif (/(\S+):(\S+)/) { 200 | $section->{$1} = $2; 201 | } 202 | } 203 | 204 | return keys %res == 1 ? $section : \%res; 205 | } 206 | 207 | sub _process_xread_structured { 208 | return $_[1] unless ref $_[1] eq 'ARRAY'; 209 | return {map { ($_->[0] => $_->[1]) } @{$_[1]}}; 210 | } 211 | 212 | sub DESTROY { 213 | my $self = shift; 214 | 215 | if (my $txn = delete $self->{txn}) { 216 | $self->connection(1)->write_p('DISCARD')->wait if $txn eq 'blocking'; 217 | } 218 | elsif (my $redis = $self->{redis} and my $conn = $self->{_conn_dequeue}) { 219 | $redis->_enqueue($conn); 220 | } 221 | } 222 | 223 | 1; 224 | 225 | =encoding utf8 226 | 227 | =head1 NAME 228 | 229 | Mojo::Redis::Database - Execute basic redis commands 230 | 231 | =head1 SYNOPSIS 232 | 233 | use Mojo::Redis; 234 | 235 | my $redis = Mojo::Redis->new; 236 | my $db = $redis->db; 237 | 238 | # Blocking 239 | say "foo=" .$db->get("foo"); 240 | 241 | # Non-blocking 242 | $db->get(foo => sub { my ($db, $res) = @_; say "foo=$res" }); 243 | 244 | # Promises 245 | $db->get_p("foo")->then(sub { my ($res) = @_; say "foo=$res" }); 246 | 247 | See L 248 | for example L application. 249 | 250 | =head1 DESCRIPTION 251 | 252 | L has methods for sending and receiving structured 253 | data to the Redis server. 254 | 255 | =head1 ATTRIBUTES 256 | 257 | =head2 redis 258 | 259 | $conn = $db->redis; 260 | $db = $db->redis(Mojo::Redis->new); 261 | 262 | Holds a L object used to create the connections to talk with Redis. 263 | 264 | =head1 METHODS 265 | 266 | =head2 append 267 | 268 | $int = $db->append($key, $value); 269 | $db = $db->append($key, $value, sub { my ($db, $err, $int) = @_ }); 270 | $promise = $db->append_p($key, $value); 271 | 272 | Append a value to a key. 273 | 274 | See L for more information. 275 | 276 | =head2 bgrewriteaof 277 | 278 | $ok = $db->bgrewriteaof; 279 | $db = $db->bgrewriteaof(sub { my ($db, $err, $ok) = @_ }); 280 | $promise = $db->bgrewriteaof_p; 281 | 282 | Asynchronously rewrite the append-only file. 283 | 284 | See L for more information. 285 | 286 | =head2 bgsave 287 | 288 | $ok = $db->bgsave; 289 | $db = $db->bgsave(sub { my ($db, $err, $ok) = @_ }); 290 | $promise = $db->bgsave_p; 291 | 292 | Asynchronously save the dataset to disk. 293 | 294 | See L for more information. 295 | 296 | =head2 bitcount 297 | 298 | $int = $db->bitcount($key, [start end]); 299 | $db = $db->bitcount($key, [start end], sub { my ($db, $err, $int) = @_ }); 300 | $promise = $db->bitcount_p($key, [start end]); 301 | 302 | Count set bits in a string. 303 | 304 | See L for more information. 305 | 306 | =head2 bitfield 307 | 308 | $res = $db->bitfield($key, [GET type offset], [SET type offset value], [INCRBY type offset increment], [OVERFLOW WRAP|SAT|FAIL]); 309 | $db = $db->bitfield($key, [GET type offset], [SET type offset value], [INCRBY type offset increment], [OVERFLOW WRAP|SAT|FAIL], sub { my ($db, $err, $res) = @_ }); 310 | $promise = $db->bitfield_p($key, [GET type offset], [SET type offset value], [INCRBY typeoffset increment], [OVERFLOW WRAP|SAT|FAIL]); 311 | 312 | Perform arbitrary bitfield integer operations on strings. 313 | 314 | See L for more information. 315 | 316 | =head2 bitop 317 | 318 | $int = $db->bitop($operation, $destkey, $key [key ...]); 319 | $db = $db->bitop($operation, $destkey, $key [key ...], sub { my ($db, $err, $int) = @_ }); 320 | $promise = $db->bitop_p($operation, $destkey, $key [key ...]); 321 | 322 | Perform bitwise operations between strings. 323 | 324 | See L for more information. 325 | 326 | =head2 bitpos 327 | 328 | $int = $db->bitpos($key, $bit, [start], [end]); 329 | $db = $db->bitpos($key, $bit, [start], [end], sub { my ($db, $err, $int) = @_ }); 330 | $promise = $db->bitpos_p($key, $bit, [start], [end]); 331 | 332 | Find first bit set or clear in a string. 333 | 334 | See L for more information. 335 | 336 | =head2 blpop 337 | 338 | $db = $db->blpop($key [key ...], $timeout, sub { my ($db, $val, $key) = @_ }); 339 | $promise = $db->blpop_p($key [key ...], $timeout); 340 | 341 | Remove and get the first element in a list, or block until one is available. 342 | 343 | See L for more information. 344 | 345 | =head2 brpop 346 | 347 | $db = $db->brpop($key [key ...], $timeout, sub { my ($db, $val, $key) = @_ }); 348 | $promise = $db->brpop_p($key [key ...], $timeout); 349 | 350 | Remove and get the last element in a list, or block until one is available. 351 | 352 | See L for more information. 353 | 354 | =head2 brpoplpush 355 | 356 | $db = $db->brpoplpush($source, $destination, $timeout, sub { my ($db, $err, $array_ref) = @_ }); 357 | $promise = $db->brpoplpush_p($source, $destination, $timeout); 358 | 359 | Pop a value from a list, push it to another list and return it; or block until one is available. 360 | 361 | See L for more information. 362 | 363 | =head2 bzpopmax 364 | 365 | $db = $db->bzpopmax($key [key ...], $timeout, sub { my ($db, $err, $array_ref) = @_ }); 366 | $promise = $db->bzpopmax_p($key [key ...], $timeout); 367 | 368 | Remove and return the member with the highest score from one or more sorted sets, or block until one is available. 369 | 370 | See L for more information. 371 | 372 | =head2 bzpopmin 373 | 374 | $db = $db->bzpopmin($key [key ...], $timeout, sub { my ($db, $err, $array_ref) = @_ }); 375 | $promise = $db->bzpopmin_p($key [key ...], $timeout); 376 | 377 | Remove and return the member with the lowest score from one or more sorted sets, or block until one is available. 378 | 379 | See L for more information. 380 | 381 | =head2 call 382 | 383 | $res = $db->call($command => @args); 384 | $db = $db->call($command => @args, sub { my ($db, $err, $res) = @_; }); 385 | 386 | Same as L, but either blocks or passes the result into a callback. 387 | 388 | =head2 call_p 389 | 390 | $promise = $db->call_p($command => @args); 391 | $promise = $db->call_p(GET => "some:key"); 392 | 393 | Used to send a custom command to the Redis server. 394 | 395 | =head2 client 396 | 397 | $res = $db->client(@args); 398 | $db = $db->client(@args, sub { my ($db, $err, $res) = @_ }); 399 | $promise = $db->client_p(@args); 400 | 401 | Run a "CLIENT" command on the server. C<@args> can be: 402 | 403 | =over 2 404 | 405 | =item * KILL [ip:port] [ID client-id] [TYPE normal|master|slave|pubsub] [ADDR ip:port] [SKIPME yes/no] 406 | 407 | =item * LIST 408 | 409 | =item * GETNAME 410 | 411 | =item * PAUSE timeout 412 | 413 | =item * REPLY [ON|OFF|SKIP] 414 | 415 | =item * SETNAME connection-name 416 | 417 | =back 418 | 419 | See L for more information. 420 | 421 | =head2 connection 422 | 423 | $non_blocking_connection = $db->connection(0); 424 | $blocking_connection = $db->connection(1); 425 | 426 | Returns a L object. The default is to return a 427 | connection suitable for non-blocking methods, but passing in a true value will 428 | return the connection used for blocking methods. 429 | 430 | # Blocking 431 | my $res = $db->get("some:key"); 432 | 433 | # Non-blocking 434 | $db->get_p("some:key"); 435 | $db->get("some:key", sub { ... }); 436 | 437 | =head2 cluster 438 | 439 | $res = $db->cluster(@args); 440 | $db = $db->cluster(@args, sub { my ($db, $err, $res) = @_ }); 441 | $promise = $db->cluster_p(@args); 442 | 443 | Used to execute cluster commands. 444 | 445 | See L for more information. 446 | 447 | =head2 command 448 | 449 | $array_ref = $db->command(@args); 450 | $db = $db->command(@args, sub { my ($db, $err, $array_ref) = @_ }); 451 | $promise = $db->command_p(@args); 452 | 453 | Get array of Redis command details. 454 | 455 | =over 2 456 | 457 | =item * empty list 458 | 459 | =item * COUNT 460 | 461 | =item * GETKEYS 462 | 463 | =item * INFO command-name [command-name] 464 | 465 | =back 466 | 467 | See L for more information. 468 | 469 | =head2 dbsize 470 | 471 | $int = $db->dbsize; 472 | $db = $db->dbsize(sub { my ($db, $err, $int) = @_ }); 473 | $promise = $db->dbsize_p; 474 | 475 | Return the number of keys in the selected database. 476 | 477 | See L for more information. 478 | 479 | =head2 decr 480 | 481 | $num = $db->decr($key); 482 | $db = $db->decr($key, sub { my ($db, $err, $num) = @_ }); 483 | $promise = $db->decr_p($key); 484 | 485 | Decrement the integer value of a key by one. 486 | 487 | See L for more information. 488 | 489 | =head2 decrby 490 | 491 | $num = $db->decrby($key, $decrement); 492 | $db = $db->decrby($key, $decrement, sub { my ($db, $err, $num) = @_ }); 493 | $promise = $db->decrby_p($key, $decrement); 494 | 495 | Decrement the integer value of a key by the given number. 496 | 497 | See L for more information. 498 | 499 | =head2 del 500 | 501 | $ok = $db->del($key [key ...]); 502 | $db = $db->del($key [key ...], sub { my ($db, $err, $ok) = @_ }); 503 | $promise = $db->del_p($key [key ...]); 504 | 505 | Delete a key. 506 | 507 | See L for more information. 508 | 509 | =head2 discard 510 | 511 | See L. 512 | 513 | =head2 discard_p 514 | 515 | $ok = $db->discard; 516 | $db = $db->discard(sub { my ($db, $err, $ok) = @_ }); 517 | $promise = $db->discard_p; 518 | 519 | Discard all commands issued after MULTI. 520 | 521 | See L for more information. 522 | 523 | =head2 dump 524 | 525 | $ok = $db->dump($key); 526 | $db = $db->dump($key, sub { my ($db, $err, $ok) = @_ }); 527 | $promise = $db->dump_p($key); 528 | 529 | Return a serialized version of the value stored at the specified key. 530 | 531 | See L for more information. 532 | 533 | =head2 echo 534 | 535 | $res = $db->echo($message); 536 | $db = $db->echo($message, sub { my ($db, $err, $res) = @_ }); 537 | $promise = $db->echo_p($message); 538 | 539 | Echo the given string. 540 | 541 | See L for more information. 542 | 543 | =head2 eval 544 | 545 | $res = $db->eval($script, $numkeys, $key [key ...], $arg [arg ...]); 546 | $db = $db->eval($script, $numkeys, $key [key ...], $arg [arg ...], sub { my ($db, $err, $res) = @_ }); 547 | $promise = $db->eval_p($script, $numkeys, $key [key ...], $arg [arg ...]); 548 | 549 | Execute a Lua script server side. 550 | 551 | See L for more information. 552 | 553 | =head2 evalsha 554 | 555 | $res = $db->evalsha($sha1, $numkeys, $key [key ...], $arg [arg ...]); 556 | $db = $db->evalsha($sha1, $numkeys, $key [key ...], $arg [arg ...], sub { my ($db, $err, $res) = @_ }); 557 | $promise = $db->evalsha_p($sha1, $numkeys, $key [key ...], $arg [arg ...]); 558 | 559 | Execute a Lua script server side. 560 | 561 | See L for more information. 562 | 563 | =head2 exec 564 | 565 | See L. 566 | 567 | =head2 exec_p 568 | 569 | $array_ref = $db->exec; 570 | $db = $db->exec(sub { my ($db, $err, $array_ref) = @_ }); 571 | $promise = $db->exec_p; 572 | 573 | Execute all commands issued after L. 574 | 575 | See L for more information. 576 | 577 | =head2 exists 578 | 579 | $int = $db->exists($key [key ...]); 580 | $db = $db->exists($key [key ...], sub { my ($db, $err, $int) = @_ }); 581 | $promise = $db->exists_p($key [key ...]); 582 | 583 | Determine if a key exists. 584 | 585 | See L for more information. 586 | 587 | =head2 expire 588 | 589 | $int = $db->expire($key, $seconds); 590 | $db = $db->expire($key, $seconds, sub { my ($db, $err, $int) = @_ }); 591 | $promise = $db->expire_p($key, $seconds); 592 | 593 | Set a key's time to live in seconds. 594 | 595 | See L for more information. 596 | 597 | =head2 expireat 598 | 599 | $int = $db->expireat($key, $timestamp); 600 | $db = $db->expireat($key, $timestamp, sub { my ($db, $err, $int) = @_ }); 601 | $promise = $db->expireat_p($key, $timestamp); 602 | 603 | Set the expiration for a key as a UNIX timestamp. 604 | 605 | See L for more information. 606 | 607 | =head2 flushall 608 | 609 | $str = $db->flushall([ASYNC]); 610 | $db = $db->flushall([ASYNC], sub { my ($db, $err, $str) = @_ }); 611 | $promise = $db->flushall_p([ASYNC]); 612 | 613 | Remove all keys from all databases. 614 | 615 | See L for more information. 616 | 617 | =head2 flushdb 618 | 619 | $str = $db->flushdb([ASYNC]); 620 | $db = $db->flushdb([ASYNC], sub { my ($db, $err, $str) = @_ }); 621 | $promise = $db->flushdb_p([ASYNC]); 622 | 623 | Remove all keys from the current database. 624 | 625 | See L for more information. 626 | 627 | =head2 geoadd 628 | 629 | $res = $db->geoadd($key, $longitude latitude member [longitude latitude member ...]); 630 | $db = $db->geoadd($key, $longitude latitude member [longitude latitude member ...], sub { my ($db, $err, $res) = @_ }); 631 | $promise = $db->geoadd_p($key, $longitude latitude member [longitude latitude member ...]); 632 | 633 | Add one or more geospatial items in the geospatial index represented using a sorted set. 634 | 635 | See L for more information. 636 | 637 | =head2 geodist 638 | 639 | $res = $db->geodist($key, $member1, $member2, [unit]); 640 | $db = $db->geodist($key, $member1, $member2, [unit], sub { my ($db, $err, $res) = @_ }); 641 | $promise = $db->geodist_p($key, $member1, $member2, [unit]); 642 | 643 | Returns the distance between two members of a geospatial index. 644 | 645 | See L for more information. 646 | 647 | =head2 geohash 648 | 649 | $res = $db->geohash($key, $member [member ...]); 650 | $db = $db->geohash($key, $member [member ...], sub { my ($db, $err, $res) = @_ }); 651 | $promise = $db->geohash_p($key, $member [member ...]); 652 | 653 | Returns members of a geospatial index as standard geohash strings. 654 | 655 | See L for more information. 656 | 657 | =head2 geopos 658 | 659 | $array_ref = $db->geopos($key, $member [member ...]); 660 | $db = $db->geopos($key, $member [member ...], sub { my ($db, $err, $array_ref) = @_ }); 661 | $promise = $db->geopos_p($key, $member [member ...]); 662 | 663 | Returns longitude and latitude of members of a geospatial index: 664 | 665 | [{lat => $num, lng => $num}, ...] 666 | 667 | See L for more information. 668 | 669 | =head2 georadius 670 | 671 | $res = $db->georadius($key, $longitude, $latitude, $radius, $m|km|ft|mi, [WITHCOORD],[WITHDIST], [WITHHASH], [COUNT count], [ASC|DESC], [STORE key], [STOREDIST key]); 672 | $db = $db->georadius($key, $longitude, $latitude, $radius, $m|km|ft|mi, [WITHCOORD],[WITHDIST], [WITHHASH], [COUNT count], [ASC|DESC], [STORE key], [STOREDIST key], sub { my ($db, $err, $res) = @_ }); 673 | $promise = $db->georadius_p($key, $longitude, $latitude, $radius, $m|km|ft|mi, [WITHCOORD], [WITHDIST], [WITHHASH], [COUNT count], [ASC|DESC], [STORE key], [STOREDIST key]); 674 | 675 | Query a sorted set representing a geospatial index to fetch members matching a given maximum distance from a point. 676 | 677 | See L for more information. 678 | 679 | =head2 georadiusbymember 680 | 681 | $res = $db->georadiusbymember($key, $member, $radius, $m|km|ft|mi, [WITHCOORD], [WITHDIST], [WITHHASH], [COUNT count], [ASC|DESC], [STORE key], [STOREDIST key]); 682 | $db = $db->georadiusbymember($key, $member, $radius, $m|km|ft|mi, [WITHCOORD], [WITHDIST], [WITHHASH], [COUNT count], [ASC|DESC], [STORE key], [STOREDIST key], sub { my ($db, $err, $res) = @_ }); 683 | $promise = $db->georadiusbymember_p($key, $member, $radius, $m|km|ft|mi, [WITHCOORD], [WITHDIST], [WITHHASH], [COUNT count], [ASC|DESC], [STORE key], [STOREDIST key]); 684 | 685 | Query a sorted set representing a geospatial index to fetch members matching a given maximum distance from a member. 686 | 687 | See L for more information. 688 | 689 | =head2 get 690 | 691 | $res = $db->get($key); 692 | $db = $db->get($key, sub { my ($db, $err, $res) = @_ }); 693 | $promise = $db->get_p($key); 694 | 695 | Get the value of a key. 696 | 697 | See L for more information. 698 | 699 | =head2 getbit 700 | 701 | $res = $db->getbit($key, $offset); 702 | $db = $db->getbit($key, $offset, sub { my ($db, $err, $res) = @_ }); 703 | $promise = $db->getbit_p($key, $offset); 704 | 705 | Returns the bit value at offset in the string value stored at key. 706 | 707 | See L for more information. 708 | 709 | =head2 getrange 710 | 711 | $res = $db->getrange($key, $start, $end); 712 | $db = $db->getrange($key, $start, $end, sub { my ($db, $err, $res) = @_ }); 713 | $promise = $db->getrange_p($key, $start, $end); 714 | 715 | Get a substring of the string stored at a key. 716 | 717 | See L for more information. 718 | 719 | =head2 getset 720 | 721 | $res = $db->getset($key, $value); 722 | $db = $db->getset($key, $value, sub { my ($db, $err, $res) = @_ }); 723 | $promise = $db->getset_p($key, $value); 724 | 725 | Set the string value of a key and return its old value. 726 | 727 | See L for more information. 728 | 729 | =head2 hdel 730 | 731 | $res = $db->hdel($key, $field [field ...]); 732 | $db = $db->hdel($key, $field [field ...], sub { my ($db, $err, $res) = @_ }); 733 | $promise = $db->hdel_p($key, $field [field ...]); 734 | 735 | Delete one or more hash fields. 736 | 737 | See L for more information. 738 | 739 | =head2 hexists 740 | 741 | $res = $db->hexists($key, $field); 742 | $db = $db->hexists($key, $field, sub { my ($db, $err, $res) = @_ }); 743 | $promise = $db->hexists_p($key, $field); 744 | 745 | Determine if a hash field exists. 746 | 747 | See L for more information. 748 | 749 | =head2 hget 750 | 751 | $res = $db->hget($key, $field); 752 | $db = $db->hget($key, $field, sub { my ($db, $err, $res) = @_ }); 753 | $promise = $db->hget_p($key, $field); 754 | 755 | Get the value of a hash field. 756 | 757 | See L for more information. 758 | 759 | =head2 hgetall 760 | 761 | $res = $db->hgetall($key); 762 | $db = $db->hgetall($key, sub { my ($db, $err, $res) = @_ }); 763 | $promise = $db->hgetall_p($key); 764 | 765 | Get all the fields and values in a hash. The returned value from Redis is 766 | automatically turned into a hash-ref for convenience. 767 | 768 | See L for more information. 769 | 770 | =head2 hincrby 771 | 772 | $res = $db->hincrby($key, $field, $increment); 773 | $db = $db->hincrby($key, $field, $increment, sub { my ($db, $err, $res) = @_ }); 774 | $promise = $db->hincrby_p($key, $field, $increment); 775 | 776 | Increment the integer value of a hash field by the given number. 777 | 778 | See L for more information. 779 | 780 | =head2 hincrbyfloat 781 | 782 | $res = $db->hincrbyfloat($key, $field, $increment); 783 | $db = $db->hincrbyfloat($key, $field, $increment, sub { my ($db, $err, $res) = @_ }); 784 | $promise = $db->hincrbyfloat_p($key, $field, $increment); 785 | 786 | Increment the float value of a hash field by the given amount. 787 | 788 | See L for more information. 789 | 790 | =head2 hkeys 791 | 792 | $res = $db->hkeys($key); 793 | $db = $db->hkeys($key, sub { my ($db, $err, $res) = @_ }); 794 | $promise = $db->hkeys_p($key); 795 | 796 | Get all the fields in a hash. 797 | 798 | See L for more information. 799 | 800 | =head2 hlen 801 | 802 | $res = $db->hlen($key); 803 | $db = $db->hlen($key, sub { my ($db, $err, $res) = @_ }); 804 | $promise = $db->hlen_p($key); 805 | 806 | Get the number of fields in a hash. 807 | 808 | See L for more information. 809 | 810 | =head2 hmget 811 | 812 | $res = $db->hmget($key, $field [field ...]); 813 | $db = $db->hmget($key, $field [field ...], sub { my ($db, $err, $res) = @_ }); 814 | $promise = $db->hmget_p($key, $field [field ...]); 815 | 816 | Get the values of all the given hash fields. 817 | 818 | See L for more information. 819 | 820 | =head2 hmset 821 | 822 | $res = $db->hmset($key, $field => $value [field value ...]); 823 | $db = $db->hmset($key, $field => $value [field value ...], sub { my ($db, $err, $res) = @_ }); 824 | $promise = $db->hmset_p($key, $field => $value [field value ...]); 825 | 826 | Set multiple hash fields to multiple values. 827 | 828 | See L for more information. 829 | 830 | =head2 hset 831 | 832 | $res = $db->hset($key, $field, $value); 833 | $db = $db->hset($key, $field, $value, sub { my ($db, $err, $res) = @_ }); 834 | $promise = $db->hset_p($key, $field, $value); 835 | 836 | Set the string value of a hash field. 837 | 838 | See L for more information. 839 | 840 | =head2 hsetnx 841 | 842 | $res = $db->hsetnx($key, $field, $value); 843 | $db = $db->hsetnx($key, $field, $value, sub { my ($db, $err, $res) = @_ }); 844 | $promise = $db->hsetnx_p($key, $field, $value); 845 | 846 | Set the value of a hash field, only if the field does not exist. 847 | 848 | See L for more information. 849 | 850 | =head2 hstrlen 851 | 852 | $res = $db->hstrlen($key, $field); 853 | $db = $db->hstrlen($key, $field, sub { my ($db, $err, $res) = @_ }); 854 | $promise = $db->hstrlen_p($key, $field); 855 | 856 | Get the length of the value of a hash field. 857 | 858 | See L for more information. 859 | 860 | =head2 hvals 861 | 862 | $res = $db->hvals($key); 863 | $db = $db->hvals($key, sub { my ($db, $err, $res) = @_ }); 864 | $promise = $db->hvals_p($key); 865 | 866 | Get all the values in a hash. 867 | 868 | See L for more information. 869 | 870 | =head2 info 871 | 872 | $res = $db->info($section); 873 | $db = $db->info($section, sub { my ($db, $err, $res) = @_ }); 874 | $promise = $db->info_p($section); 875 | 876 | Get information and statistics about the server. See also L. 877 | 878 | See L for more information. 879 | 880 | =head2 info_structured 881 | 882 | Same as L, but the result is a hash-ref where the keys are the different 883 | sections, with key/values in a sub hash. Will only be key/values if <$section> 884 | is specified. 885 | 886 | =head2 incr 887 | 888 | $res = $db->incr($key); 889 | $db = $db->incr($key, sub { my ($db, $err, $res) = @_ }); 890 | $promise = $db->incr_p($key); 891 | 892 | Increment the integer value of a key by one. 893 | 894 | See L for more information. 895 | 896 | =head2 incrby 897 | 898 | $res = $db->incrby($key, $increment); 899 | $db = $db->incrby($key, $increment, sub { my ($db, $err, $res) = @_ }); 900 | $promise = $db->incrby_p($key, $increment); 901 | 902 | Increment the integer value of a key by the given amount. 903 | 904 | See L for more information. 905 | 906 | =head2 incrbyfloat 907 | 908 | $res = $db->incrbyfloat($key, $increment); 909 | $db = $db->incrbyfloat($key, $increment, sub { my ($db, $err, $res) = @_ }); 910 | $promise = $db->incrbyfloat_p($key, $increment); 911 | 912 | Increment the float value of a key by the given amount. 913 | 914 | See L for more information. 915 | 916 | =head2 keys 917 | 918 | $res = $db->keys($pattern); 919 | $db = $db->keys($pattern, sub { my ($db, $err, $res) = @_ }); 920 | $promise = $db->keys_p($pattern); 921 | 922 | Find all keys matching the given pattern. 923 | 924 | See L for more information. 925 | 926 | =head2 lastsave 927 | 928 | $res = $db->lastsave; 929 | $db = $db->lastsave(sub { my ($db, $err, $res) = @_ }); 930 | $promise = $db->lastsave_p; 931 | 932 | Get the UNIX time stamp of the last successful save to disk. 933 | 934 | See L for more information. 935 | 936 | =head2 lindex 937 | 938 | $res = $db->lindex($key, $index); 939 | $db = $db->lindex($key, $index, sub { my ($db, $err, $res) = @_ }); 940 | $promise = $db->lindex_p($key, $index); 941 | 942 | Get an element from a list by its index. 943 | 944 | See L for more information. 945 | 946 | =head2 linsert 947 | 948 | $res = $db->linsert($key, $BEFORE|AFTER, $pivot, $value); 949 | $db = $db->linsert($key, $BEFORE|AFTER, $pivot, $value, sub { my ($db, $err, $res) = @_ }); 950 | $promise = $db->linsert_p($key, $BEFORE|AFTER, $pivot, $value); 951 | 952 | Insert an element before or after another element in a list. 953 | 954 | See L for more information. 955 | 956 | =head2 llen 957 | 958 | $res = $db->llen($key); 959 | $db = $db->llen($key, sub { my ($db, $err, $res) = @_ }); 960 | $promise = $db->llen_p($key); 961 | 962 | Get the length of a list. 963 | 964 | See L for more information. 965 | 966 | =head2 lpop 967 | 968 | $res = $db->lpop($key); 969 | $db = $db->lpop($key, sub { my ($db, $err, $res) = @_ }); 970 | $promise = $db->lpop_p($key); 971 | 972 | Remove and get the first element in a list. 973 | 974 | See L for more information. 975 | 976 | =head2 lpush 977 | 978 | $res = $db->lpush($key, $value [value ...]); 979 | $db = $db->lpush($key, $value [value ...], sub { my ($db, $err, $res) = @_ }); 980 | $promise = $db->lpush_p($key, $value [value ...]); 981 | 982 | Prepend one or multiple values to a list. 983 | 984 | See L for more information. 985 | 986 | =head2 lpushx 987 | 988 | $res = $db->lpushx($key, $value); 989 | $db = $db->lpushx($key, $value, sub { my ($db, $err, $res) = @_ }); 990 | $promise = $db->lpushx_p($key, $value); 991 | 992 | Prepend a value to a list, only if the list exists. 993 | 994 | See L for more information. 995 | 996 | =head2 lrange 997 | 998 | $res = $db->lrange($key, $start, $stop); 999 | $db = $db->lrange($key, $start, $stop, sub { my ($db, $err, $res) = @_ }); 1000 | $promise = $db->lrange_p($key, $start, $stop); 1001 | 1002 | Get a range of elements from a list. 1003 | 1004 | See L for more information. 1005 | 1006 | =head2 lrem 1007 | 1008 | $res = $db->lrem($key, $count, $value); 1009 | $db = $db->lrem($key, $count, $value, sub { my ($db, $err, $res) = @_ }); 1010 | $promise = $db->lrem_p($key, $count, $value); 1011 | 1012 | Remove elements from a list. 1013 | 1014 | See L for more information. 1015 | 1016 | =head2 lset 1017 | 1018 | $res = $db->lset($key, $index, $value); 1019 | $db = $db->lset($key, $index, $value, sub { my ($db, $err, $res) = @_ }); 1020 | $promise = $db->lset_p($key, $index, $value); 1021 | 1022 | Set the value of an element in a list by its index. 1023 | 1024 | See L for more information. 1025 | 1026 | =head2 ltrim 1027 | 1028 | $res = $db->ltrim($key, $start, $stop); 1029 | $db = $db->ltrim($key, $start, $stop, sub { my ($db, $err, $res) = @_ }); 1030 | $promise = $db->ltrim_p($key, $start, $stop); 1031 | 1032 | Trim a list to the specified range. 1033 | 1034 | See L for more information. 1035 | 1036 | =head2 mget 1037 | 1038 | $res = $db->mget($key [key ...]); 1039 | $db = $db->mget($key [key ...], sub { my ($db, $err, $res) = @_ }); 1040 | $promise = $db->mget_p($key [key ...]); 1041 | 1042 | Get the values of all the given keys. 1043 | 1044 | See L for more information. 1045 | 1046 | =head2 move 1047 | 1048 | $res = $db->move($key, $db); 1049 | $db = $db->move($key, $db, sub { my ($db, $err, $res) = @_ }); 1050 | $promise = $db->move_p($key, $db); 1051 | 1052 | Move a key to another database. 1053 | 1054 | See L for more information. 1055 | 1056 | =head2 mset 1057 | 1058 | $res = $db->mset($key value [key value ...]); 1059 | $db = $db->mset($key value [key value ...], sub { my ($db, $err, $res) = @_ }); 1060 | $promise = $db->mset_p($key value [key value ...]); 1061 | 1062 | Set multiple keys to multiple values. 1063 | 1064 | See L for more information. 1065 | 1066 | =head2 msetnx 1067 | 1068 | $res = $db->msetnx($key value [key value ...]); 1069 | $db = $db->msetnx($key value [key value ...], sub { my ($db, $err, $res) = @_ }); 1070 | $promise = $db->msetnx_p($key value [key value ...]); 1071 | 1072 | Set multiple keys to multiple values, only if none of the keys exist. 1073 | 1074 | See L for more information. 1075 | 1076 | =head2 multi 1077 | 1078 | See L. 1079 | 1080 | =head2 multi_p 1081 | 1082 | $res = $db->multi; 1083 | $db = $db->multi(sub { my ($db, $err, $res) = @_ }); 1084 | $promise = $db->multi_p; 1085 | 1086 | Mark the start of a transaction block. Commands issued after L will 1087 | automatically be discarded if C<$db> goes out of scope. Need to call 1088 | L to commit the queued commands to Redis. 1089 | 1090 | NOTE: the previously supported C syntax has been removed, 1091 | because it did not work as expected. See 1092 | L for details. 1093 | When L gets called with non-zero arguments, it Cs. 1094 | Use the promise chaining instead: 1095 | 1096 | $db->multi_p->then(sub { 1097 | Mojo::Promise->all( 1098 | $db->set_p(...), 1099 | $db->incr_p(...), 1100 | ... 1101 | ); 1102 | })->then(sub { 1103 | $db->exec_p; 1104 | })->then ... 1105 | 1106 | See L for more information. 1107 | 1108 | =head2 object 1109 | 1110 | $res = $db->object($subcommand, [arguments [arguments ...]]); 1111 | $db = $db->object($subcommand, [arguments [arguments ...]], sub { my ($db, $err, $res) =@_ }); 1112 | $promise = $db->object_p($subcommand, [arguments [arguments ...]]); 1113 | 1114 | Inspect the internals of Redis objects. 1115 | 1116 | See L for more information. 1117 | 1118 | =head2 persist 1119 | 1120 | $res = $db->persist($key); 1121 | $db = $db->persist($key, sub { my ($db, $err, $res) = @_ }); 1122 | $promise = $db->persist_p($key); 1123 | 1124 | Remove the expiration from a key. 1125 | 1126 | See L for more information. 1127 | 1128 | =head2 pexpire 1129 | 1130 | $res = $db->pexpire($key, $milliseconds); 1131 | $db = $db->pexpire($key, $milliseconds, sub { my ($db, $err, $res) = @_ }); 1132 | $promise = $db->pexpire_p($key, $milliseconds); 1133 | 1134 | Set a key's time to live in milliseconds. 1135 | 1136 | See L for more information. 1137 | 1138 | =head2 pexpireat 1139 | 1140 | $res = $db->pexpireat($key, $milliseconds-timestamp); 1141 | $db = $db->pexpireat($key, $milliseconds-timestamp, sub { my ($db, $err, $res) = @_ }); 1142 | $promise = $db->pexpireat_p($key, $milliseconds-timestamp); 1143 | 1144 | Set the expiration for a key as a UNIX timestamp specified in milliseconds. 1145 | 1146 | See L for more information. 1147 | 1148 | =head2 pfadd 1149 | 1150 | $res = $db->pfadd($key, $element [element ...]); 1151 | $db = $db->pfadd($key, $element [element ...], sub { my ($db, $err, $res) = @_ }); 1152 | $promise = $db->pfadd_p($key, $element [element ...]); 1153 | 1154 | Adds the specified elements to the specified HyperLogLog. 1155 | 1156 | See L for more information. 1157 | 1158 | =head2 pfcount 1159 | 1160 | $res = $db->pfcount($key [key ...]); 1161 | $db = $db->pfcount($key [key ...], sub { my ($db, $err, $res) = @_ }); 1162 | $promise = $db->pfcount_p($key [key ...]); 1163 | 1164 | Return the approximated cardinality of the set(s) observed by the HyperLogLog at key(s). 1165 | 1166 | See L for more information. 1167 | 1168 | =head2 pfmerge 1169 | 1170 | $res = $db->pfmerge($destkey, $sourcekey [sourcekey ...]); 1171 | $db = $db->pfmerge($destkey, $sourcekey [sourcekey ...], sub { my ($db, $err, $res) = @_}); 1172 | $promise = $db->pfmerge_p($destkey, $sourcekey [sourcekey ...]); 1173 | 1174 | Merge N different HyperLogLogs into a single one. 1175 | 1176 | See L for more information. 1177 | 1178 | =head2 ping 1179 | 1180 | $res = $db->ping([message]); 1181 | $db = $db->ping([message], sub { my ($db, $err, $res) = @_ }); 1182 | $promise = $db->ping_p([message]); 1183 | 1184 | Ping the server. 1185 | 1186 | See L for more information. 1187 | 1188 | =head2 psetex 1189 | 1190 | $res = $db->psetex($key, $milliseconds, $value); 1191 | $db = $db->psetex($key, $milliseconds, $value, sub { my ($db, $err, $res) = @_ }); 1192 | $promise = $db->psetex_p($key, $milliseconds, $value); 1193 | 1194 | Set the value and expiration in milliseconds of a key. 1195 | 1196 | See L for more information. 1197 | 1198 | =head2 pttl 1199 | 1200 | $res = $db->pttl($key); 1201 | $db = $db->pttl($key, sub { my ($db, $err, $res) = @_ }); 1202 | $promise = $db->pttl_p($key); 1203 | 1204 | Get the time to live for a key in milliseconds. 1205 | 1206 | See L for more information. 1207 | 1208 | =head2 publish 1209 | 1210 | $res = $db->publish($channel, $message); 1211 | $db = $db->publish($channel, $message, sub { my ($db, $err, $res) = @_ }); 1212 | $promise = $db->publish_p($channel, $message); 1213 | 1214 | Post a message to a channel. 1215 | 1216 | See L for more information. 1217 | 1218 | =head2 randomkey 1219 | 1220 | $res = $db->randomkey; 1221 | $db = $db->randomkey(sub { my ($db, $err, $res) = @_ }); 1222 | $promise = $db->randomkey_p; 1223 | 1224 | Return a random key from the keyspace. 1225 | 1226 | See L for more information. 1227 | 1228 | =head2 readonly 1229 | 1230 | $res = $db->readonly(); 1231 | $db = $db->readonly(, sub { my ($db, $res) = @_ }); 1232 | $promise = $db->readonly_p(); 1233 | 1234 | Enables read queries for a connection to a cluster slave node. 1235 | 1236 | See L for more information. 1237 | 1238 | =head2 readwrite 1239 | 1240 | $res = $db->readwrite(); 1241 | $db = $db->readwrite(, sub { my ($db, $res) = @_ }); 1242 | $promise = $db->readwrite_p(); 1243 | 1244 | Disables read queries for a connection to a cluster slave node. 1245 | 1246 | See L for more information. 1247 | 1248 | =head2 rename 1249 | 1250 | $res = $db->rename($key, $newkey); 1251 | $db = $db->rename($key, $newkey, sub { my ($db, $err, $res) = @_ }); 1252 | $promise = $db->rename_p($key, $newkey); 1253 | 1254 | Rename a key. 1255 | 1256 | See L for more information. 1257 | 1258 | =head2 renamenx 1259 | 1260 | $res = $db->renamenx($key, $newkey); 1261 | $db = $db->renamenx($key, $newkey, sub { my ($db, $err, $res) = @_ }); 1262 | $promise = $db->renamenx_p($key, $newkey); 1263 | 1264 | Rename a key, only if the new key does not exist. 1265 | 1266 | See L for more information. 1267 | 1268 | =head2 role 1269 | 1270 | $res = $db->role; 1271 | $db = $db->role(sub { my ($db, $err, $res) = @_ }); 1272 | $promise = $db->role_p; 1273 | 1274 | Return the role of the instance in the context of replication. 1275 | 1276 | See L for more information. 1277 | 1278 | =head2 rpop 1279 | 1280 | $res = $db->rpop($key); 1281 | $db = $db->rpop($key, sub { my ($db, $err, $res) = @_ }); 1282 | $promise = $db->rpop_p($key); 1283 | 1284 | Remove and get the last element in a list. 1285 | 1286 | See L for more information. 1287 | 1288 | =head2 rpoplpush 1289 | 1290 | $res = $db->rpoplpush($source, $destination); 1291 | $db = $db->rpoplpush($source, $destination, sub { my ($db, $err, $res) = @_ }); 1292 | $promise = $db->rpoplpush_p($source, $destination); 1293 | 1294 | Remove the last element in a list, prepend it to another list and return it. 1295 | 1296 | See L for more information. 1297 | 1298 | =head2 rpush 1299 | 1300 | $res = $db->rpush($key, $value [value ...]); 1301 | $db = $db->rpush($key, $value [value ...], sub { my ($db, $err, $res) = @_ }); 1302 | $promise = $db->rpush_p($key, $value [value ...]); 1303 | 1304 | Append one or multiple values to a list. 1305 | 1306 | See L for more information. 1307 | 1308 | =head2 rpushx 1309 | 1310 | $res = $db->rpushx($key, $value); 1311 | $db = $db->rpushx($key, $value, sub { my ($db, $err, $res) = @_ }); 1312 | $promise = $db->rpushx_p($key, $value); 1313 | 1314 | Append a value to a list, only if the list exists. 1315 | 1316 | See L for more information. 1317 | 1318 | =head2 restore 1319 | 1320 | $res = $db->restore($key, $ttl, $serialized-value, [REPLACE]); 1321 | $db = $db->restore($key, $ttl, $serialized-value, [REPLACE], sub { my ($db, $err, $res) = @_ }); 1322 | $promise = $db->restore_p($key, $ttl, $serialized-value, [REPLACE]); 1323 | 1324 | Create a key using the provided serialized value, previously obtained using DUMP. 1325 | 1326 | See L for more information. 1327 | 1328 | =head2 sadd 1329 | 1330 | $res = $db->sadd($key, $member [member ...]); 1331 | $db = $db->sadd($key, $member [member ...], sub { my ($db, $err, $res) = @_ }); 1332 | $promise = $db->sadd_p($key, $member [member ...]); 1333 | 1334 | Add one or more members to a set. 1335 | 1336 | See L for more information. 1337 | 1338 | =head2 save 1339 | 1340 | $res = $db->save; 1341 | $db = $db->save(sub { my ($db, $err, $res) = @_ }); 1342 | $promise = $db->save_p; 1343 | 1344 | Synchronously save the dataset to disk. 1345 | 1346 | See L for more information. 1347 | 1348 | =head2 scard 1349 | 1350 | $res = $db->scard($key); 1351 | $db = $db->scard($key, sub { my ($db, $err, $res) = @_ }); 1352 | $promise = $db->scard_p($key); 1353 | 1354 | Get the number of members in a set. 1355 | 1356 | See L for more information. 1357 | 1358 | =head2 script 1359 | 1360 | $res = $db->script($sub_command, @args); 1361 | $db = $db->script($sub_command, @args, sub { my ($db, $err, $res) = @_ }); 1362 | $promise = $db->script_p($sub_command, @args); 1363 | 1364 | Execute a script command. 1365 | 1366 | See L, 1367 | L, 1368 | L, 1369 | L or 1370 | L for more information. 1371 | 1372 | =head2 sdiff 1373 | 1374 | $res = $db->sdiff($key [key ...]); 1375 | $db = $db->sdiff($key [key ...], sub { my ($db, $err, $res) = @_ }); 1376 | $promise = $db->sdiff_p($key [key ...]); 1377 | 1378 | Subtract multiple sets. 1379 | 1380 | See L for more information. 1381 | 1382 | =head2 sdiffstore 1383 | 1384 | $res = $db->sdiffstore($destination, $key [key ...]); 1385 | $db = $db->sdiffstore($destination, $key [key ...], sub { my ($db, $err, $res) = @_ }); 1386 | $promise = $db->sdiffstore_p($destination, $key [key ...]); 1387 | 1388 | Subtract multiple sets and store the resulting set in a key. 1389 | 1390 | See L for more information. 1391 | 1392 | =head2 set 1393 | 1394 | $res = $db->set($key, $value, [expiration EX seconds|PX milliseconds], [NX|XX]); 1395 | $db = $db->set($key, $value, [expiration EX seconds|PX milliseconds], [NX|XX], sub {my ($db, $err, $res) = @_ }); 1396 | $promise = $db->set_p($key, $value, [expiration EX seconds|PX milliseconds], [NX|XX]); 1397 | 1398 | Set the string value of a key. 1399 | 1400 | See L for more information. 1401 | 1402 | =head2 setbit 1403 | 1404 | $res = $db->setbit($key, $offset, $value); 1405 | $db = $db->setbit($key, $offset, $value, sub { my ($db, $err, $res) = @_ }); 1406 | $promise = $db->setbit_p($key, $offset, $value); 1407 | 1408 | Sets or clears the bit at offset in the string value stored at key. 1409 | 1410 | See L for more information. 1411 | 1412 | =head2 setex 1413 | 1414 | $res = $db->setex($key, $seconds, $value); 1415 | $db = $db->setex($key, $seconds, $value, sub { my ($db, $err, $res) = @_ }); 1416 | $promise = $db->setex_p($key, $seconds, $value); 1417 | 1418 | Set the value and expiration of a key. 1419 | 1420 | See L for more information. 1421 | 1422 | =head2 setnx 1423 | 1424 | $res = $db->setnx($key, $value); 1425 | $db = $db->setnx($key, $value, sub { my ($db, $err, $res) = @_ }); 1426 | $promise = $db->setnx_p($key, $value); 1427 | 1428 | Set the value of a key, only if the key does not exist. 1429 | 1430 | See L for more information. 1431 | 1432 | =head2 setrange 1433 | 1434 | $res = $db->setrange($key, $offset, $value); 1435 | $db = $db->setrange($key, $offset, $value, sub { my ($db, $err, $res) = @_ }); 1436 | $promise = $db->setrange_p($key, $offset, $value); 1437 | 1438 | Overwrite part of a string at key starting at the specified offset. 1439 | 1440 | See L for more information. 1441 | 1442 | =head2 sinter 1443 | 1444 | $res = $db->sinter($key [key ...]); 1445 | $db = $db->sinter($key [key ...], sub { my ($db, $err, $res) = @_ }); 1446 | $promise = $db->sinter_p($key [key ...]); 1447 | 1448 | Intersect multiple sets. 1449 | 1450 | See L for more information. 1451 | 1452 | =head2 sinterstore 1453 | 1454 | $res = $db->sinterstore($destination, $key [key ...]); 1455 | $db = $db->sinterstore($destination, $key [key ...], sub { my ($db, $err, $res) = @_ }); 1456 | $promise = $db->sinterstore_p($destination, $key [key ...]); 1457 | 1458 | Intersect multiple sets and store the resulting set in a key. 1459 | 1460 | See L for more information. 1461 | 1462 | =head2 sismember 1463 | 1464 | $res = $db->sismember($key, $member); 1465 | $db = $db->sismember($key, $member, sub { my ($db, $err, $res) = @_ }); 1466 | $promise = $db->sismember_p($key, $member); 1467 | 1468 | Determine if a given value is a member of a set. 1469 | 1470 | See L for more information. 1471 | 1472 | =head2 slaveof 1473 | 1474 | $res = $db->slaveof($host, $port); 1475 | $db = $db->slaveof($host, $port, sub { my ($db, $err, $res) = @_ }); 1476 | $promise = $db->slaveof_p($host, $port); 1477 | 1478 | Make the server a slave of another instance, or promote it as master. 1479 | 1480 | See L for more information. 1481 | 1482 | =head2 slowlog 1483 | 1484 | $res = $db->slowlog($subcommand, [argument]); 1485 | $db = $db->slowlog($subcommand, [argument], sub { my ($db, $err, $res) = @_ }); 1486 | $promise = $db->slowlog_p($subcommand, [argument]); 1487 | 1488 | Manages the Redis slow queries log. 1489 | 1490 | See L for more information. 1491 | 1492 | =head2 smembers 1493 | 1494 | $res = $db->smembers($key); 1495 | $db = $db->smembers($key, sub { my ($db, $err, $res) = @_ }); 1496 | $promise = $db->smembers_p($key); 1497 | 1498 | Get all the members in a set. 1499 | 1500 | See L for more information. 1501 | 1502 | =head2 smove 1503 | 1504 | $res = $db->smove($source, $destination, $member); 1505 | $db = $db->smove($source, $destination, $member, sub { my ($db, $err, $res) = @_ }); 1506 | $promise = $db->smove_p($source, $destination, $member); 1507 | 1508 | Move a member from one set to another. 1509 | 1510 | See L for more information. 1511 | 1512 | =head2 sort 1513 | 1514 | $res = $db->sort($key, [BY pattern], [LIMIT offset count], [GET pattern [GET pattern ...]], [ASC|DESC], [ALPHA], [STORE destination]); 1515 | $db = $db->sort($key, [BY pattern], [LIMIT offset count], [GET pattern [GET pattern ...]], [ASC|DESC], [ALPHA], [STORE destination], sub { my ($db, $err, $res) = @_ }); 1516 | $promise = $db->sort_p($key, [BY pattern], [LIMIT offset count], [GET pattern [GET pattern ...]], [ASC|DESC], [ALPHA], [STORE destination]); 1517 | 1518 | Sort the elements in a list, set or sorted set. 1519 | 1520 | See L for more information. 1521 | 1522 | =head2 spop 1523 | 1524 | $res = $db->spop($key, [count]); 1525 | $db = $db->spop($key, [count], sub { my ($db, $err, $res) = @_ }); 1526 | $promise = $db->spop_p($key, [count]); 1527 | 1528 | Remove and return one or multiple random members from a set. 1529 | 1530 | See L for more information. 1531 | 1532 | =head2 srandmember 1533 | 1534 | $res = $db->srandmember($key, [count]); 1535 | $db = $db->srandmember($key, [count], sub { my ($db, $err, $res) = @_ }); 1536 | $promise = $db->srandmember_p($key, [count]); 1537 | 1538 | Get one or multiple random members from a set. 1539 | 1540 | See L for more information. 1541 | 1542 | =head2 srem 1543 | 1544 | $res = $db->srem($key, $member [member ...]); 1545 | $db = $db->srem($key, $member [member ...], sub { my ($db, $err, $res) = @_ }); 1546 | $promise = $db->srem_p($key, $member [member ...]); 1547 | 1548 | Remove one or more members from a set. 1549 | 1550 | See L for more information. 1551 | 1552 | =head2 strlen 1553 | 1554 | $res = $db->strlen($key); 1555 | $db = $db->strlen($key, sub { my ($db, $err, $res) = @_ }); 1556 | $promise = $db->strlen_p($key); 1557 | 1558 | Get the length of the value stored in a key. 1559 | 1560 | See L for more information. 1561 | 1562 | =head2 sunion 1563 | 1564 | $res = $db->sunion($key [key ...]); 1565 | $db = $db->sunion($key [key ...], sub { my ($db, $err, $res) = @_ }); 1566 | $promise = $db->sunion_p($key [key ...]); 1567 | 1568 | Add multiple sets. 1569 | 1570 | See L for more information. 1571 | 1572 | =head2 sunionstore 1573 | 1574 | $res = $db->sunionstore($destination, $key [key ...]); 1575 | $db = $db->sunionstore($destination, $key [key ...], sub { my ($db, $err, $res) = @_ }); 1576 | $promise = $db->sunionstore_p($destination, $key [key ...]); 1577 | 1578 | Add multiple sets and store the resulting set in a key. 1579 | 1580 | See L for more information. 1581 | 1582 | =head2 time 1583 | 1584 | $res = $db->time; 1585 | $db = $db->time(sub { my ($db, $err, $res) = @_ }); 1586 | $promise = $db->time_p; 1587 | 1588 | Return the current server time. 1589 | 1590 | See L for more information. 1591 | 1592 | =head2 touch 1593 | 1594 | $res = $db->touch($key [key ...]); 1595 | $db = $db->touch($key [key ...], sub { my ($db, $err, $res) = @_ }); 1596 | $promise = $db->touch_p($key [key ...]); 1597 | 1598 | Alters the last access time of a key(s). Returns the number of existing keys specified. 1599 | 1600 | See L for more information. 1601 | 1602 | =head2 ttl 1603 | 1604 | $res = $db->ttl($key); 1605 | $db = $db->ttl($key, sub { my ($db, $err, $res) = @_ }); 1606 | $promise = $db->ttl_p($key); 1607 | 1608 | Get the time to live for a key. 1609 | 1610 | See L for more information. 1611 | 1612 | =head2 type 1613 | 1614 | $res = $db->type($key); 1615 | $db = $db->type($key, sub { my ($db, $err, $res) = @_ }); 1616 | $promise = $db->type_p($key); 1617 | 1618 | Determine the type stored at key. 1619 | 1620 | See L for more information. 1621 | 1622 | =head2 unlink 1623 | 1624 | $res = $db->unlink($key [key ...]); 1625 | $db = $db->unlink($key [key ...], sub { my ($db, $err, $res) = @_ }); 1626 | $promise = $db->unlink_p($key [key ...]); 1627 | 1628 | Delete a key asynchronously in another thread. Otherwise it is just as DEL, but non blocking. 1629 | 1630 | See L for more information. 1631 | 1632 | =head2 unwatch 1633 | 1634 | $res = $db->unwatch; 1635 | $db = $db->unwatch(sub { my ($db, $err, $res) = @_ }); 1636 | $promise = $db->unwatch_p; 1637 | 1638 | Forget about all watched keys. 1639 | 1640 | See L for more information. 1641 | 1642 | =head2 watch 1643 | 1644 | $res = $db->watch($key [key ...]); 1645 | $db = $db->watch($key [key ...], sub { my ($db, $err, $res) = @_ }); 1646 | $promise = $db->watch_p($key [key ...]); 1647 | 1648 | Watch the given keys to determine execution of the MULTI/EXEC block. 1649 | 1650 | See L for more information. 1651 | 1652 | =head2 xadd 1653 | 1654 | $res = $db->xadd($key, $ID, $field string [field string ...]); 1655 | $db = $db->xadd($key, $ID, $field string [field string ...], sub { my ($db, $err, $res) = @_ }); 1656 | $promise = $db->xadd_p($key, $ID, $field string [field string ...]); 1657 | 1658 | Appends a new entry to a stream. 1659 | 1660 | See L for more information. 1661 | 1662 | =head2 xlen 1663 | 1664 | $res = $db->xlen($key); 1665 | $db = $db->xlen($key, sub { my ($db, $err, $res) = @_ }); 1666 | $promise = $db->xlen_p($key); 1667 | 1668 | Return the number of entires in a stream. 1669 | 1670 | See L for more information. 1671 | 1672 | =head2 xpending 1673 | 1674 | $res = $db->xpending($key, $group, [start end count], [consumer]); 1675 | $db = $db->xpending($key, $group, [start end count], [consumer], sub { my ($db, $err, $res) = @_ }); 1676 | $promise = $db->xpending_p($key, $group, [start end count], [consumer]); 1677 | 1678 | Return information and entries from a stream consumer group pending entries list, that are messages fetched but never acknowledged. 1679 | 1680 | See L for more information. 1681 | 1682 | =head2 xrange 1683 | 1684 | $res = $db->xrange($key, $start, $end, [COUNT count]); 1685 | $db = $db->xrange($key, $start, $end, [COUNT count], sub { my ($db, $err, $res) = @_ }); 1686 | $promise = $db->xrange_p($key, $start, $end, [COUNT count]); 1687 | 1688 | Return a range of elements in a stream, with IDs matching the specified IDs interval. 1689 | 1690 | See L for more information. 1691 | 1692 | =head2 xread 1693 | 1694 | $res = $db->xread([COUNT count], [BLOCK milliseconds], $STREAMS, $key [key ...], $ID [ID ...]); 1695 | $db = $db->xread([COUNT count], [BLOCK milliseconds], $STREAMS, $key [key ...], $ID [ID ...], sub { my ($db, $err, $res) = @_ }); 1696 | $promise = $db->xread_p([COUNT count], [BLOCK milliseconds], $STREAMS, $key [key ...], $ID [ID ...]); 1697 | 1698 | Return never seen elements in multiple streams, with IDs greater than the ones reported by the caller for each stream. Can block. 1699 | 1700 | See L for more information. 1701 | 1702 | =head2 xread_structured 1703 | 1704 | Same as L, but the result is a data structure like this: 1705 | 1706 | { 1707 | $stream_name => [ 1708 | [ $id1 => [@data1] ], 1709 | [ $id2 => [@data2] ], 1710 | ... 1711 | ] 1712 | } 1713 | 1714 | This method is currently EXPERIMENTAL, but will only change if bugs are 1715 | discovered. 1716 | 1717 | =head2 xreadgroup 1718 | 1719 | $res = $db->xreadgroup($GROUP group consumer, [COUNT count], [BLOCK milliseconds], $STREAMS, $key [key ...], $ID [ID ...]); 1720 | $db = $db->xreadgroup($GROUP group consumer, [COUNT count], [BLOCK milliseconds], $STREAMS, $key [key ...], $ID [ID ...], sub { my ($db, $err, $res) = @_ }); 1721 | $promise = $db->xreadgroup_p($GROUP group consumer, [COUNT count], [BLOCK milliseconds], $STREAMS, $key [key ...], $ID [ID ...]); 1722 | 1723 | Return new entries from a stream using a consumer group, or access the history of the pending entries for a given consumer. Can block. 1724 | 1725 | See L for more information. 1726 | 1727 | =head2 xrevrange 1728 | 1729 | $res = $db->xrevrange($key, $end, $start, [COUNT count]); 1730 | $db = $db->xrevrange($key, $end, $start, [COUNT count], sub { my ($db, $err, $res) = @_ }); 1731 | $promise = $db->xrevrange_p($key, $end, $start, [COUNT count]); 1732 | 1733 | Return a range of elements in a stream, with IDs matching the specified IDs interval, in reverse order (from greater to smaller IDs) compared to XRANGE. 1734 | 1735 | See L for more information. 1736 | 1737 | =head2 zadd 1738 | 1739 | $res = $db->zadd($key, [NX|XX], [CH], [INCR], $score member [score member ...]); 1740 | $db = $db->zadd($key, [NX|XX], [CH], [INCR], $score member [score member ...], sub {my ($db, $err, $res) = @_ }); 1741 | $promise = $db->zadd_p($key, [NX|XX], [CH], [INCR], $score member [score member ...]); 1742 | 1743 | Add one or more members to a sorted set, or update its score if it already exists. 1744 | 1745 | See L for more information. 1746 | 1747 | =head2 zcard 1748 | 1749 | $res = $db->zcard($key); 1750 | $db = $db->zcard($key, sub { my ($db, $err, $res) = @_ }); 1751 | $promise = $db->zcard_p($key); 1752 | 1753 | Get the number of members in a sorted set. 1754 | 1755 | See L for more information. 1756 | 1757 | =head2 zcount 1758 | 1759 | $res = $db->zcount($key, $min, $max); 1760 | $db = $db->zcount($key, $min, $max, sub { my ($db, $err, $res) = @_ }); 1761 | $promise = $db->zcount_p($key, $min, $max); 1762 | 1763 | Count the members in a sorted set with scores within the given values. 1764 | 1765 | See L for more information. 1766 | 1767 | =head2 zincrby 1768 | 1769 | $res = $db->zincrby($key, $increment, $member); 1770 | $db = $db->zincrby($key, $increment, $member, sub { my ($db, $err, $res) = @_ }); 1771 | $promise = $db->zincrby_p($key, $increment, $member); 1772 | 1773 | Increment the score of a member in a sorted set. 1774 | 1775 | See L for more information. 1776 | 1777 | =head2 zinterstore 1778 | 1779 | $res = $db->zinterstore($destination, $numkeys, $key [key ...], [WEIGHTS weight [weight ...]], [AGGREGATE SUM|MIN|MAX]); 1780 | $db = $db->zinterstore($destination, $numkeys, $key [key ...], [WEIGHTS weight [weight ...]], [AGGREGATE SUM|MIN|MAX], sub { my ($db, $err, $res) = @_ }); 1781 | $promise = $db->zinterstore_p($destination, $numkeys, $key [key ...], [WEIGHTS weight [weight ...]], [AGGREGATE SUM|MIN|MAX]); 1782 | 1783 | Intersect multiple sorted sets and store the resulting sorted set in a new key. 1784 | 1785 | See L for more information. 1786 | 1787 | =head2 zlexcount 1788 | 1789 | $res = $db->zlexcount($key, $min, $max); 1790 | $db = $db->zlexcount($key, $min, $max, sub { my ($db, $err, $res) = @_ }); 1791 | $promise = $db->zlexcount_p($key, $min, $max); 1792 | 1793 | Count the number of members in a sorted set between a given lexicographical range. 1794 | 1795 | See L for more information. 1796 | 1797 | =head2 zpopmax 1798 | 1799 | $res = $db->zpopmax($key, [count]); 1800 | $db = $db->zpopmax($key, [count], sub { my ($db, $err, $res) = @_ }); 1801 | $promise = $db->zpopmax_p($key, [count]); 1802 | 1803 | Remove and return members with the highest scores in a sorted set. 1804 | 1805 | See L for more information. 1806 | 1807 | =head2 zpopmin 1808 | 1809 | $res = $db->zpopmin($key, [count]); 1810 | $db = $db->zpopmin($key, [count], sub { my ($db, $err, $res) = @_ }); 1811 | $promise = $db->zpopmin_p($key, [count]); 1812 | 1813 | Remove and return members with the lowest scores in a sorted set. 1814 | 1815 | See L for more information. 1816 | 1817 | =head2 zrange 1818 | 1819 | $res = $db->zrange($key, $start, $stop, [WITHSCORES]); 1820 | $db = $db->zrange($key, $start, $stop, [WITHSCORES], sub { my ($db, $err, $res) = @_ }); 1821 | $promise = $db->zrange_p($key, $start, $stop, [WITHSCORES]); 1822 | 1823 | Return a range of members in a sorted set, by index. 1824 | 1825 | See L for more information. 1826 | 1827 | =head2 zrangebylex 1828 | 1829 | $res = $db->zrangebylex($key, $min, $max, [LIMIT offset count]); 1830 | $db = $db->zrangebylex($key, $min, $max, [LIMIT offset count], sub { my ($db, $err, $res) = @_ }); 1831 | $promise = $db->zrangebylex_p($key, $min, $max, [LIMIT offset count]); 1832 | 1833 | Return a range of members in a sorted set, by lexicographical range. 1834 | 1835 | See L for more information. 1836 | 1837 | =head2 zrangebyscore 1838 | 1839 | $res = $db->zrangebyscore($key, $min, $max, [WITHSCORES], [LIMIT offset count]); 1840 | $db = $db->zrangebyscore($key, $min, $max, [WITHSCORES], [LIMIT offset count], sub {my ($db, $err, $res) = @_ }); 1841 | $promise = $db->zrangebyscore_p($key, $min, $max, [WITHSCORES], [LIMIT offset count]); 1842 | 1843 | Return a range of members in a sorted set, by score. 1844 | 1845 | See L for more information. 1846 | 1847 | =head2 zrank 1848 | 1849 | $res = $db->zrank($key, $member); 1850 | $db = $db->zrank($key, $member, sub { my ($db, $err, $res) = @_ }); 1851 | $promise = $db->zrank_p($key, $member); 1852 | 1853 | Determine the index of a member in a sorted set. 1854 | 1855 | See L for more information. 1856 | 1857 | =head2 zrem 1858 | 1859 | $res = $db->zrem($key, $member [member ...]); 1860 | $db = $db->zrem($key, $member [member ...], sub { my ($db, $err, $res) = @_ }); 1861 | $promise = $db->zrem_p($key, $member [member ...]); 1862 | 1863 | Remove one or more members from a sorted set. 1864 | 1865 | See L for more information. 1866 | 1867 | =head2 zremrangebylex 1868 | 1869 | $res = $db->zremrangebylex($key, $min, $max); 1870 | $db = $db->zremrangebylex($key, $min, $max, sub { my ($db, $err, $res) = @_ }); 1871 | $promise = $db->zremrangebylex_p($key, $min, $max); 1872 | 1873 | Remove all members in a sorted set between the given lexicographical range. 1874 | 1875 | See L for more information. 1876 | 1877 | =head2 zremrangebyrank 1878 | 1879 | $res = $db->zremrangebyrank($key, $start, $stop); 1880 | $db = $db->zremrangebyrank($key, $start, $stop, sub { my ($db, $err, $res) = @_ }); 1881 | $promise = $db->zremrangebyrank_p($key, $start, $stop); 1882 | 1883 | Remove all members in a sorted set within the given indexes. 1884 | 1885 | See L for more information. 1886 | 1887 | =head2 zremrangebyscore 1888 | 1889 | $res = $db->zremrangebyscore($key, $min, $max); 1890 | $db = $db->zremrangebyscore($key, $min, $max, sub { my ($db, $err, $res) = @_ }); 1891 | $promise = $db->zremrangebyscore_p($key, $min, $max); 1892 | 1893 | Remove all members in a sorted set within the given scores. 1894 | 1895 | See L for more information. 1896 | 1897 | =head2 zrevrange 1898 | 1899 | $res = $db->zrevrange($key, $start, $stop, [WITHSCORES]); 1900 | $db = $db->zrevrange($key, $start, $stop, [WITHSCORES], sub { my ($db, $err, $res) = @_ }); 1901 | $promise = $db->zrevrange_p($key, $start, $stop, [WITHSCORES]); 1902 | 1903 | Return a range of members in a sorted set, by index, with scores ordered from high to low. 1904 | 1905 | See L for more information. 1906 | 1907 | =head2 zrevrangebylex 1908 | 1909 | $res = $db->zrevrangebylex($key, $max, $min, [LIMIT offset count]); 1910 | $db = $db->zrevrangebylex($key, $max, $min, [LIMIT offset count], sub { my ($db, $err, $res) = @_ }); 1911 | $promise = $db->zrevrangebylex_p($key, $max, $min, [LIMIT offset count]); 1912 | 1913 | Return a range of members in a sorted set, by lexicographical range, ordered from higher to lower strings. 1914 | 1915 | See L for more information. 1916 | 1917 | =head2 zrevrangebyscore 1918 | 1919 | $res = $db->zrevrangebyscore($key, $max, $min, [WITHSCORES], [LIMIT offset count]); 1920 | $db = $db->zrevrangebyscore($key, $max, $min, [WITHSCORES], [LIMIT offset count], sub { my ($db, $err, $res) = @_ }); 1921 | $promise = $db->zrevrangebyscore_p($key, $max, $min, [WITHSCORES], [LIMIT offset count]); 1922 | 1923 | Return a range of members in a sorted set, by score, with scores ordered from high to low. 1924 | 1925 | See L for more information. 1926 | 1927 | =head2 zrevrank 1928 | 1929 | $res = $db->zrevrank($key, $member); 1930 | $db = $db->zrevrank($key, $member, sub { my ($db, $err, $res) = @_ }); 1931 | $promise = $db->zrevrank_p($key, $member); 1932 | 1933 | Determine the index of a member in a sorted set, with scores ordered from high to low. 1934 | 1935 | See L for more information. 1936 | 1937 | =head2 zscore 1938 | 1939 | $res = $db->zscore($key, $member); 1940 | $db = $db->zscore($key, $member, sub { my ($db, $err, $res) = @_ }); 1941 | $promise = $db->zscore_p($key, $member); 1942 | 1943 | Get the score associated with the given member in a sorted set. 1944 | 1945 | See L for more information. 1946 | 1947 | =head2 zunionstore 1948 | 1949 | $res = $db->zunionstore($destination, $numkeys, $key [key ...], [WEIGHTS weight [weight ...]], [AGGREGATE SUM|MIN|MAX]); 1950 | $db = $db->zunionstore($destination, $numkeys, $key [key ...], [WEIGHTS weight [weight ...]], [AGGREGATE SUM|MIN|MAX], sub { my ($db, $err, $res) = @_ }); 1951 | $promise = $db->zunionstore_p($destination, $numkeys, $key [key ...], [WEIGHTS weight [weight ...]], [AGGREGATE SUM|MIN|MAX]); 1952 | 1953 | Add multiple sorted sets and store the resulting sorted set in a new key. 1954 | 1955 | See L for more information. 1956 | 1957 | =head1 SEE ALSO 1958 | 1959 | L. 1960 | 1961 | =cut 1962 | -------------------------------------------------------------------------------- /lib/Mojo/Redis/PubSub.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Redis::PubSub; 2 | use Mojo::Base 'Mojo::EventEmitter'; 3 | 4 | use Mojo::JSON qw(from_json to_json); 5 | 6 | use constant DEBUG => $ENV{MOJO_REDIS_DEBUG}; 7 | 8 | has connection => sub { 9 | my $self = shift; 10 | my $conn = $self->redis->_connection; 11 | 12 | Scalar::Util::weaken($self); 13 | for my $name (qw(close error response)) { 14 | my $handler = "_on_$name"; 15 | $conn->on($name => sub { $self and $self->$handler(@_) }); 16 | } 17 | 18 | return $conn; 19 | }; 20 | 21 | has db => sub { 22 | my $self = shift; 23 | my $db = $self->redis->db; 24 | Scalar::Util::weaken($db->{redis}); 25 | return $db; 26 | }; 27 | 28 | has reconnect_interval => 1; 29 | has redis => sub { Carp::confess('redis is requried in constructor') }; 30 | 31 | sub channels_p { shift->db->call_p(qw(PUBSUB CHANNELS), @_) } 32 | sub json { ++$_[0]{json}{$_[1]} and return $_[0] } 33 | 34 | sub keyspace_listen { 35 | my ($self, $cb) = (shift, pop); 36 | my $key = $self->_keyspace_key(@_); 37 | $self->{keyspace_listen}{$key} = 1; 38 | return $self->listen($key, $cb); 39 | } 40 | 41 | sub keyspace_unlisten { 42 | my ($self, $cb) = (shift, ref $_[-1] eq 'CODE' ? pop : undef); 43 | return $self->unlisten($self->_keyspace_key(@_), $cb); 44 | } 45 | 46 | sub listen { 47 | my ($self, $name, $cb) = @_; 48 | 49 | unless (@{$self->{chans}{$name} ||= []}) { 50 | Mojo::IOLoop->remove(delete $self->{reconnect_tid}) if $self->{reconnect_tid}; 51 | $self->_write([($name =~ /\*/ ? 'PSUBSCRIBE' : 'SUBSCRIBE') => $name]); 52 | } 53 | 54 | push @{$self->{chans}{$name}}, $cb; 55 | return $cb; 56 | } 57 | 58 | sub notify_p { 59 | my ($self, $name, $payload) = @_; 60 | $payload = to_json $payload if $self->{json}{$name}; 61 | return $self->db->call_p(PUBLISH => $name, $payload); 62 | } 63 | 64 | sub notify { shift->notify_p(@_)->wait } 65 | sub numpat_p { shift->db->call_p(qw(PUBSUB NUMPAT)) } 66 | sub numsub_p { shift->db->call_p(qw(PUBSUB NUMSUB), @_)->then(\&_flatten) } 67 | 68 | sub unlisten { 69 | my ($self, $name, $cb) = @_; 70 | my $chans = $self->{chans}{$name}; 71 | 72 | @$chans = $cb ? grep { $cb ne $_ } @$chans : (); 73 | unless (@$chans) { 74 | my $conn = $self->connection; 75 | $conn->write(($name =~ /\*/ ? 'PUNSUBSCRIBE' : 'UNSUBSCRIBE'), $name) if $conn->is_connected; 76 | delete $self->{chans}{$name}; 77 | } 78 | 79 | return $self; 80 | } 81 | 82 | sub _flatten { +{@{$_[0]}} } 83 | 84 | sub _keyspace_key { 85 | my $args = ref $_[-1] eq 'HASH' ? pop : {}; 86 | my $self = shift; 87 | 88 | local $args->{key} = $_[0] // $args->{key} // '*'; 89 | local $args->{op} = $_[1] // $args->{op} // '*'; 90 | local $args->{type} = $args->{type} || ($args->{key} eq '*' ? 'keyevent' : 'keyspace'); 91 | 92 | return sprintf '__%s@%s__:%s', $args->{type}, $args->{db} // $self->redis->url->path->[0] // '*', 93 | $args->{type} eq 'keyevent' ? $args->{op} : $args->{key}; 94 | } 95 | 96 | sub _on_close { 97 | my $self = shift; 98 | $self->emit(disconnect => $self->connection); 99 | 100 | my $delay = $self->reconnect_interval; 101 | return $self if $delay < 0 or $self->{reconnect_tid}; 102 | 103 | warn qq([Mojo::Redis::PubSub] Reconnecting in ${delay}s...\n) if DEBUG; 104 | Scalar::Util::weaken($self); 105 | $self->{reconnect} = 1; 106 | $self->{reconnect_tid} = Mojo::IOLoop->timer($delay => sub { $self and $self->_reconnect }); 107 | return $self; 108 | } 109 | 110 | sub _on_error { $_[0]->emit(error => $_[2]) } 111 | 112 | sub _on_response { 113 | my ($self, $conn, $res) = @_; 114 | $self->emit(reconnect => $conn) if delete $self->{reconnect}; 115 | 116 | # $res = [pmessage => $name, $channel, $data] 117 | # $res = [message => $channel, $data] 118 | 119 | return unless ref $res eq 'ARRAY'; 120 | return $self->emit(@$res) unless $res->[0] =~ m!^p?message$!i; 121 | 122 | my ($name) = $res->[0] eq 'pmessage' ? splice @$res, 1, 1 : ($res->[1]); 123 | my $keyspace_listen = $self->{keyspace_listen}{$name}; 124 | 125 | local $@; 126 | $res->[2] = eval { from_json $res->[2] } if $self->{json}{$name}; 127 | for my $cb (@{$self->{chans}{$name} || []}) { 128 | $self->$cb($keyspace_listen ? [@$res[1, 2]] : $res->[2], $res->[1]); 129 | } 130 | } 131 | 132 | sub _reconnect { 133 | my $self = shift; 134 | delete $self->{$_} for qw(before_connect connection reconnect_tid); 135 | $self->_write(map { [(/\*/ ? 'PSUBSCRIBE' : 'SUBSCRIBE') => $_] } keys %{$self->{chans}}); 136 | } 137 | 138 | sub _write { 139 | my ($self, @commands) = @_; 140 | my $conn = $self->connection; 141 | $self->emit(before_connect => $conn) unless $self->{before_connect}++; 142 | $conn->write(@$_) for @commands; 143 | } 144 | 145 | 1; 146 | 147 | =encoding utf8 148 | 149 | =head1 NAME 150 | 151 | Mojo::Redis::PubSub - Publish and subscribe to Redis messages 152 | 153 | =head1 SYNOPSIS 154 | 155 | use Mojo::Redis; 156 | 157 | my $redis = Mojo::Redis->new; 158 | my $pubsub = $redis->pubsub; 159 | 160 | $pubsub->listen("user:superwoman:messages" => sub { 161 | my ($pubsub, $message, $channel) = @_; 162 | say "superwoman got a message '$message' from channel '$channel'"; 163 | }); 164 | 165 | $pubsub->notify("user:batboy:messages", "How are you doing?"); 166 | 167 | See L 168 | for example L application. 169 | 170 | =head1 DESCRIPTION 171 | 172 | L is an implementation of the Redis Publish/Subscribe 173 | messaging paradigm. This class has the same API as L, so 174 | you can easily switch between the backends. 175 | 176 | This object holds one connection for receiving messages, and one connection 177 | for sending messages. They are created lazily the first time L or 178 | L is called. These connections does not affect the connection pool 179 | for L. 180 | 181 | See L for more details. 182 | 183 | =head1 EVENTS 184 | 185 | =head2 before_connect 186 | 187 | $pubsub->on(before_connect => sub { my ($pubsub, $conn) = @_; ... }); 188 | 189 | Emitted before L is connected to the redis server. This can be 190 | useful if you want to gather the L 191 | or run other commands before it goes into subscribe mode. 192 | 193 | =head2 disconnect 194 | 195 | $pubsub->on(disconnect => sub { my ($pubsub, $conn) = @_; ... }); 196 | 197 | Emitted after L is disconnected from the redis server. 198 | 199 | =head2 psubscribe 200 | 201 | $pubsub->on(psubscribe => sub { my ($pubsub, $channel, $success) = @_; ... }); 202 | 203 | Emitted when the server responds to the L request and/or when 204 | L resends psubscribe messages. 205 | 206 | This event is EXPERIMENTAL. 207 | 208 | =head2 reconnect 209 | 210 | $pubsub->on(reconnect => sub { my ($pubsub, $conn) = @_; ... }); 211 | 212 | Emitted after switching the L with a new connection. This event 213 | will only happen if L is 0 or more. 214 | 215 | =head2 subscribe 216 | 217 | $pubsub->on(subscribe => sub { my ($pubsub, $channel, $success) = @_; ... }); 218 | 219 | Emitted when the server responds to the L request and/or when 220 | L resends subscribe messages. 221 | 222 | This event is EXPERIMENTAL. 223 | 224 | =head1 ATTRIBUTES 225 | 226 | =head2 db 227 | 228 | $db = $pubsub->db; 229 | 230 | Holds a L object that will be used to publish messages 231 | or run other commands that cannot be run by the L. 232 | 233 | =head2 connection 234 | 235 | $conn = $pubsub->connection; 236 | 237 | Holds a L object that will be used to subscribe to 238 | channels. 239 | 240 | =head2 reconnect_interval 241 | 242 | $interval = $pubsub->reconnect_interval; 243 | $pubsub = $pubsub->reconnect_interval(1); 244 | $pubsub = $pubsub->reconnect_interval(0.1); 245 | $pubsub = $pubsub->reconnect_interval(-1); 246 | 247 | The amount of time in seconds to wait to L after disconnecting. 248 | Default is 1 (second). L can be disabled by setting this to a 249 | negative value. 250 | 251 | =head2 redis 252 | 253 | $conn = $pubsub->redis; 254 | $pubsub = $pubsub->redis(Mojo::Redis->new); 255 | 256 | Holds a L object used to create the connections to talk with Redis. 257 | 258 | =head1 METHODS 259 | 260 | =head2 channels_p 261 | 262 | $promise = $pubsub->channels_p->then(sub { my $channels = shift }); 263 | $promise = $pubsub->channels_p("pat*")->then(sub { my $channels = shift }); 264 | 265 | Lists the currently active channels. An active channel is a Pub/Sub channel 266 | with one or more subscribers (not including clients subscribed to patterns). 267 | 268 | =head2 json 269 | 270 | $pubsub = $pubsub->json("foo"); 271 | 272 | Activate automatic JSON encoding and decoding with L and 273 | L for a channel. 274 | 275 | # Send and receive data structures 276 | $pubsub->json("foo")->listen(foo => sub { 277 | my ($pubsub, $payload, $channel) = @_; 278 | say $payload->{bar}; 279 | }); 280 | $pubsub->notify(foo => {bar => 'I ♥ Mojolicious!'}); 281 | 282 | =head2 keyspace_listen 283 | 284 | $cb = $pubsub->keyspace_listen(\%args, sub { my ($pubsub, $message) = @_ }) }); 285 | $cb = $pubsub->keyspace_listen({key => "cool:key"}, sub { my ($pubsub, $message) = @_ }) }); 286 | $cb = $pubsub->keyspace_listen({op => "del"}, sub { my ($pubsub, $message) = @_ }) }); 287 | 288 | Used to listen for keyspace notifications. See L 289 | for more details. The channel that will be subscribed to will look like one of 290 | these: 291 | 292 | __keyspace@${db}__:$key $op 293 | __keyevent@${db}__:$op $key 294 | 295 | This means that "key" and "op" is mutually exclusive from the list of 296 | parameters below: 297 | 298 | =over 2 299 | 300 | =item * db 301 | 302 | Default database to listen for events is the database set in 303 | L. "*" is also a valid value, meaning listen for events 304 | happening in all databases. 305 | 306 | =item * key 307 | 308 | Alternative to passing in C<$key>. Default value is "*". 309 | 310 | =item * op 311 | 312 | Alternative to passing in C<$op>. Default value is "*". 313 | 314 | =back 315 | 316 | =head2 keyspace_unlisten 317 | 318 | $pubsub = $pubsub->keyspace_unlisten(@args); 319 | $pubsub = $pubsub->keyspace_unlisten(@args, $cb); 320 | 321 | Stop listening for keyspace events. See L for details about 322 | keyspace events and what C<@args> can be. 323 | 324 | =head2 listen 325 | 326 | $cb = $pubsub->listen($channel => sub { my ($pubsub, $message, $channel) = @_ }); 327 | 328 | Subscribe to an exact channel name 329 | (L) or a channel name with a 330 | pattern (L). C<$channel> in 331 | the callback will be the exact channel name, without any pattern. C<$message> 332 | will be the data published to that the channel. 333 | 334 | The returning code ref can be passed on to L. 335 | 336 | =head2 notify 337 | 338 | $pubsub->notify($channel => $message); 339 | 340 | Send a plain string message to a channel. This method is the same as: 341 | 342 | $pubsub->notify_p($channel => $message)->wait; 343 | 344 | =head2 notify_p 345 | 346 | $p = $pubsub->notify_p($channel => $message); 347 | 348 | Send a plain string message to a channel and returns a L object. 349 | 350 | =head2 numpat_p 351 | 352 | $promise = $pubsub->channels_p->then(sub { my $int = shift }); 353 | 354 | Returns the number of subscriptions to patterns (that are performed using the 355 | PSUBSCRIBE command). Note that this is not just the count of clients 356 | subscribed to patterns but the total number of patterns all the clients are 357 | subscribed to. 358 | 359 | =head2 numsub_p 360 | 361 | $promise = $pubsub->numsub_p(@channels)->then(sub { my $channels = shift }); 362 | 363 | Returns the number of subscribers (not counting clients subscribed to 364 | patterns) for the specified channels as a hash-ref, where the keys are 365 | channel names. 366 | 367 | =head2 unlisten 368 | 369 | $pubsub = $pubsub->unlisten($channel); 370 | $pubsub = $pubsub->unlisten($channel, $cb); 371 | 372 | Unsubscribe from a channel. 373 | 374 | =head1 SEE ALSO 375 | 376 | L. 377 | 378 | =cut 379 | -------------------------------------------------------------------------------- /t/00-project.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | use File::Find; 3 | 4 | plan skip_all => 'No such directory: .git' unless $ENV{TEST_ALL} or -d '.git'; 5 | plan skip_all => 'HARNESS_PERL_SWITCHES =~ /Devel::Cover/' if +($ENV{HARNESS_PERL_SWITCHES} || '') =~ /Devel::Cover/; 6 | 7 | for (qw( 8 | Test::CPAN::Changes::changes_file_ok+VERSION!4 9 | Test::Pod::Coverage::pod_coverage_ok+VERSION!1 10 | Test::Pod::pod_file_ok+VERSION!1 11 | Test::Spelling::pod_file_spelling_ok+has_working_spellchecker!1 12 | )) 13 | { 14 | my ($fqn, $module, $sub, $check, $skip_n) = /^((.*)::(\w+))\+(\w+)!(\d+)$/; 15 | next if eval "use $module;$module->$check"; 16 | no strict qw(refs); 17 | no warnings qw(redefine); 18 | *$fqn = sub { 19 | SKIP: { skip "$sub(@_) ($module is required)", $skip_n } 20 | }; 21 | } 22 | 23 | my @files; 24 | find({wanted => sub { /\.pm$/ and push @files, $File::Find::name }, no_chdir => 1}, -e 'blib' ? 'blib' : 'lib'); 25 | plan tests => @files * 4 + 4; 26 | 27 | Test::Spelling::add_stopwords() 28 | if Test::Spelling->can('has_working_spellchecker') && Test::Spelling->has_working_spellchecker; 29 | 30 | for my $file (@files) { 31 | my $module = $file; 32 | $module =~ s,\.pm$,,; 33 | $module =~ s,.*/?lib/,,; 34 | $module =~ s,/,::,g; 35 | ok eval "use $module; 1", "use $module" or diag $@; 36 | Test::Pod::pod_file_ok($file); 37 | Test::Pod::Coverage::pod_coverage_ok($module, {also_private => [qr/^[A-Z_]+$/]}); 38 | Test::Spelling::pod_file_spelling_ok($file); 39 | } 40 | 41 | Test::CPAN::Changes::changes_file_ok(); 42 | 43 | __DATA__ 44 | ADDR 45 | AUTH 46 | GETKEYS 47 | GETNAME 48 | HSCAN 49 | Henning 50 | HyperLogLog 51 | HyperLogLogs 52 | Lua 53 | PSUBSCRIBE 54 | Pipelining 55 | SETNAME 56 | SKIPME 57 | SSCAN 58 | Thorsen 59 | XRANGE 60 | ZSCAN 61 | bgrewriteaof 62 | bgsave 63 | bitcount 64 | bitop 65 | bitpos 66 | blpop 67 | brpop 68 | brpoplpush 69 | bzpopmax 70 | bzpopmin 71 | cardinality 72 | dbsize 73 | decr 74 | decrby 75 | del 76 | differnet 77 | entires 78 | evalsha 79 | expireat 80 | flushall 81 | flushdb 82 | geoadd 83 | geodist 84 | geohash 85 | geopos 86 | georadius 87 | georadiusbymember 88 | geospatial 89 | getbit 90 | getrange 91 | getset 92 | hdel 93 | hexists 94 | hget 95 | hgetall 96 | hincrby 97 | hincrbyfloat 98 | hkeys 99 | hlen 100 | hmget 101 | hmset 102 | hset 103 | hsetnx 104 | hstrlen 105 | hvals 106 | incr 107 | incrby 108 | incrbyfloat 109 | ioloop 110 | keyspace 111 | lastsave 112 | lindex 113 | linsert 114 | llen 115 | lpop 116 | lpush 117 | lpushx 118 | lrange 119 | lrem 120 | lset 121 | ltrim 122 | mget 123 | mset 124 | msetnx 125 | pexpire 126 | pexpireat 127 | pfadd 128 | pfcount 129 | pfmerge 130 | psetex 131 | psubscribe 132 | pttl 133 | pubsub 134 | randomkey 135 | readonly 136 | readwrite 137 | redis 138 | redis 139 | renamenx 140 | resends 141 | rpop 142 | rpoplpush 143 | rpush 144 | rpushx 145 | sadd 146 | scard 147 | sdiff 148 | sdiffstore 149 | setbit 150 | setex 151 | setnx 152 | setrange 153 | sinter 154 | sinterstore 155 | sismember 156 | slaveof 157 | slowlog 158 | smembers 159 | smove 160 | spop 161 | srandmember 162 | srem 163 | sunion 164 | sunionstore 165 | ttl 166 | unlisten 167 | unwatch 168 | usecase 169 | xadd 170 | xlen 171 | xpending 172 | xrange 173 | xread 174 | xreadgroup 175 | xrevrange 176 | zadd 177 | zcard 178 | zcount 179 | zincrby 180 | zinterstore 181 | zlexcount 182 | zpopmax 183 | zpopmin 184 | zrange 185 | zrangebylex 186 | zrangebyscore 187 | zrank 188 | zrem 189 | zremrangebylex 190 | zremrangebyrank 191 | zremrangebyscore 192 | zrevrange 193 | zrevrangebylex 194 | zrevrangebyscore 195 | zrevrank 196 | zscore 197 | zunionstore 198 | -------------------------------------------------------------------------------- /t/benchmark.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Benchmark qw(cmpthese timeit timestr :hireswallclock); 4 | 5 | plan skip_all => 'TEST_ONLINE=redis://localhost' unless $ENV{MOJO_REDIS_URL} = $ENV{TEST_ONLINE}; 6 | plan skip_all => 'TEST_BENCHMARK=500' unless my $n_times = $ENV{TEST_BENCHMARK}; 7 | 8 | my @classes = qw(Mojo::Redis Mojo::Redis2); 9 | my @protocols = qw(Protocol::Redis Protocol::Redis::Faster Protocol::Redis::XS); 10 | my $key = "test:benchmark:$0"; 11 | my %t; 12 | 13 | for my $class (@classes) { 14 | eval "require $class;1" or next; 15 | 16 | for my $protocol (@protocols) { 17 | eval "require $protocol;1" or next; 18 | my $redis = $class->new->protocol_class($protocol); 19 | 20 | my ($bm, $lrange) = run($redis->isa('Mojo::Redis2') ? $redis : $redis->db, $protocol); 21 | is_deeply $lrange, [reverse 0 .. $n_times - 1], sprintf '%s/%s %s', ref $redis, $protocol, timestr $bm; 22 | 23 | my $bm_key = join '/', $redis->isa('Mojo::Redis2') ? 'Redis2' : 'Redis', 24 | $protocol =~ m!Protocol::Redis::(\w+)! ? $1 : 'PP'; 25 | $t{$bm_key} = $bm; 26 | } 27 | } 28 | 29 | compare(qw(Redis/Faster Redis2/Faster)); 30 | compare(qw(Redis/Faster Redis/PP)); 31 | cmpthese(\%t) if $ENV{HARNESS_IS_VERBOSE}; 32 | 33 | done_testing; 34 | 35 | sub compare { 36 | my ($an, $bn) = @_; 37 | return diag "Cannot compare $an and $bn" unless my $ao = $t{$an} and my $bo = $t{$bn}; 38 | ok $ao->cpu_a <= $bo->cpu_a, sprintf '%s (%ss) is not slower than %s (%ss)', $an, $ao->cpu_a, $bn, $bo->cpu_a; 39 | } 40 | 41 | sub run { 42 | my $db = shift; 43 | 44 | $db->del($key); 45 | 46 | my ($lpush, $lrange); 47 | my $i = 0; 48 | my $bm = timeit( 49 | $n_times, 50 | sub { 51 | $lpush = $db->lpush($key => $i++); 52 | $lrange = $db->lrange($key => 0, -1); 53 | } 54 | ); 55 | 56 | $db->del($key); 57 | 58 | return $bm, $lrange; 59 | } 60 | -------------------------------------------------------------------------------- /t/cache-offline.t: -------------------------------------------------------------------------------- 1 | BEGIN { $ENV{MOJO_REDIS_CACHE_OFFLINE} = 1 } 2 | use Mojo::Base -strict; 3 | use Test::More; 4 | use Mojo::Redis; 5 | 6 | my $redis = Mojo::Redis->new; 7 | my $cache = $redis->cache(namespace => $0); 8 | my $n = 0; 9 | my $res; 10 | 11 | for (1 .. 2) { 12 | $cache->memoize_p(main => 'cache_me', [{foo => 42}])->then(sub { $res = shift })->wait; 13 | is_deeply $res, {foo => 42}, 'memoize cache_me with hash'; 14 | } 15 | 16 | is $n, 1, 'compute only called once per key'; 17 | 18 | $cache->refresh(1)->memoize_p(main => 'cache_me', [{foo => 42}])->then(sub { $res = shift })->wait; 19 | is $n, 2, 'compute called after refresh()'; 20 | 21 | $cache->compute_p('some:die:key', sub { die 'oops!' })->catch(sub { $res = shift })->then(sub { $res = shift })->wait; 22 | like $res, qr{oops!}, 'failed to cache'; 23 | 24 | { 25 | no warnings 'redefine'; 26 | local *Mojo::Redis::Cache::_time = sub { time + 601 }; 27 | $cache->refresh(0)->memoize_p(main => 'cache_me', [{foo => 42}])->then(sub { $res = shift })->wait; 28 | is $n, 3, 'compute called after expired'; 29 | } 30 | 31 | done_testing; 32 | 33 | sub cache_me { 34 | $n++; 35 | return $_[1] || 'default value'; 36 | } 37 | -------------------------------------------------------------------------------- /t/cache.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | 5 | plan skip_all => 'TEST_ONLINE=redis://localhost' unless $ENV{TEST_ONLINE}; 6 | 7 | my $redis = Mojo::Redis->new($ENV{TEST_ONLINE}); 8 | my $cache = $redis->cache(namespace => $0); 9 | my $n_computed = 0; 10 | my $res; 11 | 12 | cleanup(); 13 | 14 | for my $i (1 .. 2) { 15 | note "run $i"; 16 | $cache->compute_p( 17 | 'some:key', 18 | 60.7, 19 | sub { 20 | $n_computed++; 21 | my $p = Mojo::Promise->new; 22 | Mojo::IOLoop->timer(0.1 => sub { $p->resolve('some data') }); 23 | return $p; 24 | } 25 | )->then(sub { $res = shift })->wait; 26 | 27 | is $res, 'some data', 'computed some:key'; 28 | 29 | $cache->compute_p('some:other:key', sub { $n_computed++; +{some => "data"} })->then(sub { $res = shift })->wait; 30 | is_deeply $res, {some => 'data'}, 'computed some:other:key'; 31 | 32 | $cache->memoize_p(main => 'cache_me', [42], 5)->then(sub { $res = shift })->wait; 33 | is_deeply $res, 42, 'memoize cache_me with 42'; 34 | 35 | $cache->memoize_p(main => 'cache_me')->then(sub { $res = shift })->wait; 36 | is_deeply $res, 'default value', 'memoize cache_me with default'; 37 | 38 | $cache->memoize_p(main => 'cache_me', 30)->then(sub { $res = shift })->wait; 39 | is_deeply $res, 'default value', 'memoize cache_me with default'; 40 | 41 | $cache->memoize_p(main => 'cache_me', [{foo => 42}])->then(sub { $res = shift })->wait; 42 | is_deeply $res, {foo => 42}, 'memoize cache_me with hash'; 43 | 44 | $cache->compute_p('some:negative:key', -5.2, sub { $n_computed++; 'too cool' })->then(sub { $res = [@_] })->wait; 45 | is_deeply $res, ['too cool', $i == 1 ? {computed => 1} : {expired => 0}], 'compute_p with negative expire'; 46 | } 47 | 48 | is $n_computed, 6, 'compute only called once per key'; 49 | 50 | note 'refresh'; 51 | $cache->refresh(1)->memoize_p(main => 'cache_me', [{foo => 42}])->then(sub { $res = shift })->wait; 52 | is $n_computed, 7, 'compute called after refresh()'; 53 | 54 | note 'exception'; 55 | $cache->compute_p('some:die:key', sub { die 'oops!' })->then(sub { $res = shift })->catch(sub { $res = shift })->wait; 56 | like $res, qr{oops!}, 'failed to cache'; 57 | 58 | note 'stale cache'; 59 | Mojo::Util::monkey_patch('Mojo::Redis::Cache', _time => sub { Time::HiRes::time() + 5.2 }); 60 | $cache->refresh(0); 61 | $cache->compute_p('some:negative:key', -5.2, sub { die "yikes!\n" })->then(sub { $res = [@_] }) 62 | ->catch(sub { $res = shift })->wait; 63 | is_deeply $res, ['too cool', {error => "yikes!\n", expired => 1}], 'compute_p expired data and error'; 64 | 65 | note 'refreshed cache'; 66 | $cache->compute_p('some:negative:key', -5.2, sub { $n_computed++; 'cool2' })->then(sub { $res = [@_] }) 67 | ->catch(sub { $res = shift })->wait; 68 | is_deeply $res, ['cool2', {computed => 1, expired => 1}], 'compute_p expired data'; 69 | 70 | cleanup(); 71 | done_testing; 72 | 73 | sub cache_me { 74 | $n_computed++; 75 | return $_[1] || 'default value'; 76 | } 77 | 78 | sub cleanup { 79 | $redis->db->del( 80 | map {"$0:$_"} 'some:key', 81 | 'some:die:key', 'some:negative:key', 'some:other:key', '@M:main:cache_me:[]', '@M:main:cache_me:[42]', 82 | '@M:main:cache_me:[{"foo":42}]', 83 | ); 84 | } 85 | -------------------------------------------------------------------------------- /t/connection-auth.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | 5 | my $port = Mojo::IOLoop::Server->generate_port; 6 | Mojo::IOLoop->server({port => $port}, sub { }); 7 | 8 | my $redis = Mojo::Redis->new("redis://whatever:s3cret\@localhost:$port/12"); 9 | is $redis->db->connection->url->port, $port, 'port'; 10 | is $redis->db->connection->url->password, 's3cret', 'password'; 11 | 12 | my @write; 13 | $redis->on(connection => sub { my ($redis, $conn) = @_; @write = @{$conn->{write}} }); 14 | 15 | my $db = $redis->db; 16 | my $err; 17 | $db->connection->once(connect => sub { $err = $_[1]; Mojo::IOLoop->stop }); 18 | $db->connection->_connect; 19 | Mojo::IOLoop->start; 20 | is_deeply \@write, [["*2\r\n\$4\r\nAUTH\r\n\$6\r\ns3cret\r\n"], ["*2\r\n\$6\r\nSELECT\r\n\$2\r\n12\r\n"],], 21 | 'write queue'; 22 | 23 | done_testing; 24 | -------------------------------------------------------------------------------- /t/connection-lost.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | use Errno qw(ECONNREFUSED ENOTCONN); 5 | 6 | # Dummy server 7 | my $port = Mojo::IOLoop::Server->generate_port; 8 | my $server_id = make_server(Mojo::IOLoop->singleton); 9 | my $redis = Mojo::Redis->new("redis://localhost:$port"); 10 | my $err; 11 | 12 | note 'Promises should be rejected on error'; 13 | my $db = $redis->db; 14 | Mojo::IOLoop->next_tick(sub { $db->connection->disconnect }); 15 | get_p($db)->wait; 16 | is $err, 'Premature connection close', 'client disconnected'; 17 | 18 | $err = ''; 19 | get_p($redis->db)->wait; 20 | is $err, 'Premature connection close', 'server closed stream'; 21 | 22 | my $err_re = join '|', map { local $! = $_; quotemeta "$!" } ECONNREFUSED, ENOTCONN; 23 | $err = ''; 24 | Mojo::IOLoop->remove($server_id); 25 | get_p($redis->db)->wait; 26 | 27 | { 28 | local $TODO = $err =~ /$err_re/ ? '' : "server most likely disappeared ($@)"; 29 | like $err, qr/$err_re/, 'server disappeared'; 30 | } 31 | 32 | note 'Do not reconnect in the middle of a transaction'; 33 | $server_id = make_server($redis->_blocking_connection->ioloop); 34 | $db = $redis->db; 35 | my $step = 0; 36 | my @err; 37 | for my $m (qw(multi incr incr exec)) { 38 | eval { $db->$m($m eq 'incr' ? ($0) : ()); ++$step } or do { push @err, $@ }; 39 | note "($step) $@" if $@; 40 | } 41 | 42 | is $step, 1, 'all blocking methods fail after the first fail'; 43 | like shift(@err), qr{^$_}, "expected $_" 44 | for 'Premature connection close', 'Redis server has gone away', 'Redis server has gone away'; 45 | isnt $redis->_blocking_connection, $db->connection(1), 'fresh connection next time'; 46 | is $redis->_blocking_connection->ioloop, $db->connection(1)->ioloop, 'same blocking ioloop'; 47 | 48 | note 'No blocking connection should be put back into connection queue'; 49 | $db = $redis->db; 50 | $db->connection(1)->{stream} = 1; # pretend we are connected 51 | undef $db; 52 | ok !(grep { warn $_; $_->ioloop ne Mojo::IOLoop->singleton } @{$redis->{queue}}), 'no blocking connections in queue'; 53 | 54 | done_testing; 55 | 56 | sub get_p { 57 | return shift->get_p($0)->then(sub { diag "Should not be successfule: @_" })->catch(sub { $err = shift }); 58 | } 59 | 60 | sub make_server { 61 | return shift->server( 62 | {port => $port}, 63 | sub { 64 | my ($loop, $stream) = @_; 65 | $stream->on( 66 | read => sub { 67 | my ($stream, $buf) = @_; 68 | return $stream->write("+OK\r\n") if $buf =~ /EXEC/; # Should not come to this 69 | return $stream->write("+OK\r\n") if $buf =~ /MULTI/; 70 | return $stream->close; 71 | } 72 | ); 73 | } 74 | ); 75 | } 76 | -------------------------------------------------------------------------------- /t/connection-sentinel.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | 5 | my $port = Mojo::IOLoop::Server->generate_port; 6 | my $redis = Mojo::Redis->new("redis://whatever:s3cret\@mymaster/12?sentinel=localhost:$port&sentinel=localhost:$port"); 7 | my $conn_n = 0; 8 | my @messages; 9 | 10 | Mojo::IOLoop->server( 11 | {port => $port}, 12 | sub { 13 | my ($loop, $stream) = @_; 14 | my $protocol = $redis->protocol_class->new(api => 1); 15 | my @res = ({type => '$', data => 'OK'}); 16 | 17 | push @res, 18 | $conn_n == 0 19 | ? {type => '$', data => 'IDONTKNOW'} 20 | : {type => '*', data => [{type => '$', data => 'localhost'}, {type => '$', data => $port}]}; 21 | 22 | push @res, {type => '$', data => 42}; 23 | 24 | my $cid = ++$conn_n; 25 | $protocol->on_message(sub { 26 | push @messages, pop; 27 | $messages[-1]{c} = $cid; 28 | $stream->write($protocol->encode(shift @res)) if @res; 29 | }); 30 | 31 | $stream->on(read => sub { $protocol->parse(pop) }); 32 | } 33 | ); 34 | 35 | my $foo; 36 | $redis->db->get_p('foo')->then(sub { $foo = shift })->wait; 37 | is $foo, 42, 'get foo'; 38 | 39 | my @get_master_addr_by_name = ( 40 | {data => 'SENTINEL', type => '$'}, 41 | {data => 'get-master-addr-by-name', type => '$'}, 42 | {data => 'mymaster', type => '$'}, 43 | ); 44 | 45 | is_deeply( 46 | \@messages, 47 | [ 48 | {c => 1, data => [{data => 'AUTH', type => '$'}, {data => 's3cret', type => '$'}], type => '*'}, 49 | {c => 1, data => \@get_master_addr_by_name, type => '*'}, 50 | {c => 2, data => [{data => 'AUTH', type => '$'}, {data => 's3cret', type => '$'}], type => '*'}, 51 | {c => 2, data => \@get_master_addr_by_name, type => '*'}, 52 | {c => 3, data => [{data => 'AUTH', type => '$'}, {data => 's3cret', type => '$'}], type => '*'}, 53 | {c => 3, data => [{data => 'SELECT', type => '$'}, {data => '12', type => '$'}], type => '*'}, 54 | {c => 3, data => [{data => 'GET', type => '$'}, {data => 'foo', type => '$'}], type => '*'}, 55 | ], 56 | 'discovery + connect + command' 57 | ) or diag explain \@messages; 58 | 59 | done_testing; 60 | -------------------------------------------------------------------------------- /t/connection-unix.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | 5 | my $url = Mojo::URL->new->host('/tmp/redis.sock'); 6 | my $redis = Mojo::Redis->new($url); 7 | my $args; 8 | 9 | Mojo::Util::monkey_patch('Mojo::IOLoop::Client', 'connect' => sub { $args = $_[1] }); 10 | is $redis->db->connection->url->host, '/tmp/redis.sock', 'host'; 11 | is $redis->db->connection->url->port, undef, 'port'; 12 | 13 | $redis->db->connection->_connect; 14 | is_deeply $args, {path => '/tmp/redis.sock', timeout => 10}, 'connect args'; 15 | 16 | done_testing; 17 | -------------------------------------------------------------------------------- /t/connection.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | 5 | plan skip_all => 'TEST_ONLINE=redis://localhost/8' unless $ENV{TEST_ONLINE}; 6 | plan skip_all => 'Need a database index in TEST_ONLINE' unless $ENV{TEST_ONLINE} =~ m!/\d+\b!; 7 | 8 | my $redis = Mojo::Redis->new($ENV{TEST_ONLINE}); 9 | 10 | my $db = $redis->db; 11 | my $conn = $db->connection; 12 | isa_ok($db, 'Mojo::Redis::Database'); 13 | isa_ok($conn, 'Mojo::Redis::Connection'); 14 | 15 | $redis->on(connection => sub { $redis->{connections}++ }); 16 | 17 | note 'Create one connection'; 18 | my $connected = 0; 19 | my $err; 20 | $conn->once(connect => sub { $connected++; Mojo::IOLoop->stop }); 21 | $conn->once(error => sub { $err = $_[1]; Mojo::IOLoop->stop }); 22 | is $conn->_connect, $conn, '_connect()'; 23 | Mojo::IOLoop->start; 24 | is $connected, 1, 'connected' or diag $err; 25 | is @{$redis->{queue} || []}, 0, 'zero connections in queue'; 26 | 27 | note 'Put connection back into queue'; 28 | undef $db; 29 | is @{$redis->{queue}}, 1, 'one connection in queue'; 30 | 31 | note 'Create more connections than max_connections'; 32 | my @db; 33 | push @db, $redis->db for 1 .. 6; # one extra 34 | $_->connection->_connect->once(connect => sub { ++$connected == 6 and Mojo::IOLoop->stop }) for @db; 35 | Mojo::IOLoop->start; 36 | 37 | note 'Put max connections back into the queue'; 38 | is $db[0]->connection, $conn, 'reusing connection'; 39 | @db = (); 40 | is @{$redis->{queue}}, 5, 'five connections in queue'; 41 | 42 | note 'Take one connection out of the queue'; 43 | $redis->db->connection->disconnect; 44 | undef $db; 45 | is @{$redis->{queue}}, 4, 'four connections in queue'; 46 | 47 | note 'Write and auto-connect'; 48 | my @res; 49 | delete $redis->{queue}; 50 | $db = $redis->db; 51 | $conn->write_p('PING')->then(sub { @res = @_; Mojo::IOLoop->stop })->wait; 52 | is_deeply \@res, ['PONG'], 'ping response'; 53 | 54 | note 'New connection, because disconnected'; 55 | $conn = $db->connection; 56 | $conn->disconnect; 57 | $db = $redis->db; 58 | $db->connection->write_p('PING')->wait; 59 | isnt $db->connection, $conn, 'new connection when disconnected'; 60 | 61 | is $redis->{connections}++, 7, 'connections emitted'; 62 | 63 | note 'Encoding'; 64 | my $str = 'I ♥ Mojolicious!'; 65 | $conn = $db->connection; 66 | 67 | is $redis->encoding, 'UTF-8', 'default redis encoding'; 68 | is $conn->encoding, 'UTF-8', 'encoding passed on to connection'; 69 | $conn->write_p(qw(get t:redis:encoding))->then(sub { @res = @_ })->wait; 70 | is_deeply \@res, [undef], 'undefined key not decoded'; 71 | $conn->write_p(qw(set t:redis:encoding), $str)->wait; 72 | $conn->write_p(qw(get t:redis:encoding))->then(sub { @res = @_ })->wait; 73 | is_deeply \@res, [$str], 'unicode encoding'; 74 | 75 | $conn->encoding(undef); 76 | $conn->write_p(qw(set t:redis:encoding), Mojo::Util::encode('UTF-8', $str))->wait; 77 | $conn->encoding('UTF-8'); 78 | $conn->write_p(qw(get t:redis:encoding))->then(sub { @res = @_ })->wait; 79 | is $res[0], $str, 'no encoding'; 80 | 81 | note 'Make sure encoding is reset'; 82 | $db = $redis->db; 83 | $db->connection->encoding('whatever'); 84 | undef $db; 85 | $db = $redis->db; 86 | is $db->connection->encoding, 'UTF-8', 'connection encoding is reset'; 87 | 88 | note 'Cleanup'; 89 | $conn->write_p(qw(del t:redis:encoding))->wait; 90 | 91 | $redis->encoding(undef); 92 | is $redis->db->connection->encoding, undef, 'Encoding changed for new connections'; 93 | 94 | note 'Fork-safety'; 95 | $conn = $db->connection; 96 | undef $db; 97 | $redis->{pid} = -1; 98 | isnt $redis->db->connection, $conn, 'new fork gets a new connecion'; 99 | undef $conn; 100 | $redis->{pid} = $$; 101 | $conn = $redis->_blocking_connection; 102 | $redis->{pid} = -1; 103 | isnt $redis->_blocking_connection, $conn, 'new fork gets a new blocking connection'; 104 | undef $conn; 105 | $redis->{pid} = $$; 106 | 107 | note 'Connection closes when ref is lost'; 108 | $db = $redis->db; 109 | $db->get_p($0)->catch(sub { $err = shift })->wait; # Make sure we are connected 110 | ok $db->connection->is_connected, 'connected' or diag $err; 111 | my $closed; 112 | $db->connection->on(close => sub { $closed++ }); 113 | $redis->max_connections(0); 114 | undef $db; 115 | ok $closed, 'connection was closed on destruction'; 116 | 117 | note 'New connection, because URL changed'; 118 | use Socket; 119 | my $host = $redis->url->host; 120 | $db = $redis->db; 121 | $db->get_p($0)->catch(sub { $err = shift })->wait; # Make sure we are connected 122 | $redis->url->host($host =~ /[a-z]/ ? inet_ntoa(inet_aton $host) : gethostbyaddr(inet_aton($host), AF_INET)); 123 | note 'Changed host to ' . $redis->url->host; 124 | $db = undef; 125 | is @{$redis->{queue}}, 0, 'database was not enqued' or diag $err; 126 | 127 | note 'Blocking connection'; 128 | $db = $redis->db; 129 | isnt $db->connection(1)->ioloop, Mojo::IOLoop->singleton, 'blocking connection'; 130 | isnt $db->connection(1)->ioloop, $db->connection(0)->ioloop, 131 | 'blocking connection does not share non-blocking connection ioloop'; 132 | 133 | done_testing; 134 | -------------------------------------------------------------------------------- /t/cursor.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | 5 | use constant ELEMENTS_COUNT => $ENV{REDIS_TEST_ELEMENTS_COUNT} || 1000; 6 | 7 | plan skip_all => 'TEST_ONLINE=redis://localhost' unless $ENV{TEST_ONLINE}; 8 | 9 | my $redis = Mojo::Redis->new($ENV{TEST_ONLINE}); 10 | my $db = $redis->db; 11 | my ($cursor, $expected, $guard, $res); 12 | 13 | cleanup(); 14 | 15 | # Constructor 16 | $cursor = $redis->cursor; 17 | is_deeply $cursor->command, [scan => 0], 'default cursor command'; 18 | $cursor = $redis->cursor(scan => 0, match => '*', count => 100); 19 | is_deeply $cursor->command, [scan => 0, match => '*', count => 100], 'scan, match and count'; 20 | 21 | note 'Reset cursor'; 22 | $cursor->command->[1] = 32; 23 | $cursor->{finished} = 1; 24 | $cursor->again; 25 | is $cursor->command->[1], 0, 'cursor is reset'; 26 | ok !$cursor->finished, 'finished is reset'; 27 | 28 | $db->set("redis:scan_test:key$_", $_) for 1 .. ELEMENTS_COUNT; 29 | $expected = [sort map {"redis:scan_test:key$_"} 1 .. ELEMENTS_COUNT]; 30 | 31 | note 'SCAN'; 32 | $cursor = $redis->cursor(scan => 0, match => 'redis:scan_test:key*'); 33 | $guard = 10000; 34 | $res = []; 35 | while ($guard-- && (my $r = $cursor->next)) { push @$res, @$r } 36 | is_deeply [sort @$res], $expected, 'scan next() blocking'; 37 | ok $cursor->finished, 'finished is set'; 38 | 39 | $res = []; 40 | $cursor->again->all(sub { Mojo::IOLoop->stop; $res = [$_[1], @{$_[2]}] }); 41 | Mojo::IOLoop->start; 42 | is_deeply [sort @$res], ['', @$expected], 'all(CODE)'; 43 | 44 | $res = []; 45 | $cursor->again->all_p->then(sub { $res = shift })->wait; 46 | is_deeply [sort @$res], $expected, 'all_p()'; 47 | 48 | $cursor = $redis->cursor(keys => 'redis:scan_test:key*'); 49 | is_deeply [sort @{$cursor->all}], $expected, 'keys'; 50 | 51 | note 'HSCAN'; 52 | $db->hset('redis:scan_test:hash', "key.$_" => "val.$_") for 1 .. ELEMENTS_COUNT; 53 | $cursor = $redis->cursor(hgetall => 'redis:scan_test:hash'); 54 | $cursor->next_p->then(sub { $res = $_[0] })->wait; 55 | my @keys = keys %$res; 56 | my @vals = values %$res; 57 | like $keys[0], qr{^key\.\d+$}, 'hgetall next_p() keys'; 58 | like $vals[0], qr{^val\.\d+$}, 'hgetall next_p() vals'; 59 | is_deeply($cursor->all, $db->hgetall('redis:scan_test:hash'), 'hgetall'); 60 | 61 | $cursor = $redis->cursor(hkeys => 'redis:scan_test:hash'); 62 | is_deeply([sort @{$cursor->all}], [sort @{$db->hkeys('redis:scan_test:hash')}], 'hkeys'); 63 | 64 | note 'SSCAN'; 65 | $db->sadd('redis:scan_test:set', $_) for 1 .. ELEMENTS_COUNT; 66 | $cursor = $redis->cursor(smembers => 'redis:scan_test:set'); 67 | is_deeply([sort @{$cursor->all}], [sort @{$db->smembers('redis:scan_test:set')}], 'smembers'); 68 | 69 | cleanup(); 70 | done_testing; 71 | 72 | sub cleanup { 73 | $db->del("redis:scan_test:key$_", $_) for 1 .. ELEMENTS_COUNT; 74 | $db->del(qw(redis:scan_test:hash redis:scan_test:set redis:scan_test:zset)); 75 | } 76 | -------------------------------------------------------------------------------- /t/db.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | 5 | plan skip_all => 'TEST_ONLINE=redis://localhost' unless $ENV{TEST_ONLINE}; 6 | 7 | my $redis = Mojo::Redis->new($ENV{TEST_ONLINE}); 8 | my $db = $redis->db; 9 | my ($res, @res); 10 | 11 | # SET 12 | $db = $redis->db; 13 | $db->set($0 => 123, sub { @res = @_; Mojo::IOLoop->stop }); 14 | Mojo::IOLoop->start; 15 | is_deeply \@res, [$db, '', 'OK'], 'set'; 16 | 17 | # GET 18 | $db->get($0 => sub { @res = @_; Mojo::IOLoop->stop }); 19 | Mojo::IOLoop->start; 20 | is_deeply \@res, [$db, '', '123'], 'get'; 21 | 22 | $db->get_p($0)->then(sub { @res = (then => @_) })->catch(sub { @res = (catch => @_) })->wait; 23 | is_deeply \@res, [then => '123'], 'get_p'; 24 | 25 | # DEL 26 | is_deeply $db->del($0), 1, 'blocking del'; 27 | 28 | # BLPOP 29 | @res = (); 30 | $db->del_p('some:empty:list', $0); 31 | $db->lpush_p($0 => '456')->then(gather_cb('then'))->catch(gather_cb('catch')); 32 | $db->blpop_p('some:empty:list', $0, 2)->then(gather_cb('popped'))->wait; 33 | is_deeply \@res, ["then: 1", "popped: 456 $0"], 'blpop_p' or diag join ', ', @res; 34 | 35 | # HASHES 36 | $db->hmset_p($0, a => 11, b => 22); 37 | $db->hgetall_p($0)->then(sub { $res = shift })->wait; 38 | is_deeply $res, {a => 11, b => 22}, 'hgetall_p'; 39 | 40 | # Custom command 41 | $db->call_p(HGETALL => $0)->then(sub { $res = [@_] })->wait; 42 | is_deeply [$db->call(HGETALL => $0)], $res, 'call_p() == call()'; 43 | 44 | $res = $db->hkeys($0); 45 | is_deeply $res, [qw(a b)], 'hkeys'; 46 | 47 | ok $db->info_structured('memory')->{maxmemory_human}, 'got info_structured'; 48 | $db->info_structured_p->then(sub { $res = shift })->wait; 49 | ok $res->{clients}{connected_clients}, 'got info_structured for all sections, clients'; 50 | ok $res->{memory}{maxmemory_human}, 'got info_structured for all sections, memory'; 51 | 52 | done_testing; 53 | 54 | sub gather_cb { 55 | my $prefix = shift; 56 | return sub { push @res, "$prefix: @_" }; 57 | } 58 | -------------------------------------------------------------------------------- /t/geo.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | 5 | plan skip_all => 'TEST_ONLINE=redis://localhost' unless $ENV{TEST_ONLINE}; 6 | plan skip_all => 'cpanm Test::Deep' unless eval 'require Test::Deep;1'; 7 | 8 | Test::Deep->import; 9 | 10 | my $redis = Mojo::Redis->new($ENV{TEST_ONLINE}); 11 | my $db = $redis->db; 12 | my $key = "places:$0"; 13 | my $res; 14 | 15 | $db->geoadd($key => 13.361389, 38.115556, 'Palermo', 15.087269, 37.502669, 'Catania'); 16 | 17 | is $db->geodist($key => qw(Palermo Catania)), 166274.1516, 'geodist'; 18 | 19 | is_deeply $db->georadius($key => qw(15 37 100 km)), ['Catania'], 'georadius 100km'; 20 | is_deeply $db->georadius($key => qw(15 37 200 km)), ['Palermo', 'Catania'], 'georadius 200km'; 21 | 22 | my $tol = 0.00001; 23 | cmp_deeply( 24 | $db->geopos($key => qw(Catania NonExisting Palermo)), 25 | [ 26 | {lat => num(37.502669, $tol), lng => num(15.087269, $tol)}, 27 | undef, 28 | {lat => num(38.115556, $tol), lng => num(13.361389, $tol)}, 29 | ], 30 | 'geopos' 31 | ); 32 | 33 | $db->del($key); 34 | 35 | done_testing; 36 | -------------------------------------------------------------------------------- /t/keyspace-listen.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | 5 | my @events; 6 | my $redis = Mojo::Redis->new($ENV{TEST_ONLINE} || 'redis://localhost'); 7 | my $pubsub = $redis->pubsub; 8 | 9 | my $dbsel = $redis->url->path->[0] // '*'; 10 | is $pubsub->_keyspace_key, '__keyevent@'.$dbsel.'__:*', 'keyevent default db wildcard'; 11 | 12 | $redis->url->path->parse('/5'); 13 | is $pubsub->_keyspace_key, '__keyevent@5__:*', 'keyevent default wildcard'; 14 | is $pubsub->_keyspace_key({type => 'key*'}), '__key*@5__:*', 'keyboth wildcard listen'; 15 | is $pubsub->_keyspace_key(foo => undef), '__keyspace@5__:foo', 'keyspace foo'; 16 | is $pubsub->_keyspace_key(undef, 'del'), '__keyevent@5__:del', 'keyevent del'; 17 | is $pubsub->_keyspace_key('foo', 'rename', {db => 1, key => 'x', op => 'y'}), '__keyspace@1__:foo', 18 | 'keyspace foo and db'; 19 | is $pubsub->_keyspace_key({db => 0, key => 'foo', type => 'key*'}), '__key*@0__:foo', 'key* db and type'; 20 | 21 | my $cb = $pubsub->keyspace_listen(undef, 'del', {db => 1}, sub { }); 22 | is ref($cb), 'CODE', 'keyspace_listen returns callback'; 23 | is_deeply $pubsub->{chans}{'__keyevent@1__:del'}, [$cb], 'callback is set up'; 24 | is $pubsub->keyspace_unlisten(undef, 'del', {db => 1}, $cb), $pubsub, 'keyspace_unlisten with callback'; 25 | ok !$pubsub->{chans}{'__keyevent@1__:del'}, 'callback is removed'; 26 | $pubsub->{chans}{'__keyevent@1__:del'} = [$cb]; 27 | is $pubsub->keyspace_unlisten(undef, 'del', {db => 1}), $pubsub, 'keyspace_unlisten without callback'; 28 | ok !$pubsub->{chans}{'__keyevent@1__:del'}, 'callback is removed'; 29 | 30 | if ($ENV{TEST_KEA} && $ENV{TEST_ONLINE}) { 31 | my $kea = $redis->db->config(qw(get notify-keyspace-events))->[1]; 32 | diag "config get notify-keyspace-events == $kea"; 33 | $redis->db->config(qw(set notify-keyspace-events KEA)); 34 | 35 | $redis->pubsub->keyspace_listen(\&gather); 36 | $redis->pubsub->keyspace_listen({type => 'keyspace'}, \&gather); 37 | Mojo::IOLoop->timer(0.15 => sub { Mojo::IOLoop->stop }); 38 | Mojo::IOLoop->start; 39 | 40 | my $key = 'mojo:redis:test:keyspace:listen'; 41 | $redis->db->tap(set => $key => __FILE__)->del($key => __FILE__); 42 | Mojo::IOLoop->start; 43 | $redis->db->config(qw(set notify-keyspace-events), $kea); 44 | 45 | ok + (grep { $_->[1] eq 'del' } @events), 'keyspace del event'; 46 | ok + (grep { $_->[1] eq 'set' } @events), 'keyspace set event'; 47 | ok + (grep { $_->[0] =~ /:set$/ } @events), 'keyevent set event'; 48 | ok + (grep { $_->[0] =~ /:del$/ } @events), 'keyevent del event'; 49 | } 50 | 51 | done_testing; 52 | 53 | sub gather { 54 | push @events, $_[1]; 55 | Mojo::IOLoop->stop if @events >= 4; 56 | } 57 | -------------------------------------------------------------------------------- /t/method-coverage.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Util 'trim'; 4 | use Mojo::Redis::Cursor; 5 | use Mojo::Redis::Database; 6 | use Mojo::Redis::PubSub; 7 | use Mojo::UserAgent; 8 | 9 | plan skip_all => 'CHECK_METHOD_COVERAGE=1' unless $ENV{CHECK_METHOD_COVERAGE}; 10 | 11 | my $methods = Mojo::UserAgent->new->get('https://redis.io/commands')->res->dom->find('[data-name]'); 12 | my @classes = qw(Mojo::Redis::Database Mojo::Redis::PubSub); 13 | my (%doc, %skip); 14 | 15 | $skip{method}{$_} = 1 for qw(auth hscan quit monitor migrate pubsub scan select shutdown sscan sync swapdb wait zscan); 16 | 17 | $methods = $methods->map(sub { 18 | $doc{$_->{'data-name'}} = [ 19 | trim($_->at('.summary')->text), 20 | join(', ', map { $_ = trim($_); /^\w/ ? "\$$_" : $_ } grep {/\w/} split /[\n\r]+/, $_->at('.args')->text) 21 | ]; 22 | return $_->{'data-name'}; 23 | }); 24 | 25 | METHOD: 26 | for my $command (sort { $a cmp $b } @$methods) { 27 | my $method = $command; 28 | $method =~ s!\s.*$!!g; 29 | 30 | if ($skip{method}{$method}) { 31 | note "Skipping $method"; 32 | next METHOD; 33 | } 34 | 35 | $method = 'listen' if $method =~ /subscribe$/; 36 | $method = 'unlisten' if $method =~ /unsubscribe$/; 37 | 38 | REDIS_CLASS: 39 | for my $class (@classes) { 40 | next REDIS_CLASS unless $class->can($method) or $class->can("${method}_p"); 41 | ok 1, "$class can $method ($command)"; 42 | next METHOD; 43 | } 44 | ok 0, "not implemented: $method ($command)"; 45 | } 46 | 47 | if (open my $SRC, '<', $INC{'Mojo/Redis/Database.pm'}) { 48 | my %has_doc; 49 | /^=head2 (\w+)/ and $has_doc{$1} = 1 for <$SRC>; 50 | 51 | for my $method ( 52 | sort @Mojo::Redis::Database::BASIC_COMMANDS, 53 | @Mojo::Redis::Database::BLOCKING_COMMANDS, 54 | qw(exec discard multi watch unwatch) 55 | ) 56 | { 57 | next if $has_doc{$method} or !$doc{$method}; 58 | my ($summary, $args) = @{$doc{$method}}; 59 | $summary .= '.' unless $summary =~ /\W$/; 60 | 61 | print <<"HERE"; 62 | 63 | =head2 $method 64 | 65 | \$res = \$self->$method($args); 66 | \$self = \$self->$method($args, sub { my (\$self, \$res) = \@_ }); 67 | \$promise = \$self->${method}_p($args); 68 | 69 | $summary 70 | 71 | See L for more information. 72 | HERE 73 | } 74 | } 75 | 76 | done_testing; 77 | -------------------------------------------------------------------------------- /t/pipelining.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | 5 | plan skip_all => 'TEST_ONLINE=redis://localhost' unless $ENV{TEST_ONLINE}; 6 | 7 | my $redis = Mojo::Redis->new($ENV{TEST_ONLINE}); 8 | my $db = $redis->db; 9 | my $key = "$0:pipelining"; 10 | my @res; 11 | 12 | Mojo::Promise->all( 13 | $db->set_p($key, 10), $db->incrby_p($key, 9), $db->incr_p($key), $db->get_p($key), 14 | $db->incr_p($key), $db->get_p($key), 15 | )->then(sub { 16 | @res = map {@$_} @_; 17 | })->wait; 18 | 19 | is_deeply \@res, ['OK', 19, 20, 20, 21, 21], 'Not waiting for response before sending a command'; 20 | 21 | done_testing; 22 | -------------------------------------------------------------------------------- /t/pubsub-reconnect.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Mojo::Redis; 3 | use Test::More; 4 | 5 | plan skip_all => 'TEST_ONLINE=redis://localhost' unless $ENV{TEST_ONLINE}; 6 | 7 | my $redis = Mojo::Redis->new($ENV{TEST_ONLINE}); 8 | my $channel = "test:$$"; 9 | my $expected_reconnects = 3; 10 | my ($pubsub_id, @before_connect, @disconnect, @err, @payloads, @reconnect); 11 | 12 | note 'setup pubsub'; 13 | my $pubsub = $redis->pubsub; 14 | $pubsub->on(error => sub { shift; diag "[error] @_" }); 15 | $pubsub->reconnect_interval(0.3); 16 | 17 | $pubsub->on(before_connect => sub { push @before_connect, $_[1] }); 18 | $pubsub->on(disconnect => sub { push @disconnect, $_[1] }); 19 | $pubsub->on(reconnect => sub { push @reconnect, $_[1] }); 20 | $pubsub->on(reconnect => sub { shift->notify($channel => 'reconnected') }); 21 | 22 | $pubsub->on( 23 | before_connect => sub { 24 | my ($pubsub, $conn) = @_; 25 | $conn->write_p(qw(CLIENT ID))->then( 26 | sub { 27 | $pubsub_id = shift; 28 | Mojo::IOLoop->timer(0.1 => sub { $pubsub->notify($channel => 'kill') }); 29 | }, 30 | sub { 31 | @err = @_; 32 | Mojo::IOLoop->stop; 33 | } 34 | ); 35 | } 36 | ); 37 | 38 | note 'reconnect enabled'; 39 | $pubsub->listen($channel => \&gather); 40 | $pubsub->listen("$channel:$_" => sub { }) for 1 .. 4; 41 | 42 | Mojo::IOLoop->start; 43 | plan skip_all => "CLIENT ID: @err" if @err; 44 | 45 | is_deeply \@payloads, [qw(kill reconnected) x $expected_reconnects], 'got payloads'; 46 | is @before_connect, $expected_reconnects + 1, 'got before_connect events'; 47 | is @reconnect, $expected_reconnects, 'got reconnect events'; 48 | is @disconnect, $expected_reconnects, 'got disconnect events'; 49 | isnt $before_connect[0], $before_connect[1], 'fresh connection'; 50 | 51 | note 'reconnect disabled'; 52 | (@before_connect, @disconnect, @reconnect) = (); 53 | $pubsub->reconnect_interval(-1); 54 | $pubsub->on( 55 | disconnect => sub { 56 | Mojo::IOLoop->timer(0.5 => sub { Mojo::IOLoop->stop }); 57 | } 58 | ); 59 | Mojo::IOLoop->timer(0.1 => sub { $pubsub->connection->disconnect }); 60 | Mojo::IOLoop->start; 61 | is_deeply \@err, [], 'no errors'; 62 | is @before_connect + @reconnect, 0, 'got no before_connect or reconnect events'; 63 | is @disconnect, 1, 'got only disconnect event'; 64 | 65 | done_testing; 66 | 67 | sub gather { 68 | my ($pubsub, $payload) = @_; 69 | note "payload=($payload)"; 70 | push @payloads, $payload; 71 | 72 | if ($payload eq 'kill') { 73 | $pubsub->db->client_p(KILL => ID => $pubsub_id); 74 | } 75 | elsif ($payload eq 'reconnected') { 76 | Mojo::IOLoop->stop if @disconnect == $expected_reconnects; 77 | } 78 | } 79 | -------------------------------------------------------------------------------- /t/pubsub.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::JSON qw(encode_json); 4 | use Mojo::Redis; 5 | 6 | plan skip_all => 'TEST_ONLINE=redis://localhost' unless $ENV{TEST_ONLINE}; 7 | *memory_cycle_ok 8 | = eval 'require Test::Memory::Cycle;1' ? \&Test::Memory::Cycle::memory_cycle_ok : sub { ok 1, 'memory_cycle_ok' }; 9 | 10 | my $redis = Mojo::Redis->new($ENV{TEST_ONLINE}); 11 | my $db = $redis->db; 12 | my $pubsub = $redis->pubsub; 13 | my (@events, @messages, @res); 14 | 15 | subtest memory => sub { 16 | memory_cycle_ok($redis, 'cycle ok for Mojo::Redis'); 17 | memory_cycle_ok($redis, 'cycle ok for Mojo::Redis::PubSub'); 18 | }; 19 | 20 | subtest events => sub { 21 | $pubsub->on(error => sub { shift; push @events, [error => @_] }); 22 | $pubsub->on(psubscribe => sub { shift; push @events, [psubscribe => @_] }); 23 | $pubsub->on(subscribe => sub { shift; push @events, [subscribe => @_] }); 24 | 25 | is ref($pubsub->listen("rtest:$$:1" => \&gather)), 'CODE', 'listen'; 26 | $pubsub->listen("rtest:$$:2" => \&gather); 27 | note 'Waiting for subscriptions to be set up...'; 28 | Mojo::Promise->timer(0.15)->wait; 29 | memory_cycle_ok($redis, 'cycle ok after listen'); 30 | }; 31 | 32 | subtest notify => sub { 33 | $pubsub->notify("rtest:$$:1" => 'message one'); 34 | $db->publish_p("rtest:$$:2" => 'message two')->wait; 35 | memory_cycle_ok($redis, 'cycle ok after notify'); 36 | has_messages("rtest:$$:1/message one", "rtest:$$:2/message two"); 37 | }; 38 | 39 | subtest channels => sub { 40 | $pubsub->channels_p('rtest*')->then(sub { @res = @_ })->wait; 41 | is_deeply [sort @{$res[0]}], ["rtest:$$:1", "rtest:$$:2"], 'channels_p'; 42 | }; 43 | 44 | subtest numsub => sub { 45 | $pubsub->numsub_p("rtest:$$:1")->then(sub { @res = @_ })->wait; 46 | is_deeply $res[0], {"rtest:$$:1" => 1}, 'numsub_p'; 47 | }; 48 | 49 | subtest numpat => sub { 50 | $pubsub->numpat_p->then(sub { @res = @_ })->wait; 51 | is_deeply $res[0], 0, 'numpat_p'; 52 | }; 53 | 54 | subtest unlisten => sub { 55 | is $pubsub->unlisten("rtest:$$:1", \&gather), $pubsub, 'unlisten'; 56 | memory_cycle_ok($pubsub, 'cycle ok after unlisten'); 57 | $db->publish_p("rtest:$$:1" => 'nobody is listening to this'); 58 | 59 | note 'Making sure the last message is not received'; 60 | Mojo::Promise->timer(0.15)->wait; 61 | has_messages(); 62 | }; 63 | 64 | subtest 'listen patterns' => sub { 65 | $pubsub->listen("rtest:$$:*" => \&gather); 66 | Mojo::Promise->timer(0.1)->wait; 67 | 68 | $pubsub->notify("rtest:$$:4" => 'message four'); 69 | $pubsub->notify("rtest:$$:5" => 'message five'); 70 | wait_for_messages(2); 71 | 72 | has_messages("rtest:$$:5/message five", "rtest:$$:4/message four"); 73 | $pubsub->unlisten("rtest:$$:*"); 74 | }; 75 | 76 | subtest connection => sub { 77 | my $conn = $pubsub->connection; 78 | is @{$conn->subscribers('response')}, 1, 'only one message subscriber'; 79 | 80 | undef $pubsub; 81 | delete $redis->{pubsub}; 82 | isnt $redis->db->connection, $conn, 'pubsub connection cannot be re-used'; 83 | }; 84 | 85 | subtest 'json data' => sub { 86 | $pubsub = $redis->pubsub; 87 | $pubsub->listen("rtest:$$:1" => \&gather); 88 | Mojo::Promise->timer(0.1)->wait; 89 | 90 | $pubsub->notify_p("rtest:$$:1" => '{"invalid"'); 91 | $pubsub->json("rtest:$$:1"); 92 | $pubsub->notify("rtest:$$:1" => {some => 'data'}); 93 | $pubsub->notify("rtest:$$:1" => 'just a string'); 94 | wait_for_messages(3); 95 | 96 | has_messages("rtest:$$:1/undef", qq(rtest:$$:1/HASH/{"some":"data"}), "rtest:$$:1/just a string"); 97 | }; 98 | 99 | subtest events => sub { 100 | is_deeply [sort { $a cmp $b } map { $_->[0] } @events], [qw(psubscribe subscribe subscribe)], 'events'; 101 | }; 102 | 103 | done_testing; 104 | 105 | sub gather { 106 | shift; 107 | push @messages, join '/', map { !defined($_) ? 'undef' : ref($_) ? (ref($_), encode_json($_)) : $_ } reverse @_; 108 | } 109 | 110 | sub has_messages { 111 | is_deeply [sort @messages], [sort @_], 'has messages' or diag explain \@messages; 112 | @messages = (); 113 | } 114 | 115 | sub wait_for_messages { 116 | my $n = shift; 117 | Mojo::IOLoop->one_tick until @messages >= $n; 118 | } 119 | -------------------------------------------------------------------------------- /t/redis.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | use Mojo::URL; 5 | 6 | my $redis = Mojo::Redis->new; 7 | like $redis->protocol_class, qr{^Protocol::Redis}, 'connection_class'; 8 | is $redis->max_connections, 5, 'max_connections'; 9 | is $redis->url, 'redis://localhost:6379', 'default url'; 10 | 11 | $redis = Mojo::Redis->new('redis://redis.localhost', max_connections => 1); 12 | is $redis->url, 'redis://redis.localhost', 'custom url'; 13 | is $redis->max_connections, 1, 'custom max_connections'; 14 | 15 | $redis = Mojo::Redis->new(Mojo::URL->new('redis://redis.example.com')->userinfo('x:foo')); 16 | is $redis->url, 'redis://redis.example.com', 'custom url object'; 17 | is $redis->url->userinfo, 'x:foo', 'userinfo retained'; 18 | 19 | $redis = Mojo::Redis->new({max_connections => 3}); 20 | is $redis->max_connections, 3, 'constructor with hash ref'; 21 | 22 | $redis = Mojo::Redis->new(max_connections => 2); 23 | is $redis->max_connections, 2, 'constructor with list'; 24 | 25 | $ENV{MOJO_REDIS_URL} = 'redis://redis.env.localhost'; 26 | $redis = Mojo::Redis->new; 27 | is $redis->url, 'redis://redis.env.localhost', 'custom default url'; 28 | 29 | done_testing; 30 | -------------------------------------------------------------------------------- /t/scripting.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | use Mojo::Loader 'data_section'; 5 | use Mojo::Util 'sha1_sum'; 6 | 7 | plan skip_all => 'TEST_ONLINE=redis://localhost' unless $ENV{TEST_ONLINE}; 8 | 9 | my $redis = Mojo::Redis->new($ENV{TEST_ONLINE}); 10 | my $db = $redis->db; 11 | 12 | my $script_myid = data_section(main => 'change_database_add_3_numbers_and_change_back_to_default_database.lua'); 13 | my $script_outtable 14 | = data_section(main => 'pull_out_from_a_redis_list_generate_sha1hex_for_each_element_and_return_the_array.lua'); 15 | 16 | my $script_myid_sha = $db->script(load => $script_myid); 17 | ok $db->script(exists => $script_myid_sha)->[0], 'script myid exists'; 18 | ok !$db->script(exists => sha1_sum('nope'))->[0], 'script nope does not exist'; 19 | 20 | my $input = Mojo::Collection->new(1 .. 3)->map(sub { int rand 999999 }); 21 | my $key = "$0:eval"; 22 | is $redis->db->eval($script_myid, 1, $key, @$input), $input->reduce(sub { $a + $b }), 'eval myid'; 23 | is $redis->db->evalsha($script_myid_sha, 1, $key, @$input), $input->reduce(sub { $a + $b }), 'evalsha myid'; 24 | 25 | done_testing; 26 | 27 | __DATA__ 28 | @@ change_database_add_3_numbers_and_change_back_to_default_database.lua 29 | redis.call("SELECT", 1) 30 | redis.call("SET", KEYS[1], ARGV[1]) 31 | redis.call("INCRBY", KEYS[1], ARGV[2]) 32 | local myid = redis.call("INCRBY", KEYS[1], ARGV[3]) 33 | redis.call("DEL", KEYS[1]) 34 | redis.call("SELECT", 0) 35 | return myid 36 | @@ pull_out_from_a_redis_list_generate_sha1hex_for_each_element_and_return_the_array.lua 37 | local intable = redis.call('LRANGE', KEYS[1], 0, -1); 38 | local outtable = {} 39 | for _,val in ipairs(intable) do 40 | table.insert(outtable, redis.sha1hex(val)) 41 | end 42 | redis.call('DEL', KEYS[1]) 43 | return outtable 44 | -------------------------------------------------------------------------------- /t/txn.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | 5 | plan skip_all => 'TEST_ONLINE=redis://localhost' unless $ENV{TEST_ONLINE}; 6 | 7 | my $redis = Mojo::Redis->new($ENV{TEST_ONLINE}); 8 | my $db = $redis->db; 9 | my $key = "txn:$0"; 10 | my @res; 11 | 12 | $db->multi_p->then(sub { 13 | return Mojo::Promise->all($db->set_p($key => 1011), $db->get_p($key), $db->incr_p($key), $db->incrby_p($key => -10)); 14 | })->then(sub { 15 | push @res, map { $_->[0] } @_; 16 | return $db->exec_p; 17 | })->then(sub { 18 | push @res, @{$_[0]}; 19 | })->wait; 20 | is_deeply(\@res, [('QUEUED') x 4, 'OK', 1011, 1012, 1002], 'exec_p'); 21 | 22 | @res = ($db->tap('multi')->tap(get => $key)->tap(incrby => $key => 10)->exec); 23 | is_deeply($res[0], [1002, 1012], 'exec'); 24 | 25 | @res = ($db->tap('multi')->set($key => 'something else')); 26 | is_deeply(\@res, ['QUEUED'], 'set after multi'); 27 | undef $db; 28 | is $redis->db->get($key), 1012, 'rollback when $db goes out of scope'; 29 | 30 | done_testing; 31 | -------------------------------------------------------------------------------- /t/xread.t: -------------------------------------------------------------------------------- 1 | use Mojo::Base -strict; 2 | use Test::More; 3 | use Mojo::Redis; 4 | 5 | plan skip_all => 'TEST_ONLINE=redis://localhost/8' unless $ENV{TEST_ONLINE}; 6 | 7 | my $redis = Mojo::Redis->new($ENV{TEST_ONLINE}); 8 | my $db = $redis->db; 9 | my $stream_name = "test:stream:$0"; 10 | my ($err, $len, $range, $read, $struct, @p); 11 | 12 | note 'Fresh start'; 13 | $db->del($stream_name); 14 | 15 | push @p, 16 | $redis->db->xread_p(BLOCK => 2000, STREAMS => $stream_name, '$')->then(sub { $read = shift }) 17 | ->catch(sub { $err = shift }); 18 | 19 | push @p, 20 | $redis->db->xread_structured_p(BLOCK => 2000, STREAMS => $stream_name, '$')->then(sub { $struct = shift }) 21 | ->catch(sub { $err = shift }); 22 | 23 | Mojo::IOLoop->timer( 24 | 0.2 => sub { 25 | my $db = $redis->db; 26 | Mojo::Promise->all(map { $db->xadd_p($stream_name, '*', xn => $_) } 11, 22)->then(sub { 27 | push @p, $db->xlen_p($stream_name)->then(sub { $len = shift }); 28 | push @p, $db->xrange_p($stream_name, '-', '+')->then(sub { $range = shift }); 29 | return Mojo::Promise->all(@p); 30 | })->finally(sub { Mojo::IOLoop->stop }); 31 | } 32 | ); 33 | 34 | Mojo::IOLoop->start; 35 | 36 | plan skip_all => 'xread is not supported' if $err and $err =~ m!unknown command!i; 37 | 38 | ok !$err, 'no error' or diag $err; 39 | is $len, 2, 'xlen'; 40 | is_deeply $range->[1][1], [xn => 22], 'xrange[1]' or diag explain($range); 41 | is_deeply $read->[0][0], $stream_name, 'xread stream_name' or diag explain($read); 42 | is_deeply $read->[0][1][0][1], [xn => 11], 'xread data' or diag explain($read); 43 | is_deeply $struct->{$stream_name}[0][1], [xn => 11], 'xread_structured' or diag explain($struct); 44 | 45 | note 'Cleanup'; 46 | $db->del($stream_name); 47 | 48 | done_testing; 49 | --------------------------------------------------------------------------------