Skip to content

Instantly share code, notes, and snippets.

@ktat
Created May 22, 2011 06:48
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save ktat/985234 to your computer and use it in GitHub Desktop.
Save ktat/985234 to your computer and use it in GitHub Desktop.
WebSocket perl client
#!/usr/bin/perl
use strict;
use warnings;
use POSIX ":sys_wait_h";
use Protocol::WebSocket::Handshake::Client;
use Protocol::WebSocket::Frame;
use IO::Socket;
use open ':utf8';
use open ':std';
$| = 1;
run();
sub run {
my $s = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => 50000, Proto => 'tcp');
if ($s->connected) {
my $hc = Protocol::WebSocket::Handshake::Client->new(url => 'ws://127.0.0.1:50000');
my $parent_pid = $$;
print $s $hc->to_string;
if (my $pid = fork()) {
# parent process
warn "parent:" . $parent_pid;
warn "child :" . $pid;
local @SIG{qw/INT TERM ALRM/} = (sub { client_exit($s); }) x 3;
while (my $msg = <STDIN>) {
if (waitpid (-1, WNOHANG)) {
warn "child($pid) is gone (server is down ?)";
client_exit($s)
}
last unless $msg;
chomp($msg);
my $frame = Protocol::WebSocket::Frame->new($msg);
print $s $frame->to_string;
}
# close connection.
client_exit($s);
} elsif (defined $pid) {
# child process
close STDOUT; close STDIN; close STDERR;
while (my $l = $s->getline) {
print $l;
}
# send INT signal to parent process.
kill 2, $parent_pid;
}
}
}
sub client_exit {
my $s = shift;
if ($s->connected) {
# close connection
print $s "\xFF\x00";
close $s
}
if (my $child_pid = wait -1, WNOHANG) {
kill 9, $child_pid;
}
exit;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment