#!/usr/bin/perl

use Benchmark;

$|=1;

$m=500; $n=100;

$list = [(qw(asdf sdgh eqrt fgh adsfg 123 trwy xccfsg cxb), undef)x$m];

timethese( $n, {
    pack1=>q{$a1 = pack_list1($list)},
    pack2=>q{$a2 = pack_list2($list)}
} );

print "packs inconsistent\n" unless $a1 eq $a2;

print length($a1), " : ", length($a2), "\n";

timethese( $n, {
    unpack1=>q{$b1 = unpack_list1($a1)},
    unpack2=>q{$b2 = unpack_list2($a2)}
} );

print "unpacks inconsistent\n" unless (join '-',@$b1) eq (join '-', @$b2);

sub pack_list1 {
    my $packed = pack 'N', scalar @{$_[0]};

    for my $item (@{$_[0]}) {
	$packed .= defined $item ?
	    (pack 'n', length $item) . $item :
	    pack 'n', 0xFFFF;
    }

    return $packed;
}

# unpack a 'binary protocol' list
# this will return undef if there is a protocol error
sub unpack_list1 {
    my $packed = shift;
    my $n = unpack 'N', substr $packed, 0, 4, '';
#    return unless defined $n;
    my @list = ();
    while ($packed) {
	my $len = unpack 'n', substr $packed, 0, 2, '';
#	return unless defined $len and $len <= length($packed);
	push @list, ($len == 0xFFFF) ?
	    undef :
	    substr $packed, 0, $len, '';
    }
#    return unless $n == @list;
    return \@list;#wantarray ? @list : \@list;
}

sub pack_list2 {
    my $packed = pack 'N', scalar @{$_[0]};

    for my $item (@{$_[0]}) {
	$packed .= defined $item ?
	    (pack 'N', length $item) . $item :
	    pack 'N', 0xFFFFFFFF;
    }

    return $packed;
}

# unpack a 'binary protocol' list
# this will return undef if there is a protocol error
sub unpack_list2 {
    my $packed = shift;
    my $n = unpack 'N', substr $packed, 0, 4, '';
#    return unless defined $n;
    my @list = ();
    while ($packed) {
	my $len = unpack 'N', substr $packed, 0, 4, '';
#	return unless defined $len and $len <= length($packed);
	push @list, ($len == 0xFFFFFFFF) ?
	    undef :
	    substr $packed, 0, $len, '';
    }
#    return unless $n == @list;
    return \@list;#wantarray ? @list : \@list;
}