Skip to content

Instantly share code, notes, and snippets.

@masak
Created August 22, 2010 09:34
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save masak/543580 to your computer and use it in GitHub Desktop.
Save masak/543580 to your computer and use it in GitHub Desktop.
diff --git a/src/core/IO/Socket.pm b/src/core/IO/Socket.pm
index 2373b4b..3353df3 100644
--- a/src/core/IO/Socket.pm
+++ b/src/core/IO/Socket.pm
@@ -1,34 +1,93 @@
-use v6;
-
-role IO::Socket {
- has $!PIO;
- has $!buffer = '';
-
- method recv (Int $bufsize = Inf) {
- fail('Socket not available') unless $!PIO;
- my $received;
- while $bufsize > $!buffer.bytes {
- $received = $!PIO.recv();
- last unless $received.chars;
- $!buffer ~= $received;
- }
- if $bufsize == Inf {
- $received = $!buffer;
- $!buffer = '';
- } else {
- $received = $!buffer.substr(0, $bufsize);
- $!buffer .= substr($bufsize);
- }
- return $received;
- }
-
- method send (Str $string) {
- fail("Not connected") unless $!PIO;
- return $!PIO.send($string);
- }
-
- method close () {
- fail("Not connected!") unless $!PIO;
- return $!PIO.close();
- }
+
+class IO::Socket
+{
+ has $!PIO;
+ has @!buf;
+
+ method open (Str $hostname, Int $port) { ... }
+
+ method close() { ... }
+
+ # sugar for backward compatibility
+ method recv(Int $bytes, Str $enc = 'UTF-8') {
+ return self.read($bytes).decode($enc);
+ }
+ method send(Str $str) {
+ self.write($str);
+ }
+
+
+ multi method write(Str $str) {
+ fail("Not connected") unless $!PIO;
+ return $!PIO.send($str);
+ }
+
+ multi method write(Buf $buf) {
+ fail("Not connected") unless $!PIO;
+ my @contents = $buf.contents;
+ my $pio = $!PIO;
+ Q:PIR {
+ $P0 = find_lex '@contents'
+
+ .local pmc bb
+ .local string s
+ bb = new ['ByteBuffer']
+ .local pmc it
+ .local int i
+ it = iter $P0
+ i = 0
+ loop:
+ unless it goto done
+ $P1 = shift it
+ $I1 = $P1
+ bb[i] = $I1
+ inc i
+ goto loop
+ done:
+ s = bb.'get_string_as'(binary:"")
+ .local pmc pio
+ pio = find_lex '$pio'
+ pio = deref_unless_object pio
+ pio.'send'(s)
+ };
+ @contents.elems;
+ }
+
+ method read(Int $bytes) {
+ fail("Not connected") unless $!PIO;
+ while(@!buf.elems < $bytes) {
+ my @r = self._read();
+ #say "DBG> read "~@r.perl~" --> "~@!buf.perl;
+ push @!buf, @r;
+ }
+ my $r = Buf.new(@!buf[0..^$bytes]);
+ @!buf = @!buf[$bytes..^@!buf.elems];
+ #say "DBG> returning "~$r.perl~" remains "~@!buf.perl;
+ return $r;
+ }
+
+ method _read() {
+ my $pio = $!PIO;
+ my @bytes = Q:PIR {
+ .local int byte
+ .local pmc bytebuffer, it, result
+ .local pmc pio
+ pio = find_lex '$pio'
+ pio = deref_unless_object pio
+ $S0 = pio.'recv'()
+ bytebuffer = new ['ByteBuffer']
+ bytebuffer = $S0
+
+ result = new ['Parcel']
+ it = iter bytebuffer
+ bytes_loop:
+ unless it goto done
+ byte = shift it
+ push result, byte
+ goto bytes_loop
+ done:
+ %r = result
+ };
+ return @bytes;
+ }
}
diff --git a/src/core/IO/Socket/INET.pm b/src/core/IO/Socket/INET.pm
index c4214c1..113bfcb 100644
--- a/src/core/IO/Socket/INET.pm
+++ b/src/core/IO/Socket/INET.pm
@@ -1,71 +1,81 @@
-class IO::Socket::INET is Cool does IO::Socket {
- method open (Str $hostname, Int $port) {
+class IO::Socket::INET is IO::Socket
+{
+ method open (Str $hostname, Int $port)
+ {
+ my $s = Q:PIR {
+ .include "socket.pasm"
+ .local pmc sock
+ .local pmc address
+ .local string hostname
+ .local int port
+ .local string buf
+ .local int ret
- my $s = Q:PIR {
- .include "socket.pasm"
- .local pmc sock
- .local pmc address
- .local string hostname
- .local int port
- .local string buf
- .local int ret
+ .local pmc self
+ self = find_lex 'self'
- .local pmc self
- self = find_lex 'self'
+ $P0 = find_lex "$hostname"
+ hostname = $P0
- $P0 = find_lex "$hostname"
- hostname = $P0
+ $P0 = find_lex "$port"
+ port = $P0
- $P0 = find_lex "$port"
- port = $P0
+ # Create the socket handle
+ sock = root_new ['parrot';'Socket']
+ $P1 = new 'Integer'
+ unless sock goto ERR
+ sock.'socket'(.PIO_PF_INET, .PIO_SOCK_STREAM, .PIO_PROTO_TCP)
- # Create the socket handle
- sock = root_new ['parrot';'Socket']
- $P1 = new 'Integer'
- unless sock goto ERR
- sock.'socket'(.PIO_PF_INET, .PIO_SOCK_STREAM, .PIO_PROTO_TCP)
+ # Pack a sockaddr_in structure with IP and port
+ address = sock.'sockaddr'(hostname, port)
+ $P1 = sock.'connect'(address)
+ setattribute self, '$!PIO', sock
+ goto DONE
+ ERR:
+ $P1 = -1
+ DONE:
+ %r = $P1
+ };
+ }
- # Pack a sockaddr_in structure with IP and port
- address = sock.'sockaddr'(hostname, port)
- $P1 = sock.'connect'(address)
- setattribute self, '$!PIO', sock
- goto DONE
- ERR:
- $P1 = -1
- DONE:
- %r = $P1
- };
- unless $s==0 { fail "IO::Socket::INET Couldn't create socket."; }
- return 1;
- }
+ # TODO invoke close if $!PIO on DESTROY ?
+ method close() {
+ $!PIO.close();
+ $!PIO = 0;
+ }
- method socket(Int $domain, Int $type, Int $protocol) {
- return IO::Socket::INET.new( :PIO(Q:PIR {{
- .local pmc pio
- .local pmc domain
- .local pmc type
- .local pmc protocol
- pio = root_new ['parrot';'Socket']
- domain = find_lex "$domain"
- type = find_lex "$type"
- protocol = find_lex "$protocol"
- pio.'socket'(domain, type, protocol)
- %r = pio
- }}) );
- }
+
+
+ method socket(Int $domain, Int $type, Int $protocol) {
+ return IO::Socket::INET.new( :PIO(Q:PIR {{
+ .local pmc pio
+ .local pmc domain
+ .local pmc type
+ .local pmc protocol
+ pio = root_new ['parrot';'Socket']
+ domain = find_lex "$domain"
+ type = find_lex "$type"
+ protocol = find_lex "$protocol"
+ pio.'socket'(domain, type, protocol)
+ %r = pio
+ }}) );
+ }
+
+ method bind($host, $port) {
+ $!PIO.bind($!PIO.sockaddr($host, $port));
+ return self;
+ }
+
+ method listen() {
+ $!PIO.listen(1);
+ return self;
+ }
+
+ method accept() {
+ return $!PIO.accept();
+ }
- method bind($host, $port) {
- $!PIO.bind($!PIO.sockaddr($host, $port));
- return self;
- }
- method listen() {
- $!PIO.listen(1);
- return self;
- }
- method accept() {
- return $!PIO.accept();
- }
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment