Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re^2: split string at variable position with matching

by AnomalousMonk (Bishop)
on Sep 12, 2021 at 02:28 UTC ( #11136673=note: print w/replies, xml ) Need Help??


in reply to Re: split string at variable position with matching
in thread split string at variable position with matching

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

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
Note that for any $pos to the left of the leftmost '*' in the string, no meaningful split is returned.


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

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11136673]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (1)
As of 2022-01-17 01:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    In 2022, my preferred method to securely store passwords is:












    Results (50 votes). Check out past polls.

    Notices?