Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Refactoring challenge.

by BrowserUk (Patriarch)
on Mar 05, 2005 at 20:30 UTC ( [id://436956]=perlquestion: print w/replies, xml ) Need Help??

BrowserUk has asked for the wisdom of the Perl Monks concerning the following question:

This code is a mess, but works. Can you refactor it?

The nastiest thing is $flag, but it's open season on the rest of it too.

It's deliberately unrunnable, as you don't have the code for f1() or f2() or any sample data. Does that make it too hard?

{ my( $indent, $depth ) = ( "\t", 0 ); sub pp { my $flag; my( $pos1, $first ) = f1( $str ); if( defined $first ) { if( $first eq CONST1 ) { $pos1++; $depth++; } else { my $pos2 = f2( $str, $first ); if( defined $pos2 ) { $pos1 = $pos2 + 2; } else { $flag = 1; } } } print $indent x $depth, substr( $str, 0, $pos1 ); $str =~ s[^.{$pos1}\s*][]; $depth++ if $flag; return; } }

Examine what is said, not who speaks.
Silence betokens consent.
Love the truth but pardon error.

Replies are listed 'Best First'.
Re: Refactoring challenge.
by dragonchild (Archbishop) on Mar 06, 2005 at 01:23 UTC
    The first thing is that I'm going to be changing the callers because pp() references global data (namely $str). pp() also alters that data, so I will be returning the altered $str.

    The code, upon first glance, looks slightly unfactored. But, I've taken the common element (the actual print command) and moved it out of the sub. This allows for pp() to display the actual parts that differ. For example, you have four separate paths through pp(), depending on how f1() and f2() behave. This version makes that explicit.

    { my ($indent, $depth) = ( "\t", 0 ); my $_print = sub { print $indent x $depth, substr( $_[0], 0, $_[1] ); }; sub pp { return unless @_; my ($str) = @_; my ($pos, $first ) = f1( $str ); if ( defined $first ) { if ( $first eq CONST1 ) { $depth++; $_print->( $str, ++$pos ); } elsif ( defined( my $newpos = f2( $str, $first ) ) ) { $_print->( $str, $newpos + 2 ); } else { $_print->( $str, $pos ); $depth++; } } else { $_print->( $str, $pos ); } $str =~ s[^.{$pos1}\s*][]; return $str; } }

    Update: Upon further thought, the calls to f1() and f2() need to be refactored further.

    { my ($indent, $depth) = ( "\t", 0 ); my $_print = sub { print $indent x $depth, substr( $_[0], 0, $_[1] ); }; my $_call_f1_f2 = sub { my $str = shift; my ($pos, $first) = f1( $str ); return ($pos, 0) if !defined $first; if ( $first eq CONST1 ) { $depth--; return ($pos + 1, 0); } $pos = f2( $str, $first ); return ($newpos + 2, 0) if defined $pos; return ($pos, 1); }; sub pp { return unless @_; my ($str) = @_; my ($pos, $depth_mod) = $_call_f1_f2->( $str ); $_print->( $str, $pos ); $depth += $depth_mod; $str =~ s[^.{$pos1}\s*][]; return $str; } }

    Update: Typo in code ($_->print -> $_print->) fixed.

    Being right, does not endow the right to be rude; politeness costs nothing.
    Being unknowing, is not the same as being stupid.
    Expressing a contrary opinion, whether to the individual or the group, is more often a sign of deeper thought than of cantankerous belligerence.
    Do not mistake your goals as the only goals; your opinion as the only opinion; your confidence as correctness. Saying you know better is not the same as explaining you know better.

      Thankyou. That is (almost) perfect.

      Which impresses the heck outta me cos I've rather spent altogether too long staring at that code trying to refactor it and every time I changed it, it broke . Badly.

      And I have had another (very competent) set of eyes look it over (complete with the full context) prior to posting.

      Plugged your version back into the real conetxt and made two changes:

    • The first $depth++ should be $depth--.
    • And $newpos + 2 had to be $pos += $newpos + 2.

      Both trivial typos given the "paper exercise" nature of the task.

      You will see the code in it's proper context over the next couple of weeks or so, but for now. Thankyou.


      Examine what is said, not who speaks.
      Silence betokens consent.
      Love the truth but pardon error.
        You're very welcome. :-)

        A few notes:

        • The first $depth++ should be $depth--.

          That's a bug in your original posting. I was wondering how $depth decremented ...

        • And $newpos + 2 had to be $pos += $newpos + 2.

          You're absolutely correct - I missed that.

        Being right, does not endow the right to be rude; politeness costs nothing.
        Being unknowing, is not the same as being stupid.
        Expressing a contrary opinion, whether to the individual or the group, is more often a sign of deeper thought than of cantankerous belligerence.
        Do not mistake your goals as the only goals; your opinion as the only opinion; your confidence as correctness. Saying you know better is not the same as explaining you know better.

        Honestly, I did think of doing it that way, but considered it rather too repetitive. The problem is there are conditions under which you want to change the depth for your next state — but a separate issue is whether you want to change depth before processing the current state. That's why the code ends up so messy.

        The following doesn't get rid of the variable, but rather repurposes and renames it to separate the two distinct decisions involved more cleanly.

        { my( $indent, $depth ) = ( "\t", 0 ); sub pp { my $next_depth; my( $end_chunk, $first ) = f1( $str ); if( defined $first ) { if( $first eq CONST1 ) { ++$end_chunk; $next_depth = --$depth; } elsif( defined my $pos2 = f2( $str, $first ) ) { $next_depth = $depth; $end_chunk = $pos2 + 2; } else { $next_depth = $depth + 1; } } else { $next_depth = $depth; } print $indent x $depth, substr( $str, 0, $end_chunk ); $str =~ s[^.{$end_chunk}\s*][]; $depth = $new_depth; return; } }

        I still think your code is doing a lot of manual pattern matching which could be better done by the regex engine.

        Makeshifts last the longest.

      It seems that $_->print calls $_print... or am I wrong?

      I don't understand this. Is there a name for this feature/behavior of perl?

      Nice refactor++.

Re: Refactoring challenge.
by thor (Priest) on Mar 05, 2005 at 21:33 UTC
    Your subroutine is never called, so one could refactor your code by deleting the definition of pp. What I'm trying to say is that I think we (or at least I) need a little more context upon which to operate.

    thor

    Feel the white light, the light within
    Be your own disciple, fan the sparks of will
    For all of us waiting, your kingdom will come

      Your subroutine is never called
      Of course it is - you just didn't get the entire program (as already indicated in the original article).
      What I'm trying to say is that I think we (or at least I) need a little more context upon which to operate.
      Why? Your assignment is to refactor the given code. That's a local operation, and doesn't have to depend on more context (then the assignment would be to refactor the code given, in addition to the context).
        Why? Your assignment is to refactor the given code. That's a local operation, and doesn't have to depend on more context (then the assignment would be to refactor the code given, in addition to the context).
        Well...for starters, I didn't see if/where $depth was used outside of the subroutine. If it isn't used, I'd refactor the code so that $depth was scoped to the sub. Given the code, who knows? It's somewhat difficult to refactor code that you don't know the usage of. Truth be told, I did have a refactoring of it that I was ready to post, but then saw that I didn't have enough context upon which to base my refactorings. However, I felt that I might make better choices with more context.

        thor

        Feel the white light, the light within
        Be your own disciple, fan the sparks of will
        For all of us waiting, your kingdom will come

Re: Refactoring challenge.
by hv (Prior) on Mar 06, 2005 at 12:21 UTC

    A small point: that s/// is pretty inefficient, and replacing it with:

    substr($str, 0, $pos1) = '';
    makes it clear that you could do it implicitly in the previous line just by adding an extra argument:
    print $indent x $depth, substr( $str, 0, $pos1, '' );

    dragonchild's refactored version would not need the $pos = $newpos + 2 correction if the (suitably renamed) $_print() did the same thing.

    I'd be tempted to make it read a bit more cleanly by also passing in the depth to $_print() and include a slight reordering to flatten:

    my $_consume = sub { print $indent x $_[2], substr $_[0], 0, $_[1], ''; } sub pp { return unless @_; my($str) = @_; my($length, $first) = f1($str); if (!defined $first) { $_consume->($str, $length, $depth); } elsif ($first eq CONST1) {
          $_consume->($str, $length, --$depth);
    $_consume->($str, $length + 1, --$depth); } elsif (defined(my $newlen = f2($str, $first))) { $_consume->($str, $newlen + 2, $depth); } else { $_consume->($str, $length, $depth++); } return $str; }

    Update: passing $str to be modified in this way is probably not safe - if I remember right, any attached magic will cause a temporary copy to be passed instead - so some slight modifications to pass \$str instead are probably required.

    Update 2: added a missing + 1

    Hugo

      Thanks Hugo, that helps a bit more :)

      A small point: that s/// is pretty inefficient,

      Unfortunately, $string =~ s[^.{$pos}\s*][]; doesn't just remove that part of the string that has been printed, it also removes any leading whitespace from the remainder of the string that otherwise would mess up the indenting.

      I've been trying to remove the need for that, by having f1() and f2() advance the pointer(s) beyond the whitespace after they locate their relevant positions, so that it gets output on the end of the previous line of output where it does no harm, but so far, I've failed.

      However, incorporating it into the _print/_consume sub is a good idea.

      And passing the $depth through simplifies things a bit more.

      Unfortunately, I cannot flatten the nesting in quite the way you have as the $pos ($length as you have it) will also be undefined if $first is undefined. I realise that this was implicit rather than explicit in the OP.

      It's a shame, and something I will attempt to correct if possible, because as you have it, the parser becomes a state machine which would be very nice.

      For now, the magic problem doesn't arise as $str is just a string (generated wholey within the outer layers of my code and will not have any magic attached), but it is something that I wasn't aware of and worth noting for the future.

      As it stands, the combined refactoring, in-situ of it's surrounding context, has introduced a minor edge case bug that wasn't there before, but the reduction in clutter should make it easier to resolve.

      The point I had been at for over a week, was that I had arrived at code that worked, by hacking at my initial attempt, but that it was so fragile that every time I tried to clean it up, it broke badly. By isolating this part from the rest and getting other eyes to look at it, it has simplified the overall thing to the point where it is much less fragile.


      Examine what is said, not who speaks.
      Silence betokens consent.
      Love the truth but pardon error.

        Unfortunately, [the substitution] also removes any leading whitespace from the remainder of the string

        Oops, I completely missed that. But adding a trailing

        $_[0] =~ s/^\s+//;
        to $_consume() is enough to fix that.

        Unfortunately, I cannot flatten the nesting in quite the way you have as the $pos ($length as you have it) will also be undefined if $first is undefined.

        Both your original code and dragonchild's refactor contradict this - both use the returned $pos1 ($pos) unaltered when $first is undefined.

        For now, the magic problem doesn't arise as $str is just a string (generated wholey within the outer layers of my code and will not have any magic attached)

        As I remember it, the principle (and most embarrassing) time that it becomes a problem is when the parameter is tainted.

        Hugo

      I like your rewrite of the logic. Mapping it to the original took a small braintwist, but that's cool. :-)

      I'm not sure the $_consume() method should encapsulate the printing as well. That makes it difficult to replace the print method without breaking stuff. To tell you the truth, I think the biggest issue is f1() and f2(). The entire pp() experience isn't being refactored correctly. For one thing, the fact that f1() and f2() are separated is a smell to me. The bigger smell of the flag (that BrowserUk noticed) is gone, but that leaves the smaller smell of the two functions that (seemingly) do similar things.

      Being right, does not endow the right to be rude; politeness costs nothing.
      Being unknowing, is not the same as being stupid.
      Expressing a contrary opinion, whether to the individual or the group, is more often a sign of deeper thought than of cantankerous belligerence.
      Do not mistake your goals as the only goals; your opinion as the only opinion; your confidence as correctness. Saying you know better is not the same as explaining you know better.

Re: Refactoring challenge.
by dws (Chancellor) on Mar 06, 2005 at 17:41 UTC

    This code is a mess, but works. Can you refactor it?

    Sure. First, show me your unit tests, so that I can have confidence that my refactorings aren't breaking any unstated assumptions. In particular, on first read of the code, I'd want to see the tests that demonstrate (and document) what you expect

    $str =~ s[^.{$pos1}\s*][];
    to do and not do. Otherwise, I'd be left making educated guesses. That might work, or it might not.

      $str =~ s[^.{$pos1}\s*][];

      removes $pos1 characters from the front of the string, plus (optionally) any whitespace that immediately follows them. Not complicated but necessary.

      As for the unit tests, that would require I publish several hundred lines of support code, which would be a bit much to expect any to look through.

      Otherwise, I'd be left making educated guesses. That might work, or it might not.

      Fair enough. I wasn't asking for a perfect working solution, just some fresh ideas to set me on my way, which dragonchild and hv both gave me.


      Examine what is said, not who speaks.
      Silence betokens consent.
      Love the truth but pardon error.

      There is a testcase at 437114.


      Examine what is said, not who speaks.
      Silence betokens consent.
      Love the truth but pardon error.
Re: Refactoring challenge.
by BrowserUk (Patriarch) on Mar 07, 2005 at 01:01 UTC

    Okay. Since a couple of people have asked about a runnable testcase, I've hacked together a version that tests the code on a static string that gets chopped up and fed to pp(), rather than generated during the recursive traversal of a datastructure as in the real code.

    There are two version here. The original, very messy but working version, and a slightly cleaned up--thanks to dragonchild and hv--that now exhibits an edgecase bug that I am trying to track down.

    To see the introduced bug, download both as (say) test1.pl and test2.pl and run them both with a command line parameter of '403'. (you'll need a console capable of handling 405 chars wide or redirect to a file and view the output in an editor that doesn't wrap).

    Right truncated, the output from the two versions looks like this:

    P:\test>test1 403 ## Working [ 0:42:06.40] P:\test>test1 403 { a => [ SCALAR(0x18bb45c), { a => b, c => d, e => f, g => h, }, [ +1, 2 b => [ SELFREF(018bb45c), { a => b, c => d, e => f, g => h, }, [ +1, 2 c => [ SELFREF(018bb45c), { a => b, c => d, e => f, g => h, }, [ +1, 2 d => [ SELFREF(018bb45c), { a => b, c => d, e => f, g => h, }, [ +1, 2 e => [ SELFREF(018bb45c), { a => b, c => d, e => f, g => h, }, [ +1, 2 f => [ SELFREF(018bb45c), { a => b, c => d, e => f, g => h, }, [ +1, 2 g => [ SELFREF(018bb45c), { a => b, c => d, e => f, g => h, }, [ +1, 2 h => [ SELFREF(018bb45c), { a => b, c => d, e => f, g => h, }, [ +1, 2 i => [ SELFREF(018bb45c), { a => b, c => d, e => f, g => h, }, [ +1, 2 j => [ SELFREF(018bb45c), { a => b, c => d, e => f, g => h, }, [ +1, 2 } P:\test>test2 403 ## Broken { a => [ SCALAR(0x18bb45c), { a => b, c => d, e => f, b => [ SELFREF(018bb45c), { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], ], c => [ SELFREF(018bb45c), { a => b, c => d, e => f, d => [ SELFREF(018bb45c), { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], ], e => [ SELFREF(018bb45c), { a => b, c => d, e => f, f => [ SELFREF(018bb45c), { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], ], g => [ SELFREF(018bb45c), { a => b, c => d, e => f, h => [ SELFREF(018bb45c), { a => b, c => d, e => f, i => [ SELFREF(018bb45c), { a => b, c => d, e => f, j => [ SELFREF(018bb45c), { a => b, c => d, e => f, }

    Another iteresting transition point with the supplied data occurs with paramters of 35 & 36. Note the differences in the formatting of the values for the 'f' and 'i' keys.

    Test1.pl

    test2.pl (Add the __DATA__ section from above.)


    Examine what is said, not who speaks.
    Silence betokens consent.
    Love the truth but pardon error.

      This seems like a rather problematic approach, in both before and after variants:

      my ($pos, $first ) = ( pos $string, $1 ) if $string =~ m/([\[\{\]\}, +])/g; return unless defined $pos;
      which I'd rather write as:
      $string =~ m/([\Q[]{},\E])/ or return; my($pos, $first) = ($+[0], $1);

      With the code as is I'm not sure what you expect $pos and $first to be when the match fails, but if my reformulation is appropriate, it becomes clear that neither will ever be set to undef - that should either allow the remaining code to be simplified some, or point to a problem.

      Hugo

        That is a much better way to write it, except that even using $+[0] rather than pos, the /g is still required? I do not pretend to understand that, but it is so.

        Which also explains why it broke when I tried to use $-[0] originally. I would never have thought that @- and @+ where dependant upon /g? Is that a bug?

        I mentioned I was embarassed by the code. My only excuse is that it evolved into the state where it worked and I've been concerned with more fundemental restructuring.

        In-situ, with the /g, it makes no difference to the functioning of the code--which means your version is now in the real code.

        I'm not sure what you expect $pos and $first to be when the match fails...

        Nothing! If the match fails, there is nothing (or nothing further) that can be done in the call and the code just returns to the caller. If the match fails, I do not have any break point upon which to decide to output anything, so all I can do is wait until more of the string accumulates. Ie. the next call, or the one after that.


        Examine what is said, not who speaks.
        Silence betokens consent.
        Love the truth but pardon error.
      I think your edge case is addressed by putting and length( $string ) back into your while conditional.

      I prefer a single chain of if/elsifs to nesting, and I factored out the use of $string as it is invariably the first argument to $_print:


      Caution: Contents may have been coded under pressure.
Re: Refactoring challenge.
by tphyahoo (Vicar) on Mar 06, 2005 at 22:37 UTC
    BrowserUK wrote

    "It's deliberately unrunnable, as you don't have the code for f1() or f2() or any sample data. Does that make it too hard?"

    Yes. I'd like to hack on this, but without the functions and sample data, my brain swims.

    Dragonchild and hv came up with good ideas, but for those of us with less experience, having dummy f1/2 and some sample data would make it a lot easier to see if our ideas were legitimate.

    I think you could have coded some dummyup up with a lot less effort than it would take to do unit tests, as dws suggested

    Just my 2c!

      Okay. Since you asked, see 437114.


      Examine what is said, not who speaks.
      Silence betokens consent.
      Love the truth but pardon error.
    A reply falls below the community's threshold of quality. You may see it by logging in.
Re: Refactoring challenge.
by BrowserUk (Patriarch) on Mar 08, 2005 at 00:42 UTC

    The final incarnation (unless you know better?), with grateful thanks to all who helped especially dragonchild, hv & Roy Johnson

    #! perl -slw use strict; use List::Util qw[ min ]; $|=1; sub indexBal { my( $string, $lookFor, $limit ) = @_; my $nesting = 0; for( my( $position, $char ) = ( 0, substr $string, 0, 1 ); $position < min( length( $string ) , $limit ); $char = substr $string, ++$position, 1 ) { $nesting++ if 1+index '[{', $char; $nesting-- if 1+index ']}', $char; die 'Unbalanced' if $nesting < 0; return $position if $char eq $lookFor and $nesting == 0 } return; } my $depth = 0; my $indent = ' '; my $string = ''; sub findChunk { my( $str, $width ) = @_; $str =~ m/([\Q[]{},\E])/g or return (); my( $pos, $first ) = ( $+[0], $1 ); return( $pos +1, 0 ) if $first eq ','; return( $pos +1, -1 ) if 1+index ']}', $first; if( my $pos2 = indexBal( $str, $first eq '[' ? ']' : '}', $width ) + ) { return( $pos2 +2, 0 ); } return( $pos , +1 ); } sub pp { my( $nextBit, $width, $EOS ) = @_; $string .= $nextBit; while( length( $string ) > $width or $EOS ) { my( $pos, $adjust ) = findChunk( $string, $width ); return unless defined $pos; $depth-- if $adjust < 0; print $indent x $depth, substr( $string, 0, $pos, '' ); $string =~ s[^\s*][]; $depth++ if $adjust > 0; } return; } ## Test harness only below here my $data = <DATA>; my $width = $ARGV[ 0 ]||100; $indent = $ARGV[ 1 ] if @ARGV == 2; while( length $data ) { my $p = 1+rindex( $data, ',', 1+rand( 100 ) )||length $data; my $sub = substr( $data, 0, $p, '' ); pp( $sub, $width, !length $data ); } __DATA__ { a => [ SCALAR(0x18bb45c), { a => b, c => d, e => f, g => h, }, [ 1, + 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, } +, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => + h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f +, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, +e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], ], b => [ S +ELFREF(018bb45c), { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, + 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, + 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ + 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, + }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g + => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], ], c => [ SELFREF(01 +8bb45c), { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, + 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, + 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, + 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, } +, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], ], d => [ SELFREF(018bb45c), +{ a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 +, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, + 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, + 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, + 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, + 3, 4, 5, 6, 7, 8, 9, 10, ], ], e => [ SELFREF(018bb45c), { a => b, + c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a + => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, +], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, + 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, + 6, 7, 8, 9, 10, ], ], f => [ SELFREF(018bb45c), { a => b, c => d, +e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c +=> d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => + b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], +{ a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 +, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, + 9, 10, ], ], g => [ SELFREF(018bb45c), { a => b, c => d, e => f, g + => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e = +> f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => +d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, + c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a + => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, +], ], h => [ SELFREF(018bb45c), { a => b, c => d, e => f, g => h, } +, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => + h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f +, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, +e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c +=> d, e => f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], ], i +=> [ SELFREF(018bb45c), { a => b, c => d, e => f, g => h, }, [ 1, 2, + 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ + 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, + }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g + => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e = +> f, g => h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], ], j => [ SELF +REF(018bb45c), { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, 4, 5, + 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, 2, 3, + 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, }, [ 1, + 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => h, } +, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], { a => b, c => d, e => f, g => + h, }, [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ], ], }

    Examine what is said, not who speaks.
    Silence betokens consent.
    Love the truth but pardon error.
      I had to take another shot at it. I noticed that comma was a sequence point, so you basically have the non-comma opening bracket match, and the comma match, which covers both closing brackets and unbracketed terms.

      There may be some refactoring still left to do (update: did some more this morning), but I'm happy with it, and I need to go to bed.

      sub pp_new { my( $nextBit, $width, $EOS ) = @_; $string .= $nextBit; while( length( $string ) > ($EOS ? 0 : $width) ) { for (substr($string, 0, $width)) { my $pos; my $leftmargin = $indent x $depth; if (my ($bracket) = /^[^,]*?([\Q[{\E])/) { $bracket =~ tr/[{/]}/; if (my $closepos = indexBal($_, $bracket, $width)) { $pos = $closepos + 2; } else { $pos = $+[0]; ++$depth } } else { $pos = 1 + (/,/ ? $+[0] : $width); $leftmargin = $indent x --$depth if substr($_, 0, $pos +-1) =~ /([\Q]}\E])/; } print $leftmargin, substr( $_, 0, $pos, '' ); } $string =~ s/^\s+//; } }

      Caution: Contents may have been coded under pressure.
      Maybe it would clearer like this, or at any rate more clear to people that only know perl. (I guess this is a vb/c thing.)
      #$nesting++ if 1+index '[{', $char; #$nesting-- if 1+index ']}', $char; $nesting++ if $char=~/[[{]/; $nesting-- if $char=~/[\]}]/; # not sure if I escaped this right
      The 1+index idiom baffled me, it requires that you know index returns -1 if no match. Thanks to demerphq for helping me understand.

        I was using regex in the earlier versions if you look back, but I personally find the escaped regexes to be most unreadable. I think that the way it is now captures the essence of the tests very well.

        In theory at least, you can use /[[}]/ without any escaping as (most) meta characters have no special meaning inside character classes, but it doesn't work in practice.

        I actually thought that was true for all meta characters until hv showed me /([\Q[]{},\E])/, which is better than the alternative, but still far from transparent.

        I've never used VB, though it's not totally dissimilar to the DEC Basic Plus I used 25 years ago. I still sometimes type instr when I mean index.

        (I think instr is the better name for the function actually)


        Examine what is said, not who speaks.
        Silence betokens consent.
        Love the truth but pardon error.

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others avoiding work at the Monastery: (3)
As of 2024-04-25 22:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found