API-MikroTik

 view release on metacpan or  search on metacpan

MANIFEST  view on Meta::CPAN

README.md
t/lib/API/MikroTik/Mockup.pm
t/mikrotik-online.t
t/mikrotik.t
t/pod.t
t/pod_coverage.t
t/promises.t
t/query.t
t/response.t
t/sentence.t
META.yml                                 Module YAML meta-data (added by MakeMaker)
META.json                                Module JSON meta-data (added by MakeMaker)

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

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());
        },

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

        },
    );
}

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 {

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)};
        push @$data, $item;

        next unless @$words;

        while (my $w = shift @$words) {
            $item->{$1 || $2} = $3 if ($w =~ /^(?:=([^=]+)|(\.tag))=(.*)/);
        }
    }

    return $self->{data} = $data;
}

1;


=encoding utf8

=head1 NAME

API::MikroTik::Response - Parse responses from a buffer

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

  }

=head1 DESCRIPTION

Parser for API protocol responses.

=head1 ATTRIBUTES

L<API::MikroTik::Response> implements the following attributes.

=head2 data

  my $items = $response->data;

Sentences fetched in last operation;

=head2 sentence

  my $sentence = $response->sentence;
  $response->sentence(API::MikroTik::Sentence->new());

L<API::MikroTik::Sentence> object used to decode sentences from network buffer.

=head1 METHODS

=head2 parse

  my $list = $response->parse(\$buff);

Parses data from a buffer and returns list of hashrefs with attributes for each
sentence. There are some special attributes:

=over 2

=item '.tag'

  '.tag' => 1

Reply tag.

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

Encodes sentence. Attributes is a hashref with attribute-value pairs. Query will
be parsed with L<API::MikroTik::Query/build_query>.

Can be also called as an object method.

=head2 fetch

  my $words = $sentence->fetch(\$buff);

Fetches a sentence from a buffer and parses it into a list of API words. In a
situation when amount of data in the buffer are insufficient to complete the
sentence, already processed words and the remaining buffer will be stored in an
object. On a next call will prepend a buffer with kept data and merge a result
with the one stored from a previous call.


=head2 is_incomplete

  my $done = !$sentence->is_incomplete;

Indicates that a processed buffer was incomplete and remaining amount of data was
insufficient to complete a sentence.

=head2 reset

  my $sentence->reset;

Clears an incomplete status and removes a remaining buffer.

=head1 SEE ALSO

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

    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\": $@";

t/pod_coverage.t  view on Meta::CPAN

use Mojo::Base -strict;

use Test::More;

plan skip_all => 'set TEST_POD to enable this test (developer only!)'
  unless $ENV{TEST_POD};
plan skip_all => 'Test::Pod::Coverage 1.04+ required for this test!'
  unless eval 'use Test::Pod::Coverage 1.04; 1';

# DEPRECATED!
all_pod_coverage_ok({also_private => ['data', 'remaining']});

t/response.t  view on Meta::CPAN

use Test::More;
use API::MikroTik::Response;
use API::MikroTik::Sentence qw(encode_sentence);

my $r = API::MikroTik::Response->new();

my $packed = encode_sentence('!re', {a => 1, b => 2});
$packed .= encode_sentence('!re', {c => 3, d => 4, e => 5}, undef, 3);
$packed .= encode_sentence('!done');

my $data = $r->parse(\$packed);
is_deeply $data,
    [
    {a => '1', b => '2', '.tag' => '',  '.type' => '!re'},
    {e => '5', d => '4', c      => '3', '.tag'  => '3', '.type' => '!re'},
    {'.tag' => '', '.type' => '!done'}
    ],
    'right response';

# reassemble partial buffer
my ($attr, @parts);
$attr->{$_} = $_ x 200 for 1 .. 4;