API-MikroTik
view release on metacpan or search on metacpan
modifying or distributing the Package, you accept this license. Do not
use, modify, or distribute the Package, if you do not accept this
license.
(11) If your Modified Version has been derived from a Modified
Version made by someone other than you, you are nevertheless required
to ensure that your Modified Version complies with the requirements of
this license.
(12) This license does not grant you the right to use any trademark,
service mark, tradename, or logo of the Copyright Holder.
(13) This license includes the non-exclusive, worldwide,
free-of-charge patent license to make, have made, use, offer to sell,
sell, import and otherwise transfer the Package with respect to any
patent claims licensable by the Copyright Holder that are necessarily
infringed by the Package. If you institute patent litigation
(including a cross-claim or counterclaim) against any party alleging
that the Package constitutes direct or contributory patent
infringement, then this Artistic License to you shall terminate on the
date that such litigation is filed.
lib/API/MikroTik.pm view on Meta::CPAN
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;
}
);
lib/API/MikroTik.pm view on Meta::CPAN
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 {
lib/API/MikroTik/Query.pm view on Meta::CPAN
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') {
@expr = @{$$el};
lib/API/MikroTik/Query.pm view on Meta::CPAN
next;
}
else {
@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') ? '|'
: '';
}
lib/API/MikroTik/Query.pm view on Meta::CPAN
# 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) {
my @expr
= ref $_ eq 'HASH'
? _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};
lib/API/MikroTik/Query.pm view on Meta::CPAN
Conditions can be grouped and nested if needed. It's like putting brackets around
them.
# Same thing, but with prefixes
my $query = {
-and => [mtu => 1460, 'actual-mtu' => 1460],
-or => {running => 'false', disabled => 'true'}
};
You can change logic applied to a block by using keywords. Those keywords
will go outside for blocks that affect multiple attributes, or ...
# !(type = 'ether') AND !(type = 'wlan')
# Will produce the same result
my $query = {type => [-and => {-not => 'ether'}, {-not => 'wlan'}]};
$query = {type => {-not => [-and => 'ether', 'wlan']}};
# Wrong, second condition will replace first
$query = {type => {-not => 'ether', -not => 'wlan'}};
t/lib/API/MikroTik/Mockup.pm view on Meta::CPAN
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'};
t/mikrotik.t view on Meta::CPAN
tls => 1,
ioloop => $loop,
);
# check connection
$api->tls(1);
my $res = $api->cmd('/resp');
like $api->error, qr/IO::Socket::SSL/, 'connection error';
$api->tls(0);
# check login
$api->password('');
$res = $api->cmd('/resp');
like $api->error, qr/cannot log/, 'login error';
$api->password('tset');
# timeouts
$api->timeout(1);
my $ctime = steady_time();
$res = $api->cmd('/nocmd');
ok((steady_time() - $ctime) < 1.1, 'timeout ok');
$api->timeout(0.5);
$ctime = steady_time();
$res = $api->cmd('/nocmd');
use Test::More;
use API::MikroTik::Query 'build_query';
my $r = build_query({a => 1, b => 2, c => 3, d => 4});
is_deeply $r, ['?a=1', '?b=2', '?c=3', '?d=4', '?#&&&'], 'simple AND';
$r = build_query([a => 1, b => 2, c => 3]);
is_deeply $r, ['?a=1', '?b=2', '?c=3', '?#||'], 'simple OR';
$r = build_query({-and => [a => 1, b => 2, c => 3]});
is_deeply $r, ['?a=1', '?b=2', '?c=3', '?#&&'], 'specific logic AND';
$r = build_query({-or => {a => 1, b => 2, c => 3, d => 4}});
is_deeply $r, ['?a=1', '?b=2', '?c=3', '?d=4', '?#|||'], 'specific logic OR';
$r = build_query({-or => {a => 1, b => 2}, -and => [c => 3, d => 4, e => 5]});
is_deeply $r, ['?c=3', '?d=4', '?e=5', '?#&&', '?a=1', '?b=2', '?#|', '?#&'],
'nested ops';
$r = build_query(
[
-or => {a => 1, b => 2, -and => {e => 5, f => 6, g => 7}},
-and => [c => 3, d => 4],
{h => 8, i => 9}
'literal query';
$r = build_query();
is_deeply $r, [], 'empty query';
$r = build_query({a => [1, 2, 3]});
is_deeply $r, ['?a=1', '?a=2', '?a=3', '?#||'], 'arrayref value';
$r = build_query([a => [-and => 1, 2, 3]]);
is_deeply $r, ['?a=1', '?a=2', '?a=3', '?#&&'],
'arrayref value with specific logic';
$r = build_query({a => {'>', [1, 2, 3]}});
is_deeply $r, ['?a>1', '?a>2', '?a>3', '?#||'],
'arrayref value with specific operator';
$r = build_query({a => {'=', [-and => 1, 2, 3]}});
is_deeply $r, ['?a=1', '?a=2', '?a=3', '?#&&'],
'arrayref value with logic and operator';
$r = build_query({a => {'<' => 3, '>' => 1}});
is_deeply $r, ['?a<3', '?a>1', '?#&'], 'hashref value';
$r = build_query({a => [-or => {'>', 1}, {'<', 2}, {'>', 3, '<', 4}]});
is_deeply $r, ['?a>1', '?a<2', '?a<4', '?a>3', '?#&', '?#||'],
'list of hashrefs';
$r = build_query({a => {-not => 1}, -has => 'b', -has_not => 'c'});
is_deeply $r, ['?b', '?-c', '?a=1', '?#!', '?#&&'], 'special cases';
( run in 1.451 second using v1.01-cache-2.11-cpan-49f99fa48dc )