view release on metacpan or  search on metacpan

lib/Algorithm/CP/IZ.pm  view on Meta::CPAN

    my $constname;
    our $AUTOLOAD;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "&Algorithm::CP::IZ::constant not defined" if $constname eq 'constant';
    my ($error, $val) = constant($constname);
    if ($error) { croak $error; }
    {
	no strict 'refs';
	# Fixed between 5.005_53 and 5.005_61
#XXX	if ($] >= 5.00561) {
#XXX	    *$AUTOLOAD = sub () { $val };
#XXX	}
#XXX	else {
	    *$AUTOLOAD = sub { $val };
#XXX	}
    }
    goto &$AUTOLOAD;
}

require XSLoader;
XSLoader::load('Algorithm::CP::IZ', $VERSION);

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

my $Instances = 0;

sub _report_error {
    my $msg = shift;
    croak __PACKAGE__ . ": ". $msg;
}

sub new {
    my $class = shift;

    if ($Instances > 0) {
	_report_error("another instance is working.");
    }

    Algorithm::CP::IZ::cs_init();
    $Instances++;

    bless {
	_vars => [],
	_cxt0 => [],
	_cxt => [],
	_const_vars => {},
	_backtracks => {},
	_ref_int_arrays => {},
	_ref_var_arrays => {},
    }, $class;
}

sub DESTROY {
    my $self = shift;
    my $vars = $self->{_vars};

    for my $v (@$vars) {
	# we must check existence of variable for global destruction.
	$v->_invalidate if (defined $v);
    }

    Algorithm::CP::IZ::cs_end();
    $Instances--;
}

sub save_context {
    my $self = shift;
    
    my $ret = Algorithm::CP::IZ::cs_saveContext();

    my $cxt = $self->{_cxt};
    push(@$cxt, []);

    $self->backtrack(undef, 0, sub { pop(@$cxt) });

    return $ret;
}

sub restore_context {
    my $self = shift;

    my $cxt = $self->{_cxt};
    if (@$cxt == 0) {
	_report_error("restore_context: bottom of context stack");
    }

    Algorithm::CP::IZ::cs_restoreContext();
}

sub restore_context_until {
    my $self = shift;
    my $label = shift;

    validate([$label], ["I"],
	     "Usage: restore_context_until(int_label)");

    my $cxt = $self->{_cxt};
    if (@$cxt == 0) {
	_report_error("restore_context_until: invalid label");
    }

    Algorithm::CP::IZ::cs_restoreContextUntil($label);
}

sub forget_save_context {
    my $self = shift;

    my $cxt = $self->{_cxt};
    if (@$cxt == 0) {
	_report_error("forget_save_context: bottom of context stack");
    }

    Algorithm::CP::IZ::cs_forgetSaveContext();
}

sub forget_save_context_until {
    my $self = shift;
    my $label = shift;