File Coverage

blib/lib/Long/Jump.pm

Criterion	Covered	Total	%
statement	37	38	97.3
branch	13	14	92.8
condition	3	3	100.0
subroutine	8	8	100.0
pod	3	3	100.0
total	64	66	96.9

package Long::Jump;
use strict;
use warnings;

our $VERSION = '0.000004';

use Carp qw/croak/;
use Importer Importer => 'import';

our @EXPORT_OK = qw/setjump longjump havejump/;

my (%STACK, $SEEK, $OUT);

sub havejump { $STACK{$_[-1]} ? 1 : 0 }

sub setjump {
    my ($name, $code, @args) = @_;

    croak "You must name your jump point" unless defined $name;
    croak "You must provide a subroutine as a second argument" unless $code && ref($code) eq 'CODE';

    croak "There is already a jump point named '$name'" if exists $STACK{$name};

    local $STACK{$name} = 1;

    LONG_JUMP_SET: {
        $code->(@args);
        return undef;
    }

    longjump($SEEK, @$OUT) if $name ne $SEEK;

    my $out = $OUT;
    $OUT = undef;
    return $out;
}

sub longjump {
    $SEEK = shift;

    croak "No such jump point: '$SEEK'" unless $STACK{$SEEK};

    $OUT = [@_];

    my $ok = eval { no warnings 'exiting'; last LONG_JUMP_SET; 1 };
    my $err = $@;

    my $msg = "longjump('$SEEK') failed";
    $msg .= ", error: $err" unless $ok;

    croak $msg;
}

1;

__END__