perl websocket client WIP

Signed-off-by: Bill Erickson <berickxx@gmail.com>

diff --git a/src/perl/lib/OpenSRF/Utils/WebSocketsClient.pm b/src/perl/lib/OpenSRF/Utils/WebSocketsClient.pm
deleted file mode 100644 (file)
index da4be56..0000000
--- a/src/perl/lib/OpenSRF/Utils/WebSocketsClient.pm
+++ /dev/null
@@ -1,193 +0,0 @@
-package OpenSRF::Utils::WebSocketsClient;
-# -------------------------------------------------------------
-# Copyright (C) 2016, King County Library System
-# Bill Erickson <berickxx@gmail.com>
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-# -------------------------------------------------------------
-#
-# WebSocketsClient library.
-#
-# SSL only for now.
-#
-# -------------------------------------------------------------
-use strict;
-use warnings;
-use IO::Socket::SSL;
-use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
-use Protocol::WebSocket::Client;
-use OpenSRF::Utils::JSON;
-
-sub new {
-    my ($class, %args) = @_;
-
-    my $self = {
-        host => $args{host} || 'localhost',
-        port => $args{port} || 7682,
-        path => $args{path} || '/osrf-websocket-translator',
-        ssl_params => $args{ssl_params} || {},
-        connected => 0,
-        responses => []
-    };
-
-    return bless($self, $class);
-}
-
-sub connect {
-    my $self = shift;
-
-    $self->connect_socket or return undef;
-
-    my $url = sprintf("wss://%s:%d", $self->{host}, $self->{port});
-    $url .= '/' . $self->{path} if $self->{path};
-
-    my $client = Protocol::WebSocket::Client->new(
-        url => $url,
-        on_write => sub {
-            my ($client, $data) = @_;
-            $self->{socket}->print($data);
-        },
-        on_connect => sub {
-            my $client = shift;
-            $self->{connected} = 1;
-        },
-        on_error => sub {
-            my ($client, $error) = @_;
-            warn "ERROR: $error\n";
-            $self->disconnect;
-        }
-    );
-
-    $client->on(
-        # add resposnes to the response queue
-        read => sub {
-            my ($client, $data) = @_;
-            push(@{$self->{responses}}, 
-                OpenSRF::Utils::JSON->JSON2perl($data));
-        }
-    );
-
-    $self->{client} = $client; # needed in connect/recv callback
-
-    $client->connect;
-
-    while (!$self->{connected}) { $self->recv(-1) }
-
-    return 1;
-}
-
-sub connect_socket {
-    my $self = shift;
-
-    my $sock = IO::Socket::SSL->new(
-        PeerHost => $self->{host},
-        PeerPort => int($self->{port}),
-        Proto    => 'tcp',
-        %{$self->{ssl_params}}
-    );
-
-    return $self->{socket} = $sock if $sock && $sock->connected;
-
-    warn "SSL socket connection failed to ".
-        $self->{host}.":".$self->{port}." => $!\n";
-
-    return undef;
-}
-
-sub send {
-    my ($self, $msg) = @_;
-    my $json = OpenSRF::Utils::JSON->perl2JSON($msg);
-    $self->{client}->write($json);
-}
-
-sub next_msg {
-    my $self = shift;
-    return shift @{$self->{responses}};
-}
-
-sub peek_msg {
-    my $self = shift;
-    return (@{$self->{responses}} > 0);
-}
-
-sub recv {
-    my ($self, $timeout) = @_;
-    return $self->next_msg if $self->peek_msg;
-
-    $timeout ||= 0;
-    $timeout = undef if $timeout < 0;
-    my $socket = $self->{socket};
-
-    set_block($socket);
-    
-    # build the select readset
-    my $infile = '';
-    vec($infile, $socket->fileno, 1) = 1;
-
-    my $nfound = select($infile, undef, undef, $timeout);
-    return undef if !$nfound or $nfound == -1;
-
-    # now slurp the data off the socket
-    my $buf;
-    my $read_size = 1024;
-    my $nonblock = 0;
-    my $nbytes;
-    my $first_read = 1;
-
-    while($nbytes = sysread($socket, $buf, $read_size)) {
-        $self->{client}->read($buf);
-        if($nbytes < $read_size or $self->peek_msg) {
-            set_block($socket) if $nonblock;
-            last;
-        }
-        set_nonblock($socket) unless $nonblock;
-        $nonblock = 1;
-        $first_read = 0;
-    }
-
-    if ($first_read and defined $nbytes and $nbytes == 0) {
-        # if the first read on an active socket is 0 bytes, 
-        # the socket has been disconnected from the remote end. 
-        die "Disconnected from Jabber server\n";
-    }
-
-    return $self->next_msg;
-}
-
-sub disconnect {
-    my $self = shift;
-    $self->{connected} = 0;
-    return unless $self->{client};
-    $self->{client}->disconnect;
-    delete $self->{client};
-}
-
-# -----------------------------------------------------------
-# Puts a file handle into blocking mode
-# -----------------------------------------------------------
-sub set_block {
-    my $fh = shift;
-    my  $flags = fcntl($fh, F_GETFL, 0);
-    $flags &= ~O_NONBLOCK;
-    fcntl($fh, F_SETFL, $flags);
-}
-
-# -----------------------------------------------------------
-# Puts a file handle into non-blocking mode
-# -----------------------------------------------------------
-sub set_nonblock {
-    my $fh = shift;
-    my  $flags = fcntl($fh, F_GETFL, 0);
-    fcntl($fh, F_SETFL, $flags | O_NONBLOCK);
-}
-
-1;
-