@@ -0,0 +1,87 @@
+## HOW TO CONTRIBUTE
+
+Thank you for considering contributing to this distribution. This file
+contains instructions that will help you work with the source code.
+
+The distribution is managed with Dist::Zilla. This means than many of the
+usual files you might expect are not in the repository, but are generated at
+release time, as is much of the documentation. Some generated files are
+kept in the repository as a convenience (e.g. Makefile.PL or cpanfile).
+
+Generally, **you do not need Dist::Zilla to contribute patches**. You do need
+Dist::Zilla to create a tarball. See below for guidance.
+
+### Getting dependencies
+
+If you have App::cpanminus 1.6 or later installed, you can use `cpanm` to
+satisfy dependencies like this:
+
+ $ cpanm --installdeps .
+
+Otherwise, look for either a `Makefile.PL` or `cpanfile` file for
+a list of dependencies to satisfy.
+
+### Running tests
+
+You can run tests directly using the `prove` tool:
+
+ $ prove -l
+ $ prove -lv t/some_test_file.t
+
+For most of my distributions, `prove` is entirely sufficient for you to test any
+patches you have. I use `prove` for 99% of my testing during development.
+
+### Code style and tidying
+
+Please try to match any existing coding style. If there is a `.perltidyrc`
+file, please install Perl::Tidy and use perltidy before submitting patches.
+
+If there is a `tidyall.ini` file, you can also install Code::TidyAll and run
+`tidyall` on a file or `tidyall -a` to tidy all files.
+
+### Patching documentation
+
+Much of the documentation Pod is generated at release time. Some is
+generated boilerplate; other documentation is built from pseudo-POD
+directives in the source like C<=method> or C<=func>.
+
+If you would like to submit a documentation edit, please limit yourself to
+the documentation you see.
+
+If you see typos or documentation issues in the generated docs, please
+email or open a bug ticket instead of patching.
+
+### Installing and using Dist::Zilla
+
+Dist::Zilla is a very powerful authoring tool, optimized for maintaining a
+large number of distributions with a high degree of automation, but it has a
+large dependency chain, a bit of a learning curve and requires a number of
+author-specific plugins.
+
+To install it from CPAN, I recommend one of the following approaches for
+the quickest installation:
+
+ # using CPAN.pm, but bypassing non-functional pod tests
+ $ cpan TAP::Harness::Restricted
+ $ PERL_MM_USE_DEFAULT=1 HARNESS_CLASS=TAP::Harness::Restricted cpan Dist::Zilla
+
+ # using cpanm, bypassing *all* tests
+ $ cpanm -n Dist::Zilla
+
+In either case, it's probably going to take about 10 minutes. Go for a walk,
+go get a cup of your favorite beverage, take a bathroom break, or whatever.
+When you get back, Dist::Zilla should be ready for you.
+
+Then you need to install any plugins specific to this distribution:
+
+ $ cpan `dzil authordeps`
+ $ dzil authordeps | cpanm
+
+Once installed, here are some dzil commands you might try:
+
+ $ dzil build
+ $ dzil test
+ $ dzil xtest
+
+You can learn more about Dist::Zilla at http://dzil.org/
+
@@ -1,5 +1,21 @@
Changes for Sub::Uplevel
+0.25 2015-01-26 20:32:52-05:00 America/New_York
+
+ [Fixed]
+
+ - fixed: 00-compile.t failures under Windows (bug #98230).
+ The 00-compile.t file has been moved to a release test and is
+ no longer shipped. [Michael Gray]
+
+ [Meta]
+
+ - moved bug tracker to Github
+
+ - updated repo files explaining how to contribute
+
+ - enabled Travis CI
+
0.24 2012-02-20 22:18:46 EST5EDT
- no changes from 0.23_03
@@ -1,4 +1,4 @@
-This software is copyright (c) 2012 by Michael Schwern and David Golden.
+This software is copyright (c) 2015 by Michael Schwern and David Golden.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -12,7 +12,7 @@ b) the "Artistic License"
--- The GNU General Public License, Version 1, February 1989 ---
-This software is Copyright (c) 2012 by Michael Schwern and David Golden.
+This software is Copyright (c) 2015 by Michael Schwern and David Golden.
This is free software, licensed under:
@@ -22,7 +22,7 @@ This is free software, licensed under:
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
- 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA
+ 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -272,7 +272,7 @@ That's all there is to it!
--- The Artistic License 1.0 ---
-This software is Copyright (c) 2012 by Michael Schwern and David Golden.
+This software is Copyright (c) 2015 by Michael Schwern and David Golden.
This is free software, licensed under:
@@ -1,3 +1,5 @@
+# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.031.
+CONTRIBUTING.mkdn
Changes
LICENSE
MANIFEST
@@ -5,12 +7,13 @@ META.json
META.yml
Makefile.PL
README
-README.PATCHING
+cpanfile
dist.ini
examples/uplevel-demo.pl
lib/Sub/Uplevel.pm
perlcritic.rc
-t/00-compile.t
+t/00-report-prereqs.dd
+t/00-report-prereqs.t
t/01_die_check.t
t/02_uplevel.t
t/03_nested_uplevels.t
@@ -23,9 +26,11 @@ t/09_emptylist.t
t/lib/Bar.pm
t/lib/Foo.pm
t/lib/Importer.pm
+xt/author/00-compile.t
xt/author/critic.t
xt/author/pod-spell.t
xt/release/distmeta.t
+xt/release/minimum-version.t
xt/release/pod-coverage.t
xt/release/pod-syntax.t
xt/release/portability.t
@@ -5,13 +5,13 @@
"David Golden <dagolden@cpan.org>"
],
"dynamic_config" : 0,
- "generated_by" : "Dist::Zilla version 4.300005, CPAN::Meta::Converter version 2.112621",
+ "generated_by" : "Dist::Zilla version 5.031, CPAN::Meta::Converter version 2.143240",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
- "version" : "2"
+ "version" : 2
},
"name" : "Sub-Uplevel",
"no_index" : {
@@ -28,46 +28,73 @@
"prereqs" : {
"configure" : {
"requires" : {
- "ExtUtils::MakeMaker" : "6.30"
+ "ExtUtils::MakeMaker" : "6.17",
+ "perl" : "5.006"
+ }
+ },
+ "develop" : {
+ "requires" : {
+ "Dist::Zilla" : "5",
+ "Dist::Zilla::PluginBundle::DAGOLDEN" : "0.073",
+ "File::Spec" : "0",
+ "File::Temp" : "0",
+ "IO::Handle" : "0",
+ "IPC::Open3" : "0",
+ "Pod::Coverage::TrustPod" : "0",
+ "Test::CPAN::Meta" : "0",
+ "Test::More" : "0",
+ "Test::Pod" : "1.41",
+ "Test::Pod::Coverage" : "1.08",
+ "Test::Spelling" : "0.12",
+ "Test::Version" : "1"
}
},
"runtime" : {
"requires" : {
- "Carp" : 0,
- "constant" : 0,
+ "Carp" : "0",
+ "constant" : "0",
"perl" : "5.006",
- "strict" : 0,
- "warnings" : 0
+ "strict" : "0",
+ "warnings" : "0"
}
},
"test" : {
+ "recommends" : {
+ "CPAN::Meta" : "2.120900"
+ },
"requires" : {
- "Exporter" : 0,
- "File::Find" : 0,
- "File::Temp" : 0,
- "Test::More" : 0
+ "Exporter" : "0",
+ "ExtUtils::MakeMaker" : "0",
+ "File::Spec" : "0",
+ "Test::More" : "0",
+ "perl" : "5.006"
}
}
},
"provides" : {
"Sub::Uplevel" : {
"file" : "lib/Sub/Uplevel.pm",
- "version" : "0.24"
+ "version" : "0.25"
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
- "mailto" : "bug-sub-uplevel at rt.cpan.org",
- "web" : "http://rt.cpan.org/Public/Dist/Display.html?Name=Sub-Uplevel"
+ "web" : "https://github.com/dagolden/Sub-Uplevel/issues"
},
- "homepage" : "https://github.com/dagolden/sub-uplevel",
+ "homepage" : "https://github.com/dagolden/Sub-Uplevel",
"repository" : {
"type" : "git",
- "url" : "https://github.com/dagolden/sub-uplevel.git",
- "web" : "https://github.com/dagolden/sub-uplevel"
+ "url" : "https://github.com/dagolden/Sub-Uplevel.git",
+ "web" : "https://github.com/dagolden/Sub-Uplevel"
}
},
- "version" : "0.24"
+ "version" : "0.25",
+ "x_authority" : "cpan:DAGOLDEN",
+ "x_contributors" : [
+ "Adam Kennedy <adamk@cpan.org>",
+ "Alexandr Ciornii <alexchorny@gmail.com>",
+ "Michael Gray <mg13@sanger.ac.uk>"
+ ]
}
@@ -4,18 +4,20 @@ author:
- 'Michael Schwern <mschwern@cpan.org>'
- 'David Golden <dagolden@cpan.org>'
build_requires:
- Exporter: 0
- File::Find: 0
- File::Temp: 0
- Test::More: 0
+ Exporter: '0'
+ ExtUtils::MakeMaker: '0'
+ File::Spec: '0'
+ Test::More: '0'
+ perl: '5.006'
configure_requires:
- ExtUtils::MakeMaker: 6.30
+ ExtUtils::MakeMaker: '6.17'
+ perl: '5.006'
dynamic_config: 0
-generated_by: 'Dist::Zilla version 4.300005, CPAN::Meta::Converter version 2.112621'
+generated_by: 'Dist::Zilla version 5.031, CPAN::Meta::Converter version 2.143240'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: Sub-Uplevel
no_index:
directory:
@@ -28,15 +30,20 @@ no_index:
provides:
Sub::Uplevel:
file: lib/Sub/Uplevel.pm
- version: 0.24
+ version: '0.25'
requires:
- Carp: 0
- constant: 0
- perl: 5.006
- strict: 0
- warnings: 0
+ Carp: '0'
+ constant: '0'
+ perl: '5.006'
+ strict: '0'
+ warnings: '0'
resources:
- bugtracker: http://rt.cpan.org/Public/Dist/Display.html?Name=Sub-Uplevel
- homepage: https://github.com/dagolden/sub-uplevel
- repository: https://github.com/dagolden/sub-uplevel.git
-version: 0.24
+ bugtracker: https://github.com/dagolden/Sub-Uplevel/issues
+ homepage: https://github.com/dagolden/Sub-Uplevel
+ repository: https://github.com/dagolden/Sub-Uplevel.git
+version: '0.25'
+x_authority: cpan:DAGOLDEN
+x_contributors:
+ - 'Adam Kennedy <adamk@cpan.org>'
+ - 'Alexandr Ciornii <alexchorny@gmail.com>'
+ - 'Michael Gray <mg13@sanger.ac.uk>'
@@ -1,28 +1,24 @@
+# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.031.
use strict;
use warnings;
use 5.006;
-use ExtUtils::MakeMaker 6.30;
+use ExtUtils::MakeMaker 6.17;
my %WriteMakefileArgs = (
"ABSTRACT" => "apparently run a function in a higher stack frame",
"AUTHOR" => "Michael Schwern <mschwern\@cpan.org>, David Golden <dagolden\@cpan.org>",
- "BUILD_REQUIRES" => {
- "Exporter" => 0,
- "File::Find" => 0,
- "File::Temp" => 0,
- "Test::More" => 0
- },
"CONFIGURE_REQUIRES" => {
- "ExtUtils::MakeMaker" => "6.30"
+ "ExtUtils::MakeMaker" => "6.17"
},
"DISTNAME" => "Sub-Uplevel",
"EXE_FILES" => [],
"LICENSE" => "perl",
+ "MIN_PERL_VERSION" => "5.006",
"NAME" => "Sub::Uplevel",
"PREREQ_PM" => {
"Carp" => 0,
@@ -30,24 +26,35 @@ my %WriteMakefileArgs = (
"strict" => 0,
"warnings" => 0
},
- "VERSION" => "0.24",
+ "TEST_REQUIRES" => {
+ "Exporter" => 0,
+ "ExtUtils::MakeMaker" => 0,
+ "File::Spec" => 0,
+ "Test::More" => 0
+ },
+ "VERSION" => "0.25",
"test" => {
"TESTS" => "t/*.t"
}
);
-unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) {
- my $br = delete $WriteMakefileArgs{BUILD_REQUIRES};
- my $pp = $WriteMakefileArgs{PREREQ_PM};
- for my $mod ( keys %$br ) {
- if ( exists $pp->{$mod} ) {
- $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod};
- }
- else {
- $pp->{$mod} = $br->{$mod};
- }
- }
+my %FallbackPrereqs = (
+ "Carp" => 0,
+ "Exporter" => 0,
+ "ExtUtils::MakeMaker" => "6.17",
+ "File::Spec" => 0,
+ "Test::More" => 0,
+ "constant" => 0,
+ "strict" => 0,
+ "warnings" => 0
+);
+
+
+unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
+ delete $WriteMakefileArgs{TEST_REQUIRES};
+ delete $WriteMakefileArgs{BUILD_REQUIRES};
+ $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}
delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
@@ -2,7 +2,7 @@ NAME
Sub::Uplevel - apparently run a function in a higher stack frame
VERSION
- version 0.24
+ version 0.25
SYNOPSIS
use Sub::Uplevel;
@@ -133,24 +133,31 @@ SEE ALSO
SUPPORT
Bugs / Feature Requests
Please report any bugs or feature requests through the issue tracker at
- <http://rt.cpan.org/Public/Dist/Display.html?Name=Sub-Uplevel>. You will
- be notified automatically of any progress on your issue.
+ <https://github.com/dagolden/Sub-Uplevel/issues>. You will be notified
+ automatically of any progress on your issue.
Source Code
This is open source software. The code repository is available for
public review and contribution under the terms of the license.
- <https://github.com/dagolden/sub-uplevel>
+ <https://github.com/dagolden/Sub-Uplevel>
- git clone https://github.com/dagolden/sub-uplevel.git
+ git clone https://github.com/dagolden/Sub-Uplevel.git
AUTHORS
* Michael Schwern <mschwern@cpan.org>
* David Golden <dagolden@cpan.org>
+CONTRIBUTORS
+ * Adam Kennedy <adamk@cpan.org>
+
+ * Alexandr Ciornii <alexchorny@gmail.com>
+
+ * Michael Gray <mg13@sanger.ac.uk>
+
COPYRIGHT AND LICENSE
- This software is copyright (c) 2012 by Michael Schwern and David Golden.
+ This software is copyright (c) 2015 by Michael Schwern and David Golden.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -1,42 +0,0 @@
-README.PATCHING
-
-Thank you for considering contributing to this distribution. This file
-contains instructions that will help you work with the source code.
-
-The distribution is managed with Dist::Zilla. This means than many of the
-usual files you might expect are not in the repository, but are generated
-at release time (e.g. Makefile.PL).
-
-However, you can run tests directly using the 'prove' tool:
-
- $ prove -l
- $ prove -lv t/some_test_file.t
-
-For most distributions, 'prove' is entirely sufficent for you to test any
-patches you have.
-
-Likewise, much of the documentation Pod is generated at release time.
-Depending on the distribution, some documentation may be written in a Pod
-dialect called WikiDoc. (See Pod::WikiDoc on CPAN.) If you would like to
-submit a documentation edit, please limit yourself to the documentation you
-see.
-
-If you see typos or documentation issues in the generated docs, please
-email or open a bug ticket instead of patching.
-
-Dist::Zilla is a very powerful authoring tool, but requires a number of
-author-specific plugins. If you would like to use it for contributing,
-install it from CPAN, then run one of the following commands, depending on
-your CPAN client:
-
- $ cpan `dzil authordeps`
- $ dzil authordeps | cpanm
-
-Once installed, here are some dzil commands you might try:
-
- $ dzil build
- $ dzil test
- $ dzil xtest
-
-You can learn more about Dist::Zilla at http://dzil.org/
-
@@ -0,0 +1,38 @@
+requires "Carp" => "0";
+requires "constant" => "0";
+requires "perl" => "5.006";
+requires "strict" => "0";
+requires "warnings" => "0";
+
+on 'test' => sub {
+ requires "Exporter" => "0";
+ requires "ExtUtils::MakeMaker" => "0";
+ requires "File::Spec" => "0";
+ requires "Test::More" => "0";
+ requires "perl" => "5.006";
+};
+
+on 'test' => sub {
+ recommends "CPAN::Meta" => "2.120900";
+};
+
+on 'configure' => sub {
+ requires "ExtUtils::MakeMaker" => "6.17";
+ requires "perl" => "5.006";
+};
+
+on 'develop' => sub {
+ requires "Dist::Zilla" => "5";
+ requires "Dist::Zilla::PluginBundle::DAGOLDEN" => "0.073";
+ requires "File::Spec" => "0";
+ requires "File::Temp" => "0";
+ requires "IO::Handle" => "0";
+ requires "IPC::Open3" => "0";
+ requires "Pod::Coverage::TrustPod" => "0";
+ requires "Test::CPAN::Meta" => "0";
+ requires "Test::More" => "0";
+ requires "Test::Pod" => "1.41";
+ requires "Test::Pod::Coverage" => "1.08";
+ requires "Test::Spelling" => "0.12";
+ requires "Test::Version" => "1";
+};
@@ -5,6 +5,7 @@ license = Perl_5
copyright_holder = Michael Schwern and David Golden
[@DAGOLDEN]
+:version = 0.073
stopwords = PadWalker
stopwords = Tcl's
stopwords = Welch
@@ -2,7 +2,8 @@ package Sub::Uplevel;
use 5.006;
use strict;
# ABSTRACT: apparently run a function in a higher stack frame
-our $VERSION = '0.24'; # VERSION
+
+our $VERSION = '0.25';
# Frame check global constant
our $CHECK_FRAMES;
@@ -49,6 +50,77 @@ sub _force_reload {
}
}
+#pod =head1 SYNOPSIS
+#pod
+#pod use Sub::Uplevel;
+#pod
+#pod sub foo {
+#pod print join " - ", caller;
+#pod }
+#pod
+#pod sub bar {
+#pod uplevel 1, \&foo;
+#pod }
+#pod
+#pod #line 11
+#pod bar(); # main - foo.plx - 11
+#pod
+#pod =head1 DESCRIPTION
+#pod
+#pod Like Tcl's uplevel() function, but not quite so dangerous. The idea
+#pod is just to fool caller(). All the really naughty bits of Tcl's
+#pod uplevel() are avoided.
+#pod
+#pod B<THIS IS NOT THE SORT OF THING YOU WANT TO DO EVERYDAY>
+#pod
+#pod =over 4
+#pod
+#pod =item B<uplevel>
+#pod
+#pod uplevel $num_frames, \&func, @args;
+#pod
+#pod Makes the given function think it's being executed $num_frames higher
+#pod than the current stack level. So when they use caller($frames) it
+#pod will actually give caller($frames + $num_frames) for them.
+#pod
+#pod C<uplevel(1, \&some_func, @_)> is effectively C<goto &some_func> but
+#pod you don't immediately exit the current subroutine. So while you can't
+#pod do this:
+#pod
+#pod sub wrapper {
+#pod print "Before\n";
+#pod goto &some_func;
+#pod print "After\n";
+#pod }
+#pod
+#pod you can do this:
+#pod
+#pod sub wrapper {
+#pod print "Before\n";
+#pod my @out = uplevel 1, &some_func;
+#pod print "After\n";
+#pod return @out;
+#pod }
+#pod
+#pod C<uplevel> has the ability to issue a warning if C<$num_frames> is more than
+#pod the current call stack depth, although this warning is disabled and compiled
+#pod out by default as the check is relatively expensive.
+#pod
+#pod To enable the check for debugging or testing, you should set the global
+#pod C<$Sub::Uplevel::CHECK_FRAMES> to true before loading Sub::Uplevel for the
+#pod first time as follows:
+#pod
+#pod #!/usr/bin/perl
+#pod
+#pod BEGIN {
+#pod $Sub::Uplevel::CHECK_FRAMES = 1;
+#pod }
+#pod use Sub::Uplevel;
+#pod
+#pod Setting or changing the global after the module has been loaded will have
+#pod no effect.
+#pod
+#pod =cut
# @Up_Frames -- uplevel stack
# $Caller_Proxy -- whatever caller() override was in effect before uplevel
@@ -110,6 +182,55 @@ sub _uplevel_caller (;$) { ## no critic Prototypes
# to skip this function's caller
return $Caller_Proxy->( $height + 1 ) if ! @Up_Frames;
+#pod =begin _private
+#pod
+#pod So it has to work like this:
+#pod
+#pod Call stack Actual uplevel 1
+#pod CORE::GLOBAL::caller
+#pod Carp::short_error_loc 0
+#pod Carp::shortmess_heavy 1 0
+#pod Carp::croak 2 1
+#pod try_croak 3 2
+#pod uplevel 4
+#pod function_that_called_uplevel 5
+#pod caller_we_want_to_see 6 3
+#pod its_caller 7 4
+#pod
+#pod So when caller(X) winds up below uplevel(), it only has to use
+#pod CORE::caller(X+1) (to skip CORE::GLOBAL::caller). But when caller(X)
+#pod winds up no or above uplevel(), it's CORE::caller(X+1+uplevel+1).
+#pod
+#pod Which means I'm probably going to have to do something nasty like walk
+#pod up the call stack on each caller() to see if I'm going to wind up
+#pod before or after Sub::Uplevel::uplevel().
+#pod
+#pod =end _private
+#pod
+#pod =begin _dagolden
+#pod
+#pod I found the description above a bit confusing. Instead, this is the logic
+#pod that I found clearer when CORE::GLOBAL::caller is invoked and we have to
+#pod walk up the call stack:
+#pod
+#pod * if searching up to the requested height in the real call stack doesn't find
+#pod a call to uplevel, then we can return the result at that height in the
+#pod call stack
+#pod
+#pod * if we find a call to uplevel, we need to keep searching upwards beyond the
+#pod requested height at least by the amount of upleveling requested for that
+#pod call to uplevel (from the Up_Frames stack set during the uplevel call)
+#pod
+#pod * additionally, we need to hide the uplevel subroutine call, too, so we search
+#pod upwards one more level for each call to uplevel
+#pod
+#pod * when we've reached the top of the search, we want to return that frame
+#pod in the call stack, i.e. the requested height plus any uplevel adjustments
+#pod found during the search
+#pod
+#pod =end _dagolden
+#pod
+#pod =cut
my $saw_uplevel = 0;
my $adjust = 0;
@@ -145,19 +266,90 @@ sub _uplevel_caller (;$) { ## no critic Prototypes
return @_ ? @caller : @caller[0..2]; # extra info or regular
}
+#pod =back
+#pod
+#pod =head1 EXAMPLE
+#pod
+#pod The main reason I wrote this module is so I could write wrappers
+#pod around functions and they wouldn't be aware they've been wrapped.
+#pod
+#pod use Sub::Uplevel;
+#pod
+#pod my $original_foo = \&foo;
+#pod
+#pod *foo = sub {
+#pod my @output = uplevel 1, $original_foo;
+#pod print "foo() returned: @output";
+#pod return @output;
+#pod };
+#pod
+#pod If this code frightens you B<you should not use this module.>
+#pod
+#pod
+#pod =head1 BUGS and CAVEATS
+#pod
+#pod Well, the bad news is uplevel() is about 5 times slower than a normal
+#pod function call. XS implementation anyone? It also slows down every invocation
+#pod of caller(), regardless of whether uplevel() is in effect.
+#pod
+#pod Sub::Uplevel overrides CORE::GLOBAL::caller temporarily for the scope of
+#pod each uplevel call. It does its best to work with any previously existing
+#pod CORE::GLOBAL::caller (both when Sub::Uplevel is first loaded and within
+#pod each uplevel call) such as from Contextual::Return or Hook::LexWrap.
+#pod
+#pod However, if you are routinely using multiple modules that override
+#pod CORE::GLOBAL::caller, you are probably asking for trouble.
+#pod
+#pod You B<should> load Sub::Uplevel as early as possible within your program. As
+#pod with all CORE::GLOBAL overloading, the overload will not affect modules that
+#pod have already been compiled prior to the overload. One module that often is
+#pod unavoidably loaded prior to Sub::Uplevel is Exporter. To forcibly recompile
+#pod Exporter (and Exporter::Heavy) after loading Sub::Uplevel, use it with the
+#pod ":aggressive" tag:
+#pod
+#pod use Sub::Uplevel qw/:aggressive/;
+#pod
+#pod The private function C<Sub::Uplevel::_force_reload()> may be passed a list of
+#pod additional modules to reload if ":aggressive" is not aggressive enough.
+#pod Reloading modules may break things, so only use this as a last resort.
+#pod
+#pod As of version 0.20, Sub::Uplevel requires Perl 5.6 or greater.
+#pod
+#pod =head1 HISTORY
+#pod
+#pod Those who do not learn from HISTORY are doomed to repeat it.
+#pod
+#pod The lesson here is simple: Don't sit next to a Tcl programmer at the
+#pod dinner table.
+#pod
+#pod =head1 THANKS
+#pod
+#pod Thanks to Brent Welch, Damian Conway and Robin Houston.
+#pod
+#pod See http://www.perl.com/perl/misc/Artistic.html
+#pod
+#pod =head1 SEE ALSO
+#pod
+#pod PadWalker (for the similar idea with lexicals), Hook::LexWrap,
+#pod Tcl's uplevel() at http://www.scriptics.com/man/tcl8.4/TclCmd/uplevel.htm
+#pod
+#pod =cut
1;
__END__
+
=pod
+=encoding UTF-8
+
=head1 NAME
Sub::Uplevel - apparently run a function in a higher stack frame
=head1 VERSION
-version 0.24
+version 0.25
=head1 SYNOPSIS
@@ -343,14 +535,14 @@ See http://www.perl.com/perl/misc/Artistic.html
PadWalker (for the similar idea with lexicals), Hook::LexWrap,
Tcl's uplevel() at http://www.scriptics.com/man/tcl8.4/TclCmd/uplevel.htm
-=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders
+=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
=head1 SUPPORT
=head2 Bugs / Feature Requests
Please report any bugs or feature requests through the issue tracker
-at L<http://rt.cpan.org/Public/Dist/Display.html?Name=Sub-Uplevel>.
+at L<https://github.com/dagolden/Sub-Uplevel/issues>.
You will be notified automatically of any progress on your issue.
=head2 Source Code
@@ -358,9 +550,9 @@ You will be notified automatically of any progress on your issue.
This is open source software. The code repository is available for
public review and contribution under the terms of the license.
-L<https://github.com/dagolden/sub-uplevel>
+L<https://github.com/dagolden/Sub-Uplevel>
- git clone https://github.com/dagolden/sub-uplevel.git
+ git clone https://github.com/dagolden/Sub-Uplevel.git
=head1 AUTHORS
@@ -376,12 +568,31 @@ David Golden <dagolden@cpan.org>
=back
+=head1 CONTRIBUTORS
+
+=for stopwords Adam Kennedy Alexandr Ciornii Michael Gray
+
+=over 4
+
+=item *
+
+Adam Kennedy <adamk@cpan.org>
+
+=item *
+
+Alexandr Ciornii <alexchorny@gmail.com>
+
+=item *
+
+Michael Gray <mg13@sanger.ac.uk>
+
+=back
+
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2012 by Michael Schwern and David Golden.
+This software is copyright (c) 2015 by Michael Schwern and David Golden.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
-
@@ -4,16 +4,22 @@ verbose = 8
[Variables::ProhibitPunctuationVars]
allow = $@ $!
+[TestingAndDebugging::ProhibitNoStrict]
+allow = refs
+
+[Variables::ProhibitEvilVariables]
+variables = $DB::single
+
# Turn these off
[-BuiltinFunctions::ProhibitStringyEval]
[-ControlStructures::ProhibitPostfixControls]
[-ControlStructures::ProhibitUnlessBlocks]
[-Documentation::RequirePodSections]
[-InputOutput::ProhibitInteractiveTest]
-[-Miscellanea::RequireRcsKeywords]
[-References::ProhibitDoubleSigils]
[-RegularExpressions::RequireExtendedFormatting]
[-InputOutput::ProhibitTwoArgOpen]
+[-Modules::ProhibitEvilModules]
# Turn this on
[Lax::ProhibitStringyEval::ExceptForRequire]
@@ -1,73 +0,0 @@
-#!perl
-
-use strict;
-use warnings;
-
-use Test::More;
-
-
-
-use File::Find;
-use File::Temp qw{ tempdir };
-
-my @modules;
-find(
- sub {
- return if $File::Find::name !~ /\.pm\z/;
- my $found = $File::Find::name;
- $found =~ s{^lib/}{};
- $found =~ s{[/\\]}{::}g;
- $found =~ s/\.pm$//;
- # nothing to skip
- push @modules, $found;
- },
- 'lib',
-);
-
-sub _find_scripts {
- my $dir = shift @_;
-
- my @found_scripts = ();
- find(
- sub {
- return unless -f;
- my $found = $File::Find::name;
- # nothing to skip
- open my $FH, '<', $_ or do {
- note( "Unable to open $found in ( $! ), skipping" );
- return;
- };
- my $shebang = <$FH>;
- return unless $shebang =~ /^#!.*?\bperl\b\s*$/;
- push @found_scripts, $found;
- },
- $dir,
- );
-
- return @found_scripts;
-}
-
-my @scripts;
-do { push @scripts, _find_scripts($_) if -d $_ }
- for qw{ bin script scripts };
-
-my $plan = scalar(@modules) + scalar(@scripts);
-$plan ? (plan tests => $plan) : (plan skip_all => "no tests to run");
-
-{
- # fake home for cpan-testers
- local $ENV{HOME} = tempdir( CLEANUP => 1 );
-
- like( qx{ $^X -Ilib -e "require $_; print '$_ ok'" }, qr/^\s*$_ ok/s, "$_ loaded ok" )
- for sort @modules;
-
- SKIP: {
- eval "use Test::Script 1.05; 1;";
- skip "Test::Script needed to test script compilation", scalar(@scripts) if $@;
- foreach my $file ( @scripts ) {
- my $script = $file;
- $script =~ s!.*/!!;
- script_compiles( $file, "$script script compiles" );
- }
- }
-}
@@ -0,0 +1,48 @@
+do { my $x = {
+ 'configure' => {
+ 'requires' => {
+ 'ExtUtils::MakeMaker' => '6.17',
+ 'perl' => '5.006'
+ }
+ },
+ 'develop' => {
+ 'requires' => {
+ 'Dist::Zilla' => '5',
+ 'Dist::Zilla::PluginBundle::DAGOLDEN' => '0.073',
+ 'File::Spec' => '0',
+ 'File::Temp' => '0',
+ 'IO::Handle' => '0',
+ 'IPC::Open3' => '0',
+ 'Pod::Coverage::TrustPod' => '0',
+ 'Test::CPAN::Meta' => '0',
+ 'Test::More' => '0',
+ 'Test::Pod' => '1.41',
+ 'Test::Pod::Coverage' => '1.08',
+ 'Test::Spelling' => '0.12',
+ 'Test::Version' => '1'
+ }
+ },
+ 'runtime' => {
+ 'requires' => {
+ 'Carp' => '0',
+ 'constant' => '0',
+ 'perl' => '5.006',
+ 'strict' => '0',
+ 'warnings' => '0'
+ }
+ },
+ 'test' => {
+ 'recommends' => {
+ 'CPAN::Meta' => '2.120900'
+ },
+ 'requires' => {
+ 'Exporter' => '0',
+ 'ExtUtils::MakeMaker' => '0',
+ 'File::Spec' => '0',
+ 'Test::More' => '0',
+ 'perl' => '5.006'
+ }
+ }
+ };
+ $x;
+ }
\ No newline at end of file
@@ -0,0 +1,176 @@
+#!perl
+
+use strict;
+use warnings;
+
+# This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.019
+
+use Test::More tests => 1;
+
+use ExtUtils::MakeMaker;
+use File::Spec;
+
+# from $version::LAX
+my $lax_version_re =
+ qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )?
+ |
+ (?:\.[0-9]+) (?:_[0-9]+)?
+ ) | (?:
+ v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )?
+ |
+ (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)?
+ )
+ )/x;
+
+# hide optional CPAN::Meta modules from prereq scanner
+# and check if they are available
+my $cpan_meta = "CPAN::Meta";
+my $cpan_meta_pre = "CPAN::Meta::Prereqs";
+my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic
+
+# Verify requirements?
+my $DO_VERIFY_PREREQS = 1;
+
+sub _max {
+ my $max = shift;
+ $max = ( $_ > $max ) ? $_ : $max for @_;
+ return $max;
+}
+
+sub _merge_prereqs {
+ my ($collector, $prereqs) = @_;
+
+ # CPAN::Meta::Prereqs object
+ if (ref $collector eq $cpan_meta_pre) {
+ return $collector->with_merged_prereqs(
+ CPAN::Meta::Prereqs->new( $prereqs )
+ );
+ }
+
+ # Raw hashrefs
+ for my $phase ( keys %$prereqs ) {
+ for my $type ( keys %{ $prereqs->{$phase} } ) {
+ for my $module ( keys %{ $prereqs->{$phase}{$type} } ) {
+ $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module};
+ }
+ }
+ }
+
+ return $collector;
+}
+
+my @include = qw(
+
+);
+
+my @exclude = qw(
+
+);
+
+# Add static prereqs to the included modules list
+my $static_prereqs = do 't/00-report-prereqs.dd';
+
+# Merge all prereqs (either with ::Prereqs or a hashref)
+my $full_prereqs = _merge_prereqs(
+ ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ),
+ $static_prereqs
+);
+
+# Add dynamic prereqs to the included modules list (if we can)
+my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
+if ( $source && $HAS_CPAN_META ) {
+ if ( my $meta = eval { CPAN::Meta->load_file($source) } ) {
+ $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs);
+ }
+}
+else {
+ $source = 'static metadata';
+}
+
+my @full_reports;
+my @dep_errors;
+my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;
+
+# Add static includes into a fake section
+for my $mod (@include) {
+ $req_hash->{other}{modules}{$mod} = 0;
+}
+
+for my $phase ( qw(configure build test runtime develop other) ) {
+ next unless $req_hash->{$phase};
+ next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING});
+
+ for my $type ( qw(requires recommends suggests conflicts modules) ) {
+ next unless $req_hash->{$phase}{$type};
+
+ my $title = ucfirst($phase).' '.ucfirst($type);
+ my @reports = [qw/Module Want Have/];
+
+ for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) {
+ next if $mod eq 'perl';
+ next if grep { $_ eq $mod } @exclude;
+
+ my $file = $mod;
+ $file =~ s{::}{/}g;
+ $file .= ".pm";
+ my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
+
+ my $want = $req_hash->{$phase}{$type}{$mod};
+ $want = "undef" unless defined $want;
+ $want = "any" if !$want && $want == 0;
+
+ my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";
+
+ if ($prefix) {
+ my $have = MM->parse_version( File::Spec->catfile($prefix, $file) );
+ $have = "undef" unless defined $have;
+ push @reports, [$mod, $want, $have];
+
+ if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
+ if ( $have !~ /\A$lax_version_re\z/ ) {
+ push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
+ }
+ elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
+ push @dep_errors, "$mod version '$have' is not in required range '$want'";
+ }
+ }
+ }
+ else {
+ push @reports, [$mod, $want, "missing"];
+
+ if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
+ push @dep_errors, "$mod is not installed ($req_string)";
+ }
+ }
+ }
+
+ if ( @reports ) {
+ push @full_reports, "=== $title ===\n\n";
+
+ my $ml = _max( map { length $_->[0] } @reports );
+ my $wl = _max( map { length $_->[1] } @reports );
+ my $hl = _max( map { length $_->[2] } @reports );
+ splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl];
+
+ push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports;
+ push @full_reports, "\n";
+ }
+ }
+}
+
+if ( @full_reports ) {
+ diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
+}
+
+if ( @dep_errors ) {
+ diag join("\n",
+ "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n",
+ "The following REQUIRED prerequisites were not satisfied:\n",
+ @dep_errors,
+ "\n"
+ );
+}
+
+pass;
+
+# vim: ts=4 sts=4 sw=4 et:
@@ -0,0 +1,54 @@
+use 5.006;
+use strict;
+use warnings;
+
+# this test was generated with Dist::Zilla::Plugin::Test::Compile 2.051
+
+use Test::More;
+
+plan tests => 1 + ($ENV{AUTHOR_TESTING} ? 1 : 0);
+
+my @module_files = (
+ 'Sub/Uplevel.pm'
+);
+
+
+
+# fake home for cpan-testers
+use File::Temp;
+local $ENV{HOME} = File::Temp::tempdir( CLEANUP => 1 );
+
+
+my $inc_switch = -d 'blib' ? '-Mblib' : '-Ilib';
+
+use File::Spec;
+use IPC::Open3;
+use IO::Handle;
+
+open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!";
+
+my @warnings;
+for my $lib (@module_files)
+{
+ # see L<perlfaq8/How can I capture STDERR from an external command?>
+ my $stderr = IO::Handle->new;
+
+ my $pid = open3($stdin, '>&STDERR', $stderr, $^X, $inc_switch, '-e', "require q[$lib]");
+ binmode $stderr, ':crlf' if $^O eq 'MSWin32';
+ my @_warnings = <$stderr>;
+ waitpid($pid, 0);
+ is($?, 0, "$lib loaded ok");
+
+ if (@_warnings)
+ {
+ warn @_warnings;
+ push @warnings, @_warnings;
+ }
+}
+
+
+
+is(scalar(@warnings), 0, 'no warnings found')
+ or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ) if $ENV{AUTHOR_TESTING};
+
+
@@ -1,19 +1,14 @@
-#!perl
-# This test is generated by Dist::Zilla::Plugin::Test::PodSpelling
-
+use strict;
+use warnings;
use Test::More;
-eval "use Pod::Wordlist::hanekomu";
-plan skip_all => "Pod::Wordlist::hanekomu required for testing POD spelling"
- if $@;
-
-eval "use Test::Spelling 0.12";
-plan skip_all => "Test::Spelling 0.12 required for testing POD spelling"
- if $@;
+# generated by Dist::Zilla::Plugin::Test::PodSpelling 2.006008
+use Test::Spelling 0.12;
+use Pod::Wordlist;
add_stopwords(<DATA>);
-all_pod_files_spelling_ok('bin', 'lib');
+all_pod_files_spelling_ok( qw( bin lib ) );
__DATA__
PadWalker
Tcl's
@@ -21,7 +16,19 @@ Welch
uplevel
Michael
Schwern
+mschwern
David
Golden
+dagolden
and
-
+Adam
+Kennedy
+adamk
+Alexandr
+Ciornii
+alexchorny
+Gray
+mg13
+lib
+Sub
+Uplevel
@@ -1,7 +1,6 @@
#!perl
+# This file was automatically generated by Dist::Zilla::Plugin::MetaTests.
-use Test::More;
+use Test::CPAN::Meta;
-eval "use Test::CPAN::Meta";
-plan skip_all => "Test::CPAN::Meta required for testing META.yml" if $@;
meta_yaml_ok();
@@ -0,0 +1,8 @@
+#!perl
+
+use Test::More;
+
+eval "use Test::MinimumVersion";
+plan skip_all => "Test::MinimumVersion required for testing minimum versions"
+ if $@;
+all_minimum_version_ok( qq{5.010} );
@@ -1,13 +1,7 @@
#!perl
+# This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests.
-use Test::More;
-
-eval "use Test::Pod::Coverage 1.08";
-plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage"
- if $@;
-
-eval "use Pod::Coverage::TrustPod";
-plan skip_all => "Pod::Coverage::TrustPod required for testing POD coverage"
- if $@;
+use Test::Pod::Coverage 1.08;
+use Pod::Coverage::TrustPod;
all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' });
@@ -1,7 +1,6 @@
#!perl
+# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests.
use Test::More;
-
-eval "use Test::Pod 1.41";
-plan skip_all => "Test::Pod 1.41 required for testing POD" if $@;
+use Test::Pod 1.41;
all_pod_files_ok();
@@ -1,8 +1,12 @@
#!perl
+use strict;
+use warnings;
+
use Test::More;
eval 'use Test::Portability::Files';
plan skip_all => 'Test::Portability::Files required for testing portability'
if $@;
+options(test_one_dot => 0);
run_tests();
@@ -1,12 +1,22 @@
-#!/usr/bin/perl
-use 5.006;
use strict;
use warnings;
use Test::More;
-use Test::Requires {
- 'Test::Version' => 0.04,
+# generated by Dist::Zilla::Plugin::Test::Version 0.003001
+use Test::Version;
+
+my @imports = ( 'version_all_ok' );
+
+my $params = {
+ is_strict => 0,
+ has_version => 1,
};
+push @imports, $params
+ if version->parse( $Test::Version::VERSION ) >= version->parse('1.002');
+
+
+Test::Version->import(@imports);
+
version_all_ok;
done_testing;