I still don't really understand your requirement, but here's a different approach. In my previous solution, the absolute offset of the start of the number field in the line had always to be the same if subsequent lines were to be rejected once a valid number line was detected. In this solution, the offset between the end of the $toss_tag substring and the start of the number field must remain the same, wherever the toss tag happens to be in the string. So in the following string:
I hope that makes sense. (I also slightly simplified some of the field capture logic, but that shouldn't matter.) Tested under Perl version 5.8.9, so it should work under any later version.+----------------------------------- any number of any characters | before toss-tag field | | +---------------------------- toss-tag field (defined | | string, constant width) | | | | +--------------------- any number of any non-digits | | | between end of toss-tag | | | and start of number field. | | | characters can vary after | | | first field seen, but width | | | cannot vary once set. | | | | | | +----------- number field. number cannot | | | | vary once set. | | | | | | | | +---- any number of any characters | | | | | after number field | | | | | /---+----\/+\/----+----\/---+---\/-+-----------------------\ 'line 2 xx Foo NineChars 1234-12.3 other 123 first valid keep'
c:\@Work\Perl\monks>perl -wMstrict -e "use Data::Dump qw(dd); ;; my @lines = ( 'line 1 this line has no Foo number: keep', 'line 2 xx Foo NineChars 1234-12.3 other 123 first valid keep', 'KILL 3 x Foo kill-this 1234-12.3 line 123 DELETE', 'line 4 Foo -retain- 1234-12.3 offset 123 line keep', 'KILL 5 Foo ninechars 1234-12.3 line 123 DELETE', 'line 6 Foo --retain-- 1234-12.3 offset 123 line keep', 'line 7 Foox not tag 1234-12.3 same offset 123 keep', 'line 8 has no Foo number: keep', 'KILL 9 xxx Foo toss-this 1234-12.3 other 123 DELETE', 'line 10 Foo -retain- 1234-12.3 this line keep', 'line 11 Foo ninechars 1234-21.3 same offset, different sn: keep', 'KILL 12 x Foo nInEcHaRs 1234-12.3 one DELETE', 'line 13 no Foo number: keep', ); dd \@lines; print qq{\n}; ;; my $strange_n = qr{ (?<! \d) \d+ - \d+ (?: [.] \d+)* (?! [.\d]) }xms; my $toss_tag = qr{ \b Foo \b }xms; ;; my $rx_can_toss = qr{ \A .+ ($toss_tag) \D* ($strange_n) }xms; ;; my ($first_sn_seen, $sn, $sn_offset); ;; my @keep_lines; LINE: for my $i (0 .. $#lines) { my ($sn_seen, $this_sn, $this_sn_offset) = $lines[$i] =~ $rx_can_toss ? (1, $2, $-[2]-$+[1]) : (); if ($sn_seen) { if ($first_sn_seen) { next LINE if $sn eq $this_sn && $sn_offset == $this_sn_offset; } else { ($first_sn_seen, $sn, $sn_offset) = (1, $this_sn, $this_sn_offs +et); } } push @keep_lines, $lines[$i]; } dd \@keep_lines; " [ "line 1 this line has no Foo number: keep", "line 2 xx Foo NineChars 1234-12.3 other 123 first valid keep", "KILL 3 x Foo kill-this 1234-12.3 line 123 DELETE", "line 4 Foo -retain- 1234-12.3 offset 123 line keep", "KILL 5 Foo ninechars 1234-12.3 line 123 DELETE", "line 6 Foo --retain-- 1234-12.3 offset 123 line keep", "line 7 Foox not tag 1234-12.3 same offset 123 keep", "line 8 has no Foo number: keep", "KILL 9 xxx Foo toss-this 1234-12.3 other 123 DELETE", "line 10 Foo -retain- 1234-12.3 this line keep", "line 11 Foo ninechars 1234-21.3 same offset, different sn: keep", "KILL 12 x Foo nInEcHaRs 1234-12.3 one DELETE", "line 13 no Foo number: keep", ] [ "line 1 this line has no Foo number: keep", "line 2 xx Foo NineChars 1234-12.3 other 123 first valid keep", "line 4 Foo -retain- 1234-12.3 offset 123 line keep", "line 6 Foo --retain-- 1234-12.3 offset 123 line keep", "line 7 Foox not tag 1234-12.3 same offset 123 keep", "line 8 has no Foo number: keep", "line 10 Foo -retain- 1234-12.3 this line keep", "line 11 Foo ninechars 1234-21.3 same offset, different sn: keep", "line 13 no Foo number: keep", ]
Give a man a fish: <%-{-{-{-<
In reply to Re^2: Array Exact Position Filter
by AnomalousMonk
in thread Array Exact Position Filter
by Perolizador
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |