This is some example code I wrote a few days ago. It's based on a odometer-class and a wheel-class. Maybe it's useful to someone.
EDIT: the class-variable $DONE in the odometer-class is a bad idea and should be changed to an instance-variable.
#!/usr/bin/perl
use strict;
use warnings;
package Wheel;
sub new {
my $class = shift;
my @items = @_;
my $self = {
items => \@items,
position => 0,
notch => [],
};
bless $self, $class;
return $self;
}
sub on_notch {
my $self = shift;
my $call = shift || sub { print "Notch!\n" };
push @{$self->{notch}}, $call;
}
sub succ {
my $self = shift;
if ($self->{position}++ < $#{$self->{items}}) {
$self->{position} and return $self->{items}->[$self->{position
+}];
} else {
$self->{position} = 0;
$_->() for @{$self->{notch}};
return $self->{items}->[$self->{position}];
}
}
sub to_s {
my $self = shift;
return $self->{items}->[$self->{position}];
}
package Odometer;
use Data::Dumper;
my $DONE = 0;
sub new {
my $class = shift;
my $self = [];
return bless $self, $class;
}
sub add_wheel {
my $self = shift;
my @items = @_;
my $w = Wheel->new(@items);
push @$self, $w;
$self->[$#$self-1]->on_notch(sub {$w->succ}) if $#$self > 0;
}
sub succ {
my $self = shift;
my $temp = $self->to_s;
$self->[0]->succ;
if ($DONE == 2) {
return undef;
} else {
$DONE++ if $DONE;
return $temp;
}
}
sub to_s {
my $self = shift;
return join ' ', map { $_->to_s } reverse @$self;
}
sub add_termination {
my $self = shift;
$self->[-1]->on_notch( sub { $DONE = 1} );
}
package main;
my $o = Odometer->new;
$o->add_wheel(qw/foo bar buz/);
$o->add_wheel(qw/dark light/);
$o->add_wheel(qw/red green blue yellow/);
$o->add_termination;
while (my $cur = $o->succ) {
print $cur . "\n";
};