Re: Refactoring challenge.

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,
  }
[download]

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

#! perl -slw
use strict;
use List::Util qw[ min ];
$|=1;

## Original working code.

my $data = <DATA>;

my $depth = 0;
my $indent = '    ';
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 $char =~ m/[\[\{]/;
        $nesting-- if $char =~ m/[\]\}]/;
        die 'Unbalanced' if $nesting < 0;
        return $position if $char eq $lookFor and $nesting == 0
    }
    return;
}

my $string = '';
sub pp {
    my( $s, $max_width, $EOS ) = @_;
    $string .= $s;
#    warn "\npp:'$string'\n";
    while( length( $string ) > $max_width or $EOS and length( $string 
+) ) {
        my $flag;
        $string =~ m/([\[\{\]\},])/g and my( $position, $first ) = ( p
+os $string, $1 );
        return unless defined $position;
        if( defined $first and $first ne ',' ) {
            if( $first =~ m/[\]\}]/ ) {
                $position++;
                $depth--;
            }
            else {
                my $position2 = indexBal $string, $first eq '[' ? ']' 
+: '}', $max_width;
                if( defined $position2 ) {
                    $position = $position2 + 2;
                }
                else {
                    $flag = 1;
                }
            }
        }
        print $indent x $depth, substr( $string, 0, $position );# <STD
+IN>;
        $string =~ s[^.{$position}\s*][];
        $depth++ if $flag;
    }
}

## Test harness only below here

my $width = $ARGV[ 0 ]||100;
$indent = $ARGV[ 1 ] if @ARGV == 2;

while( length $data ) {
    my $p = 1+rindex( $data, ',', $width+rand( 50 ) )||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,  ],  ],  }
[download]

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

#! perl -slw
use strict;
use List::Util qw[ min ];
$|=1;

## Mildly cleaned up version with edgecase bug.

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 $char =~ m/[\[\{]/;
        $nesting-- if $char =~ m/[\]\}]/;
        die 'Unbalanced' if $nesting < 0;
        return $position if $char eq $lookFor and $nesting == 0
    }
    return;
}

my $depth = 0;
my $indent = '    ';
my $string = '';
my $_print = sub {
    print $indent x $_[2], substr( $_[0], 0, $_[1], '' );
    $_[0] =~ s[^\s*][];
};

sub pp {
    my( $s, $max_width, $EOS ) = @_;
    $string .= $s;
    while( length( $string ) > $max_width or $EOS ) {

        my ($pos, $first ) = ( pos $string, $1 ) if $string =~ m/([\[\
+{\]\},])/g;
        return unless defined $pos;

        if ( defined $first and $first ne ',' ) {
            if ( $first =~ m/[\]\}]/ ) {
                $_print->( $string, ++$pos, --$depth );
            }
            elsif ( defined( my $newpos = indexBal( $string, $first eq
+ '[' ? ']' : '}', $max_width ) ) ) {
                $_print->( $string, $newpos + 2, $depth );
            }
            else {
                $_print->( $string, $pos, $depth++ );
            }
        }
        else {
            $_print->( $string, $pos, $depth );
        }
    }
    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, ',', $width+rand( 50 ) )||length $data;
    my $sub = substr( $data, 0, $p, '' );
    pp( $sub, $width, !length $data );
}

__DATA__
[download]

Examine what is said, not who speaks.

Silence betokens consent.

Love the truth but pardon error.

Comment on Re: Refactoring challenge. Select or Download Code

Replies are listed 'Best First'.
Re^2: Refactoring challenge. by hv (Prior) on Mar 07, 2005 at 14:13 UTC
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;` [download] which I'd rather write as: `$string =~ m/([\Q[]{},\E])/ or return; my($pos, $first) = ($+[0], $1);` [download] 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	[reply] [d/l] [select]
Re^3: Refactoring challenge. by BrowserUk (Patriarch) on Mar 07, 2005 at 16:43 UTC
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.	[reply] [d/l] [select]
Re^4: Refactoring challenge. by Roy Johnson (Monsignor) on Mar 07, 2005 at 20:33 UTC
I would never have thought that @- and @+ where dependant upon /g? Is that a bug? You need the /g because you are doing iterative matching in a while loop. Caution: Contents may have been coded under pressure.	[reply]
Re^2: Refactoring challenge. by Roy Johnson (Monsignor) on Mar 07, 2005 at 20:06 UTC
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: Read more... (1187 Bytes) Caution: Contents may have been coded under pressure.	[reply] [d/l] [select]