Three loops, but only one or two will ever iterate:

#! perl -slw
use strict;

sub truncTo {
    my( $s, $t ) = @_;
    my $l = length $s;
    $s =~ m[^\s*(.+?)\s*$];
    my( $b, $e ) = ( $-[1], $+[1] );
    ++$e while $e < $l and ( $e - $b ) < $t;
    --$b while $b and ( $e - $b ) < $t;
    --$e while ( $e - $b ) > $t;
    return substr( $s, $b, $e-$b );
}

for(
    "  ab ",
    "  ab   ",
    "  abc   ",
    "  abcd   ",
    "  abcde   ",
    "  abcdef   ",
    "  abcdefg   ",
) {
    printf "%15.15s => '%s'\n", "'$_'", truncTo( $_, 6 );
}

__END__
c:\test>828994.pl
        '  ab ' => '  ab '
      '  ab   ' => ' ab   '
     '  abc   ' => 'abc   '
    '  abcd   ' => 'abcd  '
   '  abcde   ' => 'abcde '
  '  abcdef   ' => 'abcdef'
 '  abcdefg   ' => 'abcdef'
[download]