File Coverage

blib/lib/Thrift/JSONProtocol.pm

Criterion	Covered	Total	%
statement	199	476	41.8
branch	16	112	14.2
condition	0	9	0.0
subroutine	58	111	52.2
pod	1	68	1.4
total	274	776	35.3

package Thrift::JSONProtocol;

=head1 NAME

Thrift::JSONProtocol

=head1 DESCRIPTION

JSON protocol implementation for thrift.

This is a full-featured protocol supporting write and read.

This code was adapted from the Java implementation.

Please see the C++ class header for a detailed description of the protocol's wire format.

=cut

use strict;
use warnings;
use Thrift;
use Thrift::Protocol;
use base qw(Thrift::Protocol Class::Accessor);

use utf8;
use Encode;
use MIME::Base64;

__PACKAGE__->mk_accessors(qw(trans context_ reader_));
sub transport { shift->{trans} }

use constant {
    COMMA     => ',',
    COLON     => ':',
    LBRACE    => '{',
    RBRACE    => '}',
    LBRACKET  => '[',
    RBRACKET  => ']',
    QUOTE     => '"',
    BACKSLASH => '\\',
    ZERO      => '0',

    ESCSEQ => join('','\\','u','0','0'),
    VERSION => 1,

    JSON_CHAR_TABLE => [
      # 0   1   2   3   4   5   6   7   8   9   A   B   C   D   E   F
        0,  0,  0,  0,  0,  0,  0,  0,'b','t','n',  0,'f','r',  0,  0, # 0
        0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, # 1
        1,  1,'"',  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1,  1, # 2
    ],

    ESCAPE_CHARS => "\"\\bfnrt",
    ESCAPE_CHAR_VALS => [ '"', '\\', "\b", "\f", "\n", "\r", "\t", ],

    NAME_BOOL   => 'tf',
    NAME_BYTE   => 'i8',
    NAME_I16    => 'i16',
    NAME_I32    => 'i32',
    NAME_I64    => 'i64',
    NAME_DOUBLE => 'dbl',
    NAME_STRUCT => 'rec',
    NAME_STRING => 'str',
    NAME_MAP    => 'map',
    NAME_LIST   => 'lst',
    NAME_SET    => 'set',
};

my %_getTypeNameForTypeID = (
    TType::BOOL   => NAME_BOOL,
    TType::BYTE   => NAME_BYTE,
    TType::I16    => NAME_I16,
    TType::I32    => NAME_I32,
    TType::I64    => NAME_I64,
    TType::DOUBLE => NAME_DOUBLE,
    TType::STRING => NAME_STRING,
    TType::STRUCT => NAME_STRUCT,
    TType::MAP    => NAME_MAP,
    TType::SET    => NAME_SET,
    TType::LIST   => NAME_LIST,
);

##
## Class methods
##

sub new {
    my $class = shift;

    my $self = $class->SUPER::new(@_);

    # Stack of nested contexts that we may be in
    $self->{contextStack_} = [];

    # Current context that we are in
    $self->{context_}      = Thrift::JSONProtocol::JSONBaseContext->new( protocol => $self );

    # Reader that manages a 1-byte buffer
    $self->{reader_}       = Thrift::JSONProtocol::LookaheadReader->new( protocol => $self );

    return $self;
}

sub getTypeNameForTypeID {
    my ($typeID) = @_;

    if (my $typeName = $_getTypeNameForTypeID{$typeID}) {
        return $typeName;
    }
    die TProtocolException->new( "Unrecognized type $typeID", TProtocolException::UNKNOWN )
}

sub getTypeIDForTypeName {
    my ($name) = @_;
    my $result = TType::STOP;
    my @name = split //, $name;
    if (int(@name) > 1) {
            if ($name[0] eq 'd') { $result = TType::DOUBLE }
        elsif ($name[0] eq 'i') {
                if ($name[1] eq '8') { $result = TType::BYTE }
            elsif ($name[1] eq '1') { $result = TType::I16 }
            elsif ($name[1] eq '3') { $result = TType::I32 }
            elsif ($name[1] eq '6') { $result = TType::I64 }
        }
        elsif ($name[0] eq 'l') { $result = TType::LIST   }
        elsif ($name[0] eq 'm') { $result = TType::MAP    }
        elsif ($name[0] eq 'r') { $result = TType::STRUCT }
        elsif ($name[0] eq 's') {
                if ($name[1] eq 't') { $result = TType::STRING }
            elsif ($name[1] eq 'e') { $result = TType::SET }
        }
        elsif ($name[0] eq 't') { $result = TType::BOOL }
    }
    if ($result == TType::STOP) {
        die TProtocolException->new("Unrecognized type", TProtocolException::UNKNOWN);
    }
    return $result;
}

