File Coverage

blib/lib/Whatif.pm

Criterion	Covered	Total	%
statement	37	42	88.1
branch	8	12	66.6
condition			n/a
subroutine	7	7	100.0
pod	0	2	0.0
total	52	63	82.5

package Whatif;

use strict;
use POSIX ();
use Carp qw(croak);
use base qw(Exporter DynaLoader);
use vars qw(@EXPORT $VERSION $ERR);
@EXPORT = qw(whatif ifonly);


$VERSION = '1.3';


$ERR = undef;


bootstrap Whatif $VERSION;


# do all the magic
sub whatif (&;$) {
    my ($whatif, $ifonly) = @_;

    $ERR = undef;
    my $dollardollar = $$;

    # the way to communicate between the two different versions
    my ($in, $out);
    pipe $in, $out;

    # SPLITTERS!
    my $pid = fork;
    die "couldn't fork" unless defined $pid;


    # parent
    if ($pid) {
        close $out;
        my $got = <$in>;

        # child succeded, we shut up shop and wait for it to die
        unless ($got)  {
            # close all open file handles
            foreach (0..POSIX::sysconf(&POSIX::_SC_OPEN_MAX)) {
                POSIX::close($_);
            }

            # wait for the child to die so that we can
            waitpid($pid, 0);
            POSIX::_exit(0);
        }


        # the child failed, set the error ...
        $Whatif::ERR = $got;

        # ... and if we've been given an ifonly block then run it
        $ifonly->() if (defined $ifonly);


    # child
    } else {
        close $in;
        # run the code we been given

        # some shennanigans, knicked from PPerl
        if ($] > 5.006001) {
            setreadonly('$', $dollardollar);
        } else {
            $$ = $dollardollar;
        }

        eval { $whatif->() };
        print $out $@;
        close $out;

        POSIX::_exit(0) if $@;
    }
}

# hack
sub ifonly (&) { $_[0] }


1;

=pod

=head1 NAME

Whatif - provides rollbacks, second chances and ways to overcomes regrets in code

=head1 SYNOPSIS

  my $foo = "foo";

  whatif {
    $foo = "bar";
  }; # foo is now "bar"


  whatif {
    $foo = "quux";
    die;
  }; # foo is still "bar", the call got rolled backed


  whatif {
    $foo = "yoo hoo!";
  } ifonly {
    $foo = "erk";
  }; # foo will be "yoo hoo"

  whatif {
    $foo = "here";
    die "Aaaargh\n";
  } ifonly {
    $foo = "there";
    print Whatif::ERR; # prints Aaaargh
  }; # foo will be "there"

  print Whatif::ERR; # also prints Aaaargh

  whatif {
    die;
  };
  print Whatif::ERR; # prints undef

  $foo = "outer";
  whatif {
    $foo = "middle";
    whatif { $foo = "inner" };
  }; # $foo is "inner";

  $foo = "outer";
  whatif {
    $foo = "middle";
    whatif { $foo = "inner"; die };
  }; # $foo is "middle";



B the semi-colon after the I block - without it you may get odd results;


=head1 DESCRIPTION

Whatif provides database-like rollbacks but for code instead of
database transactions. Think of I blocks as being like
I blocks but on steroids.

Essentially, if you die within a I block then all code up
until that point will be undone. Let's face it we all have regrets and
if we can't solve them in software then where can we solve them?

But that's not all. Whatif not only provides a way out of that
horrible 'OHMYGOD! What have I done?' moments but also gives you a
second chance using our special sauce 'Guardian Angel[tm]' technology
(patent pending).

Simply place an I block after a I block and,
should the I block fail, all the code in the I
block will be executed. Que convenient!

If only life itself could be like that.

=head1 BUGS

This won't work on systems that don't have fork(). Sorry. I tried to
come up with some code that worked by intercepting all writes to %:: but
that just became a nightmare and B advised me against it.
Then I tried something like


  void do_magic(SV* coderef)
  {
        PerlInterpreter *orig, *copy;

        orig = Perl_get_context();
        copy = perl_clone(orig, FALSE);

        PERL_SET_CONTEXT(copy);
        perl_call_sv(coderef, G_DISCARD|G_NOARGS|G_EVAL);

         /* Errk, it failed */
        if (SvTRUE(ERRSV)) {
                fprintf(stderr, "Errrrk\n");
                PERL_SET_CONTEXT(orig);
                perl_free(copy);
        /* ooh, it was fine */
        } else {
        perl_free(orig);
        }

  }


but that would have only worked on threaded Perls (i.e 5.8) and, err,
didn't work anyway. And after a few hours poking through perlguts and
various websites I just went with the current approach.

This also won't work where you touch the world outside of Perl's
control. Basically if you write something to a socket or a file or a DB
then you're going to have to undo your mess yourself. That's what the
I block is for. There's nothing I can do about that. Deal.


=head1 NOTES AND THANKS

B and I came up with the idea not, surprisingly, down the
pub but whilst trying to sanitise the house we were moving out of. I imagine
that the fumes probably had something to do with it and also suspect
he deliberately planted the most crack fuelled idea he could
think of into my brain, wound me up and let me go.

The current method of I-ing was devised by B who
basically gave me pretty much the whole module short of packaging it and
providing the I implementation. However he has more sense
than I do.

B helped with the I testing by
patiently typing in semi-lucid commands that I barked at him via IRC
whilst I tried random things out without the benefit of my own threaded
5.8 box.

B's PPerl provided the code
for setting readonly variables thanks to patches from the ever helpful
B. This means that your PID stays the same even after a
successful I block.

I'd also like to thank my make up B, my B and you, the B
for making all this possible.



=head1 COPYING

(C)opyright 2002, Simon Wistow

Distributed under the same terms as Perl itself.

This software is under no warranty and will probably destroy your life,
kill your friends, burn your house and bring about the apocalypse

=head1 AUTHOR

Simon Wistow

=cut