File Coverage

blib/lib/Text/Elide.pm

Criterion	Covered	Total	%
statement	21	41	51.2
branch	0	18	0.0
condition	0	6	0.0
subroutine	7	8	87.5
pod	1	1	100.0
total	29	74	39.1

package Text::Elide;

use version; $VERSION = qv('0.0.3');

use warnings;
use strict;
use Carp;

use base qw( Exporter );
our @EXPORT_OK = qw( elide );

# use Smart::Comments;
use Readonly;
use List::Util qw( min );

Readonly my $default_elipsis => " ...";

# Module implementation here

sub elide
{
    defined( my $string = shift ) || die "no string argument\n";
    defined( my $length = shift ) || die "no length argument\n";
    croak "length must be a positive integer\n" unless $length > 0;
    my $elipsis = shift || $default_elipsis;
    # trivial case where string is already less than length
    return $string if length( $string ) <= $length;
    ### require: length( $string ) > $length
    # to check if we have broken in the middle of a word ...
    my $broken_word =
        substr( $string, $length-1, 1 ) =~ /\S/ &&
        substr( $string, $length, 1 ) =~ /\S/
    ;
    # crudely truncate ...
    $string = substr( $string, 0, $length );
    ### require: length( $string ) == $length
    # strip trailing whitespace
    $string =~ s/\s*$//;
    ### require: $string =~ /\S$/
    # return truncated string if only one word / part of word (no whitespace) -
    # ( ... but possibly with leading whitespace)
    return $string if $string =~ /^\s*\S+$/;
    ### require: $string =~ /\S\s+\S/
    croak "elipsis string ($elipsis) is longer than length ($length)\n"
        if length( $elipsis ) > $length
    ;
    ### require: length( $elipsis ) <= $length
    if ( $broken_word )
    {
        # remove partial word if crude truncation split mid-word
        $string =~ s/\s+\S+$//;
        ### require: $string =~ /\S$/
    }
    # if there is only one word ...
    unless ( $string =~ /\S\s+\S/ )
    {
        # check if room for elipsis ...
        if ( length( $string ) + length( $elipsis ) <= $length )
        {
            return $string . $elipsis;
        }
        # ... else return string without elipsis
        return $string;
    }
    ### require: $string =~ /\s+\S+$/
    # recursively remove "words" until there is room for the elipsis string
    while ( length( $string ) + length( $elipsis ) > $length )
    {
        ### require: length( $string ) + length( $elipsis ) > $length
        ### require: $string =~ /\s+\S+/
        $string =~ s/\s+\S+$//;
        ### require: length( $string ) > 0
    }
    ### require: length( $string ) + length( $elipsis ) <= $length
    $string = $string . $elipsis;
    return $string;
}

1; # Magic true value required at end of module
__END__