Return-MultiLevel-0.03/0000755000175000001440000000000012200260372014006 5ustar maukeusersReturn-MultiLevel-0.03/lib/0000755000175000001440000000000012200260372014554 5ustar maukeusersReturn-MultiLevel-0.03/lib/Return/0000755000175000001440000000000012200260372016033 5ustar maukeusersReturn-MultiLevel-0.03/lib/Return/MultiLevel.pm0000644000175000001440000000635012200260261020454 0ustar maukeuserspackage Return::MultiLevel; use warnings; use strict; our $VERSION = '0.03'; use Carp qw(confess); use parent 'Exporter'; our @EXPORT_OK = qw(with_return); our $_backend; if (!$ENV{RETURN_MULTILEVEL_PP} && eval { require Scope::Upper }) { *with_return = sub (&) { my ($f) = @_; my @ctx; local $ctx[0] = Scope::Upper::HERE(); $f->(sub { defined $ctx[0] or confess "Attempt to re-enter dead call frame"; Scope::Upper::unwind(@_, $ctx[0]); }) }; $_backend = 'XS'; } else { our $uniq = 0; our @ret; *with_return = sub (&) { my ($f) = @_; my @label; local $label[0] = __PACKAGE__ . '_' . $uniq; local $uniq = $uniq + 1; $label[0] =~ tr/A-Za-z0-9_/_/cs; my $r = sub { defined $label[0] or confess "Attempt to re-enter dead call frame"; @ret = @_; goto $label[0]; }; my $c = eval qq[ #line ${\(__LINE__ + 2)} "${\__FILE__}" sub { return \$f->(\$r); $label[0]: splice \@ret } ]; die $@ if $@; $c->() }; $_backend = 'PP'; } 'ok' __END__ =head1 NAME Return::MultiLevel - return across multiple call levels =head1 SYNOPSIS use Return::MultiLevel qw(with_return); sub inner { my ($f) = @_; $f->(42); # implicitly return from 'with_return' below print "You don't see this\n"; } sub outer { my ($f) = @_; inner($f); print "You don't see this either\n"; } my $result = with_return { my ($return) = @_; outer($return); die "Not reached"; }; print $result, "\n"; # 42 =head1 DESCRIPTION This module provides a way to return immediately from a deeply nested call stack. This is similar to exceptions, but exceptions don't stop automatically at a target frame (and they can be caught by intermediate stack frames). In other words, this is more like L/L than L|perlfunc/die>. Another way to think about it is that the "multi-level return" coderef represents a single-use/upward-only continuation. =head2 Functions The following functions are available (and can be imported on demand). =over =item with_return BLOCK Executes I, passing it a code reference (called C<$return> in this description) as a single argument. Returns whatever I returns. If C<$return> is called, it causes an immediate return from C. Any arguments passed to C<$return> become C's return value (if C is in scalar context, it will return the last argument passed to C<$return>). It is an error to invoke C<$return> after its surrounding I has finished executing. In particular, it is an error to call C<$return> twice. =back =head2 Implementation notes This module uses C from L|Scope::Upper> to do its work. If L|Scope::Upper> is not available, it substitutes its own pure Perl implementation, which is based on a combination of L|perlfunc/eval> and L|perlfunc/goto>. =head1 AUTHOR Lukas Mai, C<< >> =head1 COPYRIGHT & LICENSE Copyright 2013 Lukas Mai. This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information. =cut Return-MultiLevel-0.03/META.yml0000644000175000001440000000107212200260372015257 0ustar maukeusers--- abstract: 'return across multiple call levels' author: - 'Lukas Mai ' build_requires: Test::More: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.72, CPAN::Meta::Converter version 2.132140' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Return-MultiLevel no_index: directory: - t - inc requires: Carp: 0 Exporter: 0 parent: 0 perl: 5.008000 strict: 0 warnings: 0 resources: repository: git://github.com/mauke/Return-MultiLevel.git version: 0.03 Return-MultiLevel-0.03/Makefile.PL0000644000175000001440000000314112200260036015754 0ustar maukeusersuse strict; use warnings; use ExtUtils::MakeMaker; sub merge_key_into { my ($href, $target, $source) = @_; %{$href->{$target}} = (%{$href->{$target}}, %{delete $href->{$source}}); } my %opt = ( NAME => 'Return::MultiLevel', AUTHOR => q{Lukas Mai }, VERSION_FROM => 'lib/Return/MultiLevel.pm', ABSTRACT_FROM => 'lib/Return/MultiLevel.pm', LICENSE => 'perl', PL_FILES => {}, MIN_PERL_VERSION => '5.8.0', CONFIGURE_REQUIRES => { 'strict' => 0, 'warnings' => 0, 'ExtUtils::MakeMaker' => '6.48', }, BUILD_REQUIRES => {}, TEST_REQUIRES => { 'Test::More' => 0, }, PREREQ_PM => { 'warnings' => 0, 'strict' => 0, 'parent' => 0, 'Carp' => 0, 'Exporter' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Return-MultiLevel-*' }, META_MERGE => { 'meta-spec' => { version => 2 }, resources => { repository => { url => 'git://github.com/mauke/Return-MultiLevel.git', web => 'https://github.com/mauke/Return-MultiLevel', type => 'git', }, }, }, ); (my $mm_version = ExtUtils::MakeMaker->VERSION) =~ tr/_//d; if ($mm_version < 6.67_04) { # Why? For the glory of satan, of course! no warnings qw(redefine); *ExtUtils::MM_Any::_add_requirements_to_meta_v1_4 = \&ExtUtils::MM_Any::_add_requirements_to_meta_v2; } if ($mm_version < 6.63_03) { merge_key_into \%opt, 'BUILD_REQUIRES', 'TEST_REQUIRES'; } if ($mm_version < 6.55_01) { merge_key_into \%opt, 'CONFIGURE_REQUIRES', 'BUILD_REQUIRES'; } if ($mm_version < 6.51_03) { merge_key_into \%opt, 'PREREQ_PM', 'CONFIGURE_REQUIRES'; } WriteMakefile %opt; Return-MultiLevel-0.03/t/0000755000175000001440000000000012200260372014251 5ustar maukeusersReturn-MultiLevel-0.03/t/nested.t0000644000175000001440000000061712072642050015730 0ustar maukeusers#!perl use Test::More tests => 1; use warnings FATAL => 'all'; use strict; use Return::MultiLevel qw(with_return); my @r; for my $i (1 .. 10) { push @r, with_return { my ($ret_outer) = @_; 100 + with_return { my ($ret_inner) = @_; sub { ($i % 2 ? $ret_outer : $ret_inner)->($i); 'bzzt1' }->(); 'bzzt2' } }; } is_deeply \@r, [1, 102, 3, 104, 5, 106, 7, 108, 9, 110]; Return-MultiLevel-0.03/t/00-load.t0000644000175000001440000000030112072642050015570 0ustar maukeusers#!perl use Test::More tests => 1; BEGIN { use_ok( 'Return::MultiLevel' ); } diag( "Testing Return::MultiLevel $Return::MultiLevel::VERSION ($Return::MultiLevel::_backend), Perl $], $^X" ); Return-MultiLevel-0.03/t/basic.t0000644000175000001440000000112212072642050015517 0ustar maukeusers#!perl use Test::More tests => 5; use warnings FATAL => 'all'; use strict; use Return::MultiLevel qw(with_return); is with_return { my ($ret) = @_; 42 }, 42; is with_return { my ($ret) = @_; $ret->(42); 1 }, 42; is with_return { my ($ret) = @_; sub { $ret->($_[0]); 2 }->(42); 3 }, 42; sub foo { my ($f, $x) = @_; $f->('a', $x, 'b'); return 'x'; } is_deeply [with_return { my ($ret) = @_; sub { foo $ret, "$_[0] lo"; }->('hi'); () }], ['a', 'hi lo', 'b']; is_deeply [scalar with_return { my ($ret) = @_; sub { foo $ret, "$_[0] lo"; }->('hi'); () }], ['b']; Return-MultiLevel-0.03/MANIFEST0000644000175000001440000000040612200260372015137 0ustar maukeusersChanges MANIFEST Makefile.PL README lib/Return/MultiLevel.pm t/00-load.t t/basic.t t/nested.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Return-MultiLevel-0.03/META.json0000644000175000001440000000221612200260372015430 0ustar maukeusers{ "abstract" : "return across multiple call levels", "author" : [ "Lukas Mai " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.72, CPAN::Meta::Converter version 2.132140", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Return-MultiLevel", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : {} }, "runtime" : { "requires" : { "Carp" : "0", "Exporter" : "0", "parent" : "0", "perl" : "5.008000", "strict" : "0", "warnings" : "0" } }, "test" : { "requires" : { "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "git://github.com/mauke/Return-MultiLevel.git", "web" : "https://github.com/mauke/Return-MultiLevel" } }, "version" : "0.03" } Return-MultiLevel-0.03/Changes0000644000175000001440000000041312200260312015271 0ustar maukeusersRevision history for Return-MultiLevel 0.03 2013-08-06 - require 5.8 because 5.6 segfaults for some reason 0.02 2013-08-01 - drop dependency on Scope::OnExit::Wrap 0.01 2013-01-04 First version, released on an unsuspecting world. Return-MultiLevel-0.03/README0000644000175000001440000000176112176536006014707 0ustar maukeusersReturn-MultiLevel Return across multiple call levels INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Return::MultiLevel You can also look for information at: RT, CPAN's request tracker http://rt.cpan.org/NoAuth/Bugs.html?Dist=Return-MultiLevel AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/Return-MultiLevel CPAN Ratings http://cpanratings.perl.org/d/Return-MultiLevel MetaCPAN https://metacpan.org/module/Return::MultiLevel COPYRIGHT AND LICENCE Copyright (C) 2013 Lukas Mai This program is free software; you can redistribute it and/or modify it under the terms of either: the GNU General Public License as published by the Free Software Foundation; or the Artistic License. See http://dev.perl.org/licenses/ for more information.