comment on

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.

In reply to Re: Refactoring challenge. by BrowserUk
in thread Refactoring challenge. by BrowserUk

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

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, details, 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, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.