sub check_utf8 {
    my ($string_ref) = @_;

    return if ! utf8::is_utf8($$string_ref);
    $$string_ref = Encode::encode_utf8($$string_ref);
}

##
## Object methods
##

#
# Helper methods
#

# Push a new JSON context onto the stack.
sub pushContext {
    my ($self, $context) = @_;
    push @{ $self->{contextStack_} }, delete $self->{context_};
    $self->{context_} = $context;
}

# Pop the last JSON context off the stack
sub popContext {
    my ($self) = @_;
    my $context = pop @{ $self->{contextStack_} };
    $self->{context_} = $context;
    return $context;
}

# Read a byte that must match $expected; otherwise an excpetion is thrown.
sub readJSONSyntaxChar {
    my ($self, $expected) = @_;
    my $got = $self->{reader_}->read();
    if ($got ne $expected) {
        die TProtocolException->new("Unexpected character: $got", TProtocolException::INVALID_DATA);
    }
    return length $got;
}

# Convenience method for writing and getting the length of the string written
sub write {
    my ($self, $string) = @_;
    $self->transport->write($string);
    return length $string;
}

#
# Read/write JSON methods
#

# Write the bytes in array buf as a JSON characters, escaping as needed
sub writeJSONString {
    my ($self, $string) = @_;
    my @b = split //, $string;

    my $xfer = 0;

    $xfer += $self->context_->write();

    $xfer += $self->write(QUOTE);

    my $len = int @b;
    for (my $i = 0; $i < $len; $i++) {
        my $ord = ord($b[$i]);
        if (($ord & 0x00FF) >= 0x30) {
            if ($b[$i] eq BACKSLASH) {
                $xfer += $self->write(BACKSLASH . BACKSLASH);
            }
            else {
                $xfer += $self->write($b[$i]);
            }
        }
        else {
            my $tmp = JSON_CHAR_TABLE->[$ord];
            if ($tmp eq '1') {
                $xfer += $self->write($b[$i]);
            }
            elsif ($tmp eq '0') {
                my $hex = unpack 'H*', chr($ord);
                $xfer += $self->write(ESCSEQ . $hex);
            }
            else {
                $xfer += $self->write(BACKSLASH . $tmp);
            }
        }
    }

    $xfer += $self->write(QUOTE);

    return $xfer;
}

# Read in a JSON string, unescaping as appropriate.. Skip reading from the
# context if skipContext is true.
sub readJSONString {
    my ($self, $string, $skipContext) = @_;

    my $xfer = 0;

    $xfer += $self->context_->read() if ! $skipContext;

    $xfer += $self->readJSONSyntaxChar(QUOTE);

    $$string = '';

    while (1) {
        my $ch = $self->reader_->read();
        $xfer++;
        if ($ch eq QUOTE) {
            last;
        }
        if ($ch eq substr ESCSEQ, 0, 1) {
            $ch = $self->reader_->read();
            $xfer++;
            if ($ch eq substr ESCSEQ, 1, 1) {
                $xfer += $self->readJSONSyntaxChar(ZERO);
                $xfer += $self->readJSONSyntaxChar(ZERO);
                my $tmp = $self->transport->readAll(2);
                $ch = chr(hex($tmp));
                $xfer += 2;
            }
            else {
                my $off = index ESCAPE_CHARS, $ch;
                if ($off == -1) {
                    die TProtocolException->new("Expected control char, got '$ch'", TProtocolException::INVALID_DATA);
                }
                $ch = ESCAPE_CHAR_VALS->[$off];
            }
        }
        $$string .= $ch;
    }

    return $xfer;
}

# Write out number as a JSON value. If the context dictates so, it will be
# wrapped in quotes to output as a JSON string.

