File Coverage

blib/lib/EV/Redis.pm
Criterion Covered Total %
statement 63 70 90.0
branch 26 62 41.9
condition 4 16 25.0
subroutine 12 13 92.3
pod 2 2 100.0
total 107 163 65.6


line stmt bran cond sub pod time code
1             package EV::Redis;
2 24     24   5340635 use strict;
  24         54  
  24         692  
3 24     24   79 use warnings;
  24         54  
  24         1425  
4              
5 24     24   101 use Carp ();
  24         30  
  24         338  
6 24     24   719 use EV;
  24         2465  
  24         608  
7              
8             BEGIN {
9 24     24   82 use XSLoader;
  24         96  
  24         983  
10 24     24   68 our $VERSION = '0.09';
11 24         30356 XSLoader::load __PACKAGE__, $VERSION;
12             }
13              
14             sub new {
15 6     6 1 358941 my ($class, %args) = @_;
16              
17             Carp::croak("Cannot specify both 'host' and 'path'")
18 6 0 33     22 if exists $args{host} && exists $args{path};
19             Carp::croak("Cannot specify both 'prefer_ipv4' and 'prefer_ipv6'")
20 6 0 33     17 if $args{prefer_ipv4} && $args{prefer_ipv6};
21              
22 6   33     43 my $loop = $args{loop} // EV::default_loop;
23 6         106 my $self = $class->_new($loop);
24              
25 6   33 0   47 $self->on_error($args{on_error} // sub { die @_ });
  0         0  
26 6 50       13 $self->on_connect($args{on_connect}) if exists $args{on_connect};
27 6 50       11 $self->on_disconnect($args{on_disconnect}) if exists $args{on_disconnect};
28 6 50       15 $self->on_push($args{on_push}) if exists $args{on_push};
29 6 50       10 $self->connect_timeout($args{connect_timeout}) if defined $args{connect_timeout};
30 6 50       11 $self->command_timeout($args{command_timeout}) if defined $args{command_timeout};
31 6 50       13 $self->max_pending($args{max_pending}) if defined $args{max_pending};
32 6 50       11 $self->waiting_timeout($args{waiting_timeout}) if defined $args{waiting_timeout};
33 6 50       13 $self->resume_waiting_on_reconnect($args{resume_waiting_on_reconnect}) if defined $args{resume_waiting_on_reconnect};
34 6 50       12 $self->priority($args{priority}) if defined $args{priority};
35 6 50       14 $self->keepalive($args{keepalive}) if defined $args{keepalive};
36 6 50       15 $self->prefer_ipv4($args{prefer_ipv4}) if exists $args{prefer_ipv4};
37 6 50       31 $self->prefer_ipv6($args{prefer_ipv6}) if exists $args{prefer_ipv6};
38 6 50       12 $self->source_addr($args{source_addr}) if defined $args{source_addr};
39 6 50       18 $self->tcp_user_timeout($args{tcp_user_timeout}) if defined $args{tcp_user_timeout};
40 6 50       15 $self->cloexec($args{cloexec}) if exists $args{cloexec};
41 6 50       11 $self->reuseaddr($args{reuseaddr}) if exists $args{reuseaddr};
42              
43             # Configure reconnect if specified
44 6 50       25 if ($args{reconnect}) {
45             $self->reconnect(
46             1,
47             $args{reconnect_delay} // 1000,
48 0   0     0 $args{max_reconnect_attempts} // 0
      0        
49             );
50             }
51              
52             # Configure TLS if specified (must be done before connect)
53 6 100       15 if ($args{tls}) {
54 1 50       7 Carp::croak("TLS support not compiled in; rebuild with EV_REDIS_SSL=1")
55             unless $self->has_ssl;
56             Carp::croak("TLS requires 'host' parameter (not 'path')")
57 1 50       191 if exists $args{path};
58             $self->_setup_ssl_context(
59             $args{tls_ca}, $args{tls_capath}, $args{tls_cert}, $args{tls_key},
60             $args{tls_server_name},
61 0 0       0 exists $args{tls_verify} ? ($args{tls_verify} ? 1 : 0) : 1,
    0          
62             );
63             }
64              
65 5 50       23 if (exists $args{host}) {
    50          
66 0 0       0 Carp::croak("'host' must be a defined string") unless defined $args{host};
67             defined $args{port}
68             ? $self->connect($args{host}, $args{port})
69 0 0       0 : $self->connect($args{host});
70             }
71             elsif (exists $args{path}) {
72 0 0       0 Carp::croak("'path' must be a defined string") unless defined $args{path};
73 0         0 $self->connect_unix($args{path});
74             }
75              
76 5         15 $self;
77             }
78              
79             our $AUTOLOAD;
80              
81             sub AUTOLOAD {
82 1     1   8 (my $method = $AUTOLOAD) =~ s/.*:://;
83 1 50       4 return if $method eq 'DESTROY';
84              
85             my $sub = sub {
86 1     1   2 my $self = shift;
87 1         11 $self->command($method, @_);
88 1         4 };
89              
90 24     24   164 no strict 'refs';
  24         32  
  24         1603  
91 1         4 *$method = $sub;
92 1         2 goto $sub;
93             }
94              
95             sub can {
96 2     2 1 248 my ($self, $method) = @_;
97              
98             # Check for installed methods (including those installed by AUTOLOAD)
99 24     24   165 no strict 'refs';
  24         95  
  24         3654  
100 2         3 my $code = *{"EV::Redis::$method"}{CODE};
  2         21  
101 2 100       8 return $code if $code;
102              
103             # Fall back to SUPER::can for inherited methods
104 1         33 return $self->SUPER::can($method);
105             }
106              
107             1;
108              
109             =head1 NAME
110              
111             EV::Redis - Asynchronous redis client using hiredis and EV
112              
113             =head1 SYNOPSIS
114              
115             use EV::Redis;
116            
117             my $redis = EV::Redis->new;
118             $redis->connect('127.0.0.1');
119            
120             # or
121             my $redis = EV::Redis->new( host => '127.0.0.1' );
122            
123             # command
124             $redis->set('foo' => 'bar', sub {
125             my ($res, $err) = @_;
126            
127             print $res; # OK
128            
129             $redis->get('foo', sub {
130             my ($res, $err) = @_;
131            
132             print $res; # bar
133            
134             $redis->disconnect;
135             });
136             });
137            
138             # start main loop
139             EV::run;
140              
141             =head1 DESCRIPTION
142              
143             EV::Redis is a fork of L by Daisuke Murase (typester),
144             extended with reconnection, flow control, TLS, and RESP3 support. It is a
145             drop-in replacement: the API is fully backward-compatible with EV::Hiredis.
146              
147             This is an asynchronous client for Redis using hiredis and L as backend.
148             It connects to L with C-level interface so that it runs faster.
149              
150             =head1 ANYEVENT INTEGRATION
151              
152             L has a support for EV as its one of backends, so L can be used in your AnyEvent applications seamlessly.
153              
154             =head1 NO UTF-8 SUPPORT
155              
156             Unlike other redis modules, this module doesn't support utf-8 string.
157              
158             This module handle all variables as bytes. You should encode your utf-8 string before passing commands like following:
159              
160             use Encode;
161            
162             # set $val
163             $redis->set(foo => encode_utf8 $val, sub { ... });
164            
165             # get $val
166             $redis->get(foo, sub {
167             my $val = decode_utf8 $_[0];
168             });
169              
170             =head1 METHODS
171              
172             =head2 new(%options);
173              
174             Create new L instance.
175              
176             Available C<%options> are:
177              
178             =over
179              
180             =item * host => 'Str'
181              
182             =item * port => 'Int'
183              
184             Hostname and port number of redis-server to connect. Mutually exclusive with C.
185              
186             =item * path => 'Str'
187              
188             UNIX socket path to connect. Mutually exclusive with C.
189              
190             =item * on_error => $cb->($errstr)
191              
192             Error callback will be called when a connection level error occurs.
193             If not provided (or C), a default handler that calls C is
194             installed. To have no error handler, call C<< $obj->on_error(undef) >>
195             after construction.
196              
197             This callback can be set by C<< $obj->on_error($cb) >> method any time.
198              
199             =item * on_connect => $cb->()
200              
201             Connection callback will be called when connection successful and completed to redis server.
202              
203             This callback can be set by C<< $obj->on_connect($cb) >> method any time.
204              
205             =item * on_disconnect => $cb->()
206              
207             Disconnect callback will be called when disconnection occurs (both normal and error cases).
208              
209             This callback can be set by C<< $obj->on_disconnect($cb) >> method any time.
210              
211             =item * on_push => $cb->($reply)
212              
213             RESP3 push callback for server-initiated out-of-band messages (Redis 6.0+).
214             Called with the decoded push message (an array reference). This enables
215             client-side caching invalidation and other server-push features.
216              
217             This callback can be set by C<< $obj->on_push($cb) >> method any time.
218              
219             =item * connect_timeout => $num_of_milliseconds
220              
221             Connection timeout.
222              
223             =item * command_timeout => $num_of_milliseconds
224              
225             Command timeout.
226              
227             =item * max_pending => $num
228              
229             Maximum number of commands sent to Redis concurrently. When this limit is reached,
230             additional commands are queued locally and sent as responses arrive.
231             0 means unlimited (default). Use C to check the local queue size.
232              
233             =item * waiting_timeout => $num_of_milliseconds
234              
235             Maximum time a command can wait in the local queue before being cancelled with
236             "waiting timeout" error. 0 means unlimited (default).
237              
238             =item * resume_waiting_on_reconnect => $bool
239              
240             Controls behavior of waiting queue on disconnect. If false (default), waiting
241             commands are cancelled with error on disconnect. If true, waiting commands are
242             preserved and resumed after successful reconnection.
243              
244             =item * reconnect => $bool
245              
246             Enable automatic reconnection on connection failure or unexpected disconnection.
247             Default is disabled (0).
248              
249             =item * reconnect_delay => $num_of_milliseconds
250              
251             Delay between reconnection attempts. Default is 1000 (1 second).
252              
253             =item * max_reconnect_attempts => $num
254              
255             Maximum number of reconnection attempts. 0 means unlimited. Default is 0.
256             Negative values are treated as 0 (unlimited).
257              
258             =item * priority => $num
259              
260             Priority for the underlying libev IO watchers. Higher priority watchers are
261             invoked before lower priority ones. Valid range is -2 (lowest) to +2 (highest),
262             with 0 being the default. See L documentation for details on priorities.
263              
264             =item * keepalive => $seconds
265              
266             Enable TCP keepalive with the specified interval in seconds. When enabled,
267             the OS will periodically send probes on idle connections to detect dead peers.
268             0 means disabled (default). Recommended for long-lived connections behind
269             NAT gateways or firewalls.
270              
271             =item * prefer_ipv4 => $bool
272              
273             Prefer IPv4 addresses when resolving hostnames. Mutually exclusive with
274             C.
275              
276             =item * prefer_ipv6 => $bool
277              
278             Prefer IPv6 addresses when resolving hostnames. Mutually exclusive with
279             C.
280              
281             =item * source_addr => 'Str'
282              
283             Local address to bind the outbound connection to. Useful on multi-homed
284             servers to select a specific network interface.
285              
286             =item * tcp_user_timeout => $num_of_milliseconds
287              
288             Set the TCP_USER_TIMEOUT socket option (Linux-specific). Controls how long
289             transmitted data may remain unacknowledged before the connection is dropped.
290             Helps detect dead connections faster on lossy networks.
291              
292             =item * cloexec => $bool
293              
294             Set SOCK_CLOEXEC on the Redis connection socket. Prevents the file descriptor
295             from leaking to child processes after fork/exec. Default is enabled.
296              
297             =item * reuseaddr => $bool
298              
299             Set SO_REUSEADDR on the Redis connection socket. Allows rebinding to an
300             address that is still in TIME_WAIT state. Default is disabled.
301              
302             =item * tls => $bool
303              
304             Enable TLS/SSL encryption for the connection. Requires that the module was
305             built with TLS support (auto-detected at build time, or forced with
306             C). Only valid with C connections, not C.
307              
308             =item * tls_ca => 'Str'
309              
310             Path to CA certificate file for server verification. If not specified,
311             uses the system default CA store.
312              
313             =item * tls_capath => 'Str'
314              
315             Path to a directory containing CA certificate files in OpenSSL-compatible
316             format (hashed filenames). Alternative to C for multiple CA certs.
317              
318             =item * tls_cert => 'Str'
319              
320             Path to client certificate file for mutual TLS authentication. Must be
321             specified together with C.
322              
323             =item * tls_key => 'Str'
324              
325             Path to client private key file. Must be specified together with C.
326              
327             =item * tls_server_name => 'Str'
328              
329             Server name for SNI (Server Name Indication). Optional.
330              
331             =item * tls_verify => $bool
332              
333             Enable or disable TLS peer verification. Default is true (verify).
334             Set to false to accept self-signed certificates (not recommended for
335             production).
336              
337             =item * loop => 'EV::Loop',
338              
339             EV loop for running this instance. Default is C.
340              
341             =back
342              
343             All parameters are optional.
344              
345             If parameters about connection (host&port or path) is not passed, you should call C or C method by hand to connect to redis-server.
346              
347             =head2 connect($hostname [, $port])
348              
349             =head2 connect_unix($path)
350              
351             Connect to a redis-server for C<$hostname:$port> or C<$path>. C<$port>
352             defaults to 6379. Croaks if a connection is already active.
353              
354             =head2 command($commands..., [$cb->($result, $error)])
355              
356             Do a redis command and return its result by callback. Returns C
357             (0) on success or C (-1) if the command could not be enqueued
358             (the error is also delivered via callback, so the return value is rarely needed).
359              
360             $redis->command('get', 'foo', sub {
361             my ($result, $error) = @_;
362              
363             print $result; # value for key 'foo'
364             print $error; # redis error string, undef if no error
365             });
366              
367             If any error is occurred, C<$error> presents the error message and C<$result> is undef.
368             If no error, C<$error> is undef and C<$result> presents response from redis.
369              
370             The callback is optional. Without a callback, the command runs in
371             fire-and-forget mode: the reply from Redis is silently discarded and errors
372             are not reported to Perl code (connection-level errors still trigger
373             C). This is useful for high-volume writes where individual
374             acknowledgement is not needed:
375              
376             $redis->set('counter', 42); # fire-and-forget, no callback
377              
378             NOTE: Alternatively all commands can be called via AUTOLOAD interface,
379             including fire-and-forget:
380              
381             $redis->command('get', 'foo', sub { ... });
382              
383             is equivalent to:
384              
385             $redis->get('foo', sub { ... });
386              
387             $redis->set('counter', 42); # fire-and-forget via AUTOLOAD
388              
389             B Calling C while not connected will croak with
390             "connection required before calling command", unless automatic reconnection
391             is active (reconnect timer running). In that case, commands are
392             automatically queued and sent after successful reconnection. Queued
393             commands respect C if set.
394              
395             B For C, C, and C, the
396             callback is persistent and receives all messages. For C,
397             C, and C, the confirmation is delivered through
398             the original subscribe callback (this is hiredis behavior). Any callback
399             passed to unsubscribe commands is silently discarded.
400              
401             =head2 disconnect
402              
403             Disconnect from redis-server. Safe to call when already disconnected.
404             Stops any pending reconnect timer, so explicit disconnect prevents automatic
405             reconnection. Triggers the C callback when disconnecting
406             from an active connection. When called while already disconnected, clears
407             any waiting commands (e.g., preserved by C),
408             invoking their callbacks with a "disconnected" error (C
409             does not fire in this case).
410             This method is usable for exiting event loop.
411              
412             =head2 is_connected
413              
414             Returns true (1) if a connection context is active (including while the
415             connection is being established), false (0) otherwise.
416              
417             =head2 has_ssl
418              
419             Class method. Returns true (1) if the module was built with TLS support,
420             false (0) otherwise.
421              
422             if (EV::Redis->has_ssl) {
423             # TLS connections are available
424             }
425              
426             =head2 connect_timeout([$ms])
427              
428             Get or set the connection timeout in milliseconds. Returns the current value,
429             or undef if not set. Can also be set via constructor.
430              
431             =head2 command_timeout([$ms])
432              
433             Get or set the command timeout in milliseconds. Returns the current value,
434             or undef if not set. Can also be set via constructor. When changed while
435             connected, takes effect immediately on the active connection.
436              
437             =head2 on_error([$cb->($errstr)])
438              
439             Set error callback. With a CODE reference argument, replaces the handler
440             and returns the new handler. With C or without arguments, clears
441             the handler and returns undef.
442              
443             B Calling without arguments clears the handler. There is no way to
444             read the current handler without clearing it. This applies to all handler
445             methods (C, C, C, C).
446              
447             =head2 on_connect([$cb->()])
448              
449             Set connect callback. With a CODE reference argument, replaces the handler
450             and returns the new handler. With C or without arguments, clears
451             the handler and returns undef.
452              
453             =head2 on_disconnect([$cb->()])
454              
455             Set disconnect callback, called on both normal and error disconnections.
456             With a CODE reference argument, replaces the handler and returns the new
457             handler. With C or without arguments, clears the handler and
458             returns undef.
459              
460             =head2 on_push([$cb->($reply)])
461              
462             Set RESP3 push callback for server-initiated messages (Redis 6.0+).
463             The callback receives the decoded push message as an array reference.
464             With a CODE reference argument, replaces the handler and returns the new
465             handler. With C or without arguments, clears the handler and
466             returns undef. When changed while connected, takes effect immediately.
467              
468             $redis->on_push(sub {
469             my ($msg) = @_;
470             # $msg is an array ref, e.g. ['invalidate', ['key1', 'key2']]
471             });
472              
473             =head2 reconnect($enable, $delay_ms, $max_attempts)
474              
475             Configure automatic reconnection.
476              
477             $redis->reconnect(1); # enable with defaults (1s delay, unlimited)
478             $redis->reconnect(1, 0); # enable with immediate reconnect
479             $redis->reconnect(1, 2000); # enable with 2 second delay
480             $redis->reconnect(1, 1000, 5); # enable with 1s delay, max 5 attempts
481             $redis->reconnect(0); # disable
482              
483             C<$delay_ms> defaults to 1000 (1 second). 0 means immediate reconnect.
484             C<$max_attempts> defaults to 0 (unlimited).
485              
486             When enabled, the client will automatically attempt to reconnect on connection
487             failure or unexpected disconnection. Intentional C calls will
488             not trigger reconnection.
489              
490             =head2 reconnect_enabled
491              
492             Returns true (1) if automatic reconnection is enabled, false (0) otherwise.
493              
494             =head2 pending_count
495              
496             Returns the number of commands sent to Redis awaiting responses.
497             Persistent commands (subscribe, psubscribe, ssubscribe, monitor) are not
498             included in this count.
499             When called from inside a command callback, the count includes the
500             current command (it is decremented after the callback returns).
501              
502             =head2 waiting_count
503              
504             Returns the number of commands queued locally (not yet sent to Redis).
505             These are commands that exceeded the C limit.
506              
507             =head2 max_pending($limit)
508              
509             Get or set the maximum number of concurrent commands sent to Redis.
510             Persistent commands (subscribe, psubscribe, ssubscribe, monitor) are not
511             subject to this limit.
512             0 means unlimited (default). When the limit is reached, additional commands
513             are queued locally and sent as responses arrive.
514              
515             =head2 waiting_timeout($ms)
516              
517             Get or set the maximum time in milliseconds a command can wait in the local queue.
518             Commands exceeding this timeout are cancelled with "waiting timeout" error.
519             0 means unlimited (default). Returns the current value as an integer (0 when unset).
520              
521             =head2 resume_waiting_on_reconnect($bool)
522              
523             Get or set whether waiting commands are preserved on disconnect and resumed
524             after reconnection. Default is false (waiting commands cancelled on disconnect).
525              
526             =head2 priority($priority)
527              
528             Get or set the priority for the underlying libev IO watchers. Higher priority
529             watchers are invoked before lower priority ones when multiple watchers are
530             pending. Valid range is -2 (lowest) to +2 (highest), with 0 being the default.
531             Values outside this range are clamped automatically.
532             Can be changed at any time, including while connected.
533              
534             $redis->priority(1); # higher priority
535             $redis->priority(-1); # lower priority
536             $redis->priority(99); # clamped to 2
537             my $prio = $redis->priority; # get current priority
538              
539             =head2 keepalive($seconds)
540              
541             Get or set the TCP keepalive interval in seconds. When set, the OS sends
542             periodic probes on idle connections to detect dead peers. 0 means disabled
543             (default). When set to a positive value while connected, takes effect
544             immediately. Setting to 0 while connected records the preference for future
545             connections but does not disable keepalives on the current socket.
546              
547             =head2 prefer_ipv4($bool)
548              
549             Get or set IPv4 preference for DNS resolution. Mutually exclusive with
550             C (setting one clears the other). Takes effect on the next
551             connection.
552              
553             =head2 prefer_ipv6($bool)
554              
555             Get or set IPv6 preference for DNS resolution. Mutually exclusive with
556             C (setting one clears the other). Takes effect on the next
557             connection.
558              
559             =head2 source_addr($addr)
560              
561             Get or set the local source address to bind to when connecting. This is
562             useful on multi-homed hosts to control which network interface is used.
563             Pass C to clear. Takes effect on the next TCP connection (has no
564             effect on Unix socket connections).
565              
566             =head2 tcp_user_timeout($ms)
567              
568             Get or set the TCP user timeout in milliseconds. This controls how long
569             transmitted data may remain unacknowledged before the connection is dropped.
570             0 means use the OS default. Takes effect on the next connection.
571              
572             =head2 cloexec($bool)
573              
574             Get or set the close-on-exec flag for the Redis socket. When enabled, the
575             socket is automatically closed in child processes after fork+exec. Enabled
576             by default. Takes effect on the next connection.
577              
578             =head2 reuseaddr($bool)
579              
580             Get or set SO_REUSEADDR on the Redis socket. Allows rebinding to an address
581             still in TIME_WAIT state. Disabled by default. Takes effect on the next
582             connection.
583              
584             =head2 skip_waiting
585              
586             Cancel only waiting (not yet sent) command callbacks. Each callback is invoked
587             with C<(undef, "skipped")>. In-flight commands continue normally.
588              
589             =head2 skip_pending
590              
591             Cancel all pending and waiting command callbacks. Each Perl callback is
592             invoked immediately with C<(undef, "skipped")>. For pending commands,
593             the internal hiredis tracking entry remains until a reply arrives (which
594             is then discarded); no second callback fires.
595              
596             =head2 can($method)
597              
598             Returns code reference if method is available, undef otherwise.
599             Methods installed via AUTOLOAD (Redis commands) will return true after first call.
600              
601             =head1 DESTRUCTION BEHAVIOR
602              
603             When an EV::Redis object is destroyed (goes out of scope or is explicitly
604             undefined) while commands are still pending or waiting, hiredis invokes all
605             pending command callbacks with a disconnect error, and EV::Redis invokes
606             all waiting queue callbacks with C<"disconnected">. This ensures callbacks
607             are not orphaned.
608              
609             For predictable cleanup, explicitly disconnect before destruction:
610              
611             $redis->disconnect; # Clean disconnect, callbacks get error
612             undef $redis; # Safe to destroy
613              
614             Or use skip methods to cancel with a specific error message:
615              
616             $redis->skip_pending; # Invokes callbacks with (undef, "skipped")
617             $redis->skip_waiting;
618             $redis->disconnect;
619             undef $redis;
620              
621             B If your callbacks close over the C<$redis> variable,
622             this creates a reference cycle (C<$redis> -> object -> callback -> C<$redis>)
623             that prevents garbage collection. Break the cycle before the object goes out
624             of scope by clearing callbacks:
625              
626             $redis->on_error(undef);
627             $redis->on_connect(undef);
628             $redis->on_disconnect(undef);
629             $redis->on_push(undef);
630              
631             =head1 BENCHMARKS
632              
633             Measured on Linux with Unix socket connection, 100-byte values, Perl 5.40,
634             Redis 8.x (C):
635              
636             Pipeline SET ~107K ops/sec
637             Pipeline GET ~112K ops/sec
638             Mixed workload ~112K ops/sec
639             Fire-and-forget SET ~655K ops/sec
640             Sequential round-trip ~39K ops/sec (SET+GET pairs)
641              
642             Fire-and-forget mode (no callback) is roughly 6x faster than callback mode
643             due to zero Perl-side overhead per command. Pipeline throughput is bounded
644             by the event loop round-trip, not by hiredis or the network.
645              
646             Flow control (C) has minimal impact at reasonable limits:
647              
648             unlimited ~180K ops/sec
649             max_pending=500 ~186K ops/sec
650             max_pending=100 ~146K ops/sec
651              
652             Run C for full results. Set C and
653             C environment variables to customize.
654              
655             =head1 AUTHOR
656              
657             Daisuke Murase (typester) (original L)
658              
659             vividsnow
660              
661             =head1 COPYRIGHT AND LICENSE
662              
663             Copyright (c) 2013 Daisuke Murase, 2026 vividsnow. All rights reserved.
664              
665             This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
666              
667             =cut