--- Divert.pm 2005/11/16 10:55:02 1.13
+++ Divert.pm 2005/11/16 12:08:49 1.14
@@ -43,6 +43,12 @@
our @EXPORT = qw();
our @EXPORT_OK = qw();
+# internal: create an anonymous object name
+my $_anonymous_count = 1;
+sub _anonymous_name () {
+ return sprintf("ANONYMOUS:%d", $_anonymous_count++);
+}
+
# object construction
sub new ($;$) {
my ($proto, $name) = @_;
@@ -51,7 +57,7 @@
my $self = {};
bless ($self, $class);
- $name ||= "";
+ $name ||= &String::Divert::_anonymous_name();
$self->{name} = $name; # name of object
$self->{overwrite} = 'none'; # overwrite mode (none|once|always)
@@ -228,9 +234,22 @@
my ($self) = @_;
return $self->{diversion}->[-1]->string()
if (@{$self->{diversion}} > 0);
+ return $self->_string([]);
+}
+
+# internal: string() operation with loop detection
+sub _string ($$) {
+ my ($self, $visit) = @_;
my $string = '';
+ if (grep { &String::Divert::_isobjeq($_, $self) } @{$visit}) {
+ croak "folding loop detected: " .
+ join(" -> ", map { $_->name() } @{$visit}) .
+ " -> " . $self->name();
+ }
+ push(@{$visit}, $self);
foreach my $chunk (@{$self->{chunks}}) {
if (ref($chunk)) {
+ # folding loop detection
my $prefix = '';
# check for existing prefix
# (keep in mind that m|([^\n]+)$|s _DOES NOT_
@@ -240,7 +259,7 @@
$prefix = $1;
$prefix =~ s|[^ \t]| |sg;
}
- my $block = $chunk->string(); # recursion!
+ my $block = $chunk->_string($visit); # recursion!
$block =~ s|\n(?=.)|\n$prefix|sg if ($prefix ne '');
$string .= $block;
}
@@ -248,6 +267,7 @@
$string .= $chunk;
}
}
+ pop(@{$visit});
return $string;
}
@@ -269,12 +289,6 @@
return 0;
}
-# internal: create an anonymous object name
-my $_anonymous_count = 1;
-sub _anonymous_name () {
- return sprintf("ANONYMOUS:%d", $_anonymous_count++);
-}
-
# operation: append folding sub-object
sub fold ($;$) {
my ($self, $id) = @_;
@@ -333,8 +347,6 @@
# operation: lookup particular or all folding sub-object(s)
sub folding ($;$) {
my ($self, $id) = @_;
- return $self->{diversion}->[-1]->folding($id)
- if (@{$self->{diversion}} > 0);
if (defined($id)) {
my $folding; $folding = undef;
foreach my $chunk (@{$self->{chunks}}) {
|