sub writeJSONInteger {
    my ($self, $num) = @_;
    my $xfer = 0;
    $xfer += $self->context_->write;
    my $str = $num . '';
    check_utf8(\$str);
    my $escapeNum = $self->context_->escapeNum();

    $xfer += $self->write(QUOTE) if $escapeNum;
    $xfer += $self->write($str);
    $xfer += $self->write(QUOTE) if $escapeNum;
    return $xfer;
}

# Return true if the given byte could be a valid part of a JSON number.
sub isJSONNumeric {
    my ($char) = @_;
    return $char =~ m{^[-+.0-9Ee]$} ? 1 : 0;
}

# Read in a sequence of characters that are all valid in JSON numbers. Does
# not do a complete regex check to validate that this is actually a number.
sub readJSONNumericChars {
    my ($self, $str) = @_;
    my $xfer = 0;
    while (1) {
        my $ch;
        eval {
            $ch = $self->reader_->peek();
        };
        if (my $ex = $@) {
            if ($ex->isa('TTransportException') && $ex->{code} == TTransportException::END_OF_FILE) {
                last;
            }
            die $ex;
        }
        if (! isJSONNumeric($ch)) {
            last;
        }
        $$str .= $self->reader_->read();
        $xfer++;
    }
    return $xfer;
}

# Read in a JSON number. If the context dictates, read in enclosing quotes.
sub readJSONInteger {
    my ($self, $int) = @_;
    my $xfer = 0;
    $xfer += $self->context_->read();
    my $escapeNum = $self->context_->escapeNum();

    my $str;
    $xfer += $self->readJSONSyntaxChar(QUOTE) if $escapeNum;
    $xfer += $self->readJSONNumericChars(\$str);
    $xfer += $self->readJSONSyntaxChar(QUOTE) if $escapeNum;

    $$int = $str * 1;
    return $xfer;
}

# Write out a double as a JSON value. If it is NaN or infinity or if the
# context dictates escaping, write out as JSON string.
sub writeJSONDouble {
    my ($self, $num) = @_;
    my $xfer = 0;
    $xfer += $self->context_->write();
    my $str = $num . '';
    check_utf8(\$str);
    my $special = $str =~ m{^-?(N|I)} ? 1 : 0;
    my $escapeNum = $special || $self->context_->escapeNum;

    $xfer += $self->write(QUOTE) if $escapeNum;
    $xfer += $self->write($str);
    $xfer += $self->write(QUOTE) if $escapeNum;
    return $xfer;
}

# Read in a JSON double value. Throw if the value is not wrapped in quotes
# when expected or if wrapped in quotes when not expected.
sub readJSONDouble {
    my ($self, $dub) = @_;
    my $xfer = 0;
    $xfer += $self->context_->read();

    if ($self->reader_->peek() eq QUOTE) {
        my $str;
        $xfer += $self->readJSONString(\$str, 1);
        my $special = $str =~ m{^-?(N|I)} ? 1 : 0;
        if (! $self->context_->escapeNum && ! $special) {
            # Throw exception -- we should not be in a string in this case
            die TProtocolException->new(
                "Numeric data unexpectedly quoted",
                TProtocolException::INVALID_DATA,
            );
        }
        $$dub = $str;
    }
    else {
        if ($self->context_->escapeNum()) {
            # This will throw - we should have had a quote if escapeNum == true
            $xfer += $self->readJSONSyntaxChar(QUOTE);
        }
        $xfer += $self->readJSONNumericChars($dub);
    }
    return $xfer;
}

# Write out contents of byte array b as a JSON string with base-64 encoded
# data
sub writeJSONBase64 {
    my ($self, $string) = @_;
    return $self->writeJSONString( encode_base64($string, '') );
}

# Read in a JSON string containing base-64 encoded data and decode it.
sub readJSONBase64 {
    my ($self, $string) = @_;

    my $xfer = $self->readJSONString($string);
    my $tmp = decode_base64($$string);
    $$string = $tmp;
    return $xfer;
}

sub writeJSONObjectStart {
    my ($self) = @_;
    my $xfer = 0;
    $xfer += $self->context_->write();
    $xfer += $self->write(LBRACE);
    $self->pushContext(
        Thrift::JSONProtocol::JSONPairContext->new( protocol => $self )
    );
    return $xfer;
}

