view release on metacpan or  search on metacpan

lib/Text/Elide.pm  view on Meta::CPAN

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__

=head1 NAME

Text::Elide - Perl module with simple "word" aware string truncating routine

=head1 VERSION

This document describes Text::Elide version 0.0.1

=head1 SYNOPSIS

    use Text::Elide qw( elide );
    # text is "testing testing"
    my $new_text = elide( $text, 11 );
    # new_text is "testing ..."

=head1 DESCRIPTION

This is a simple module that exports a single function - elide - which takes a string and a length and truncates the string to at most the length given. It does this is a way which is "word" aware, so that you always end up with a string that only ha...

Here are some example inputs /outputs:

    elide( "testing testing testing", 15 );     # "testing testing",
    elide( "testing testing testing", 14 );     # "testing ...",
    elide( "testing testing", 11 );             # "testing ...",
    elide( "testing testing", 10 );             # "testing",
    elide( "testing testing", 9 );              # "testing",
    elide( "testing testing", 8 );              # "testing",
    elide( "testing testing", 7 );              # "testing",
    elide( "testing testing", 6 );              # "testin",