File Coverage

blib/lib/String/Parity.pm

Criterion	Covered	Total	%
statement	53	53	100.0
branch	10	12	83.3
condition			n/a
subroutine	17	17	100.0
pod	14	14	100.0
total	94	96	97.9

package String::Parity;
$String::Parity::VERSION = '1.34';
use 5.006;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

our @EXPORT = qw(
    setEvenParity setOddParity
    setMarkParity setSpaceParity
    EvenBytes OddBytes
    MarkBytes SpaceBytes
    isEvenParity isOddParity
    isMarkParity isSpaceParity
);

our @EXPORT_OK = qw(
    showParity showMarkSpace
    $even_parity $odd_parity
    $show_parity $even_codes
);
our ($even_parity, $odd_parity, $show_parity);

my $even_bits = "\0";
my $odd_bits = "\200";
foreach (0 .. 7) {
    $even_bits .= $odd_bits;
    ($odd_bits = $even_bits) =~ tr/\0\200/\200\0/;
}

my $codes = pack('C*', (0 .. 255));
($even_parity = $codes ^ $even_bits) =~ s/(\W)/sprintf('\%o', ord $1)/eg;
($odd_parity = $codes ^ $odd_bits) =~ s/(\W)/sprintf('\%o', ord $1)/eg;
($show_parity = $even_bits) =~ tr /\0\200/eo/;

my $even_codes = '';
while ($even_bits =~ /\0/g) {
    $even_codes .= sprintf '\%o', (pos $even_bits) - 1;
}

eval <

    sub setEvenParity {
	my(\@s) = \@_;
	foreach (\@s) {
	    tr/\\0-\\377/$even_parity/;
	}
	wantarray ? \@s : join '', \@s;
    }

    sub setOddParity {
	my(\@s) = \@_;
	foreach (\@s) {
	    tr/\\0-\\377/$odd_parity/;
	}
	wantarray ? \@s : join '', \@s;
    }

    sub showParity {
	my(\@s) = \@_;
	foreach (\@s) {
	    tr/\\0-\\377/$show_parity/;
	}
	wantarray ? \@s : join '', \@s;
    }

    sub EvenBytes {
	my \$count = 0;
	foreach (\@_) {
	    \$count += tr/$even_codes//;
	}
	\$count;
    }

    sub OddBytes {
	my \$count = 0;
	foreach (\@_) {
	    \$count += tr/$even_codes//c;
	}
	\$count;
    }

EDQ
die $@ if $@;

sub isEvenParity {
    ! &OddBytes;
}

sub isOddParity {
    ! &EvenBytes;
}

sub setSpaceParity {
    my(@s) = @_;
    foreach (@s) {
	tr/\200-\377/\0-\177/;
    }
    wantarray ? @s : join '', @s;
}

sub setMarkParity {
    my(@s) = @_;
    foreach (@s) {
	tr/\0-\177/\200-\377/;
    }
    wantarray ? @s : join '', @s;
}

sub showMarkSpace {
    my(@s) = @_;
    foreach (@s) {
	tr/\0-\177/s/;
	tr/\200-\377/m/;
    }
    wantarray ? @s : join '', @s;
}

sub SpaceBytes {
    my $count = 0;
    foreach (@_) {
	$count += tr/\0-\177//;
    }
    $count;
}

sub MarkBytes {
    my $count = 0;
    foreach (@_) {
	$count += tr/\200-\377//;
    }
    $count;
}

sub isSpaceParity {
    ! &MarkBytes;
}

sub isMarkParity {
    ! &SpaceBytes;
}

1;

__END__