#  Copyright (c) 1997-2006
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
#  http://www.math.tu-berlin.de/polymake,  mailto:polymake@math.tu-berlin.de
#
#  This program is free software; you can redistribute it and/or modify it
#  under the terms of the GNU General Public License as published by the
#  Free Software Foundation; either version 2, or (at your option) any
#  later version: http://www.gnu.org/licenses/gpl.txt.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#-----------------------------------------------------------------------------
#  $Project: polymake $$Id: Scope.pm 7370 2006-05-23 21:16:03Z gawrilow $

use strict;
use namespaces;

package Poly::Scope;
use Poly::Ext;

use Struct (
   '$local_marker',
   '%deferred',		# 'arbitrary key' => Action:
	    		#   \Object or \&sub or [ \&sub, args ... ] or [ \Object, "method", args ... ]
			# For a naked Object, its method 'proceed' is called
   '@proceeded',	# holds anything returned by performed deferred actions (to be deleted during unwind)
   '%cleanup',		# the same, but during unwind.  The default method is 'cleanup'.  Key must be a reference
);

sub perform {
   my ($key, $action, $method)=@_;
   if (is_object($action)) {
      $action->$method($key);
   } elsif (is_code($action)) {
      $action->($key);
   } elsif (is_ARRAY($action)) {
      $key->$method(@$action);
   } else {
      err_print( "Poly::Scope - don't know what to do with a '$_[2]' action: $key => ", ref($action) || "'$action'" );
      ()
   }
}

sub perform_deferred {
   my ($self)=@_;
   my ($key, $action);
   while (my ($key, $action)=each %{$self->deferred}) {
      push @{$self->proceeded}, perform($key, $action, "proceed");
   }
   %{$self->deferred}=();
}

sub DESTROY {
   my ($self)=@_;
   while (my ($key, $action)=each %{$self->cleanup}) {
      local $@;
      eval { perform($key, $action, "cleanup") };
      err_print($@) if $@;
   }
   unwind($self->local_marker);
}

my $unique_key="a";

sub add_unique {
   my (undef, $key, $action, $is_empty)=@_;
   if (defined($_[0])) {
      if (!defined($is_empty) || !$is_empty->($_[0])) {
	 ++$unique_key while exists $self->deferred->{"$key#$unique_key"};
	 $self->deferred->{"$key#$unique_key"}=$_[0];
      }
   }
   $_[0]=$action;
}

sub add_deferred_action {
   my $self=shift;
   add_unique($self->{$_[0]}, @_);
}


1