File Coverage

blib/lib/Pugs/Runtime/StrPos.pm

Criterion	Covered	Total	%
statement	18	53	33.9
branch	0	10	0.0
condition			n/a
subroutine	6	25	24.0
pod	0	15	0.0
total	24	103	23.3

package Pugs::Runtime::StrPos;
# Documentation in the __END__

#use 5.006; ???
use strict;
use warnings;
use utf8;
use Data::Dumper;

use overload (
    'bool'   => \&bool,
    '0+'     => \&graphs,
    '++'     => sub {
        $_[0]->{codes} = ($_[0]->add_graphs( 1 ))->{codes};
    },
    '+='     => sub {
        $_[0]->{codes} += $_[1];
    },
    '+'     => sub {
        ($_[0]->add_graphs( $_[1] ))->{codes};
    },
    '='     => sub {
           my $self = shift;
           bless {%$self}, ref $self;
         },
    fallback => 1,
);

# new({ str => "...", codes => $n });
# $str must be utf-8
# $n can be undef, meaning "nowhere in this string"
sub new {
    return bless $_[1], $_[0];
}

# codes is the default perl5 representation
# graphs is the default perl6 representation
sub from_str_graphs {

    # -- downgrade as appropriate
    #die "string has invalid internal encoding"
    return from_str_codes( @_ )
        unless utf8::is_utf8( $_[1] );

    $_[1] =~ m/^\X{$_[2]}/g;
    return bless { str => $_[1], codes => pos($_[1]) }, $_[0];
}

sub from_str_codes {
    return bless { str => $_[1], codes => $_[2] }, $_[0];
}

sub from_str {
    return bless { str => $_[1], codes => pos( $_[1] ) }, $_[0];
}

sub clone {
    return bless { %{$_[0]} }, ref( $_[0] );
}

sub bool  {
    defined $_[0]->{codes}
}

sub codes  {
    $_[0]->{codes}
}

sub bytes {
    return undef unless defined $_[0]->{codes};

    # -- downgrade as appropriate
    #die "string has invalid internal encoding"
    return $_[0]->codes
        unless utf8::is_utf8( $_[0]->{str} );

    my $s = substr( $_[0]->{str}, 0, $_[0]->{codes} );
    {
        use bytes;
        return length( $s );
    }
    #my @bytes = unpack("C*", substr( $_[0]->{str}, 0, $_[0]->{codes} ) );
    #print "[",join(",", @bytes),"]\n";
    #return scalar @bytes;
}

sub graphs {
    return undef unless defined $_[0]->{codes};

    # -- downgrade as appropriate
    #die "string has invalid internal encoding"
    return $_[0]->codes
        unless utf8::is_utf8( $_[0]->{str} );

    #return scalar( substr( $_[0]->{str}, 0, $_[0]->{codes} ) =~ m/\X/g );
    my @g = substr( $_[0]->{str}, 0, $_[0]->{codes} ) =~ m/\X/g;
    return scalar @g;
}

sub langs {
    die "TODO: langs()";
}

sub add_codes {
    (ref $_[0])->from_str_codes( $_[0]->{str}, $_[0]->codes + $_[1] );
}

sub add_graphs {
    (ref $_[0])->from_str_graphs( $_[0]->{str}, $_[0]->graphs + $_[1] );
}

sub perl {
    local $Data::Dumper::Terse    = 1;
    local $Data::Dumper::Sortkeys = 1;
    local $Data::Dumper::Pad = '  ';
    return Dumper( $_[0] );
}

sub yaml {
    require YAML::Syck;
    # interoperability with other YAML/Syck bindings:
    $YAML::Syck::ImplicitTyping = 1;
    YAML::Syck::Dump( $_[0] );
}

# for Pugs interoperability
sub dump_hs {
    die "TODO";
}

1;

__END__