view release on metacpan or  search on metacpan

lib/API/MikroTik.pm  view on Meta::CPAN

package API::MikroTik;
use Mojo::Base '-base';

use API::MikroTik::Response;
use API::MikroTik::Sentence qw(encode_sentence);
use Carp ();
use Mojo::Collection;
use Mojo::IOLoop;
use Mojo::Util qw(md5_sum deprecated);
use Scalar::Util 'weaken';

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 {

lib/API/MikroTik.pm  view on Meta::CPAN

        }
        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

API::MikroTik - Non-blocking interface to MikroTik API

=head1 SYNOPSIS

  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, $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;

Keeps an error from last L</command> call. Empty string on successful commands.

=head2 host

  my $host = $api->host;
  $api     = $api->host('border-gw.local');

Host name or IP address to connect to. Defaults to C<192.168.88.1>.

=head2 ioloop

  my $loop = $api->ioloop;
  $api     = $api->loop(Mojo::IOLoop->new());

Event loop object to use for blocking operations, defaults to L<Mojo::IOLoop>
object.

=head2 password

  my $pass = $api->password;
  $api     = $api->password('secret');

Password for authentication. Empty string by default.

=head2 port

  my $port = $api->port;
  $api     = $api->port(8000);

API service port for connection. Defaults to C<8729> and C<8728> for TLS and
clear text connections respectively.

=head2 timeout

  my $timeout = $api->timeout;
  $api        = $api->timeout(15);

Timeout in seconds for sending request and receiving response before command
will be canceled. Default is C<10> seconds.

=head2 tls

  my $tls = $api->tls;