package Signals::XSIG::TieArray56;

use Carp;
use strict;
use warnings;

############################################################
#
# Signals::XSIG::TieArray
# for Perl <=v5.6.
#
# Applied to @{$XSIG{signal}}.
# On update, refreshes the handler for the signal.
#

# perl 5.6 does not pass negative indices to the STORE and FETCH
# methods, so we must use a different implementation to
# let us say $XSIG{signal}[-3] = ...



sub TIEARRAY {
    my ($class, @list) = @_;
    my $obj = bless {}, __PACKAGE__;
    $obj->{key} = shift @list;

    # {handlers}[0 .. max-1] are for "positive" indices,
    # {handlers}[max .. 99] are for "negative" indices
    $obj->{max} = 50;

    $obj->{bottom} = 99;         # next free slot for "unshift" operation
    $obj->{handlers} = [ (undef) x 100 ];
    for my $i (0 .. $#list) {
	$obj->{handlers}[$i] = Signals::XSIG::_qualify_handler($list[$i]);
    }
    $obj->{top} = scalar @list;  # next free slot for "push" operation

    # {start} is not used by TieArray56, but __shadow_signal_handler
    # refers to it.
    $obj->{start} = 0;
    return $obj;
}

sub FETCH {
    my ($self, $index) = @_;
    croak if $index < 0;
    return $self->{handlers}[$index];
}

sub STORE {
    my ($self, $index, $handler) = @_;
    croak if $index < 0;

    if ($index == $self->{top}) {
	$self->{top}++;
	$self->{max} = $self->{top} if $self->{max} <= $self->{top};
    } elsif ($index == $self->{bottom}) {
	$self->{bottom}--;
	$self->{max} = $self->{bottom} if $self->{max} >= $self->{bottom};
    } elsif ($index >= $self->{max}) {
	$self->{bottom} = $index-1 if $index <= $self->{bottom};
    } else {
	$self->{top} = $index+1 if $index >= $self->{top};
    }
    if ($self->{top}>$self->{bottom}
	|| $self->{top}>99
	|| $self->{bottom}>99
	|| $self->{top}<0
	|| $self->{bottom}<0) {
	croak "INCONSISTENT \n";
    }

    my $old = $self->{handlers}[$index];
    $handler = Signals::XSIG::_qualify_handler($handler);
    $self->{handlers}[$index] = $handler;
    $self->_refresh_SIG();
    return $old;
}

sub _refresh_SIG {
    my $self = shift;
    return if $Signals::XSIG::_REFRESH == 0;

    local $Signals::XSIG::_REFRESH = 0;

    my $sig = $self->{key};
    my @index_list = ();
    my @handlers = @{$self->{handlers}};
    my ($seen_default, $seen_ignore) = (0,0);
    for my $i ($self->{bottom} .. 99, 0 .. $self->{top}-1) {
	next if !defined $handlers[$i];
	next if $handlers[$i] eq 'DEFAULT' && $seen_default++;
	next if $handlers[$i] eq 'IGNORE' && $seen_ignore++;
	push @index_list, $i;
    }

    my $handler_to_install;
    if (@index_list == 0) {
	$handler_to_install = undef;
    }

    # XXX - if there is a single handler, and that handler is 'DEFAULT',
    #       do we want to install the shadow signal handler anyway?
    #       The caller may have overridden the DEFAULT behavior of the signal,
    #       so yeah, I think we do.

    elsif (@index_list == 1 &&
	   ($seen_default == 0 ||
	    ref($Signals::XSIG::DEFAULT_BEHAVIOR{$sig}) eq '')) {

	$handler_to_install = $handlers[$index_list[0]];
    } else {
	if ($sig eq '__WARN__') {
	    $handler_to_install = \&Signals::XSIG::__shadow__warn__handler;
	} elsif ($sig eq '__DIE__') {
	    $handler_to_install = \&Signals::XSIG::__shadow__die__handler;
	} else {
	    $handler_to_install = \&Signals::XSIG::__shadow_signal_handler;
	}
    }
    Signals::XSIG::untied {
	no warnings qw(uninitialized signal); ## no critic (NoWarnings)
	$SIG{$sig} = $handler_to_install;
    };
    return;
}

sub handlers {
    my $self = shift;
    my @h = @{$self->{handlers}};
    return @h[$self->{bottom}+1 .. 99, 0 .. $self->{top}-1];
}

sub FETCHSIZE {
    my ($self) = @_;
    return 100;
    # return scalar $self->handlers;
}

sub STORESIZE { }

sub EXTEND { }

sub EXISTS {
    my ($self, $index) = @_;
    croak if $index<0;
    return exists $self->{handlers}[$index];
}

sub DELETE {
    my ($self, $index) = @_;
    croak if $index < 0;
    my $old = $self->{handlers}[$index];
    $self->{handlers}[$index] = undef;
    $self->_refresh_SIG;
    return $old;
}

sub CLEAR {
    my ($self) = @_;
    $self->{handlers} = [(undef) x 100];
    $self->{top} = 0;
    $self->{bottom} = 99;
    $self->{max} = 50;
    $self->_refresh_SIG;
    return;
}

sub UNSHIFT {
    my ($self, @list) = @_;
    foreach my $handler (reverse @list) {
	$self->{handlers}[$self->{bottom}] = $handler;
	$self->{bottom}--;
	if ($self->{bottom} < $self->{max}) {
	    $self->{max}--;
	}
	if ($self->{bottom} < $self->{top}) {
	    croak;
	}
    }
    $self->_refresh_SIG;
    return $self->FETCHSIZE;
}

sub POP {
    my ($self) = @_;
    # POP cannot be used to remove the default handler (index 0)
    if ($self->{top} > 1) {
	$self->{top}--;
	my $val = $self->{handlers}[$self->{top}];
	$self->{handlers}[$self->{top}] = undef;
	$self->_refresh_SIG;
	return $val;
    }

    # disable this block: pop cannot be used to retrieve pre-handlers ...
    if (0 && $self->{bottom} < 99) {
	my $val = pop @{$self->{handlers}};
	splice @{$self->{handlers}}, $self->{max}, 0, undef;
	$self->{bottom}++;
	$self->_refresh_SIG;
	return $val;
    }

    # nothing to pop
    return;
}


sub SHIFT {
    my $self = shift;
    if ($self->{bottom} < 99) {
	$self->{bottom}++;
	my $val = $self->{handlers}[$self->{bottom}];
	$self->{handlers}[$self->{bottom}] = undef;
	$self->_refresh_SIG;
	return $val;
    }

    # disable this block: shift cannot be used to retrieve post-handlers ?
    if (0 && $self->{top} > 0) {
	my $val = shift @{$self->{handlers}};
	splice @{$self->{handlers}}, $self->{max}-1, 0, undef;
	$self->{top}--;
	return $val;
    }

    # nothing to shift
    return;
}

sub PUSH {
    my ($self, @list) = @_;
    if ($self->{top} == 0) {
	# don't set index 0 with PUSH
	$self->{top} = 1;
    }
    foreach my $handler (@list) {
	$self->{handlers}[$self->{top}] = $handler;
	$self->{top}++;
	$self->{max}++ if $self->{top} > $self->{max};
	croak if $self->{top} > $self->{bottom};
    }
    $self->_refresh_SIG;
    return $self->FETCHSIZE;
}

sub SPLICE { }

1;