File Coverage

blib/lib/String/Incremental.pm

Criterion	Covered	Total	%
statement	101	101	100.0
branch	16	18	88.8
condition			n/a
subroutine	24	24	100.0
pod	5	8	62.5
total	146	151	96.6

package String::Incremental;
use 5.008005;
use strict;
use warnings;
use Mouse;
use MouseX::Types::Mouse qw( Str ArrayRef is_Str );
use String::Incremental::Types qw( Char );
use String::Incremental::FormatParser;
use String::Incremental::Char;
use Data::Validator;
use Try::Tiny;

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

extends qw( Exporter Tie::Scalar );

our $VERSION = "0.01";

our @EXPORT_OK = qw( incremental_string );

has 'format' => ( is => 'ro', isa => Str );
has 'items'  => ( is => 'ro', isa => ArrayRef );
has 'chars'  => ( is => 'ro', isa => ArrayRef['String::Incremental::Char'] );

sub BUILDARGS {
    my ($class, %args) = @_;
    my $v = Data::Validator->new(
        format => { isa => Str },
        orders => { isa => ArrayRef, default => [] },
    );
    %args = %{$v->validate( \%args )};

    my $p = String::Incremental::FormatParser->new( $args{format}, @{$args{orders}} );

    return +{
        format => $p->format,
        items  => $p->items,
        chars  => [ grep $_->isa( __PACKAGE__ . '::Char' ), @{$p->items} ],
    };
}

sub incremental_string {
    my ($format, @orders) = @_;
    return __PACKAGE__->new( format => $format, orders => \@orders );
}

sub char {
    my ($self, $i) = @_;
    my $ch;
    unless ( defined $i ) {
        die 'index to set must be specified';
    }
    unless ( $i =~ /^\d+$/ ) {
        die 'must be specified as Int';
    }
    unless ( defined ( $ch = $self->chars->[$i] ) ) {
        die 'out of index';
    }
    return $ch;
}

sub as_string {
    my ($self) = @_;
    my @vals = map "$_", @{$self->items};
    return sprintf( $self->format, @vals );
}

sub set {
    my $v = Data::Validator->new(
        val => { isa => Str },
    )->with( 'Method', 'StrictSequenced' );
    my ($self, $args) = $v->validate( @_ );

    my @ch = $self->_extract_incremental_chars( $args->{val} );
    for ( my $i = 0; $i < @ch; $i++ ) {
        my $char = $self->char( $i );
        $char->set( $ch[$i] );
    }

    return "$self";
}

sub increment {
    my ($self) = @_;
    my ($last_ch) = grep $_->isa( __PACKAGE__ . '::Char' ), reverse @{$self->items};
    if ( defined $last_ch ) {
        $last_ch++;
    }
    return "$self";
}

sub decrement {
    my ($self) = @_;
    my ($last_ch) = grep $_->isa( __PACKAGE__ . '::Char' ), reverse @{$self->items};
    if ( defined $last_ch ) {
        $last_ch--;
    }
    return "$self";
}

sub re {
    my ($self) = @_;
    my ($re, @re);

    @re = map {
        my $i = $_;
        my $_re = $i->re();
        my $ref = ref $_;
        $ref eq __PACKAGE__ . '::Char' ? "(${_re})" : $_re;
    } @{$self->items};

    (my $fmt = $self->format) =~ s/%(?:\d+(?:\.?\d+)?)?\S/\%s/g;
    $re = sprintf $fmt, @re;

    return qr/^(${re})$/;
}

sub _extract_incremental_chars {
    my $v = Data::Validator->new(
        val => { isa => Str },
    )->with( 'Method', 'StrictSequenced' );
    my ($self, $args) = $v->validate( @_ );
    my @ch;

    (my $match, @ch) = $args->{val} =~ $self->re();
    unless ( defined $match ) {
        my $msg = 'specified value does not match with me';
        die $msg;
    }

    return wantarray ? @ch : \@ch;
}

sub TIESCALAR {
    my ($class, @args) = @_;
    return $class->new( @args );
}

sub FETCH { $_[0] }

sub STORE {
    my ($self, @args) = @_;
    if ( ref( $args[0] ) eq '' ) {  # ignore when ++/--
        $self->set( @args );
    }
}

__PACKAGE__->meta->make_immutable();
__END__