File Coverage

blib/lib/Bit/Manip/PP.pm

Criterion	Covered	Total	%
statement	79	79	100.0
branch	36	36	100.0
condition	5	6	83.3
subroutine	16	17	94.1
pod	9	9	100.0
total	145	147	98.6

package Bit::Manip::PP;

use warnings;
use strict;

our $VERSION = '1.06';

use Exporter;
our @ISA = qw(Exporter);

our @EXPORT_OK = qw(
    bit_get
    bit_set
    bit_clr
    bit_toggle
    bit_on
    bit_off
    bit_bin
    bit_count
    bit_mask
);

our %EXPORT_TAGS;
$EXPORT_TAGS{all} = [@EXPORT_OK];

sub _ref {
    shift if @_ == 2;
    if ($_[0] !~ /^\d+$/ && ref $_[0] ne 'SCALAR'){
        die "your data must either be an integer or a SCALAR reference\n";
    }

    if (ref $_[0]){
        if (${ $_[0] } !~ /^\d+/){
            die "data reference must contain only an integer\n";
        }
        return 1;
    }
    return 0;
}
sub bit_bin {
    my ($data) = @_;
    return sprintf("%b", $data);
}
sub bit_count {
    my ($n, $set) = @_;

    if (! defined $n || $n !~ /^\d+/){
        die "bit_count() requires an integer param\n";
    }

    my $bits = sprintf("%b", $n);
    my $bit_count;

    if ($set){
        $bit_count = $bits =~ tr/1/1/;
    }
    else {
        $bit_count = length($bits);
    }

    return $bit_count;
}
sub bit_mask {
    my ($bits, $lsb) = @_;
    return (2 ** $bits - 1) << $lsb;
}
sub bit_get {
    my ($data, $msb, $lsb) = @_;

    $lsb = 0 if ! defined $lsb;

    _check_msb($msb);
    $msb++; # need to start from 1 here

    _check_lsb($lsb, $msb);

    return ($data & (2**$msb-1)) >> $lsb;
}
sub bit_set {
    my ($data, $lsb, $bits, $value) = @_;

    if (@_ != 4){
        die "bit_set() requires four params\n";
    }

    _check_value($value);

    my $value_bits = bit_count($value, 0);
    if ($value_bits != $bits){
        $value_bits = $bits;
    }
    my $mask = bit_mask($value_bits, $lsb);

    if (_ref($data)){
        $$data = ($$data & ~($mask)) | ($value << $lsb);
        return 0;
    }
    else {
        $data = ($data & ~($mask)) | ($value << $lsb);
        return $data;
    }
}
sub bit_clr {
    my ($data, $lsb, $nbits) = @_;
    return bit_set($data, $lsb, $nbits, 0);
}
sub bit_toggle {
    my ($data, $bit) = @_;

    if (_ref($data)){
        $$data ^= 1 << $bit;
        return 0;
    }
    else {
        return $data ^= 1 << $bit;
    }
}
sub bit_on {
    my ($data, $bit) = @_;

    if (_ref($data)){
        $$data |= 1 << $bit;
        return 0;
    }
    else {
        return $data |= 1 << $bit;
    }
}
sub bit_off {
    my ($data, $bit) = @_;

    if (_ref($data)){
        $$data &= ~(1 << $bit);
        return 0;
    }
    else {
        return $data &= ~(1 << $bit);
    }
}
sub _check_msb {
    my ($msb) = @_;
    if ($msb < 0){
        die("\$msb param can not be negative\n");
    }
}
sub _check_lsb {
    my ($lsb, $msb) = @_;

    if ($lsb < 0){
        die "\$lsb param can't be negative\n";
    }
    if (($lsb + 1) >= $msb){
        die "\$lsb param must be less than \$msb\n";
    }
}
sub _check_value {
    shift if @_ > 1;
    my ($val) = @_;
    if ($val < 0){
        die "\$value param must be zero or greater\n";
    }
}
sub _vim{};

1;
__END__