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:
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.#!/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; }
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.){ 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; } }
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:
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: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, 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.#!/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"; }
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.