use strict;
use warnings;

# Get and length of binary string to test from
# command line and validate.
#
my $teslLen = shift
   or die qq{No string length supplied\n};
die qq{Length supplied not integer\n}
   unless $teslLen =~ /^\d+$/;

# Test one hundred strings of requested length.
#
for (1 .. 100)
{
    print qq{\nIteration $_\n};

    # Create string and print it's length.
    #
    my $binStr = makeBinStr($teslLen);
    print qq{Original length is @{[length $binStr]}\n};

    # Pack string, show packed length.
    #
    my $packedStr = packBinStr($binStr);
    print qq{  Packed length is @{[length $packedStr]}\n};

    # Reconstruct original, show length again.
    #
    my $unpackedStr = unpackBinStr($packedStr);
    print qq{Unpacked length is @{[length $binStr]}\n};

    # Die unless original and reconstructed match.
    #
    die q{Unpacked does not match original},
       qq{\n$binStr\n$unpackedStr\n}
       unless $binStr eq $unpackedStr;
}

# Make a random binary string of requested length.
#
sub makeBinStr
{
    my $digits = shift;
    my $str = q{};
    $str .= int rand 2 for 1 .. $digits;
    return $str;
}

sub packBinStr
{
    # Get binary string and validate.
    #
    my $unpacked = shift;
    die qq{String not binary\n}
       unless $unpacked =~ /^[01]+$/;

    # Get length of binary string, pack the string using
    # correct length in the template. Prepend length and an
    # asterisk to packed string so that correct length
    # can be used when unpacking later. Return packed string.
    #
    my $len = length $unpacked;
    my $packed = qq{$len*} . pack qq{b$len}, $unpacked;
    return $packed;
}

sub unpackBinStr
{
    # Get packed string and split on asterisk, use three-
    # argument split so that we only get two fields back
    # in case the packed string contains an asterisk.
    #
    my $packed = shift;
    my ($len, $packStr) = split /\*/, $packed, 2;

    # Unpack using correct length in template, return
    # binary string.
    #
    my $unpacked = unpack qq{b$len}, $packStr;
    return $unpacked;
}
[download]