File Coverage

blib/lib/Object/String.pm

Criterion	Covered	Total	%
statement	212	212	100.0
branch	38	38	100.0
condition	9	9	100.0
subroutine	78	78	100.0
pod	67	67	100.0
total	404	404	100.0

use strict;
use warnings;
use utf8;
use v5.10;

package Object::String;
use Unicode::Normalize;
use List::Util;

our $VERSION = '0.11'; # VERSION

# ABSTRACT: A string object for Perl 5

use Moo;
use namespace::clean;



has 'string' => ( is => 'ro' );


sub to_string { shift->string; }


sub to_lower {
    my $self = shift;
    $self->{string} = lc $self->{string};
    return $self;
}


sub to_lower_first {
    my $self = shift;
    $self->{string} = lcfirst $self->{string};
    return $self;
}


sub to_upper {
    my $self = shift;
    $self->{string} = uc $self->{string};
    return $self;
}


sub to_upper_first {
    my $self = shift;
    $self->{string} = ucfirst $self->{string};
    return $self;
}


sub capitalize { shift->to_lower->to_upper_first; }


sub Object::String::length { return CORE::length shift->string; }


sub ensure_left {
    my ($self, $prefix) = @_;
    $self->{string} = $self->prefix($prefix)->string
        unless($self->starts_with($prefix));
    return $self;
}


sub ensure_right {
    my ($self, $suffix) = @_;
    $self->{string} = $self->suffix($suffix)->string
        unless($self->ends_with($suffix));
    return $self;
}


sub trim_left {
    my $self = shift;
    $self->{string} =~ s/^(\s|\t)+//;
    return $self;
}


sub trim_right {
    my $self = shift;
    $self->{string} =~ s/(\s|\t)+$//;
    return $self;
}


sub trim { shift->trim_left->trim_right; }


sub clean {
    my $self = shift;
    $self->{string} =~ s/(\s|\t)+/ /g;
    return $self->trim;
}


sub collapse_whitespace { shift->clean; }


sub repeat {
    my ($self, $n) = @_;
    $self->{string} = $self->string x $n;
    return $self;
}


sub times { shift->repeat(@_); }


sub starts_with {
    my ($self, $str) = @_;
    return ($self->string =~ /^$str/);
}


sub ends_with {
    my ($self, $str) = @_;
    return ($self->string =~ /$str$/);
}


sub contains {
    my ($self, $str) = @_;
    return index $self->string, $str;
}


sub include { shift->contains(@_); }


sub chomp_left {
    my $self = shift;
    if($self->starts_with(" ") || $self->starts_with("\t")) {
        return $self->chop_left;
    }
    return $self;
}


sub chomp_right {
    my $self = shift;
    if($self->ends_with(" ") || $self->ends_with("\t")) {
        return $self->chop_right;
    }
    return $self;
}


sub chop_left {
    my $self = shift;
    $self->{string} = substr $self->{string}, 1, CORE::length $self->{string};
    return $self;

}


sub chop_right {
    my $self = shift;
    chop $self->{string};
    return $self;
}


sub is_numeric { shift->string =~ /^\d+$/; }


sub is_alpha { shift->string =~ /^[a-zA-Z]+$/; }


sub is_alpha_numeric { shift->string =~ /^[a-zA-Z0-9]+$/; }


sub is_lower {
    my $self = shift;
    return $self->string eq lc $self->string;
}


sub is_upper {
    my $self = shift;
    return $self->string eq uc $self->string;
}


sub to_boolean {
    my $self = shift;
    return 1 if $self->string =~ /^(on|yes|true)$/i;
    return 0 if $self->string =~ /^(off|no|false)$/i;
    return;
}


sub to_bool { shift->to_boolean }


sub is_empty {
    my $self = shift;
    return 1 if $self->string =~ /\s+/ || $self->string eq '';
    return 0;
}


sub count {
    my ($self, $str) = @_;
    return () = $self->string =~ /$str/g;
}


sub left {
    my ($self, $count) = @_;
    if($count < 0) {
        $self->{string} = substr $self->string, $count, abs($count);
        return $self;
    }
    $self->{string} = substr $self->string, 0, $count;
    return $self;
}


sub right {
    my ($self, $count) = @_;
    if($count < 0) {
        $self->{string} = substr $self->string, 0, abs($count);
        return $self;
    }
    $self->{string} = substr $self->string, -$count, $count;
    return $self;
}


sub underscore {
    my $self = shift;
    $self->{string} = $self->transliterate(' -', '_')->string;
    $self->{string} =~ s/::/\//g;
    $self->{string} =~ s/^([A-Z])/_$1/;
    $self->{string} =~ s/([A-Z]+)([A-Z][a-z])/$1_$2/g;
    $self->{string} =~ s/([a-z\d])([A-Z])/$1_$2/g;
    return $self->to_lower;
}


