File Coverage

blib/lib/OpusVL/Text/Util.pm

Criterion	Covered	Total	%
statement	67	73	91.7
branch	21	22	95.4
condition	5	5	100.0
subroutine	13	14	92.8
pod	9	9	100.0
total	115	123	93.5

package OpusVL::Text::Util;

use 5.014;
use strict;
use warnings;

our @ISA = qw/Exporter/;
our @EXPORT_OK = qw/truncate_text wrap_text string_to_id missing_array_items not_blank split_words line_split mask_text split_camel_case/;

use Array::Utils qw/intersect array_minus/;
use Scalar::Util qw/looks_like_number/;

# ABSTRACT: Simple text utilities

our $VERSION = '0.10';



sub truncate_text
{
    my $string = shift;
    my $length = shift;

    return $string if length($string) < $length;
    if($string =~ /^(.{0,$length}\w\b)/)
    {
        return $1 . '...';
    }
    else
    {
        return substr $string, 0, $length;
    }
}


sub wrap_text
{
    my $string = shift;
    my $length = shift;
    my $separator = shift || "\n";

    return $string if length($string) < $length;
    my @lines = $string =~ /\G(.{0,$length}\w\b|.*\w\b)\s*/g;
    return join $separator, @lines;
}


sub string_to_id
{
    my $text = shift;
    my $r = $text =~ s/\s+/_/gr;
    $r =~ s/[^\w_]//g;
    return lc $r;
}


sub line_split
{
    my $text = shift;
    my @lines = split /\r\n|\r|\n/, $text;
    return @lines
}


sub missing_array_items
{
    my ($mandatory_fields, $actual_fields) = @_;

    my @mand_found = intersect(@$mandatory_fields, @$actual_fields);
    unless(scalar @mand_found == scalar @$mandatory_fields)
    {
        my @missing = array_minus(@$mandatory_fields, @mand_found);
        return \@missing;
    }
    return;
}


sub not_blank
{
    my $value = shift;
    return 1 if $value;
    if(looks_like_number($value))
    {
        return 1;
    }
    return 0;
}


sub split_words
{
    my $value = shift;
    return split /[\s,]+/, $value;
}


sub mask_text
{
    my ($fill_char, $regex, $text) = @_;

    # fudge the regex.
    my @values = $text =~ /$regex/s;
    unless(@values)
    {
        return $fill_char x length($text);
    }
    my @chars;
    my $group = 1;
    my $group_inserted = 0;
    my $start = $-[$group];
    my $end = $+[$group];
    for (my $i = 0; $i < length($text); $i++)
    {
        if($i > $end)
        {
            $group++;
            $group_inserted = 0;
            if($group > scalar @values)
            {
                $start = length($text) + 1;
                $end = $start +1;
            }
            else
            {
                $start = $-[$group];
                $end = $+[$group];
            }
        }
        if($i >= $start && $i < $end)
        {
            unless($group_inserted)
            {
                $group_inserted = 1;
                push @chars, $values[$group-1];
            }
        }
        else
        {
            push @chars, $fill_char;
        }
    }
    return join '', @chars;
}


sub split_camel_case
{
    my $text = shift;
    # a lot of the credit for this goes to the Perl Monks.
    my @parts = $text =~ /[A-Z0-9](?:[A-Z0-9]+|[^A-Z0-9]*)(?=$|[A-Z0-9])/g;
    return \@parts;
}

1; # End of OpusVL::Text::Util

__END__