Serveur Soket tcp interactif
Bonjour , je doit conçevoir un serveur Socket Tcp, acceptant de multiple connexion sur différent ports (si besoin), et entièrement interactif
J'ai fouillé sur le CPAN j'ai trouver ce module http://search.cpan.org/~rhandom/Net-...r/Multiplex.pm
Qui me conviendrait mais , après avoir lue et relue la documentation , j'ai toujours rien comprit :? :oops: .
L'exemple suivant est fournit avec le module mais je voie pas comment l'adapter a mes besoins
Code:
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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
| #!/usr/bin/perl -w
package SampleChatServer;
use strict;
use Net::Server::Multiplex;
use vars qw(@ISA);
@ISA = qw(Net::Server::Multiplex);
# Demonstrate a Net::Server style hook
sub allow_deny_hook {
my $self = shift;
my $prop = $self->{server};
my $sock = $prop->{client};
return 1 if $prop->{peeraddr} =~ /^127\./;
return 0;
}
# Another Net::Server style hook
sub request_denied_hook {
print "Go away!\n";
print STDERR "DEBUG: Client denied!\n";
}
# IO::Multiplex style callback hook
sub mux_connection {
my $self = shift;
my $mux = shift;
my $fh = shift;
my $peer = $self->{peeraddr};
# Net::Server stores a connection counter in the {requests} field.
$self->{id} = $self->{net_server}->{server}->{requests};
# Keep some values that I might need while the {server}
# property hash still contains the current client info
# and stash them in my own object hash.
$self->{peerport} = $self->{net_server}->{server}->{peerport};
# Net::Server directs STDERR to the log_file
print STDERR "DEBUG: Client [$peer] (id $self->{id}) just connected...\n";
# Notify everyone that the client arrived
$self->broadcast($mux,"JOIN: (#$self->{id}) from $peer\r\n");
# STDOUT is tie'd to the correct IO::Multiplex handle
print "Welcome, you are number $self->{id} to connect.\r\n";
# Try out the timeout feature of IO::Multiplex
$mux->set_timeout($fh, 20);
# This is my state and will be unique to this connection
$self->{state} = "junior";
}
# If this callback is ever hooked, then the mux_connection callback
# is guaranteed to have already been run once (if defined).
sub mux_input {
my $self = shift;
my $mux = shift;
my $fh = shift;
my $in_ref = shift; # Scalar reference to the input
my $peer = $self->{peeraddr};
my $id = $self->{id};
print STDERR "DEBUG: input from [$peer] ready for consuming.\n";
# Process each line in the input, leaving partial lines
# in the input buffer
while ($$in_ref =~ s/^(.*?)\r?\n//) {
next unless $1;
my $message = "[$id - $peer] $1\r\n";
$self->broadcast($mux, $message);
print " - sent ".(length $message)." byte message\r\n";
}
if ($self->{state} eq "senior") {
$mux->set_timeout($fh, 40);
}
}
# It is possible that this callback will be called even
# if mux_connection or mux_input were never called. This
# occurs when allow_deny or allow_deny_hook fails to
# authorize the client. The callback object will be the
# default listen object instead of a client unique object.
# However, both object should contain the $self->{net_server}
# key pointing to the original Net::Server object.
sub mux_close {
my $self = shift;
my $mux = shift;
my $fh = shift;
my $peer = $self->{peeraddr};
# If mux_connection has actually been run
if (exists $self->{id}) {
$self->broadcast($mux,"LEFT: (#$self->{id}) from $peer\r\n");
print STDERR "DEBUG: Client [$peer] (id $self->{id}) closed connection!\n";
}
}
# This callback will happen when the mux->set_timeout expires.
sub mux_timeout {
my $self = shift;
my $mux = shift;
my $fh = shift;
print STDERR "DEBUG: HEARTBEAT!\n";
if ($self->{state} eq "junior") {
print "Whoa, you must have a lot of patience. You have been upgraded.\r\n";
$self->{state} = "senior";
} elsif ($self->{state} eq "senior") {
print "If you don't want to talk then you should leave. *BYE*\r\n";
close(STDOUT);
}
$mux->set_timeout($fh, 40);
}
# Routine to send a message to all clients in a mux.
sub broadcast {
my $self = shift;
my $mux = shift;
my $msg = shift;
foreach my $fh ($mux->handles) {
# NOTE: All the client unique objects can be found at
# $mux->{_fhs}->{$fh}->{object}
# In this example, the {id} would be
# $mux->{_fhs}->{$fh}->{object}->{id}
print $fh $msg;
}
}
__PACKAGE__->run(); |
Est ce que je fait fausse route et ce module est bon ? ou sinon
Pouvez vous m'aider a faire ce serveur ???
meci !!!!