sub readJSONObjectStart {
    my ($self) = @_;
    my $xfer = 0;
    $xfer += $self->context_->read();
    $xfer += $self->readJSONSyntaxChar(LBRACE);
    $self->pushContext(
        Thrift::JSONProtocol::JSONPairContext->new( protocol => $self )
    );
    return $xfer;
}

sub writeJSONObjectEnd {
    my ($self) = @_;
    $self->popContext();
    return $self->write(RBRACE);
}

sub readJSONObjectEnd {
    my ($self) = @_;
    $self->popContext();
    return $self->readJSONSyntaxChar(RBRACE);
}

sub writeJSONArrayStart {
    my ($self) = @_;
    my $xfer = 0;
    $xfer += $self->context_->write();
    $xfer += $self->write(LBRACKET);
    $self->pushContext(
        Thrift::JSONProtocol::JSONListContext->new( protocol => $self )
    );
    return $xfer;
}

sub readJSONArrayStart {
    my ($self) = @_;
    my $xfer = 0;
    $xfer += $self->context_->read();
    $xfer += $self->readJSONSyntaxChar(LBRACKET);
    $self->pushContext(
        Thrift::JSONProtocol::JSONListContext->new( protocol => $self )
    );
    return $xfer;
}

sub writeJSONArrayEnd {
    my ($self) = @_;
    $self->popContext();
    return $self->write(RBRACKET);
}

sub readJSONArrayEnd {
    my ($self) = @_;
    $self->popContext();
    return $self->readJSONSyntaxChar(RBRACKET);
}

#
# Thrift::Protocol methods
#

sub writeMessageBegin {
    my ($self, $name, $type, $seqid) = @_;

    check_utf8(\$name);

    my $xfer = 0;
    $xfer += $self->writeJSONArrayStart();
    $xfer += $self->writeJSONInteger(VERSION);
    $xfer += $self->writeJSONString($name);
    $xfer += $self->writeJSONInteger($type);
    $xfer += $self->writeJSONInteger($seqid);
    return $xfer;
}

sub readMessageBegin {
    my ($self, $name, $type, $seqid) = @_;

    my $xfer = 0;

    $xfer += $self->readJSONArrayStart();
    my $version;
    $xfer += $self->readJSONInteger(\$version);

    if ($version != VERSION) {
        die TProtocolException->new("Message contained bad version.", TProtocolException::BAD_VERSION);
    }

    $xfer += $self->readJSONString($name);
    $xfer += $self->readJSONInteger($type);
    $xfer += $self->readJSONInteger($seqid);
    return $xfer;
}

sub writeMessageEnd {
    my ($self) = @_;
    $self->writeJSONArrayEnd();
}

sub readMessageEnd {
    my ($self) = @_;
    $self->readJSONArrayEnd();
}

sub writeStructBegin {
    my ($self) = @_;
    $self->writeJSONObjectStart();
}

sub readStructBegin {
    my ($self, $name) = @_;
    $self->readJSONObjectStart();
}

sub writeStructEnd {
    my ($self) = @_;
    $self->writeJSONObjectEnd();
}

sub readStructEnd {
    my ($self) = @_;
    $self->readJSONObjectEnd();
}

sub writeFieldBegin {
    my ($self, $fieldName, $fieldType, $fieldId) = @_;
    my $xfer = 0;
    $xfer += $self->writeJSONInteger($fieldId);
    $xfer += $self->writeJSONObjectStart();
    $xfer += $self->writeJSONString(getTypeNameForTypeID($fieldType));
    return $xfer;
}

sub readFieldBegin {
    my ($self, $name, $fieldType, $fieldId) = @_;

    my $xfer = 0;
    my $ch = $self->reader_->peek();
    if ($ch eq RBRACE) {
        $$fieldType = TType::STOP;
    }
    else {
        $xfer += $self->readJSONInteger($fieldId);
        $xfer += $self->readJSONObjectStart();
        my $type;
        $xfer += $self->readJSONString(\$type);
        $$fieldType = getTypeIDForTypeName($type);
    }
    return $xfer;
}

sub writeFieldEnd {
    my ($self) = @_;
    $self->writeJSONObjectEnd();
}

sub readFieldEnd {
    my ($self) = @_;
    $self->readJSONObjectEnd();
}

sub writeFieldStop { 0 }

