File Coverage

blib/lib/Tie/Array/Boolean.pm

Criterion	Covered	Total	%
statement	42	42	100.0
branch	8	8	100.0
condition			n/a
subroutine	11	11	100.0
pod	1	1	100.0
total	62	62	100.0

package Tie::Array::Boolean;

$VERSION = '0.0.1';
@ISA = ( 'Tie::Array' );

use strict;
use warnings;

use Tie::Array;

sub TIEARRAY {
    my $class = shift;

    my $self = {
        bits  => '',
        size  => 0,
    };

    return bless $self, $class;
}

sub STORE {
    my $self  =    shift;
    my $index =    shift;
    my $value = !! shift;

    $self->STORESIZE( 1+$index ) if 1+$index > $self->FETCHSIZE();

    vec( $self->{bits}, $index, 1 ) = $value;

    return;
}

sub FETCH {
    my $self  = shift;
    my $index = shift;

    return undef if 1+$index > $self->FETCHSIZE();
    return vec( $self->{bits}, $index, 1 );
}

sub FETCHSIZE {
    my $self = shift;

    return $self->{size};
}

sub STORESIZE {
    my $self = shift;
    my $size = shift;

    if ( $size < $self->{size} ) {
        substr( $self->{bits}, int( $size / 8 ) + 1 ) = '';
        vec( $self->{bits}, $_, 1 ) = 0 for $size .. $size + 8;
    }

    $self->{size} = $size;

    return;
}

sub DELETE {
    my $self  = shift;
    my $index = shift;

    if ( $index == $self->FETCHSIZE() - 1 ) {
        $self->STORESIZE( $index );
    }
    else {
        $self->STORE( $index, 0 );
    }

    return;
}

sub EXISTS {
    my $self  = shift;
    my $index = shift;

    return $index < $self->FETCHSIZE();
}

sub get_truth_count {
    my $self = shift;

    return unpack '%32b*', $self->{bits};
}

1; # Magic true value required at end of module
__END__