Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

building sequences like an odometer

by neniro (Priest)
on Nov 21, 2006 at 21:36 UTC ( #585361=snippet: print w/replies, xml ) Need Help??
Description: 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.

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;
    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/);
while (my $cur = $o->succ) {
    print $cur . "\n";
Replies are listed 'Best First'.
Re: building sequences like an odometer
by Roy Johnson (Monsignor) on Nov 21, 2006 at 23:59 UTC
      Thank you. This is another CPAN-module I've missed so far.
Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://585361]
[KurtZ]: mice?
[Discipulus]: your cat is dryarian holli
[holli]: not even remotely KurtZ. i did find feathers in the garden a few times though
[holli]: yet no body
[virtualsue]: I was called upon to remove a gnawed mouse carcass from the living room this morning
holli googles dryarian just to make sure that isn't actually thing
[holli]: I mean, you never know, right?
[shmem]: good $localtime monkses
[holli]: mmh. maybe a user handle "dry arian" is a bit unfortunate? https://www. dryarian/
[Discipulus]: exists!

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (9)
As of 2017-11-21 12:47 GMT
Find Nodes?
    Voting Booth?
    In order to be able to say "I know Perl", you must have:

    Results (300 votes). Check out past polls.