BrowserUk has asked for the wisdom of the Perl Monks concerning the following question:
I've been playing around with some code inspired by Possibly long lists and memory leaks and came up the code below. However, I came unstuck in that I cannot for the life of me work out why the last variable element is being repeated twice when the preceding adjacent element is incremented.
I don't normally have this problem with recursive stuff. Can anyone point out my mistake?
#! perl -slw use strict; package GenURLs; #! Generals:) use Carp; use Data::Dumper; my $re = qr/^(.*?)([[{])([^]}]+)([]}])(.*?)$/; my ($base, @ranges); sub new { my ($class, $template) = (@_); croak "Usage: my \$obj = new GenURLs 'template[1-10]/{a,b,c}[-1-+1 +]'" unless $template and $template =~ $re; my $i = 0; while( $template =~ s/$re/$1\cA$i\cA$5/g ) { croak "Bad template: '$template' $1, $2, $3, $4, $5" unless defined $4 and 1+index( '[]{}', "$2$4"); if ( $2 eq '[' ) { my $range = $3; my ($start, $stop) = $range =~ /(\d+)-(\d+)/; croak "Bad range: [$start-$stop]" unless $start < $stop; push @ranges, {type=>'RANGE', start=>$start, stop=>$stop}; } else { my @list= split',', $3; push @ranges, {type=>'LIST', last=>,0, values=>\@list }; } $i++; } $base = $template; # print "$base\n", Dumper( \@ranges); return bless [], $class; } sub getIterator { my ($self, $nBatch) = @_; my $state = {last=>$base, batch=>$nBatch, nextIdx=>$#ranges, range +s=>$#ranges }; return sub { my ($count, @list) = ($state->{nBatch}, ()); my $range = $state->{nextRange} || $state->{ranges}; do { incrRange( $state, $range ); (my $item = $state->{last}) =~ tr/\cA//d; print "Pushing : '$item'"; push(@list, $item); } while (--$count and $range >=0); $state->{nextRange} = $range if $range >=0; return @list; }; } sub incrRange { my ($state, $range) = @_; my $carry = 0; if ($ranges[$range]{type} eq 'RANGE') { $state->{last} =~ s[((?:\cA(?:[^\cA]+)\cA){$range})(?:\cA([^\cA]+)\cA)] [ my $val = $2 + 1; if ($val >= $ranges[$range]{stop}) { $val = $ranges[$range]{start}; $carry = 1; } "$1\cA$val\cA"; ]e; } else { $state->{last} =~ s[((?:\cA(?:[^\cA]+)\cA){$range})(?:\cA([^\cA]+)\cA)] [ my $iVal = $ranges[$range]{last}++; if ($iVal > $#{$ranges[$range]{values}}) { $iVal = $ranges[$range]{last} = 0; $carry = 1; } "$1\cA@{$ranges[$range]{values}}[$iVal]\cA"; ]e; } incrRange($state, $range - 1) if $carry and $range >= 0; #print $state->{last}; } package main; my $genUrl = new GenURLs( 'test[1-10]{a,b,c}' ); my $iterator = $genUrl->getIterator(100); print $iterator->(); __END__
C:\test>test Pushing : 'test0a' Pushing : 'test0b' Pushing : 'test0c' Pushing : 'test1a' Pushing : 'test1a' Pushing : 'test1b' Pushing : 'test1c' Pushing : 'test2a' Pushing : 'test2a' Pushing : 'test2b' Pushing : 'test2c' Pushing : 'test3a' Pushing : 'test3a' Pushing : 'test3b' Pushing : 'test3c'
Okay you lot, get your wings on the left, halos on the right. It's one size fits all, and "No!", you can't have a different color.
Pick up your cloud down the end and "Yes" if you get allocated a grey one they are a bit damp under foot, but someone has to get them.
Get used to the wings fast cos its an 8 hour day...unless the Govenor calls for a cyclone or hurricane, in which case 16 hour shifts are mandatory.
Just be grateful that you arrived just as the tornado season finished. Them buggers are real work.
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Recursion troubles.
by rdfield (Priest) on Dec 04, 2002 at 13:54 UTC | |
by BrowserUk (Patriarch) on Dec 04, 2002 at 13:59 UTC | |
by demerphq (Chancellor) on Dec 04, 2002 at 14:07 UTC | |
by BrowserUk (Patriarch) on Dec 04, 2002 at 14:22 UTC | |
by demerphq (Chancellor) on Dec 04, 2002 at 14:27 UTC | |
by rdfield (Priest) on Dec 04, 2002 at 14:22 UTC | |
|
Re: Recursion troubles.
by dakkar (Hermit) on Dec 04, 2002 at 14:19 UTC | |
by BrowserUk (Patriarch) on Dec 04, 2002 at 14:37 UTC |