Ring.pm

#!/usr/bin/env perl
package Ring;
# return an empty ring structure
sub new {
 my $class = shift;
 my $node = { };
 $node->{NEXT} = $node->{PREV} = $node;
 my $self = { DUMMY => $node, COUNT => 0 };
 bless $self, $class;
 return $self;
}

# $node = $ring->search( $value ) : find $value in the ring
# structure in $node
sub search {
    my ($ring, $value) = @_;
    my $node = $ring->{DUMMY}->{NEXT};
    while ($node != $ring->{DUMMY} && $node->{VALUE} != $value) {
          $node = $node->{NEXT};
    }
    return $node;
} 

# $ring->insert( $value ) : insert $value into the ring structure
sub insert_value {
    my ($ring, $value) = @_;
    my $node = { VALUE => $value };
    $node->{NEXT} = $ring->{DUMMY}->{NEXT};
    $ring->{DUMMY}->{NEXT}->{PREV} = $node;
    $ring->{DUMMY}->{NEXT} = $node;
    $node->{PREV} = $ring->{DUMMY};
    ++$ring->{COUNT};
} 

# $ring->delete_value( $value ) : delete a node from the ring
# structure by value
sub delete_value {
    my ($ring, $value) = @_;
    my $node = $ring->search($value);
    return if $node == $ring->{DUMMY};
    $ring->delete_node($node);
}

1;
[download]

Recursive_Object_Test.pl

#!/usr/bin/env perl
package Subtle;
sub new {
    my $test;
    $test = \$test;
    warn "CREATING " . \$test;
    return bless \$test;
}
sub DESTROY {
    my $self = shift;
    warn "DESTROYING $self";
}

package main;
    
warn "starting program";
{
    my $a = Subtle->new;
    my $b = Subtle->new;
    $$a = 0;  # break selfref
    warn "leaving block";
}
warn "just exited block";
warn "time to die...";
    
    
    
use Smart::Comments;
use Ring;
$COUNT = 10;
for (1 .. 3) {
 my $r = Ring->new();
 for ($i = 0; $i < $COUNT; $i++) { $r->insert_value($i) }
 ### $r
}
exit 1;
[download]