API-MikroTik
view release on metacpan or search on metacpan
{'.proplist' => '.id,name,type'},
{type => ['ipip-tunnel', 'gre-tunnel'], running => 'true'}
);
if (my $err = $api->error) { die "$err\n" }
printf "%s: %s\n", $_->{name}, $_->{type} for @$list;
# Non-blocking
my $tag = $api->command(
'/system/resource/print',
{'.proplist' => 'board-name,version,uptime'} => sub {
my ($api, $err, $list) = @_;
...;
}
);
Mojo::IOLoop->start();
# Subscribe
$tag = $api->subscribe(
'/interface/listen' => sub {
my ($api, $err, $res) = @_;
...;
}
);
Mojo::IOLoop->timer(3 => sub { $api->cancel($tag) });
Mojo::IOLoop->start();
# Errors handling
$api->command(
'/random/command' => sub {
my ($api, $err, $list) = @_;
if ($err) {
warn "Error: $err, category: " . $list->[0]{category};
return;
}
...;
}
);
Mojo::IOLoop->start();
# Promises
$api->cmd_p('/interface/print')
->then(sub { my $res = shift }, sub { my ($err, $attr) = @_ })
->finally(sub { Mojo::IOLoop->stop() });
Mojo::IOLoop->start();
```
lib/API/MikroTik.pm view on Meta::CPAN
deprecated "API::MikroTik is deprecated in favour of MikroTik::Client\n";
use constant CONN_TIMEOUT => $ENV{API_MIKROTIK_CONNTIMEOUT};
use constant DEBUG => $ENV{API_MIKROTIK_DEBUG} || 0;
use constant PROMISES => !!(eval { require Mojo::Promise; 1 });
our $VERSION = 'v0.242';
has error => '';
has host => '192.168.88.1';
has ioloop => sub { Mojo::IOLoop->new() };
has password => '';
has port => 0;
has timeout => 10;
has tls => 1;
has user => 'admin';
has _tag => 0;
# Aliases
Mojo::Util::monkey_patch(__PACKAGE__, 'cmd', \&command);
Mojo::Util::monkey_patch(__PACKAGE__, 'cmd_p', \&command_p);
Mojo::Util::monkey_patch(__PACKAGE__, '_fail', \&_finish);
sub DESTROY { Mojo::Util::_global_destruction() or shift->_cleanup() }
sub cancel {
my $cb = ref $_[-1] eq 'CODE' ? pop : sub { };
return shift->_command(Mojo::IOLoop->singleton, '/cancel', {'tag' => shift},
undef, $cb);
}
sub command {
my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
my ($self, $cmd, $attr, $query) = @_;
# non-blocking
return $self->_command(Mojo::IOLoop->singleton, $cmd, $attr, $query, $cb)
if $cb;
# blocking
my $res;
$self->_command($self->ioloop, $cmd, $attr, $query,
sub { $_[0]->ioloop->stop(); $res = $_[2]; });
$self->ioloop->start();
return $res;
}
sub command_p {
Carp::croak 'Mojolicious v7.54+ is required for using promises.'
unless PROMISES;
my ($self, $cmd, $attr, $query) = @_;
my $p = Mojo::Promise->new();
$self->_command(
Mojo::IOLoop->singleton,
$cmd, $attr, $query,
sub {
return $p->reject($_[1], $_[2]) if $_[1];
$p->resolve($_[2]);
}
);
return $p;
}
sub subscribe {
do { $_[0]->{error} = 'can\'t subscribe in blocking mode'; return; }
unless ref $_[-1] eq 'CODE';
my $cb = pop;
my ($self, $cmd, $attr, $query) = @_;
$attr->{'.subscription'} = 1;
return $self->_command(Mojo::IOLoop->singleton, $cmd, $attr, $query, $cb);
}
sub _cleanup {
my $self = shift;
$_->{timeout} && $_->{loop}->remove($_->{timeout})
for values %{$self->{requests}};
$_ && $_->unsubscribe('close')->close() for values %{$self->{handles}};
delete $self->{handles};
}
sub _close {
my ($self, $loop) = @_;
$self->_fail_all($loop, 'closed prematurely');
delete $self->{handles}{$loop};
delete $self->{responses}{$loop};
}
sub _command {
my ($self, $loop, $cmd, $attr, $query, $cb) = @_;
my $tag = ++$self->{_tag};
my $r = $self->{requests}{$tag} = {tag => $tag, loop => $loop, cb => $cb};
$r->{subscription} = delete $attr->{'.subscription'};
warn "-- got request for command '$cmd' (tag: $tag)\n" if DEBUG;
$r->{sentence} = encode_sentence($cmd, $attr, $query, $tag);
return $self->_send_request($r);
}
sub _connect {
my ($self, $r) = @_;
warn "-- creating new connection\n" if DEBUG;
my $queue = $self->{queues}{$r->{loop}} = [$r];
my $tls = $self->tls;
my $port = $self->port ? $self->{port} : $tls ? 8729 : 8728;
$r->{loop}->client(
{
address => $self->host,
port => $port,
timeout => CONN_TIMEOUT,
tls => $tls,
tls_ciphers => 'HIGH'
} => sub {
my ($loop, $err, $stream) = @_;
delete $self->{queues}{$loop};
if ($err) { $self->_fail($_, $err) for @$queue; return }
warn "-- connection established\n" if DEBUG;
$self->{handles}{$loop} = $stream;
weaken $self;
$stream->on(read => sub { $self->_read($loop, $_[1]) });
$stream->on(
error => sub { $self and $self->_fail_all($loop, $_[1]) });
$stream->on(close => sub { $self && $self->_close($loop) });
$self->_login(
$loop,
sub {
if ($_[1]) {
$_[0]->_fail($_, $_[1]) for @$queue;
$stream->close();
return;
}
$self->_write_sentence($stream, $_) for @$queue;
}
);
}
);
return $r->{tag};
}
sub _enqueue {
my ($self, $r) = @_;
return $self->_connect($r) unless my $queue = $self->{queues}{$r->{loop}};
push @$queue, $r;
return $r->{tag};
}
sub _fail_all {
$_[0]->_fail($_, $_[2])
for grep { $_->{loop} eq $_[1] } values %{$_[0]->{requests}};
}
sub _finish {
my ($self, $r, $err) = @_;
delete $self->{requests}{$r->{tag}};
if (my $timer = $r->{timeout}) { $r->{loop}->remove($timer) }
$r->{cb}->($self, ($self->{error} = $err // ''), $r->{data});
}
sub _login {
my ($self, $loop, $cb) = @_;
warn "-- trying to log in\n" if DEBUG;
$loop->delay(
sub {
$self->_command($loop, '/login', {}, undef, $_[0]->begin());
},
sub {
my ($delay, $err, $res) = @_;
return $self->$cb($err) if $err;
my $secret
= md5_sum("\x00", $self->password, pack 'H*', $res->[0]{ret});
$self->_command($loop, '/login',
{name => $self->user, response => "00$secret"},
undef, $delay->begin());
},
sub {
$self->$cb($_[1]);
},
);
}
sub _read {
my ($self, $loop, $bytes) = @_;
warn "-- read bytes from socket: " . (length $bytes) . "\n" if DEBUG;
my $response = $self->{responses}{$loop} ||= API::MikroTik::Response->new();
my $data = $response->parse(\$bytes);
for (@$data) {
next unless my $r = $self->{requests}{delete $_->{'.tag'}};
my $type = delete $_->{'.type'};
lib/API/MikroTik.pm view on Meta::CPAN
$r->{data} ||= Mojo::Collection->new();
$self->_finish($r);
}
elsif ($type eq '!trap' || $type eq '!fatal') {
$self->_fail($r, $_->{message});
}
}
}
sub _send_request {
my ($self, $r) = @_;
return $self->_enqueue($r) unless my $stream = $self->{handles}{$r->{loop}};
return $self->_write_sentence($stream, $r);
}
sub _write_sentence {
my ($self, $stream, $r) = @_;
warn "-- writing sentence for tag: $r->{tag}\n" if DEBUG;
$stream->write($r->{sentence});
return $r->{tag} if $r->{subscription};
weaken $self;
$r->{timeout} = $r->{loop}
->timer($self->timeout => sub { $self->_fail($r, 'response timeout') });
return $r->{tag};
}
1;
=encoding utf8
=head1 NAME
lib/API/MikroTik.pm view on Meta::CPAN
{'.proplist' => '.id,name,type'},
{type => ['ipip-tunnel', 'gre-tunnel'], running => 'true'}
);
if (my $err = $api->error) { die "$err\n" }
printf "%s: %s\n", $_->{name}, $_->{type} for @$list;
# Non-blocking
my $tag = $api->command(
'/system/resource/print',
{'.proplist' => 'board-name,version,uptime'} => sub {
my ($api, $err, $list) = @_;
...;
}
);
Mojo::IOLoop->start();
# Subscribe
$tag = $api->subscribe(
'/interface/listen' => sub {
my ($api, $err, $el) = @_;
...;
}
);
Mojo::IOLoop->timer(3 => sub { $api->cancel($tag) });
Mojo::IOLoop->start();
# Errors handling
$api->command(
'/random/command' => sub {
my ($api, $err, $list) = @_;
if ($err) {
warn "Error: $err, category: " . $list->[0]{category};
return;
}
...;
}
);
Mojo::IOLoop->start();
# Promises
$api->cmd_p('/interface/print')
->then(sub { my $res = shift }, sub { my ($err, $attr) = @_ })
->finally(sub { Mojo::IOLoop->stop() });
Mojo::IOLoop->start();
=head1 DESCRIPTION
B<This module is deprecated in favour of> L<MikroTik::Client>B<.>
Both blocking and non-blocking interface to a MikroTik API service. With queries,
command subscriptions and Promises/A+ (courtesy of an I/O loop). Based on
L<Mojo::IOLoop> and would work alongside L<EV>.
lib/API/MikroTik.pm view on Meta::CPAN
my $user = $api->user;
$api = $api->user('admin');
User name for authentication purposes. Defaults to C<admin>.
=head1 METHODS
=head2 cancel
# subscribe to a command output
my $tag = $api->subscribe('/ping', {address => '127.0.0.1'} => sub {...});
# cancel command after 10 seconds
Mojo::IOLoop->timer(10 => sub { $api->cancel($tag) });
# or with callback
$api->cancel($tag => sub {...});
Cancels background commands. Can accept a callback as last argument.
=head2 cmd
my $list = $api->cmd('/interface/print');
An alias for L</command>.
=head2 cmd_p
lib/API/MikroTik.pm view on Meta::CPAN
my $attr = {'.proplist' => '.id,name,type'};
my $query = {type => ['ipip-tunnel', 'gre-tunnel'], running => 'true'};
my $list = $api->command($command, $attr, $query);
die $api->error if $api->error;
for (@$list) {...}
$api->command('/user/set', {'.id' => 'admin', comment => 'System admin'});
# Non-blocking
$api->command('/ip/address/print' => sub {
my ($api, $err, $list) = @_;
return if $err;
for (@$list) {...}
});
# Omit attributes
$api->command('/user/print', undef, {name => 'admin'} => sub {...});
# Errors handling
$list = $api->command('/random/command');
if (my $err = $api->error) {
die "Error: $err, category: " . $list->[0]{category};
}
Executes a command on a remote host and returns L<Mojo::Collection> with hashrefs
containing elements returned by a host. You can append a callback for non-blocking
calls.
lib/API/MikroTik.pm view on Meta::CPAN
replies in addition to error messages in an L</error> attribute or an C<$err>
argument. You should never rely on defines of the result to catch errors.
For a query syntax refer to L<API::MikroTik::Query>.
=head2 command_p
my $promise = $api->command_p('/interface/print');
$promise->then(
sub {
my $res = shift;
...
})->catch(sub {
my ($err, $attr) = @_;
});
Same as L</command>, but always performs requests non-blocking and returns a
L<Mojo::Promise> object instead of accepting a callback. L<Mojolicious> v7.54+ is
required for promises functionality.
=head2 subscribe
my $tag = $api->subscribe('/ping',
{address => '127.0.0.1'} => sub {
my ($api, $err, $res) = @_;
});
Mojo::IOLoop->timer(
3 => sub { $api->cancel($tag) }
);
Subscribe to an output of commands with continuous responses such as C<listen> or
C<ping>. Should be terminated with L</cancel>.
=head1 DEBUGGING
You can set the API_MIKROTIK_DEBUG environment variable to get some debug output
printed to stderr.
lib/API/MikroTik/Query.pm view on Meta::CPAN
package API::MikroTik::Query;
use Mojo::Base '-base';
use Exporter 'import';
use Scalar::Util 'blessed';
our @EXPORT_OK = ('build_query');
sub build_query {
my $query = blessed $_[0] ? $_[1] : $_[0];
return $$query if ref $query eq 'REF' && ref $$query eq 'ARRAY';
if (my $type = ref $query) {
return [_block(_ref_op($type), $query)];
}
else { return [] }
}
sub _block {
my ($logic, $items) = @_;
@{($items = [])} = map { $_ => $items->{$_} } sort keys %$items
if ref $items eq 'HASH';
my ($count, @words) = (0, ());
while (my $el = shift @$items) {
my @expr;
if (ref $el eq 'REF' && ref $$el eq 'ARRAY') {
lib/API/MikroTik/Query.pm view on Meta::CPAN
@expr = _value($el, shift @$items);
}
++$count && push @words, @expr if @expr;
}
push @words, '?#' . ($logic x ($count - 1)) if $count > 1;
return @words;
}
sub _ref_op {
return
($_[0] eq 'HASH' || $_[0] eq '-and') ? '&'
: ($_[0] eq 'ARRAY' || $_[0] eq '-or') ? '|'
: '';
}
sub _value {
my ($name, $val) = @_;
my $type = ref $val;
if ($type eq 'HASH') {
return _value_hash($name, $val);
}
elsif ($type eq 'ARRAY') {
return _value_array($name, '=', $val);
}
# SCALAR
return "?$name=" . ($val // '');
}
sub _value_array {
my ($name, $op, $block) = @_;
return () unless @$block;
my $logic = '|';
$logic = _ref_op(shift @$block)
if @$block[0] eq '-and' || @$block[0] eq '-or';
my ($count, @words) = (0, ());
for (@$block) {
lib/API/MikroTik/Query.pm view on Meta::CPAN
? _value_hash($name, $_)
: _value_scalar($name, $op, $_);
++$count && push @words, @expr if @expr;
}
push @words, '?#' . ($logic x ($count - 1)) if $count > 1;
return @words;
}
sub _value_hash {
my ($name, $block) = @_;
my @words = ();
for my $op (sort keys %$block) {
my $val = $block->{$op};
return _value_array($name, $op, $val) if ref $val eq 'ARRAY';
push @words, _value_scalar($name, $op, $val);
}
my $count = keys %$block;
push @words, '?#' . ('&' x ($count - 1)) if $count > 1;
return @words;
}
sub _value_scalar {
my ($name, $op, $val) = (shift, shift, shift // '');
return ("?$name=$val", '?#!') if $op eq '-not';
return '?' . $name . $op . $val;
}
1;
=encoding utf8
lib/API/MikroTik/Response.pm view on Meta::CPAN
package API::MikroTik::Response;
use Mojo::Base '-base';
use API::MikroTik::Sentence;
has data => sub { [] };
has sentence => sub { API::MikroTik::Sentence->new() };
sub parse {
my ($self, $buff) = @_;
my $data = [];
my $sentence = $self->sentence;
while ($$buff) {
my $words = $sentence->fetch($buff);
last if $sentence->is_incomplete;
my $item = {'.tag' => '', '.type' => (shift @$words)};
lib/API/MikroTik/Sentence.pm view on Meta::CPAN
package API::MikroTik::Sentence;
use Mojo::Base '-base';
use Exporter 'import';
our @EXPORT_OK = qw(encode_sentence);
use API::MikroTik::Query 'build_query';
has words => sub { [] };
sub encode_sentence {
shift if ref $_[0];
my ($command, $attr, $query, $tag)
= (shift // '', shift // {}, shift, shift);
my $sentence = _encode_word($command);
$sentence .= _encode_word("=$_=" . ($attr->{$_} // '')) for keys %$attr;
if ($query) {
$sentence .= _encode_word($_) for @{build_query($query)};
}
$sentence .= _encode_word(".tag=$tag") if $tag;
# Closing empty word.
$sentence .= "\x00";
return $sentence;
}
sub fetch {
my ($self, $buff) = @_;
my $words;
if (defined(my $old_buff = delete $self->{_buff})) {
$words = $self->{words};
$$buff = $old_buff . $$buff;
}
else { $words = $self->{words} = [] }
while (my $w = $self->_fetch_word($buff)) { push @$words, $w }
return $words;
}
sub is_incomplete {
return exists $_[0]->{_buff};
}
sub reset {
delete @{$_[0]}{qw(words _buff)};
return $_[0];
}
sub _encode_length {
my $len = shift;
my $packed;
# Screw you, mikrotik engineers, just pack length as 4 bytes. >_<
if ($len < 0x80) {
$packed = pack 'C', $len;
}
elsif ($len < 0x4000) {
$packed = pack 'n', ($len | 0x8000) & 0xffff;
lib/API/MikroTik/Sentence.pm view on Meta::CPAN
elsif ($len < 0x10000000) {
$packed = pack 'N', ($len | 0xe0000000);
}
else {
$packed = pack 'CN', 0xf0, $len;
}
return $packed;
}
sub _encode_word {
return _encode_length(length($_[0])) . $_[0];
}
sub _fetch_word {
my ($self, $buff) = @_;
return $self->{_buff} = '' unless my $buff_bytes = length $$buff;
return do { $self->{_buff} = $$buff; $$buff = ''; }
if $buff_bytes < 5 && $$buff ne "\x00";
my $len = _strip_length($buff);
my $word = substr $$buff, 0, $len, '';
return do { $self->{_buff} = _encode_length($len) . $word; ''; }
if (length $word) < $len;
return $word;
}
sub _strip_length {
my $buff = shift;
my $len = unpack 'C', substr $$buff, 0, 1, '';
if (($len & 0x80) == 0x00) {
return $len;
}
elsif (($len & 0xc0) == 0x80) {
$len &= ~0x80;
$len <<= 8;
t/lib/API/MikroTik/Mockup.pm view on Meta::CPAN
package API::MikroTik::Mockup;
use Mojo::Base '-base';
use API::MikroTik::Response;
use API::MikroTik::Sentence qw(encode_sentence);
use Mojo::IOLoop;
has 'fd';
has ioloop => sub { Mojo::IOLoop->singleton };
has 'port';
has res => sub { API::MikroTik::Response->new() };
has server => sub {
my $self = shift;
my $opts = {address => '127.0.0.1'};
if (defined(my $fd = $self->fd)) {
$opts->{fd} = $fd;
}
else {
$opts->{port} = $self->port;
$opts->{reuse} = 1;
}
my $serv_id = $self->ioloop->server(
$opts => sub {
my ($loop, $stream, $id) = @_;
$self->{h} = $stream;
$stream->on(
read => sub {
my ($stream, $bytes) = @_;
my $data = $self->res->parse(\$bytes);
for (@$data) {
my $cmd = $_->{'.type'} // '';
warn "wrong command \"$cmd\"\n" and next
unless $cmd =~ s/^\//cmd_/;
$cmd =~ s/\//_/g;
eval {
my $resp = '';
$resp .= encode_sentence(@$_) for ($self->$cmd($_));
$stream->write($resp);
} or warn "unhandled command \"$cmd\": $@";
}
}
);
$stream->on(
close => sub { $loop->remove($_) for values %{$self->{timers}} }
);
}
);
return $serv_id;
};
sub cmd_cancel {
my ($self, $attr) = @_;
my $tag = $attr->{'.tag'};
my $cmd_tag = $attr->{'tag'};
return ['!trap', {message => 'unknown command'}, undef, $tag]
unless my $id = delete $self->{timers}{$cmd_tag};
$self->ioloop->remove($id);
return (
['!trap', {category => 2, message => 'interrupted'}, undef, $cmd_tag],
_done($tag), _done($cmd_tag));
}
sub cmd_close_premature {
my ($self, $attr) = @_;
my $sent = encode_sentence('!re', {message => 'response'}, undef,
$attr->{'.tag'});
substr $sent, (length($sent) / 2), -1, '';
$self->{h}->write($sent);
$self->ioloop->timer(0.5 => sub { $self->{h}->close() });
return ();
}
sub cmd_err {
my (undef, $attr) = @_;
my $tag = $attr->{'.tag'};
return ['!trap', {message => 'random error', category => 0}, undef, $tag];
}
sub cmd_login {
my (undef, $attr) = @_;
my $tag = $attr->{'.tag'};
return _done($tag, {ret => '098f6bcd4621d373cade4e832627b4f6'})
unless $attr->{name};
return _done($tag)
if $attr->{name} eq 'test'
&& $attr->{response} eq '00119ce7e093e33497053e73f37a5d3e15';
return ['!fatal', {message => 'cannot log in'}, undef, $tag];
}
sub cmd_nocmd {
return ();
}
sub cmd_resp {
my (undef, $attr) = @_;
my $tag = $attr->{'.tag'};
my $resp = ['!re', _gen_attr(@{$attr}{'.proplist', 'count'}), undef, $tag];
return ($resp, $resp, _done($tag));
}
sub cmd_subs {
my ($self, $attr) = @_;
my $tag = $attr->{'.tag'} // 0;
my $key = $attr->{'key'};
$self->{timers}{$tag} = $self->ioloop->recurring(
0.5 => sub {
$self->{h}
->write(encode_sentence('!re', {key => $key}, undef, $tag));
}
);
return ();
}
sub _done {
return ['!done', $_[1], undef, $_[0]];
}
sub _gen_attr {
my $c = $_[1] // 0;
my $attr = {};
$attr->{$_} = 'attr' . ($c++) for split /,/, ($_[0] // 'prop1,prop2,prop0');
return $attr;
}
1;
t/mikrotik.t view on Meta::CPAN
is_deeply $res, [{message => 'random error', category => 0}],
'right error attributes';
# non-blocking
my $mockup_nb = API::MikroTik::Mockup->new()
->fd($loop->acceptor($mockup->server)->handle->fileno);
$mockup_nb->server;
$api->cmd(
'/resp',
{'.proplist' => 'prop0,prop2', count => 1} => sub {
is_deeply $_[2], _gen_result('prop0,prop2', 1), 'right result';
}
);
# subscriptions
my ($err, $tag);
$res = undef;
$tag = $api->subscribe(
'/subs',
{key => 'nnn'} => sub {
$res = $_[2] unless $err = $_[1];
$api->cancel($tag);
}
);
my ($err1, $err2);
$api->cmd('/err' => sub { $err1 = $_[1] . '1' });
$api->cmd('/err' => sub { $err2 = $_[1] . '2' });
Mojo::IOLoop->timer(1.3 => sub { Mojo::IOLoop->stop() });
Mojo::IOLoop->start();
is_deeply $res, {key => 'nnn'}, 'right result';
is $err, 'interrupted', 'right error';
is $err1, 'random error1', 'right error';
is $err2, 'random error2', 'right error';
done_testing();
sub _gen_result {
my $attr = API::MikroTik::Mockup::_gen_attr(@_);
return [$attr, $attr];
}
t/promises.t view on Meta::CPAN
host => '127.0.0.1',
port => $port,
tls => 1,
);
my $p = $api->cmd_p('/resp');
isa_ok $p, 'Mojo::Promise', 'right result type';
# connection errors
my ($err, $res);
$p->catch(sub { ($err, $res) = @_ })->finally(sub { Mojo::IOLoop->stop() });
Mojo::IOLoop->start();
like $err, qr/IO::Socket::SSL/, 'connection error';
ok !$res, 'no error attributes';
$api->tls(0);
# error
$api->cmd_p('/err')->catch(sub { ($err, $res) = @_ })
->finally(sub { Mojo::IOLoop->stop() });
Mojo::IOLoop->start();
is $err, 'random error', 'right error';
is_deeply $res, [{message => 'random error', category => 0}],
'right error attributes';
# request
$api->cmd_p('/resp')->then(sub { $res = $_[0] })
->finally(sub { Mojo::IOLoop->stop() });
Mojo::IOLoop->start();
is_deeply $res, _gen_result(), 'right result';
done_testing();
sub _gen_result {
my $attr = API::MikroTik::Mockup::_gen_attr(@_);
return [$attr, $attr];
}
is_deeply $r, ['?a=1', '?#!', '?a=2', '?#!', '?a=3', '?#!', '?#&&'],
'-not with arrayref value';
$r = build_query([[], a => 1, [{}, {}, \[]], b => [], c => 5, d => {}]);
is_deeply $r, ['?a=1', '?c=5', '?#|'], 'ignore empty structs';
$r = build_query([a => [{'=', []}, 2, {}]]);
is_deeply $r, ['?a=2'], 'ignore empty structs';
my $err;
$SIG{__WARN__} = sub { $err = $_[0] };
$r = build_query([a => undef, b => [1, undef, 2], c => {'=', undef}]);
ok !$err, 'no warning';
is_deeply $r, ['?a=', '?b=1', '?b=', '?b=2', '?#||', '?c=', '?#||'],
'right result';
done_testing();
t/sentence.t view on Meta::CPAN
# buffer ends at the end of the word, before an empty closing word
$packed = encode_sentence('/one/two', {three => 'four'});
my $tr = substr $packed, -1, 1, '';
is $tr, "\0", 'trailing empty word';
$words = $s->fetch(\$packed);
is_deeply $words, ['/one/two', '=three=four'], 'right results';
ok $s->is_incomplete, 'incomplete is set';
my $err;
$SIG{__WARN__} = sub { $err = $_[0] };
$packed = encode_sentence('/cmd', {argv => undef});
ok !$err, 'no warning';
$words = $s->reset->fetch(\$packed);
is_deeply $words, ['/cmd', '=argv='], 'right results';
done_testing();
( run in 0.317 second using v1.01-cache-2.11-cpan-4d50c553e7e )