http://qs1969.pair.com?node_id=29813

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; }
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; } }
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;
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"; }
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:

Replies are listed 'Best First'.
Re: Undoable Objects
by bikeNomad (Priest) on Jun 17, 2001 at 23:10 UTC
    It would also be a good idea to add a DESTROY method in that same scope so that the history gets cleaned up when objects go away:

    { 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; } sub DESTROY { my $self = shift; delete $history{$self}; } }