Permalink
Browse files

First commit.

  • Loading branch information...
Timothy Totten
Timothy Totten committed Oct 12, 2012
0 parents commit 94bd48aa4ddb1973f5dac13a4e0659fc3c01627b
Showing with 154 additions and 0 deletions.
  1. +2 −0 .gitignore
  2. +7 −0 META.info
  3. +65 −0 README.md
  4. +58 −0 lib/Netstring.pm6
  5. +22 −0 t/01-encoding.t
@@ -0,0 +1,2 @@
+Makefile
+blib
@@ -0,0 +1,7 @@
+{
+ "name" : "Netstring",
+ "version" : "*",
+ "description" : "A library for working with netstrings.",
+ "depends" : [],
+ "source-url" : "git://github.com/supernovus/perl6-netstring.git"
+}
@@ -0,0 +1,65 @@
+# Netstring library for Perl 6
+
+## Introduction
+
+Work with netstrings. This currently supports generating netstrings, and
+parsing a netstring from an IO stream (such as a socket.)
+
+## Usage
+
+### Generating Netstrings
+
+```perl
+ use Netstring;
+
+ to-netstring("hello world!");
+ ## returns "12:hello world!,"
+
+ my $b = Buf.new(0x68,0x65,0x6c,0x6c,0x6f,0x20,0x77,0x6f,0x72,0x6c,0x64,0x21);
+ to-netstring($b);
+ ## returns "12:hello world!,";
+
+ to-netstring-buf("hello world!");
+ ## returns Buf:0x<31 32 3a 68 65 6c 6c 6f 20 77 6f 72 6c 64 21 2c>
+
+ to-netstring-buf($b);
+ ## returns Buf:0x<31 32 3a 68 65 6c 6c 6f 20 77 6f 72 6c 64 21 2c>
+
+```
+
+### Reading Netstring from IO
+
+```perl
+ use Netstring;
+
+ my $daemon = IO::Socket::INET.new(
+ :localhost<localhost>,
+ :localport(42),
+ :listen
+ );
+
+ while my $client = $daemon.accept()
+ {
+ ## The client sends "12:hello world!," as a stream of bytes.
+ my $rawcontent = read-netstring($client);
+ my $strcontent = $rawcontent.decode;
+
+ say "The client said: $strcontent";
+ ## prints "The client said: hello world!"
+
+ $client.write($strcontent.flip);
+ ## sends "!dlrow olleh" back to the client.
+
+ $client.close();
+ }
+
+```
+
+## Author
+
+Timothy Totten, supernovus on #perl6, https://github.com/supernovus/
+
+## License
+
+Artistic License 2.0
+
@@ -0,0 +1,58 @@
+use v6;
+
+module Netstring;
+
+proto to-netstring ($) is export {*}
+proto to-netstring-buf ($) is export {*}
+
+multi to-netstring (Str $str --> Str)
+{
+ my $bytes = $str.encode.bytes;
+ return "$bytes:$str,";
+}
+
+multi to-netstring (Buf $buf --> Str)
+{
+ my $bytes = $buf.bytes;
+ my $str = $buf.decode;
+ return "$bytes:$str,";
+}
+
+multi to-netstring-buf (Str $str --> Buf)
+{
+ my $buf = $str.encode;
+ to-netstring-buf($buf);
+}
+
+multi to-netstring-buf (Buf $buf --> Buf)
+{
+ my $bytes = $buf.bytes.Str.encode;
+ my $colon = ':'.encode;
+ my $comma = ','.encode;
+ return $bytes ~ $colon ~ $buf ~ $comma;
+}
+
+sub read-netstring (IO $in --> Buf) is export
+{
+ my Str $len = '';
+ for $in.read(1) -> $byte
+ {
+ my $str = $byte.decode;
+ if $str eq ':' { last; }
+ elsif $str ~~ /^ <[0..9]> $/
+ {
+ $len ~= $str;
+ }
+ else
+ {
+ die "Invalid netstring stream data.";
+ }
+ }
+ my $content = $in.read(+$len);
+ my $terminator = $in.read(1);
+ if $terminator.decode ne ','
+ {
+ die "Missing or invalid netstring terminator."
+ }
+ return $content;
+}
@@ -0,0 +1,22 @@
+use v6;
+
+BEGIN { @*INC.unshift: './lib'; }
+
+use Test;
+use Netstring;
+
+plan 4;
+
+my $test_str = "hello world!";
+my $test_buf = $test_str.encode;
+
+my $wanted_str = "12:hello world!,";
+my $wanted_buf = $wanted_str.encode;
+
+is to-netstring($test_str), $wanted_str, 'to-netstring(Str)';
+is to-netstring($test_buf), $wanted_str, 'to-netstring(Buf)';
+
+## This would use 'is', but 'is' with Buf objects is broken at the moment.
+ok to-netstring-buf($test_str) == $wanted_buf, 'to-netstring-buf(Str)';
+ok to-netstring-buf($test_buf) == $wanted_buf, 'to-netstring-buf(Buf)';
+

0 comments on commit 94bd48a

Please sign in to comment.