#!/usr/bin/perl
#
# MODULE: Trans.pm
#
# Copyright (c) InfoWest, Inc.  All Rights Reserved.
# Written by Aaron D. Gifford (www.aarongifford.com)
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, the above list of authors and contributors, this list of
#    conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. Neither the name of the author(s) or copyright holder(s) nor the
#    names of any contributors may be used to endorse or promote products
#    derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER(S), AUTHOR(S) AND
# CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL
# IN NO EVENT SHALL THE COPYRIGHT HOLDER(S), AUTHOR(S), OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# DCONSEQUENTIAL AMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
# THE POSSIBILITY OF SUCH DAMAGE.
#
############################################################################
#
# This module implements a single-threaded transaction-like system.
# It is definitely NOT A.C.I.D. compliant - there is no transaction
# log, so there are few guarantees.  Nevertheless, it is still
# extremely useful for taking actions that may later need to be
# rolled back (undone).
#
# To make an action undoable, an anonymous subroutine is pushed onto
# a stack to be called in the event of a rollback.  If there is any
# clean-up that needs to be done (i.e. deleting any temporary files
# that may store rollback data) upon final commit, another anonymous
# subroutine can be added as well.  These anonymous routines act
# as closures.
#
# Beware of carelessly pushing such closures on the stack, for instance
# in the middle of a loop, instead of outside of the loop, as the
# closures may exist for quite some time outside of the code where they
# are created.  This is often a useless waste of resources.
#
# EXAMPLE USAGE:
# --------------
#
# To take a single action and make it undoable should it ever be a part
# of a larger encapsulated transaction, try this:
#
#    ...take some undoable action...
#
#    if ($action_was_successful) {
#      Trans::AtomReact({
#        ..code to undo the above action...
#      });
#    }
#
# Or, in a case where there are several sequential atomic actions
# taken that require all previous actions to be undone in case of
# error, do this:
#
# sub undo_example {
#
#  Trans::Begin();
#  try {
#
#   ... undoable action #1 ...
#   ... throw exception if action fails ...
#   Trans::React(sub {
#     ... code to undo action #1 ...
#   });
#
#   ... undoable action #2 ...
#   ... throw exception if action fails ...
#   Trans::React(sub {
#     ... code to undo action #2 ...
#   }, sub {
#     ... code to clean up any temporary data store upon final commit ...
#   });
#
#   ... undoable action #3  ...
#   ... throw exception if action fails ...
#   Trans::React(sub {
#     ... code to undo action #3 ...
#   });
#
#   ... later down the road ...
#
#   ... undoable action #N  ...
#   ... throw exception if action fails ...
#
#   Trans::Commit();
#  } catch Error with {
#   Trans::Rollback();
# } 
#
# In the above, the call to Trans::Begin() indicates that a new
# series of one or more undoable actions will be taken.  If at
# any time during the chain of actions, an error occurs that
# requires all past successful actions in the chain to be undone,
# the thrown error is caught, and the error handler calls
# Trans::Rollback().  If the actions all succeed, then the open
# transaction is committed with Trans::Commit().  Please note
# that if this transaction is a subtransaction (i.e. a part of
# another, encapsulating transaction), then final commit does
# NOT occur on calling Trans::Commit() until the outermost
# encapsulating transaction also calls Trans::Commit().  This
# also means that upon a call to Trans::Rollback() at any time
# before that final, outermost Trans::Commit(), the local undo
# code will be called, and any supplied clean-up code will only
# be called on the final Trans::Commit().
#
# PLEASE NOTE that this is NOT an exception handling scheme.
# This code relies on the Error module for exception handling,
# and also relies on the user of this module to make appropriate
# Trans::Rollback() and Trans::Commit() calls within exception
# handling code sections.
#
# An exception or error that might occur during unwinding of
# the transaction stack either on the outermost Trans::Commit()
# or upon Trans::Rollback() could cause trouble, so watch out.
#
############################################################################

package Trans;

use strict;
use warnings;
use Error ':try';

# Internal data structures:
#
# [Tree Node Structure] (an anonymous hash)
#   $type    The constant string "NODE"
#   $parent  Reference to the parent tree structure (or undefined if this
#            node is the top of the tree)
#   @list    List of references to EITHER:
#              1) Another tree node below this node; OR
#              2) A closure structure (see below).
#
# [Closure Structure] (an anonymous hash)
#   $type        The constant string "CLOSURE"
#   $rollback    A closure that gets called to reverse a recently completed
#                action in case of a rollback of an encapsulating transaction.
#   $cleanup     A closure that gets called to clean up any outstanding
#                data (i.e. a temporary file storing data for a possible
#                rollback) upon finalizing the outermost transaction layer
#                (with a commit).
#
# NOTE: The order of rollback or commit closures will be in reverse of the
# order they were placed in the list.

