comment on

sub split_before { my ($string, $pos) = @_; my $pos = rindex $string, '*', 30; split /(?<=^.{$pos}\*) /, $string, 2 }
[download]

The quoted code has a problem: the $pos subroutine argument (offset of '*' character of '* ' sequence to be used to split on) is masked by another my $pos definition, and then is not used at all. This is easily fixed. With many (largely imaginary) test cases (update: and there are many corner cases uncovered, but my imagination only stretches so far):

Win8 Strawberry 5.30.3.1 (64)  Sat 09/11/2021 21:56:27
C:\@Work\Perl\monks
>perl
use strict;
use warnings;

#                       1         2         3         4         5     
+    6         7
#             01234567890123456789012345678901234567890123456789012345
+678901234567890123456789
my $string = 'hello my * name is Rob * and * I am a very nice person *
+ at least * I think * so';

my @Tests_ok = (

    [ 30,       # offset associated with '* ' sequence in split
      $string,  # string to split into 2 parts
      'hello my * name is Rob * and *',                     # part 1 o
+f split
      'I am a very nice person * at least * I think * so',  # part 2
      ],

    [ 29,
      $string,
      'hello my * name is Rob * and *',
      'I am a very nice person * at least * I think * so',
      ],

    [ 31,
      $string,
      'hello my * name is Rob * and *',
      'I am a very nice person * at least * I think * so',
      ],

    [ 9,
      $string,
      'hello my *',
      'name is Rob * and * I am a very nice person * at least * I thin
+k * so',
      ],

    [ 40,
      $string,
      'hello my * name is Rob * and *',
      'I am a very nice person * at least * I think * so',
      ],

    [ 28,
      $string,
      'hello my * name is Rob *',
      'and * I am a very nice person * at least * I think * so',
      ],

    [ 60,
      $string,
      'hello my * name is Rob * and * I am a very nice person *',
      'at least * I think * so',
      ],

    [ 79,
      $string,
      'hello my * name is Rob * and * I am a very nice person * at lea
+st * I think *',
      'so',
      ],

    [ 999,
      $string,
      'hello my * name is Rob * and * I am a very nice person * at lea
+st * I think *',
      'so',
      ],

    );  # end @Tests_ok

my @Tests_fail = (  # all these tests should fail

    [ 0,  # only fails because {-1} quantifier does not compile meanin
+gfully
      $string,
      'hello my * name is Rob * and *',
      'I am a very nice person * at least * I think * so',
      ],

    [ 28,
      $string,
      'hello my * name is Rob * and *',
      'I am a very nice person * at least * I think * so',
      ],

    [ 55,
      $string,
      'hello my * name is Rob * and *',
      'I am a very nice person * at least * I think * so',
      ],

    );  # end @Tests_fail

sub split_before {  # modified from choroba pm#11136667
    my ($string, $pos) = @_;
# print "=== A: \$pos $pos \n";  # for debug
    $pos = rindex $string, '*', $pos;
# print "=== B: \$pos $pos \n";  # for debug
    split /(?<=^.{$pos}\*) /, $string, 2
    }

use Test2::V0;

VECTOR_ok:
for my $ar_vector (@Tests_ok) {

    my ($position, $str, $part1, $part2) = @$ar_vector;

    die "'$part1' '$part2' test data invalid" unless "$part1 $part2" e
+q $str;

    is [split_before($str, $position)],
       [$part1, $part2], "$position split is valid";

    }   # end for VECTOR_ok

note "\n=== all following tests expected to fail ===\n\n";

VECTOR_fail:
for my $ar_vector (@Tests_fail) {

    my ($position, $str, $part1, $part2) = @$ar_vector;

    die "'$part1' '$part2' test data invalid" unless "$part1 $part2" e
+q $str;

    isnt [split_before($str, $position)],
         [$part1, $part2], "$position split invalid";

    }   # end for VECTOR_fail

done_testing();
^Z
# Seeded srand with seed '20210911' from local date.
ok 1 - 30 split is valid
ok 2 - 29 split is valid
ok 3 - 31 split is valid
ok 4 - 9 split is valid
ok 5 - 40 split is valid
ok 6 - 28 split is valid
ok 7 - 60 split is valid
ok 8 - 79 split is valid
ok 9 - 999 split is valid
#
# === all following tests expected to fail ===
#
Unescaped left brace in regex is passed through in regex;
  marked by <-- HERE in m/(?<=^.{ <-- HERE -1}\*) / at - line 93.
ok 10 - 0 split invalid
ok 11 - 28 split invalid
ok 12 - 55 split invalid
1..12
[download]

Note that for any $pos to the left of the leftmost '*' in the string, no meaningful split is returned.

Give a man a fish: <%-{-{-{-<

In reply to Re^2: split string at variable position with matching by AnomalousMonk
in thread split string at variable position with matching by Anonymous Monk

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Problems? Is your data what you think it is?
	PerlMonks