view release on metacpan or  search on metacpan

lib/Inferno/RegMgr/TCP.pm  view on Meta::CPAN

        Is_connected=> 0,
    });
    return $io;
}

sub _cb_event {
    my ($io, $e, $err) = @_;
    if (!$io->{Is_connected}) {
        if ($e & IN) {
            if ($io->{in_buf} =~ s/\AREADY\n//xms) {
                $io->{Is_connected} = 1;
                $e |= CONNECTED;
            }
            else {
                $err = "Bug in registry: expected 'READY\\n', got '$io->{in_buf}'";
            }
        }
    }
    else {
        if ($err) {
            $e |= EOF;
        }
    }
    if ($e & IN && $io->{in_buf} !~ s/.*\n//xms) {
        $e &= ~IN;
        if (length $io->{in_buf} > KiB) {
            $err = 'Bug in registry: got 1 KiB without \\n';
        }
    }
    if ($e & EOF || $err) {
        $io->close();
    }
    if ($e || $err) {
        run_callback( @{ $io->{User_cb} }, $e, $err );
    }
    return;
}

sub open_new {
    my ($self, $opt) = @_;
    croak '{name} required' if !defined $opt->{name};
    croak '{cb} required'   if !defined $opt->{cb};
    my $io = IO::Stream->new({
        host        => $self->{host},
        port        => $self->{port_new},
        cb          => \&_cb_new,
        wait_for    => 0,
        User_cb     => [ $opt->{cb}, $opt->{method} ],
    });
    $io->write(sprintf "%s %s\n",  quote($opt->{name}), attr($opt->{attr}));
    return $io;
}

sub _cb_new {
    my ($io, $e, $err) = @_;
    $io->close();
    run_callback( @{ $io->{User_cb} }, $err );
    return;
}

sub update {
    my ($self, $io, $attr) = @_;
    $io->write(sprintf "%s\n", attr($attr));
    return;
}

sub open_find {
    my ($self, $opt) = @_;
    croak '{cb} required'   if !defined $opt->{cb};
    my $io = IO::Stream->new({
        host        => $self->{host},
        port        => $self->{port_find},
        cb          => \&_cb_find,
        wait_for    => EOF,
        in_buf_limit=> KiB*KiB,
        User_cb     => [ $opt->{cb}, $opt->{method} ],
    });
    $io->write(sprintf "%s\n", attr($opt->{attr}));
    return $io;
}

sub _cb_find {
    my ($io, $e, $err) = @_;
    my $svc;
    if ($e & EOF && !$err) {
        ($svc, $err) = parse_svc($io->{in_buf});
    }
    $io->close();
    run_callback( @{ $io->{User_cb} }, $svc, $err );
    return;
}


1; # Magic true value required at end of module
__END__

=encoding utf8

=head1 NAME

Inferno::RegMgr::TCP - Access OS Inferno's registry(4) files using TCP ports


=head1 VERSION

This document describes Inferno::RegMgr::TCP version v1.0.0


=head1 SYNOPSIS

 use Scalar::Util qw( weaken );
 use EV;
 use IO::Stream;
 use Inferno::RegMgr::TCP;

 my $reg = Inferno::RegMgr::TCP->new({ host => 'localhost' });

 $reg->open_event({
     cb   => \&cb_event,
 });