File Coverage

blib/lib/String/Incremental/Char.pm

Criterion	Covered	Total	%
statement	98	99	98.9
branch	28	28	100.0
condition			n/a
subroutine	20	20	100.0
pod	6	7	85.7
total	152	154	98.7

package String::Incremental::Char;
use 5.008005;
use warnings;
use Mouse;
use Data::Validator;
use MouseX::Types::Mouse qw( Bool Int );
use String::Incremental::Types qw( Char CharOrderStr CharOrderArrayRef is_CharOrderStr );
use Try::Tiny;

use overload (
    '""' => \&as_string,
    '++' => \&increment,
    '--' => \&decrement,
    '='  => sub { $_[0] },
);

has 'order'  => ( is  => 'ro', isa => CharOrderArrayRef );
has 'upper'  => ( is  => 'ro', isa => __PACKAGE__, predicate => 'has_upper' );
has '__i'    => ( is => 'rw', isa => Int );
has '__size' => ( is => 'ro', isa => Int );

sub BUILDARGS {
    my ($class, %args) = @_;
    my $v = Data::Validator->new(
        order => { isa => CharOrderStr|CharOrderArrayRef },
        upper => { isa => __PACKAGE__, optional => 1 },
        set   => { isa => Char, optional => 1 },
        __i   => { isa => Int, default => 0 },  # for internal use
    );
    %args = %{$v->validate( \%args )};

    if ( is_CharOrderStr( $args{order} ) ) {
        $args{order} = [ split //, $args{order} ];
    }

    %args = (
        %args,
        __size => 0 + @{$args{order}},
    );

    if ( $args{__i} >= $args{__size} ) {
        my $msg = '__i: should be less than size of "order"';
        die $msg;
    }

    return \%args;
}

sub BUILD {
    my ($self, $args) = @_;
    if ( exists $args->{set} ) {
        $self->set( $args->{set} );
    }
}

sub as_string {
    my ($self) = @_;
    return $self->order->[ $self->__i ];
}

sub set {
    my ($self, $ch, $opts) = @_;
    my $v_opts = Data::Validator->new(
        test => { isa => Bool, default => 0 },
    );
    $opts = $v_opts->validate( %{$opts || {}} );

    unless ( defined $ch ) {
        die 'value to set must be specified';
    }
    unless ( $ch =~ /^.$/ ) {
        die 'must be specified as a character';
    }
    my ($i, $found) = ( 0, 0 );
    for ( @{$self->order} ) {
        if ( $_ eq $ch ) {
            $found = 1;
            last;
        }
        $i++;
    }
    unless ( $found ) {
        my $msg = srintf( '"%s" is not in order', $ch );
        die $msg;
    }
    unless ( $opts->{test} ) {
        $self->__i( $i );
    }
    return "$self";
}

sub increment {
    my ($self) = @_;
    my ($i_try, $ch);
    $i_try = $self->__i + 1;

    if ( $i_try >= $self->__size ) {
        if ( $self->has_upper() ) {
            my $upper = $self->upper;
            try {
                $upper->increment();
                $i_try = 0;
            } catch {
                my ($msg) = @_;
                die $msg;
            };
        }
        else {
            my $msg = 'cannot increment';
            die $msg;
        }
    }

    $self->__i( $i_try );
    return $self->as_string();
}

sub decrement {
    my ($self) = @_;
    my ($i_try, $ch);
    $i_try = $self->__i - 1;

    if ( $i_try < 0 ) {
        if ( $self->has_upper() ) {
            my $upper = $self->upper;
            try {
                $upper->decrement();
                $i_try = $self->__size - 1;
            } catch {
                my ($msg) = @_;
                die $msg;
            };
        }
        else {
            my $msg = 'cannot decrement';
            die $msg;
        }
    }

    $self->__i( $i_try );
    return $self->as_string();
}

sub re {
    my ($self) = @_;
    my $re = join '', map {
        my $i = $_;
        #  ref: http://search.cpan.org/perldoc?perlrecharclass#Special_Characters_Inside_a_Bracketed_Character_Class
        ( $i =~ m/[\\\^\-\[\]]/ ) ? "\\${i}" : $i;
    } @{$self->order};
    return qr/[$re]/;
}

__PACKAGE__->meta->make_immutable();
__END__