Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
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:

  • 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.

In reply to Undoable Objects by chromatic

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (3)
    As of 2018-05-24 19:57 GMT
    Find Nodes?
      Voting Booth?