Remove word from the end of a string that has been cut off to different lengths

One way is to build the regex is an alternation of possible string versions. This I think should also extend well to more general uses

use warnings;
use strict;
use feature 'say';

my $target = shift || 'hello';

my @strings = (
    "Test 1 hello",
    "Something else",
    "Test 2 hell",
    "And also he",
    "Test 4 hel"
);

my $re_versions = build_regex($target);

foreach my $string (@strings)
{
    if ($string =~ /($re_versions)$/)
    {
        say "'$string' --> $1";
    }
};

sub build_regex {
    my ($s) = @_;
    my @versions;
    while ($s) {
        push @versions, quotemeta $s;
        chop $s;
    }
    return join '|', @versions;
}

This isn't shorter (while it certainly can be written in a shorter way) but it should be manageable for refinements in acceptable versions of the string, matching order, etc.

If there is a reason to want a compiled regex back change the function return to

my $re_str = join '|', @versions;
return qr/$re_str/;

where you can now also add flags that may be suitable.

You are looking for a regexp to match following expressions at end of a string : hello, hell, hel, he, h. We can expect that the expression is preceeded by at least once space.

You could just write :

s/\s+(hello$)|(hell$)|(hel$)|(he$)|(h$)// for @strings;

This will modify in-place all elements in the array to what you expect.

I needed, you can generate the match string automatically for any given word :

my $word  = "hello";
my @parts = map { substr $word, 0, $_ } (1..(length $word));
my $match = join "|", map { "(" . $_ . "\$)" } @words;
s/\s+$match// for @strings;

dawg's answer simplifies the regex but it doesn't work for use cases that are more complex than my example. GMB's answer works in any case but also leads to long (but admittedly better understandable) regexes. My personal solution is to use a function to construct the correct regex dynamically from any needed string:

#!/usr/bin/perl

use strict;
use warnings;

my @strings =
    (
        "Test 1 hello",
        "Something else",
        "Test 2 hell",
        "And also he",
        "Test 4 hel"
    );

my $regex = cutOffStringRegex('hello');

foreach my $string (@strings)
{
    if ($string =~ m/(.*?)\s*$regex$/x)
    {
        print "'", $string, "' -> '", $1, "'\n";
    }
}

sub cutOffStringRegex
{
    my ($string) = @_;
    my $resultString = "";
    if (length($string) == 1)
    {
        $resultString = quotemeta $string;
    }
    else
    {
        my $firstChar = quotemeta(substr $string, 0, 1);
        my $rest = substr $string, 1;
        $resultString = $firstChar . cutOffStringRegex($rest);
    }
    return '(' . $resultString . ')?';
}

cutOffStringRegex('hello') results in "(h(e(l(l(o)?)?)?)?)?". Since my question was "how to write this shorter", I won't mark this answer as the correct one because it definitly isn't shorter.

You could use a reverse logic: instead of searching for partial hellos, grab the last word and search for it in hello.

Maybe this won't be exactly shorter, but it can be cleaner. Grabbing the last word is easy enough with a /(\w+)$/, and to check if it is contained in hello no regex is needed. A simple call to index will do.

foreach (@strings) {
    (my $original = $_) =~ /(\w+)$/;
    s/\s*\w+$// unless index('hello', $1);
    say "'$original' -> '$_'";
}

To make it clear, index returns the index of the substring $1 in 'hello'. We only care about the case when it returns 0, meaning it exists and is at the start (would be -1 if non-existent or bigger than 0 at a different position). That's why we remove the last word only when this operation is 0 with unless.

If you want to remove the fragments of starting with he with that being an optional fragment:

#!/usr/bin/perl

use 5.020;
use strict;
use warnings;

my @strings =
(
    "Test 1 hello",
    "Something else",
    "Test 2 hell",
    "And also he",
    "Test 4 hel"
);

for (@strings){
    s/\hhe[lo]*$//;
    say;
}

Prints:

Test 1
Something else
Test 2
And also
Test 4

Or, you can match and keep what you want:

for (@strings){
    say $1 if /^(.*?)(?:\hhe[lo]*)?$/;
}
# same output

If you want to make sure that the captured text matches the characters hello in that order, match the captured substring:

for (@strings){
    say if /^(.*?)( he[lo]*)?$/ && (!$2 || ' hello' =~ /^$2/);
    }