sub Begin() {
  # Create a new subtree:
  my $node = { 
    'type'    => "NODE",
    'parent'  => $Trans::_CurrentNode,
    'list'    => []
  };
  if (defined($Trans::_CurrentNode)) {
    push(@{$Trans::_CurrentNode->{'list'}}, $node);
  }
  $Trans::_CurrentNode = $node;
}

sub React($$) {
  my ($rollback, $cleanup) = @_;
  my $closure = {
    'type'      => "CLOSURE",
    'rollback'  => $rollback,
    'cleanup'   => $cleanup
  };

  if (!defined($Trans::_CurrentNode)) {
    throw Error::Simple("Trans::React() called without a prior call to Trans::Begin().");
  }
  if (!defined($rollback) && !defined($cleanup)) {
    throw Error::Simple("Trans::React() called without any valid closures.");
  }

  if (defined($rollback) && ref($rollback) ne "CODE") {
    throw Error::Simple("Trans::React(): First argument is not a valid closure.");
  }
  if (defined($cleanup) && ref($cleanup) ne "CODE") {
    throw Error::Simple("Trans::React(): Second argument is not a valid closure.");
  }
  push(@{$Trans::_CurrentNode->{'list'}}, $closure);
}

sub AtomReact($$) {
  my ($rollback, $cleanup) = @_;

  Begin();
  React($rollback, $cleanup);
  Commit();
}

# The below internal function unwinds the stack upon final commit
# or upon rollback.  If $rollback == 1, then all rollback closures
# are called in reverse order as the stack is unwound.  Otherwise
# if $rollback == 0, the final commitment cleanup closures are
# called.
#

# Forward declaration so "use warnings" won't complain
sub _Unwind($); # Forward declaration so "use warnings" won't complain

# NOTE: The below is an INTERNAL USE ONLY routine!
sub _Unwind($) {
  my ($rollback) = shift(@_);
  my ($node);


  if (!$Trans::_CurrentNode) {
    throw Error::Simple("Trans::_Unwind() called once too many times, probably due to unbalanced Begin/Commit pairs.");
  }

  foreach $node (reverse(@{$Trans::_CurrentNode->{'list'}})) {
    if ($node->{'type'} eq "NODE") {
      # This is a child node, so recursively unwind:
      $Trans::_CurrentNode = $node;
      _Unwind($rollback);
    } else {
      # Execute the appropriate closure:
      if ($rollback) {
        if (defined($node->{'rollback'})) {
          $node->{'rollback'}->();
        }
      } else {
        if (defined($node->{'cleanup'})) {
          $node->{'cleanup'}->();
        }
      }
    }
  }
  $Trans::_CurrentNode = $Trans::_CurrentNode->{'parent'};
}

# Commit the transaction layer.  If this is the outermost layer,
# execute all cleanup closures:
sub Commit {
  if (!$Trans::_CurrentNode) {
    throw Error::Simple("Trans::Commit() called without matching prior call to Trans::Begin()");
  }

  if (!defined($Trans::_CurrentNode->{'parent'})) {
    # This is the final, outermost commit, so unwind the stack and call
    # any/all cleanup closures:
    _Unwind(0);
  } else {
    # Inner/sub-transaction
    $Trans::_CurrentNode = $Trans::_CurrentNode->{'parent'};
  }
}

# Initiate calling rollback closures at the lowest level chain:
sub Rollback {
  if (!defined($Trans::_CurrentNode)) {
    throw Error::Simple("Trans::Rollback() called without a prior call to Trans::Begin()");
  }
  # _Unwind the stack calling all rollback closures:
  _Unwind(1);
}

# Useful for debugging - It shows the transaction stack state
sub ShowStack {
  my ($level,$node) = @_;

  if (!$level || !defined($node)) {
    $node = $Trans::_CurrentNode;
    if (!defined($node)) {
      print "Transaction Stack is EMPTY!\n";
    } else {
      while (defined($node->{'parent'})) {
        $node = $node->{'parent'};
      }
      print "Transaction Stack:\n------------------\n";
      ShowStack(1,$node);
    }
  } else {
    my $item;

    print "  " x $level;
    print "NODE\t$node {\n";
    $level++;
    foreach $item (@{$node->{'list'}}) {
      if ($item->{'type'} eq "NODE") {
        ShowStack($level,$item);
      } else {
        print "  " x $level;
        print "CLOSURE\tROLLBACK=$item->{'rollback'}\tCLEANUP=$item->{'cleanup'}\n";
      }
    }
    $level--;
    print "  " x $level;
    print "}\n";
  }
}

# Initialize the module's static transaction stack:
$Trans::_CurrentNode = undef;

1;