Suppose your Perl objects someday come to you and complain about their lack of memory. "We've worked for you for years, but once you tell us to change something about ourselves, we can't remember being any other way!" For example, if you were writing a web service that allowed users to edit their own documents, once they committed a change to that document (provided it's kept as an object somewhere), their prior work vanishes.

Pencils have erasers, and many applications have an Undo feature. Here's one way of adding that to your Perl objects.

We'll start out simply enough:

#!/usr/bin/perl -w

use strict;

package HistoryObj;

sub new {
    my $class = shift;
    my $self = {
        color => 'blue',
        texture => 'rusty metal',
        taste => 'salt',
    };
    bless($self, $class);
    return $self;
}
[download]

Nothing surprising there. We have some class defaults, and we could extend this constructor to allow us to override these defaults when creating a new object. That's not the point here, but keep it in mind.

{
    my %history;

    sub _log {
        my $self = shift;
        my $attrib = shift;
        my $value = $self->{$attrib};
        push @{ $history{$self} }, [ $attrib, $value ];
    }

    sub undo {
        my $self = shift;
        return unless (scalar @{ $history{$self} });
        my ($attrib, $value) = @{ pop @{ $history{$self} } };
        $self->{$attrib} = $value;
    }
}
[download]

Here's the dirty work. We encapsulate two subroutines and a lexical variable in an inner scope. The subroutines will, of course, be visible elsewhere. They also happen to be the only way to get access to %history, which is the point. (The _log() subroutine has a leading underscore to mark it as private. That's a polite convention. If you're feeling especially private, you could get more paranoid.)

The history hash is a class variable (not unique to any object instance!). We key into it with $self, because that's an easy and unique identifier for different objects. For a value, we store a list containing the key that's changed and the previous value. No surprise there.

The undo sub is pretty straightforward, with that explained. First, we check to see if there's anything to undo. If not, there's no point in continuing (as we'll get an undefined array error). Otherwise, we yank out the attribute and previous value and make the change.

This does require one change to the accessor methods, however. Note that I'm using a single method for each attribute, using the existence of arguments to decide whether to get or to set:

sub color {
    my $self = shift;
    if (@_) {
        $self->_log('color');
        $self->{color} = $_[0];
    }
    return $self->{color};
}

sub texture {
    my $self = shift;
    if (@_) {
        $self->_log('texture');
        $self->{texture} = $_[0];
    }
    return $self->{texture};
}

sub taste {
    my $self = shift;
    if (@_) {
        $self->_log('taste');
        $self->{taste} = $_[0];
    }
    return $self->{taste};
}

sub all {
    my $self = shift;
    my @values = @$self{qw( color texture taste )};
    return join("\t", @values);
}

1;
[download]

Nothing surprising there. As you probably expected, there's a call to _log with the proper arguments before setting a new value. The all() sub is only there to make the following example work:

#!/usr/bin/perl -w

use strict;
use HistoryObj;

my $hist = HistoryObj->new();
my $hist2 = HistoryObj->new();

$hist->color('pink');
$hist->texture('cotton candy');
$hist->taste('sweet');
print $hist->all(), "\n\n";

$hist2->color('beet purple');
$hist2->texture('slimy round goo');
$hist2->taste('do not ask!');
print $hist2->all(), "\n\n";

for (1 .. 3) {
    $hist->undo();
    print $hist->all(), "\n\n";
}

for (1 .. 3) {
    $hist2->undo();
    print $hist2->all(), "\n\n";
}
[download]

Nothing surprising there, either. (Please don't lick rusty metal or beets at home. I'm a trained professional.) We create a couple of objects, give them new values, and, one by one, undo the operations.

Here's a quick list of possible enhancements:

• Hide _log even further.
• Limit the number of undo levels.
• Add a redo function.
• Turn this into a Journaling system (for longer attribute values) with Algorithm::Diff.

---

---

• Are you posting in the right place? Check out Where do I post X? to know for sure.
• Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:

  <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>

• Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
• Want more info? How to link or How to display code and escape characters are good places to start.