File Coverage

blib/lib/Text/Netstring.pm

Criterion	Covered	Total	%
statement	23	46	50.0
branch	15	40	37.5
condition	10	15	66.6
subroutine	5	6	83.3
pod	4	4	100.0
total	57	111	51.3

package Text::Netstring;

use strict;
use vars qw($VERSION @ISA @EXPORT_OK);

require Exporter;

#
# Copyright (c) 2003-2006 James Raftery . All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
# Please submit bug reports, patches and comments to the author.
# Latest information at http://romana.now.ie/
#
# $Id: Netstring.pm,v 1.13 2006/11/20 18:28:49 james Exp $
#
# See the Text::Netstring man page that was installed with this module for
# information on how to use the module.
#

@ISA = qw(Exporter);
# Items to export into caller's namespace by request.
@EXPORT_OK = qw(
	netstring_encode netstring_decode netstring_verify netstring_read
);

$VERSION = '0.07';


sub netstring_encode {

	# is argument a list reference?
	@_ = @{$_[0]} if (scalar(@_)==1 and ref($_[0]) eq "ARRAY");

	my @enc = map { length($_).":${_}," } @_;
	wantarray ? @enc : join("", @enc);
}

sub netstring_decode {

	# is argument a list reference?
	@_ = @{$_[0]} if (scalar(@_)==1 and ref($_[0]) eq "ARRAY");

	my @dec = map { /^(\d+):(.*),$/s and length($2)==$1 ? $2 : "" } @_;
	wantarray ? @dec : join("", @dec);
}

sub netstring_verify {

	# is argument a list reference?
	@_ = @{$_[0]} if (scalar(@_)== 1 and ref($_[0]) eq "ARRAY");

	my @ver = map { /^(\d+):(.*),$/s and length($2)==$1 } @_;
	wantarray ? @ver : do { my $i=shift(@ver); foreach (@ver) {$i &&= $_}; $i };
}

sub netstring_read {
	my $sock = shift or return undef;

	my($r, $ns);
	my $s = "";
	my $len = 0;

	# read the length
	for (;;) {
		defined($r = read($sock, $s, 1)) or return undef;

		return "" if !$r;
		last if $s eq ":";
		return undef if $s !~ /^[0-9]$/;

		$len = 10 * $len + $s;
		return undef if $len > 200000000;
	}

	$ns = $len . ":";
	$s = "";

	# read the string 'body'
	defined($r = read($sock, $s, $len)) or return undef;
	return "" if (!$r and $len != 0);	# zero length is OK
	$ns .= $s;

	# read the trailing comma
	defined($r = read($sock, $s, 1)) or return undef;
	return "" if !$r;
	return undef if $s ne ",";
	$ns .= $s;

	return $ns;
}

1;

__END__