sub underscored { shift->underscore; }


sub dasherize { shift->underscore->transliterate('_', '-'); }


sub camelize {
    my $self = shift;
    my $begins_underscore = $self->underscore->starts_with('_');
    $self->{string} = join '', map { ucfirst $_ } split /_/, $self->underscore->string;
    $self->{string} = join '::', map { ucfirst $_ } split /\//, $self->string;
    return ($begins_underscore ? $self : $self->to_lower_first);
}


sub latinise {
    my $self = shift;
    $self->{string} = NFKD($self->string);
    $self->{string} =~ s/\p{NonspacingMark}//g;
    return $self;
}


sub escape_html {
    return shift->replace_all('&', '&')
                ->replace_all('"', '"')
                ->replace_all("'", ''')
                ->replace_all('<', '<')
                ->replace_all('>', '>');
}


sub unescape_html {
    return shift->replace_all('&', '&')
                ->replace_all('"', '"')
                ->replace_all(''', "'")
                ->replace_all('<', '<')
                ->replace_all('>', '>');
}


sub index_left {
    my ($self, $substr, $position) = @_;
    return index $self->string, $substr, $position if defined $position;
    return index $self->string, $substr;
}


sub index_right {
    my ($self, $substr, $position) = @_;
    return rindex $self->string, $substr, $position if defined $position;
    return rindex $self->string, $substr;
}


sub replace_all {
    my ($self, $substr1, $substr2) = @_;
    $substr1 = quotemeta $substr1;
    $self->{string} =~ s/$substr1/$substr2/g;
    return $self;
}


sub humanize {
    return shift->underscore
                ->replace_all('_', ' ')
                ->trim
                ->capitalize;
}


sub pad_left {
    my ($self, $count, $char) = @_;
    $char = ' ' unless defined $char;
    return $self if $count <= $self->length;
    $self->{string} = $char x ($count - $self->length) . $self->string;
    return $self;
}


sub pad_right {
    my ($self, $count, $char) = @_;
    $char = ' ' unless defined $char;
    return $self if $count <= $self->length;
    $self->{string} = $self->string . $char x ($count - $self->length);
    return $self;
}


sub pad {
    my ($self, $count, $char) = @_;
    $char = ' ' unless defined $char;
    return $self if $count <= $self->length;
    my $count_left = 1 + int(($count - $self->length) / 2);
    my $count_right = $count - $self->length - $count_left;
    $self->{string} = $char x $count_left . $self->string;
    $self->{string} = $self->string . $char x $count_right;
    return $self;
}


sub next {
    my $self = shift;
    $self->{string}++;
    return $self;
}


sub slugify {
    return shift->trim
                ->humanize
                ->latinise
                ->strip_punctuation
                ->to_lower
                ->dasherize;
}


sub strip_punctuation {
    my $self = shift;
    $self->{string} =~ s/[[:punct:]]//g;
    return $self;
}


sub swapcase { shift->transliterate('a-zA-Z', 'A-Za-z'); }


sub concat {
    my ($self, @strings) = @_;
    $self->{string} = $self->string . join '', @strings;
    return $self;
}


sub suffix { shift->concat(@_); }


sub prefix {
    my ($self, @strings) = @_;
    $self->{string} = join('', @strings) . $self->string;
    return $self;
}


sub reverse {
    my $self = shift;
    $self->{string} = join '', reverse split //, $self->string;
    return $self;
}


sub count_words {
    my @arr = split /\s/, shift->clean->string;
    return $#arr + 1;
}


sub quote_meta {
    my $self = shift;
    $self->{string} = quotemeta $self->string;
    return $self;
}


sub rot13 { shift->transliterate('A-Za-z', 'N-ZA-Mn-za-m'); }


sub say { CORE::say shift->string; }


sub titleize {
    my $self = shift;
    $self->{string} = join ' ', map { str($_)->capitalize->string }
                                    split / /,
                                          $self->clean
                                               ->strip_punctuation
                                               ->string;
    return $self;
}


sub titlecase { shift->titleize }


sub squeeze {
    my ($self, $keep) = @_;
    $keep = '' unless defined $keep;
    $self->{string} =~ eval "\$self->{string} =~ tr/$keep//cs";
    return $self;
}


sub shuffle {
    my $self = shift;
    $self->{string} = join '', List::Util::shuffle split //, $self->string;
    return $self;
}


sub transliterate {
    my ($self, $str1, $str2) = @_;
    $self->{string} =~ eval "\$self->{string} =~ tr/$str1/$str2/";
    return $self;
}

no Moo;

use base 'Exporter';

our @EXPORT = qw {
    str
};


sub str {
    my $string = join ' ', @_;
    return Object::String->new(string => $string);
}

1;

__END__