File: LogConnection.pm

package info (click to toggle)
libevent-rpc-perl 1.08-2%2Bdeb9u1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 520 kB
  • sloc: perl: 2,353; makefile: 2
file content (104 lines) | stat: -rw-r--r-- 2,310 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
package Event::RPC::LogConnection;

use Carp;

use strict;
use utf8;

use Socket;

my $LOG_CONNECTION_ID;

sub get_cid                     { shift->{cid}                          }
sub get_sock                    { shift->{sock}                         }
sub get_server                  { shift->{server}                       }

sub get_watcher                 { shift->{watcher}                      }
sub set_watcher                 { shift->{watcher}              = $_[1] }

sub new {
    my $class = shift;
    my ($server, $sock) = @_;

    my $cid = ++$LOG_CONNECTION_ID;

    my $self = bless {
        cid     => $cid,
        sock    => $sock,
        server  => $server,
        watcher => undef,
    }, $class;

    $self->{watcher} = $server->get_loop->add_io_watcher(
        fh   => $sock,
        poll => 'r',
        cb   => sub { $self->input; 1 },
        desc => "log reader $cid",
    );

    $self->get_server->log (2,
        "Got new logger connection. Connection ID is $cid"
    );

    return $self;
}

sub disconnect {
    my $self = shift;

    my $sock = $self->get_sock;
    $self->get_server->get_logger->remove_fh($sock)
            if $self->get_server->get_logger;
    $self->get_server->get_loop->del_io_watcher($self->get_watcher);
    $self->set_watcher(undef);
    close $sock;

    $self->get_server->set_log_clients_connected ( $self->get_server->get_log_clients_connected - 1 );
    delete $self->get_server->get_logging_clients->{$self->get_cid};
    $self->get_server->log(2, "Log client disconnected");

    1;
}

sub input {
    my $self = shift;

    my $buffer;
    $self->disconnect
        if not sysread($self->get_sock, $buffer, 4096);

    1;
}

1;

__END__

=encoding utf8

=head1 NAME

Event::RPC::LogConnection - Represents a logging connection

=head1 SYNOPSIS

  # Internal module. No documented public interface.

=head1 DESCRIPTION

Objects of this class are created by Event::RPC server if a
client connects to the logging port of the server. It's an
internal module and has no public interface.

=head1 AUTHORS

  Jörn Reder <joern AT zyn.de>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005-2015 by Jörn Reder <joern AT zyn.de>.

This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.

=cut