use strict;
use vars qw($VERSION @ISA @EXPORT_OK);
require Exporter;
#
# Copyright (c) 2003-2006 James Raftery <james@now.ie>. 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__
=head1 NAME
Text::Netstring - Perl module for manipulation of netstrings
=head1 SYNOPSIS
use Text::Netstring qw(netstring_encode netstring_decode
netstring_verify netstring_read);
$ns = netstring_encode($text);
@ns = netstring_encode(@text);
$ns = netstring_encode(@text);
$text = netstring_decode($ns);
@text = netstring_decode(@ns);
$text = netstring_decode(@ns);
$valid = netstring_verify($string);
@valid = netstring_verify(@string);
$valid = netstring_verify(@string);
$ns = netstring_read($socket);
=head1 DESCRIPTION
This module is a collection of functions to make use of netstrings in
your perl programs. A I<netstring> is a string encoding used by, at
least, the QMTP and QMQP email protocols.
=over 4
=item netstring_encode()
Encode the argument string, list of strings, or referenced list of
strings as a netstring.
Supplying a scalar argument in a scalar context, or a list or list
reference argument in list context, does what you'd expect; encoding the
scalar or each element of the list as appropriate. Supplying a list or
list reference argument in a scalar context, however, returns a single
scalar which is the concatenation of each element of the list encoded as
a netstring.
=item netstring_decode()
Decode the argument netstring, list of netstrings, or referenced list of
netstrings returning the I<interpretation> of each. You should use
C<netstring_verify()> over any data before you try to decode it. An
invalid netstring will be returned as an empty string.
The same scalar/list context handling as for netstring_encode() applies.
=item netstring_verify()
Check the validity of the supplied netstring, list of netstrings or
referenced list of netstrings. Returns a C<TRUE> or C<FALSE> value, or
list of same, as appropriate. Supplying a list argument in a scalar
context will return a single boolean value which is C<TRUE> if and only
if each element of the argument list was successfully verified,
otherwise it's C<FALSE>.
=item netstring_read()
Read the next netstring from a socket reference supplied as an argument.
The function returns a scalar which is the netstring read from the
socket. You will need to use netstring_decode() on the return value to
obtain the string I<interpretation>. Returns undef in case of an error,
or an empty string ("") if a premature EOF was encountered.
This function will regard a netstring claiming to be larger than
200,000,000 characters as an error, yielding undef.
=back
=head1 EXAMPLES
use Text::Netstring qw(netstring_encode netstring_decode);
@s = ("foo", "bar");
$t = netstring_encode( scalar netstring_encode(@s) );
C<12:3:foo,3:bar,,> is the value of C<$t>
$s = ["5:whizz," , "4:bang,"];
$t = netstring_decode($s);
C<whizzbang> is the value of C<$t>
=head1 NOTES
The format of a netstring is described in http://cr.yp.to/proto/qmtp.txt
=head1 LICENSE
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. (Being a speaker of British english,
I'd call it a "licence" though)
=head1 AUTHOR
James Raftery <james@now.ie>.
=cut