sub writeMapBegin {
    my ($self, $keyType, $valType, $size) = @_;
    my $xfer = 0;
    $xfer += $self->writeJSONArrayStart();
    $xfer += $self->writeJSONString(getTypeNameForTypeID($keyType));
    $xfer += $self->writeJSONString(getTypeNameForTypeID($valType));
    $xfer += $self->writeJSONInteger($size);
    $xfer += $self->writeJSONObjectStart();
    return $xfer;
}

sub readMapBegin {
    my ($self, $keyType, $valType, $size) = @_;
    my $xfer = 0;
    $xfer += $self->readJSONArrayStart();

    $xfer += $self->readJSONString($keyType);
    $$keyType = getTypeIDForTypeName($$keyType);

    $xfer += $self->readJSONString($valType);
    $$valType = getTypeIDForTypeName($$valType);

    $xfer += $self->readJSONInteger($size);
    $xfer += $self->readJSONObjectStart();
    return $xfer;
}

sub writeMapEnd {
    my ($self) = @_;
    return $self->writeJSONObjectEnd() + $self->writeJSONArrayEnd();
}

sub readMapEnd {
    my ($self) = @_;
    return $self->readJSONObjectEnd() + $self->readJSONArrayEnd();
}

sub writeListBegin {
    my ($self, $elemType, $size) = @_;
    my $xfer = 0;
    $xfer += $self->writeJSONArrayStart();
    $xfer += $self->writeJSONString(getTypeNameForTypeID($elemType));
    $xfer += $self->writeJSONInteger($size);
    return $xfer;
}

sub readListBegin {
    my ($self, $elemType, $size) = @_;
    my $xfer = 0;

    $xfer += $self->readJSONArrayStart();

    $xfer += $self->readJSONString($elemType);
    $$elemType = getTypeIDForTypeName($$elemType);

    $xfer += $self->readJSONInteger($size);

    return $xfer;
}

sub writeListEnd {
    my ($self) = @_;
    $self->writeJSONArrayEnd();
}

sub readListEnd {
    my ($self) = @_;
    $self->readJSONArrayEnd();
}

sub writeSetBegin {
    my $self = shift;
    $self->writeListBegin(@_);
}

sub readSetBegin {
    my $self = shift;
    $self->readListBegin(@_);
}

sub writeSetEnd {
    my ($self) = @_;
    $self->writeListEnd();
}

sub readSetEnd {
    my ($self) = @_;
    $self->readListEnd();
}

sub writeBool {
    my ($self, $b) = @_;
    $self->writeJSONInteger($b ? 1 : 0);
}

sub readBool {
    my ($self, $b) = @_;
    my $xfer = $self->readJSONInteger($b);
    $$b = $$b ? 1 : 0;
    return $xfer;
}

sub writeByte {
    my ($self, $b) = @_;
    $self->writeJSONInteger(ord($b));
}

sub readByte {
    my ($self, $b) = @_;
    my $xfer = $self->readJSONInteger($b);
    $$b = chr($$b);
    return $xfer;
}

sub writeI16 {
    my ($self, $i16) = @_;
    $self->writeJSONInteger($i16);
}

sub readI16 {
    my ($self, $i16) = @_;
    $self->readJSONInteger($i16);
}

sub writeI32 {
    my ($self, $i32) = @_;
    $self->writeJSONInteger($i32);
}

sub readI32 {
    my ($self, $i32) = @_;
    $self->readJSONInteger($i32);
}

sub writeI64 {
    my ($self, $i64) = @_;
    $self->writeJSONInteger($i64);
}

sub readI64 {
    my ($self, $i64) = @_;
    $self->readJSONInteger($i64);
}

sub writeDouble {
    my ($self, $dub) = @_;
    $self->writeJSONDouble($dub);
}

sub readDouble {
    my ($self, $dub) = @_;
    $self->readJSONDouble($dub);
}

sub writeString {
    my ($self, $str) = @_;
    check_utf8(\$str);
    $self->writeJSONString($str);
}

sub readString {
    my ($self, $str) = @_;
    $self->readJSONString($str);
}

sub writeBinary {
    my ($self, $str) = @_;
    $self->writeJSONBase64($str);
}

sub readBinary {
    my ($self, $str) = @_;
    $self->readJSONBase64($str);
}
#
# Other related packages
#

{
    package Thrift::JSONProtocolFactory;

    use strict;
    use warnings;
    use base qw(TProtocolFactory);

    sub getProtocol {
        my ($self, $transport) = @_;
        return Thrift::JSONProtocol->new($transport);
    }
}

