view release on metacpan or  search on metacpan

Ace/SocketServer.pm  view on Meta::CPAN

  }
  return $body;
}

sub write {
  my $self = shift;
  my $data = shift;
  unless ($self->_send_msg($data,1)) {
    $self->{status} = STATUS_ERROR;
    return _error("Write to socket server failed: $!");
  }
  $self->{status} = STATUS_PENDING;
  $self->{encoring} = 0;
  return 1;
}

sub _error {
  $Ace::Error = shift;
  return;
}

# return socket (read only)
sub socket { $_[0]->{socket} }

# ----------------------------- low level -------------------------------
sub _do_encore {
  my $self = shift;
  unless ($self->_send_msg('encore')) {
    $self->{status} = STATUS_ERROR;
    return _error("Write to socket server failed: $!");
  }
  $self->{status} = STATUS_PENDING;
  return 1;
}
sub _handshake {
  my $self = shift;
  my ($user,$pass) = @_;
  $self->_send_msg(ACESERV_CLIENT_HELLO);
  my ($msg,$nonce) = $self->_recv_msg('strip');
  return unless $msg eq ACESERV_MSGOK;
  # hash username and password
  my $authdigest = md5_hex(md5_hex($user . $pass).$nonce);
  $self->_send_msg("$user $authdigest");
  my $body;
  ($msg,$body) = $self->_recv_msg('strip');
  return _error("server: $body") unless $body eq ACESERV_SERVER_HELLO;
  return 1;
}

sub _send_msg {
  my ($self,$msg,$parse) = @_;
  return unless my $sock = $self->{socket};
  local $SIG{'PIPE'} = 'IGNORE';
  $msg .= "\0";  # add terminating null
  my $request;
  if ($parse) {
    $request = ACESERV_MSGDATA;
  } else {
    $request = $msg eq "encore\0" ? ACESERV_MSGENCORE : ACESERV_MSGREQ;
  }
  my $header  = pack HEADER,WORDORDER_MAGIC,length($msg),0,$self->{client_id},0,$request;
  print $sock $header,$msg;
}

sub _recv_msg {
  my $self = shift;
  my $strip_null = shift;
  return unless my $sock = $self->{socket};
  my ($header,$body);
  my $bytes = CORE::read($sock,$header,HEADER_LEN);
  unless ($bytes > 0) {
    $self->{status} = STATUS_ERROR;
    return _error("Connection closed by remote server: $!");
  }
  my ($magic,$length,$junk1,$clientID,$junk2,$msg) = unpack HEADER,$header;
  $self->{client_id} ||= $clientID;
  $msg =~ s/\0*$//;
  $self->{last_msg} = $msg;
  if ($length > 0) {
    return _error("read of body failed: $!" ) 
      unless CORE::read($sock,$body,$length);
    $body =~ s/\0*$// if defined($strip_null) && $strip_null;
    return ($msg,$body);
  } else {
    return $msg;
  }
}

1;

__END__