sub trunc {
    @_ == 2 or return;
    my ($max_words, $text) = @_;
    $text =~ /(\W*(?:\w+\W*){1,$max_words})/ and return $1;
}

my $str = "there once was a man from Nantucket who kept all his cash in a bucket";
print trunc(5, $str), "\n";

##</code><code>##

/((?:[^\w\s]*\w+[^\w\s]*\s*){1,$max_words})/