view release on metacpan or search on metacpan
(2) You may Distribute verbatim copies of the Source form of the
Standard Version of this Package in any medium without restriction,
either gratis or for a Distributor Fee, provided that you duplicate
all of the original copyright notices and associated disclaimers. At
your discretion, such verbatim copies may or may not include a
Compiled form of the Package.
(3) You may apply any bug fixes, portability changes, and other
modifications made available from the Copyright Holder. The resulting
Package will still be considered the Standard Version, and as such
will be subject to the Original License.
Distribution of Modified Versions of the Package as Source
(4) You may Distribute your Modified Version as Source (either gratis
or for a Distributor Fee, and with or without a Compiled form of the
Modified Version) provided that you clearly document how it differs
from the Standard Version, including, but not limited to, documenting
any non-standard features, executables, or modules, and provided that
you do at least ONE of the following:
build stand-alone binary or bytecode versions of applications that
include the Package, and Distribute the result without restriction,
provided the result does not expose a direct interface to the Package.
Items That are Not Considered Part of a Modified Version
(9) Works (including, but not limited to, modules and scripts) that
merely extend or make use of the Package, do not, by themselves, cause
the Package to be a Modified Version. In addition, such works are not
considered parts of the Package itself, and are not subject to the
terms of this license.
General Provisions
(10) Any use, modification, and distribution of the Standard or
Modified Versions is governed by this Artistic License. By using,
modifying or distributing the Package, you accept this license. Do not
use, modify, or distribute the Package, if you do not accept this
license.
# API::MikroTik - Non-blocking interface to MikroTik API. [](https://travis-ci.org/anparker/api-mikrotik)
Blocking and non-blocking API interface with queries, command subscriptions
and Promises/A+ (courtesy of [Mojo::IOLoop](http://github.com/kraih/mojo/)).
```perl
my $api = API::MikroTik->new();
# Blocking
my $list = $api->command(
'/interface/print',
{'.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'};
push @{$r->{data} ||= Mojo::Collection->new()}, $_
if %$_ && !$r->{subscription};
if ($type eq '!re' && $r->{subscription}) {
$r->{cb}->($self, '', $_);
}
elsif ($type eq '!done') {
$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>.
=head1 ATTRIBUTES
L<API::MikroTik> implements the following attributes.
=head2 error
my $last_error = $api->error;
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;
$len += unpack 'C', substr $$buff, 0, 1, '';
}
elsif (($len & 0xe0) == 0xc0) {
$len &= ~0xc0;
$len <<= 16;
$len += unpack 'n', substr $$buff, 0, 2, '';
}
elsif (($len & 0xf0) == 0xe0) {
$len = unpack 'N', pack('C', ($len & ~0xe0)) . substr($$buff, 0, 3, '');
}
elsif (($len & 0xf8) == 0xf0) {
$len = unpack 'N', substr $$buff, 0, 4, '';
}
return $len;
}
1;
=encoding utf8
=head1 NAME
lib/API/MikroTik/Sentence.pm view on Meta::CPAN
my $tag = 1;
my $bytes = encode_sentence($command, $attr, $query, $tag);
my $sentence = API::MikroTik::Sentence->new();
my $words = $sentence->fetch(\$bytes);
say $_ for @$words;
=head1 DESCRIPTION
Provides subroutines for encoding API sentences and parsing them back into words.
=head1 METHODS
=head2 encode_sentence
my $bytes = encode_sentence($command, $attr, $query, $tag);
Encodes sentence. Attributes is a hashref with attribute-value pairs. Query will
be parsed with L<API::MikroTik::Query/build_query>.
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/response.t view on Meta::CPAN
{'.tag' => '', '.type' => '!done'}
],
'right response';
# reassemble partial buffer
my ($attr, @parts);
$attr->{$_} = $_ x 200 for 1 .. 4;
$packed = encode_sentence('!re', $attr);
$packed .= $packed . $packed . $packed;
push @parts, (substr $packed, 0, $_, '') for (900, 700, 880, 820);
$attr->{'.tag'} = '';
$attr->{'.type'} = '!re';
my $w = $r->parse(\$parts[0]);
is_deeply $w, [$attr], 'right result';
ok $r->sentence->is_incomplete, 'incomplete is set';
$w = $r->parse(\$parts[1]);
is_deeply $w, [], 'right result';
ok $r->sentence->is_incomplete, 'incomplete is set';
t/sentence.t view on Meta::CPAN
my $words = $s->fetch(\$packed);
is shift @$words, '/cmd/1', 'right command';
is_deeply [sort @$words], ['=a=1', '=b=2'], 'right attributes';
$words = $s->fetch(\$packed);
is shift @$words, '/cmd/2', 'right command';
is_deeply [sort @$words], ['.tag=11', '=c=foo', '=d=bar', '?e=baz'],
'right attributes';
# buffer ends in the middle of a word
$packed = encode_sentence('/one/two/three', {test => 1, another => 2});
substr $packed, 20, 20, '';
$words = $s->fetch(\$packed);
is_deeply $words, ['/one/two/three'], 'right results';
ok $s->is_incomplete, 'incomplete is set';
# reset
$s->reset;
ok !$s->is_incomplete, 'incomplete is not longer set';
# 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();