Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

Following tested under ActiveState 5.8.9 and Strawberries 5.10.1.5, 5.12.3.0 and 5.14.4.1. I'm sure this code can be simplified a bit. No Benchmark-ing whatsoever done.

use warnings # FATAL => 'all' ; use strict; use Test::More # tests => ?? + 1 # Test::NoWarnings adds 1 test 'no_plan' ; use Test::NoWarnings; my $renames = { qw(this_sub that_sub var_1 var_a var_2 var_b and FILED), map { $_ => 'FAILED' } qw(Ignore nothing can t do it), }; my ($rx_rename) = map qr{ \b (?: $_) \b }xms, join q{ | }, keys %$renames ; # functions under test ############################################### +###### eval q{ # uses s///r from version 5.14.4+ # uses \K and possessive quantifiers from 5.10+ sub replace_5_14_4 { my ($string, ) = @_; my $rx_dquot = qr{ " [^"]*+ (?: "" [^"]*+)*+ " }xms; my $rx_ceol = qr{ ' [^\n]*+ \n?+ \z }xms; my $rx_skipem = qr{ $rx_dquot | $rx_ceol }xms; return $string =~ s{ $rx_skipem*+ \K ((?: (?! $rx_skipem) .)*+) } { $1 =~ s{ ($rx_rename) }{$renames->{$1}}xmsgr }xmsger; } } if $] >= 5.014_004; die "replace_5_14_4(): $@" if $@; eval q{ # uses \K and possessive quantifiers from 5.10+ sub replace_5_10_1 { my ($string, ) = @_; my $rx_dquot = qr{ " [^"]*+ (?: "" [^"]*+ )*+ " }xms; my $rx_ceol = qr{ ' [^\n]*+ \n?+ \z }xms; my $rx_skipem = qr{ $rx_dquot | $rx_ceol }xms; $string =~ s{ $rx_skipem*+ \K ((?: (?! $rx_skipem) .)*+) } { my $one = $1; $one =~ s{ ($rx_rename) }{$renames->{$1}}xmsg unless $one =~ $rx_skipem; $one; }xmsge; return $string; } } if $] >= 5.010_001; die "replace_5_10_1(): $@" if $@; eval q{ # should be ok for any version 5.8.9+ sub replace_5_8_9 { my ($string, ) = @_; my $rx_dquot = qr{ " [^"]* (?: "" [^"]* )* " }xms; my $rx_ceol = qr{ ' [^\n]* \n? \z }xms; my $rx_skipem = qr{ $rx_dquot | $rx_ceol }xms; # alt order co +unts! $string =~ s{ ( (?> $rx_skipem) | (?> (?: (?! $rx_skipem) .)*)) } { my $one = $1; $one =~ s{ ($rx_rename) }{$renames->{$1}}xmsg unless $one =~ $rx_skipem; $one; }xmsge; return $string; } } if $] >= 5.008_009; die "replace_5_8_9(): $@" if $@; # testing ############################################################ +###### METHOD: for my $func_name (qw(replace_5_14_4 replace_5_10_1 replace_5_8_9)) +{ next METHOD unless defined &{$func_name}; note "\n testing function $func_name() \n\n"; *replace = do { no strict 'refs'; *{$func_name}; }; VECTOR: for my $ar_vector ( "NONE of these should trigger substitution", [ qq{""}, qq{""}, ], [ qq{"'"}, qq{"'"}, ], [ qq{""""}, qq{""""}, ], [ qq{"Ignore"}, qq{"Ignore"}, ], [ qq{" Ignore "}, qq{" Ignore "}, ], [ qq{" Ignore "" it "}, qq{" Ignore "" it "}, ], [ qq{" Ignore " " it "}, qq{" Ignore " " it "}, ], [ qq{" Ignore " xxx " it " ' it}, qq{" Ignore " xxx " it " ' it}, ], [ qq{ foo("var_1", "Ignore ""can't""", """") ' do it \n}, qq{ foo("var_1", "Ignore ""can't""", """") ' do it \n}, ], "ALL of these should trigger substitution(s)", [ qq{ "Ignore" this_sub("first", var_1, "Ignore ""can't""", va +r_2, """") ' do it \n}, qq{ "Ignore" that_sub("first", var_a, "Ignore ""can't""", va +r_b, """") ' do it \n}, ], [ qq{xxx can't Ignore this_sub("first", var_1, "Ignore ""can't +""", """") ' do it \n}, qq{xxx FAILED't Ignore this_sub("first", var_1, "Ignore ""ca +n't""", """") ' do it \n}, ], [ qq{xxx will Ignore't this_sub("first", var_1, "Ignore ""can' +t""", """") ' do it \n}, qq{xxx will FAILED't this_sub("first", var_1, "Ignore ""can' +t""", """") ' do it \n}, ], ) { unless (ref $ar_vector) { # really a comment in disguise? note $ar_vector; next VECTOR; } my ($string, $expected) = @$ar_vector; is replace($string), $expected, # qq{} ; } # end for VECTOR } # end for METHOD

In reply to Re: Replacing words in VB code but not strings or comments (5.8/10 versions) by AnomalousMonk
in thread Replacing words in VB code but not strings or comments by Anonymous Monk

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others rifling through the Monastery: (8)
    As of 2014-11-27 16:01 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My preferred Perl binaries come from:














      Results (186 votes), past polls