{
    # Base class for tracking JSON contexts that may require inserting/reading
    # additional JSON syntax characters
    # This base context does nothing.
    package Thrift::JSONProtocol::JSONBaseContext;

    use strict;
    use warnings;
    use base qw(Class::Accessor);
    BEGIN {
        __PACKAGE__->mk_accessors(qw(protocol));
    };

    sub new {
        my ($class, %self) = @_;
        return bless \%self, $class;
    }

    sub write { 0 }
    sub read  { 0 }
    sub escapeNum { 0 }
}

{
    # Context for JSON lists. Will insert/read commas before each item except
    # for the first one
    package Thrift::JSONProtocol::JSONListContext;

    use strict;
    use warnings;
    use base qw(Thrift::JSONProtocol::JSONBaseContext);
    BEGIN {
        __PACKAGE__->mk_accessors(qw(first_));
    };

    sub new {
        my $class = shift;
        my $self = $class->SUPER::new(@_);
        $self->first_(1);
        return $self;
    }

    sub write {
        my ($self) = @_;
        if ($self->first_) {
            $self->first_(0);
            return 0;
        }
        else {
            $self->protocol->transport->write(Thrift::JSONProtocol::COMMA);
            return length Thrift::JSONProtocol::COMMA;
        }
    }

    sub read {
        my ($self) = @_;
        if ($self->first_) {
            $self->first_(0);
            return 0;
        }
        else {
            $self->protocol->readJSONSyntaxChar(Thrift::JSONProtocol::COMMA);
            return length Thrift::JSONProtocol::COMMA;
        }
    }
}

{
    # Context for JSON records. Will insert/read colons before the value portion
    # of each record pair, and commas before each key except the first. In
    # addition, will indicate that numbers in the key position need to be
    # escaped in quotes (since JSON keys must be strings).
    package Thrift::JSONProtocol::JSONPairContext;

    use strict;
    use warnings;
    use base qw(Thrift::JSONProtocol::JSONBaseContext);
    BEGIN {
        __PACKAGE__->mk_accessors(qw(first_ colon_));
    };

    sub new {
        my $class = shift;
        my $self = $class->SUPER::new(@_);
        $self->first_(1);
        $self->colon_(1);
        return $self;
    }

    sub write {
        my ($self) = @_;

        if ($self->first_) {
            $self->first_(0);
            $self->colon_(1);
            return 0;
        }
        else {
            my $string = $self->colon_ ? Thrift::JSONProtocol::COLON : Thrift::JSONProtocol::COMMA;
            $self->protocol->transport->write($string);
            $self->colon_($self->colon_ ? 0 : 1);
            return length $string;
        }
    }

    sub read {
        my ($self) = @_;

        if ($self->first_) {
            $self->first_(0);
            $self->colon_(1);
            return 0;
        }
        else {
            my $string = $self->colon_ ? Thrift::JSONProtocol::COLON : Thrift::JSONProtocol::COMMA;
            $self->protocol->readJSONSyntaxChar($string);
            $self->colon_($self->colon_ ? 0 : 1);
            return length $string;
        }
    }

    sub escapeNum {
        my ($self) = @_;
        return $self->colon_;
    }
}

{
    # Holds up to one byte from the transport
    package Thrift::JSONProtocol::LookaheadReader;

    use strict;
    use warnings;
    use base qw(Class::Accessor);
    BEGIN {
        __PACKAGE__->mk_accessors(qw(protocol hasData_ data_));
    };

    sub new {
        my ($class, %self) = @_;
        return bless \%self, $class;
    }

    # Return and consume the next byte to be read, either taking it from the
    # data buffer if present or getting it from the transport otherwise.
    sub read {
        my ($self) = @_;
        if ($self->hasData_) {
            $self->hasData_(0);
        }
        else {
            $self->data_( $self->protocol->transport->readAll(1) );
        }
        return $self->data_;
    }

    # Return the next byte to be read without consuming, filling the data
    # buffer if it has not been filled already.
    sub peek {
        my ($self) = @_;
        if (! $self->hasData_) {
            $self->data_( $self->protocol->transport->readAll(1) );
        }
        $self->hasData_(1);
        return $self->data_;
    }
}

1;