[librole-tiny-perl] 03/09: Imported Upstream version 1.003004
gregor herrmann
gregoa at debian.org
Thu Oct 23 21:40:45 UTC 2014
This is an automated email from the git hooks/post-receive script.
gregoa pushed a commit to branch master
in repository librole-tiny-perl.
commit fdfd2bd237fcf984fcf7f81a79ac403c2d381075
Author: gregor herrmann <gregoa at debian.org>
Date: Thu Oct 23 23:29:34 2014 +0200
Imported Upstream version 1.003004
---
Changes | 3 +
MANIFEST | 3 -
META.json | 16 +-
META.yml | 7 +-
Makefile.PL | 35 ++-
lib/Role/Tiny.pm | 11 +-
lib/Role/Tiny/With.pm | 2 +-
maint/bump-version | 46 ----
t/around-does.t | 32 +--
t/does.t | 2 +
t/method-conflicts.t | 4 +-
t/modifiers.t | 1 -
t/namespace-clean.t | 2 +
t/role-basic-basic.t | 4 +-
t/role-basic-bugs.t | 7 +-
t/role-basic-composition.t | 144 +++++------
t/role-basic-exceptions.t | 6 +-
t/role-basic/lib/MyTests.pm | 42 ----
t/role-basic/lib/Try/Tiny.pm | 575 -------------------------------------------
t/role-long-package-name.t | 2 +-
t/role-tiny.t | 1 -
21 files changed, 144 insertions(+), 801 deletions(-)
diff --git a/Changes b/Changes
index 53288f6..615c796 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
Revision history for Role-Tiny
+1.003004 - 2014-10-22
+ - allow does_role to be overridden by Moo::Role
+
1.003003 - 2014-03-15
- overloads specified as method names rather than subrefs are now applied
properly
diff --git a/MANIFEST b/MANIFEST
index 34ed323..0f78af6 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,7 +1,6 @@
Changes
lib/Role/Tiny.pm
lib/Role/Tiny/With.pm
-maint/bump-version
maint/Makefile.PL.include
Makefile.PL
MANIFEST This list of files
@@ -26,9 +25,7 @@ t/role-basic-composition.t
t/role-basic-exceptions.t
t/role-basic/lib/My/Does/Basic.pm
t/role-basic/lib/My/Example.pm
-t/role-basic/lib/MyTests.pm
t/role-basic/lib/TestMethods.pm
-t/role-basic/lib/Try/Tiny.pm
t/role-duplication.t
t/role-long-package-name.t
t/role-tiny-composition.t
diff --git a/META.json b/META.json
index 6765d2f..333051e 100644
--- a/META.json
+++ b/META.json
@@ -4,7 +4,7 @@
"mst - Matt S. Trout (cpan:MSTROUT) <mst at shadowcat.co.uk>"
],
"dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 6.9, CPAN::Meta::Converter version 2.140640",
+ "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690",
"license" : [
"perl_5"
],
@@ -20,12 +20,8 @@
]
},
"prereqs" : {
- "build" : {
- "requires" : {}
- },
- "configure" : {
- "requires" : {}
- },
+ "build" : {},
+ "configure" : {},
"develop" : {
"recommends" : {
"Moo" : "0",
@@ -59,10 +55,10 @@
],
"repository" : {
"type" : "git",
- "url" : "git://git.shadowcat.co.uk/gitmo/Role-Tiny.git",
- "web" : "http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo/Role-Tiny.git"
+ "url" : "git://github.com/moose/Role-Tiny.git",
+ "web" : "https://github.com/moose/Role-Tiny"
},
"x_IRC" : "irc://irc.perl.org/#moose"
},
- "version" : "1.003003"
+ "version" : "1.003004"
}
diff --git a/META.yml b/META.yml
index 0c49666..8275177 100644
--- a/META.yml
+++ b/META.yml
@@ -5,9 +5,8 @@ author:
build_requires:
Test::Fatal: '0.003'
Test::More: '0.96'
-configure_requires: {}
dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 6.9, CPAN::Meta::Converter version 2.140640'
+generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -26,5 +25,5 @@ resources:
IRC: irc://irc.perl.org/#moose
bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Role-Tiny
license: http://dev.perl.org/licenses/
- repository: git://git.shadowcat.co.uk/gitmo/Role-Tiny.git
-version: '1.003003'
+ repository: git://github.com/moose/Role-Tiny.git
+version: '1.003004'
diff --git a/Makefile.PL b/Makefile.PL
index 90481b3..344227b 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -4,35 +4,29 @@ use 5.006;
my %META = (
name => 'Role-Tiny',
- license => 'perl_5',
prereqs => {
- configure => { requires => {
- } },
- build => { requires => {
- } },
test => { requires => {
- 'Test::More' => 0.96,
- 'Test::Fatal' => 0.003,
+ 'Test::More' => '0.96',
+ 'Test::Fatal' => '0.003',
} },
runtime => {
requires => {
- perl => 5.006,
- Exporter => '5.57',
+ 'perl' => '5.006',
+ 'Exporter' => '5.57',
},
recommends => {
- 'Class::Method::Modifiers' => 1.05,
+ 'Class::Method::Modifiers' => '1.05',
},
},
develop => { recommends => {
'namespace::clean' => 0,
- Moo => 0,
+ 'Moo' => 0,
} },
},
resources => {
- # r/w: gitmo at git.shadowcat.co.uk:Role-Tiny.git
repository => {
- url => 'git://git.shadowcat.co.uk/gitmo/Role-Tiny.git',
- web => 'http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo/Role-Tiny.git',
+ url => 'git://github.com/moose/Role-Tiny.git',
+ web => 'https://github.com/moose/Role-Tiny',
type => 'git',
},
bugtracker => {
@@ -50,10 +44,10 @@ my %META = (
my %MM_ARGS = (
PREREQ_PM => {
($] >= 5.010 ? () : ('MRO::Compat' => 0)),
- }
+ },
);
-##############################################################################
+## BOILERPLATE ###############################################################
require ExtUtils::MakeMaker;
(do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml';
@@ -64,8 +58,10 @@ my $mymeta_broken = $mymeta && $eumm_version < 6.57_07;
($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g;
($MM_ARGS{VERSION_FROM} = "lib/$MM_ARGS{NAME}.pm") =~ s{::}{/}g;
-$MM_ARGS{LICENSE} = $META{license}
- if $eumm_version >= 6.30;
+$META{license} = [ $META{license} ]
+ if $META{license} && !ref $META{license};
+$MM_ARGS{LICENSE} = $META{license}[0]
+ if $META{license} && $eumm_version >= 6.30;
$MM_ARGS{NO_MYMETA} = 1
if $mymeta_broken;
$MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META }
@@ -74,7 +70,7 @@ $MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META }
for (qw(configure build test runtime)) {
my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES';
my $r = $MM_ARGS{$key} = {
- %{$META{prereqs}{$_}{requires}},
+ %{$META{prereqs}{$_}{requires} || {}},
%{delete $MM_ARGS{$key} || {}},
};
defined $r->{$_} or delete $r->{$_} for keys %$r;
@@ -92,3 +88,4 @@ delete $MM_ARGS{CONFIGURE_REQUIRES}
if $eumm_version < 6.51_03;
ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS);
+## END BOILERPLATE ###########################################################
diff --git a/lib/Role/Tiny.pm b/lib/Role/Tiny.pm
index f3d7333..0eeadc5 100644
--- a/lib/Role/Tiny.pm
+++ b/lib/Role/Tiny.pm
@@ -6,7 +6,7 @@ sub _getstash { \%{"$_[0]::"} }
use strict;
use warnings FATAL => 'all';
-our $VERSION = '1.003003';
+our $VERSION = '1.003004';
$VERSION = eval $VERSION;
our %INFO;
@@ -368,8 +368,8 @@ sub _install_methods {
# and &overload::nil in the code slot.
next
unless $i =~ /^\(/
- && defined &overload::nil
- && $methods->{$i} == \&overload::nil;
+ && ((defined &overload::nil && $methods->{$i} == \&overload::nil)
+ || (defined &overload::_nil && $methods->{$i} == \&overload::_nil));
my $overload = ${ *{_getglob "${role}::${i}"}{SCALAR} };
next
@@ -414,8 +414,9 @@ sub _install_does {
# only add does() method to classes
return if $me->is_role($to);
+ my $does = $me->can('does_role');
# add does() only if they don't have one
- *{_getglob "${to}::does"} = \&does_role unless $to->can('does');
+ *{_getglob "${to}::does"} = $does unless $to->can('does');
return
if $to->can('DOES') and $to->can('DOES') != (UNIVERSAL->can('DOES') || 0);
@@ -423,7 +424,7 @@ sub _install_does {
my $existing = $to->can('DOES') || $to->can('isa') || $FALLBACK;
my $new_sub = sub {
my ($proto, $role) = @_;
- Role::Tiny::does_role($proto, $role) or $proto->$existing($role);
+ $proto->$does($role) or $proto->$existing($role);
};
no warnings 'redefine';
*{_getglob "${to}::DOES"} = $new_sub;
diff --git a/lib/Role/Tiny/With.pm b/lib/Role/Tiny/With.pm
index 7075b75..a209939 100644
--- a/lib/Role/Tiny/With.pm
+++ b/lib/Role/Tiny/With.pm
@@ -3,7 +3,7 @@ package Role::Tiny::With;
use strict;
use warnings FATAL => 'all';
-our $VERSION = '1.003003';
+our $VERSION = '1.003004';
$VERSION = eval $VERSION;
use Role::Tiny ();
diff --git a/maint/bump-version b/maint/bump-version
deleted file mode 100755
index 9b6b2bd..0000000
--- a/maint/bump-version
+++ /dev/null
@@ -1,46 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings FATAL => 'all';
-use autodie;
-
-chomp(my $LATEST = qx(grep '^[0-9]' Changes | head -1 | awk '{print \$1}'));
-
-my @parts = split /\./, $LATEST;
-if (@parts == 2) {
- @parts[1,2] = $parts[1] =~ /(\d{1,3})(\d{1,3})/;
-}
-
-my $OLD_DECIMAL = sprintf('%i.%03i%03i', @parts);
-
-my %bump_part = (major => 0, minor => 1, bugfix => 2);
-
-my $bump_this = $bump_part{$ARGV[0]||'bugfix'};
-
-die "no idea which part to bump - $ARGV[0] means nothing to me"
- unless defined($bump_this);
-
-my @new_parts = @parts;
-
-$new_parts[$bump_this]++;
-$new_parts[$_] = 0 for ($bump_this+1 .. 2);
-
-my $NEW_DECIMAL = sprintf('%i.%03i%03i', @new_parts);
-
-warn "Bumping $OLD_DECIMAL -> $NEW_DECIMAL\n";
-
-for my $PM_FILE (qw(
- lib/Moo.pm
- lib/Moo/Role.pm
- lib/Sub/Defer.pm
- lib/Sub/Quote.pm
-)) {
- my $file = do { local (@ARGV, $/) = ($PM_FILE); <> };
-
- $file =~ s/(?<=\$VERSION = ')${\quotemeta $OLD_DECIMAL}/${NEW_DECIMAL}/
- or die "unable to bump version number in $PM_FILE";
-
- open my $out, '>', $PM_FILE;
-
- print $out $file;
-}
diff --git a/t/around-does.t b/t/around-does.t
index 5522469..9e7320f 100644
--- a/t/around-does.t
+++ b/t/around-does.t
@@ -1,3 +1,5 @@
+use strict;
+use warnings FATAL => 'all';
use Test::More;
BEGIN {
@@ -9,24 +11,24 @@ my $pass;
my $pass2;
BEGIN {
- package Local::Role;
- use Role::Tiny;
- around does => sub {
- my ($orig, $self, @args) = @_;
- $pass++;
- return $self->$orig(@args);
- };
- around DOES => sub {
- my ($orig, $self, @args) = @_;
- $pass2++;
- return $self->$orig(@args);
- };
+ package Local::Role;
+ use Role::Tiny;
+ around does => sub {
+ my ($orig, $self, @args) = @_;
+ $pass++;
+ return $self->$orig(@args);
+ };
+ around DOES => sub {
+ my ($orig, $self, @args) = @_;
+ $pass2++;
+ return $self->$orig(@args);
+ };
}
BEGIN {
- package Local::Class;
- use Role::Tiny::With;
- with 'Local::Role';
+ package Local::Class;
+ use Role::Tiny::With;
+ with 'Local::Role';
}
ok(Local::Class->does('Local::Role'));
diff --git a/t/does.t b/t/does.t
index c17ebfd..349964d 100644
--- a/t/does.t
+++ b/t/does.t
@@ -1,3 +1,5 @@
+use strict;
+use warnings FATAL => 'all';
use Test::More tests => 14;
BEGIN {
diff --git a/t/method-conflicts.t b/t/method-conflicts.t
index 7487f88..3d35870 100644
--- a/t/method-conflicts.t
+++ b/t/method-conflicts.t
@@ -1,5 +1,5 @@
use strict;
-use warnings;
+use warnings FATAL => 'all';
use Test::More;
@@ -51,4 +51,4 @@ is(
"... which works properly",
);
-done_testing;
\ No newline at end of file
+done_testing;
diff --git a/t/modifiers.t b/t/modifiers.t
index 6d90efb..e1f8a54 100644
--- a/t/modifiers.t
+++ b/t/modifiers.t
@@ -75,4 +75,3 @@ ok(exception {
}, 'exception caught creating class with broken modifier in a role');
done_testing;
-
diff --git a/t/namespace-clean.t b/t/namespace-clean.t
index c43d49f..3119771 100644
--- a/t/namespace-clean.t
+++ b/t/namespace-clean.t
@@ -1,3 +1,5 @@
+use strict;
+use warnings FATAL => 'all';
use Test::More;
BEGIN {
diff --git a/t/role-basic-basic.t b/t/role-basic-basic.t
index 41fe801..56fb008 100644
--- a/t/role-basic-basic.t
+++ b/t/role-basic-basic.t
@@ -1,5 +1,7 @@
+use strict;
+use warnings FATAL => 'all';
use Test::More tests => 3;
-use lib 'lib', 't/role-basic/lib';
+use lib 't/role-basic/lib';
use_ok 'My::Example' or BAIL_OUT 'Could not load test module My::Example';
can_ok 'My::Example', 'no_conflict';
diff --git a/t/role-basic-bugs.t b/t/role-basic-bugs.t
index c332ada..4435a58 100644
--- a/t/role-basic-bugs.t
+++ b/t/role-basic-bugs.t
@@ -1,5 +1,8 @@
-use lib 'lib', 't/role-basic/lib', 't/lib';
-use MyTests;
+use strict;
+use warnings FATAL => 'all';
+use lib 't/role-basic/lib', 't/lib';
+use Test::More;
+use Test::Fatal;
# multiple roles with the same role
{
diff --git a/t/role-basic-composition.t b/t/role-basic-composition.t
index 640dec7..1703a09 100644
--- a/t/role-basic-composition.t
+++ b/t/role-basic-composition.t
@@ -1,5 +1,7 @@
-use lib 'lib', 't/role-basic/lib';
-use MyTests;
+use strict;
+use warnings FATAL => 'all';
+use lib 't/role-basic/lib';
+use Test::More;
require Role::Tiny;
{
@@ -122,83 +124,83 @@ $ENV{DEBUG} = 1;
}
{
- {
- package Method::Role1;
- use Role::Tiny;
- sub method1 { }
- requires 'method2';
- }
-
- {
- package Method::Role2;
- use Role::Tiny;
- sub method2 { }
- requires 'method1';
- }
- my $success = eval q{
- package Class;
- use Role::Tiny::With;
- with 'Method::Role1', 'Method::Role2';
- 1;
- };
- is $success, 1, 'composed mutually dependent methods successfully' or diag "Error: $@";
+ {
+ package Method::Role1;
+ use Role::Tiny;
+ sub method1 { }
+ requires 'method2';
+ }
+
+ {
+ package Method::Role2;
+ use Role::Tiny;
+ sub method2 { }
+ requires 'method1';
+ }
+ my $success = eval q{
+ package Class;
+ use Role::Tiny::With;
+ with 'Method::Role1', 'Method::Role2';
+ 1;
+ };
+ is $success, 1, 'composed mutually dependent methods successfully' or diag "Error: $@";
}
SKIP: {
skip "Class::Method::Modifiers not installed or too old", 1
unless eval "use Class::Method::Modifiers 1.05; 1";
- {
- package Modifier::Role1;
- use Role::Tiny;
- sub foo {
- }
- before 'bar', sub {};
- }
-
- {
- package Modifier::Role2;
- use Role::Tiny;
- sub bar {
- }
- before 'foo', sub {};
- }
- my $success = eval q{
- package Class;
- use Role::Tiny::With;
- with 'Modifier::Role1', 'Modifier::Role2';
- 1;
- };
- is $success, 1, 'composed mutually dependent modifiers successfully' or diag "Error: $@";
+ {
+ package Modifier::Role1;
+ use Role::Tiny;
+ sub foo {
+ }
+ before 'bar', sub {};
+ }
+
+ {
+ package Modifier::Role2;
+ use Role::Tiny;
+ sub bar {
+ }
+ before 'foo', sub {};
+ }
+ my $success = eval q{
+ package Class;
+ use Role::Tiny::With;
+ with 'Modifier::Role1', 'Modifier::Role2';
+ 1;
+ };
+ is $success, 1, 'composed mutually dependent modifiers successfully' or diag "Error: $@";
}
{
- {
- package Base::Role;
- use Role::Tiny;
- requires qw/method1 method2/;
- }
-
- {
- package Sub::Role1;
- use Role::Tiny;
- with 'Base::Role';
- sub method1 {}
- }
-
- {
- package Sub::Role2;
- use Role::Tiny;
- with 'Base::Role';
- sub method2 {}
- }
-
- my $success = eval q{
- package Diamant::Class;
- use Role::Tiny::With;
- with qw/Sub::Role1 Sub::Role2/;
- 1;
- };
- is $success, 1, 'composed diamantly dependent roles successfully' or diag "Error: $@";
+ {
+ package Base::Role;
+ use Role::Tiny;
+ requires qw/method1 method2/;
+ }
+
+ {
+ package Sub::Role1;
+ use Role::Tiny;
+ with 'Base::Role';
+ sub method1 {}
+ }
+
+ {
+ package Sub::Role2;
+ use Role::Tiny;
+ with 'Base::Role';
+ sub method2 {}
+ }
+
+ my $success = eval q{
+ package Diamant::Class;
+ use Role::Tiny::With;
+ with qw/Sub::Role1 Sub::Role2/;
+ 1;
+ };
+ is $success, 1, 'composed diamantly dependent roles successfully' or diag "Error: $@";
}
{
diff --git a/t/role-basic-exceptions.t b/t/role-basic-exceptions.t
index 76ab1fb..0eb4368 100644
--- a/t/role-basic-exceptions.t
+++ b/t/role-basic-exceptions.t
@@ -1,5 +1,7 @@
-use lib 'lib', 't/role-basic/lib';
-use MyTests;
+use strict;
+use warnings FATAL => 'all';
+use lib 't/role-basic/lib';
+use Test::More;
require Role::Tiny;
{
diff --git a/t/role-basic/lib/MyTests.pm b/t/role-basic/lib/MyTests.pm
deleted file mode 100644
index 3f95440..0000000
--- a/t/role-basic/lib/MyTests.pm
+++ /dev/null
@@ -1,42 +0,0 @@
-package MyTests;
-
-use strict;
-use warnings;
-
-use Test::More ();
-use Try::Tiny;
-
-sub import {
- my $class = shift;
- my $caller = caller;
-
- no strict 'refs';
- *{"${caller}::exception"} = \&exception;
- local $" = ", ";
- use Data::Dumper;
- $Data::Dumper::Terse = 1;
- @_ = Dumper(@_);
- eval <<" END";
- package $caller;
- no strict;
- use Test::More @_;
- END
- die $@ if $@;
-}
-
-sub exception (&) {
- my ($code) = @_;
-
- return try {
- $code->();
- return undef;
- }
- catch {
- return $_ if $_;
-
- my $problem = defined $_ ? 'false' : 'undef';
- Carp::confess("$problem exception caught by Test::Fatal::exception");
- };
-}
-
-1;
diff --git a/t/role-basic/lib/Try/Tiny.pm b/t/role-basic/lib/Try/Tiny.pm
deleted file mode 100644
index 67c30f3..0000000
--- a/t/role-basic/lib/Try/Tiny.pm
+++ /dev/null
@@ -1,575 +0,0 @@
-# PAUSE doesn't seem to case about this in t/role-basic/lib, but just in case ...
-package # Hide from PAUSE
- Try::Tiny;
-
-use strict;
-#use warnings;
-
-use vars qw(@EXPORT @EXPORT_OK $VERSION @ISA);
-
-BEGIN {
- require Exporter;
- @ISA = qw(Exporter);
-}
-
-$VERSION = "0.09";
-
-$VERSION = eval $VERSION;
-
- at EXPORT = @EXPORT_OK = qw(try catch finally);
-
-$Carp::Internal{+__PACKAGE__}++;
-
-# Need to prototype as @ not $$ because of the way Perl evaluates the prototype.
-# Keeping it at $$ means you only ever get 1 sub because we need to eval in a list
-# context & not a scalar one
-
-sub try (&;@) {
- my ( $try, @code_refs ) = @_;
-
- # we need to save this here, the eval block will be in scalar context due
- # to $failed
- my $wantarray = wantarray;
-
- my ( $catch, @finally );
-
- # find labeled blocks in the argument list.
- # catch and finally tag the blocks by blessing a scalar reference to them.
- foreach my $code_ref (@code_refs) {
- next unless $code_ref;
-
- my $ref = ref($code_ref);
-
- if ( $ref eq 'Try::Tiny::Catch' ) {
- $catch = ${$code_ref};
- } elsif ( $ref eq 'Try::Tiny::Finally' ) {
- push @finally, ${$code_ref};
- } else {
- use Carp;
- confess("Unknown code ref type given '${ref}'. Check your usage & try again");
- }
- }
-
- # save the value of $@ so we can set $@ back to it in the beginning of the eval
- my $prev_error = $@;
-
- my ( @ret, $error, $failed );
-
- # FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's
- # not perfect, but we could provide a list of additional errors for
- # $catch->();
-
- {
- # localize $@ to prevent clobbering of previous value by a successful
- # eval.
- local $@;
-
- # failed will be true if the eval dies, because 1 will not be returned
- # from the eval body
- $failed = not eval {
- $@ = $prev_error;
-
- # evaluate the try block in the correct context
- if ( $wantarray ) {
- @ret = $try->();
- } elsif ( defined $wantarray ) {
- $ret[0] = $try->();
- } else {
- $try->();
- };
-
- return 1; # properly set $fail to false
- };
-
- # copy $@ to $error; when we leave this scope, local $@ will revert $@
- # back to its previous value
- $error = $@;
- }
-
- # set up a scope guard to invoke the finally block at the end
- my @guards =
- map { Try::Tiny::ScopeGuard->_new($_, $failed ? $error : ()) }
- @finally;
-
- # at this point $failed contains a true value if the eval died, even if some
- # destructor overwrote $@ as the eval was unwinding.
- if ( $failed ) {
- # if we got an error, invoke the catch block.
- if ( $catch ) {
- # This works like given($error), but is backwards compatible and
- # sets $_ in the dynamic scope for the body of C<$catch>
- for ($error) {
- return $catch->($error);
- }
-
- # in case when() was used without an explicit return, the C<for>
- # loop will be aborted and there's no useful return value
- }
-
- return;
- } else {
- # no failure, $@ is back to what it was, everything is fine
- return $wantarray ? @ret : $ret[0];
- }
-}
-
-sub catch (&;@) {
- my ( $block, @rest ) = @_;
-
- return (
- bless(\$block, 'Try::Tiny::Catch'),
- @rest,
- );
-}
-
-sub finally (&;@) {
- my ( $block, @rest ) = @_;
-
- return (
- bless(\$block, 'Try::Tiny::Finally'),
- @rest,
- );
-}
-
-{
- package # hide from PAUSE
- Try::Tiny::ScopeGuard;
-
- sub _new {
- shift;
- bless [ @_ ];
- }
-
- sub DESTROY {
- my @guts = @{ shift() };
- my $code = shift @guts;
- $code->(@guts);
- }
-}
-
-__PACKAGE__
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Try::Tiny - minimal try/catch with proper localization of $@
-
-=head1 SYNOPSIS
-
- # handle errors with a catch handler
- try {
- die "foo";
- } catch {
- warn "caught error: $_"; # not $@
- };
-
- # just silence errors
- try {
- die "foo";
- };
-
-=head1 DESCRIPTION
-
-This module provides bare bones C<try>/C<catch>/C<finally> statements that are designed to
-minimize common mistakes with eval blocks, and NOTHING else.
-
-This is unlike L<TryCatch> which provides a nice syntax and avoids adding
-another call stack layer, and supports calling C<return> from the try block to
-return from the parent subroutine. These extra features come at a cost of a few
-dependencies, namely L<Devel::Declare> and L<Scope::Upper> which are
-occasionally problematic, and the additional catch filtering uses L<Moose>
-type constraints which may not be desirable either.
-
-The main focus of this module is to provide simple and reliable error handling
-for those having a hard time installing L<TryCatch>, but who still want to
-write correct C<eval> blocks without 5 lines of boilerplate each time.
-
-It's designed to work as correctly as possible in light of the various
-pathological edge cases (see L<BACKGROUND>) and to be compatible with any style
-of error values (simple strings, references, objects, overloaded objects, etc).
-
-If the try block dies, it returns the value of the last statement executed in
-the catch block, if there is one. Otherwise, it returns C<undef> in scalar
-context or the empty list in list context. The following two examples both
-assign C<"bar"> to C<$x>.
-
- my $x = try { die "foo" } catch { "bar" };
-
- my $x = eval { die "foo" } || "bar";
-
-You can add finally blocks making the following true.
-
- my $x;
- try { die 'foo' } finally { $x = 'bar' };
- try { die 'foo' } catch { warn "Got a die: $_" } finally { $x = 'bar' };
-
-Finally blocks are always executed making them suitable for cleanup code
-which cannot be handled using local. You can add as many finally blocks to a
-given try block as you like.
-
-=head1 EXPORTS
-
-All functions are exported by default using L<Exporter>.
-
-If you need to rename the C<try>, C<catch> or C<finally> keyword consider using
-L<Sub::Import> to get L<Sub::Exporter>'s flexibility.
-
-=over 4
-
-=item try (&;@)
-
-Takes one mandatory try subroutine, an optional catch subroutine & finally
-subroutine.
-
-The mandatory subroutine is evaluated in the context of an C<eval> block.
-
-If no error occurred the value from the first block is returned, preserving
-list/scalar context.
-
-If there was an error and the second subroutine was given it will be invoked
-with the error in C<$_> (localized) and as that block's first and only
-argument.
-
-C<$@> does B<not> contain the error. Inside the C<catch> block it has the same
-value it had before the C<try> block was executed.
-
-Note that the error may be false, but if that happens the C<catch> block will
-still be invoked.
-
-Once all execution is finished then the finally block if given will execute.
-
-=item catch (&;$)
-
-Intended to be used in the second argument position of C<try>.
-
-Returns a reference to the subroutine it was given but blessed as
-C<Try::Tiny::Catch> which allows try to decode correctly what to do
-with this code reference.
-
- catch { ... }
-
-Inside the catch block the caught error is stored in C<$_>, while previous
-value of C<$@> is still available for use. This value may or may not be
-meaningful depending on what happened before the C<try>, but it might be a good
-idea to preserve it in an error stack.
-
-For code that captures C<$@> when throwing new errors (i.e.
-L<Class::Throwable>), you'll need to do:
-
- local $@ = $_;
-
-=item finally (&;$)
-
- try { ... }
- catch { ... }
- finally { ... };
-
-Or
-
- try { ... }
- finally { ... };
-
-Or even
-
- try { ... }
- finally { ... }
- catch { ... };
-
-Intended to be the second or third element of C<try>. Finally blocks are always
-executed in the event of a successful C<try> or if C<catch> is run. This allows
-you to locate cleanup code which cannot be done via C<local()> e.g. closing a file
-handle.
-
-When invoked, the finally block is passed the error that was caught. If no
-error was caught, it is passed nothing. In other words, the following code
-does just what you would expect:
-
- try {
- die_sometimes();
- } catch {
- # ...code run in case of error
- } finally {
- if (@_) {
- print "The try block died with: @_\n";
- } else {
- print "The try block ran without error.\n";
- }
- };
-
-B<You must always do your own error handling in the finally block>. C<Try::Tiny> will
-not do anything about handling possible errors coming from code located in these
-blocks.
-
-In the same way C<catch()> blesses the code reference this subroutine does the same
-except it bless them as C<Try::Tiny::Finally>.
-
-=back
-
-=head1 BACKGROUND
-
-There are a number of issues with C<eval>.
-
-=head2 Clobbering $@
-
-When you run an eval block and it succeeds, C<$@> will be cleared, potentially
-clobbering an error that is currently being caught.
-
-This causes action at a distance, clearing previous errors your caller may have
-not yet handled.
-
-C<$@> must be properly localized before invoking C<eval> in order to avoid this
-issue.
-
-More specifically, C<$@> is clobbered at the beginning of the C<eval>, which
-also makes it impossible to capture the previous error before you die (for
-instance when making exception objects with error stacks).
-
-For this reason C<try> will actually set C<$@> to its previous value (before
-the localization) in the beginning of the C<eval> block.
-
-=head2 Localizing $@ silently masks errors
-
-Inside an eval block C<die> behaves sort of like:
-
- sub die {
- $@ = $_[0];
- return_undef_from_eval();
- }
-
-This means that if you were polite and localized C<$@> you can't die in that
-scope, or your error will be discarded (printing "Something's wrong" instead).
-
-The workaround is very ugly:
-
- my $error = do {
- local $@;
- eval { ... };
- $@;
- };
-
- ...
- die $error;
-
-=head2 $@ might not be a true value
-
-This code is wrong:
-
- if ( $@ ) {
- ...
- }
-
-because due to the previous caveats it may have been unset.
-
-C<$@> could also be an overloaded error object that evaluates to false, but
-that's asking for trouble anyway.
-
-The classic failure mode is:
-
- sub Object::DESTROY {
- eval { ... }
- }
-
- eval {
- my $obj = Object->new;
-
- die "foo";
- };
-
- if ( $@ ) {
-
- }
-
-In this case since C<Object::DESTROY> is not localizing C<$@> but still uses
-C<eval>, it will set C<$@> to C<"">.
-
-The destructor is called when the stack is unwound, after C<die> sets C<$@> to
-C<"foo at Foo.pm line 42\n">, so by the time C<if ( $@ )> is evaluated it has
-been cleared by C<eval> in the destructor.
-
-The workaround for this is even uglier than the previous ones. Even though we
-can't save the value of C<$@> from code that doesn't localize, we can at least
-be sure the eval was aborted due to an error:
-
- my $failed = not eval {
- ...
-
- return 1;
- };
-
-This is because an C<eval> that caught a C<die> will always return a false
-value.
-
-=head1 SHINY SYNTAX
-
-Using Perl 5.10 you can use L<perlsyn/"Switch statements">.
-
-The C<catch> block is invoked in a topicalizer context (like a C<given> block),
-but note that you can't return a useful value from C<catch> using the C<when>
-blocks without an explicit C<return>.
-
-This is somewhat similar to Perl 6's C<CATCH> blocks. You can use it to
-concisely match errors:
-
- try {
- require Foo;
- } catch {
- when (/^Can't locate .*?\.pm in \@INC/) { } # ignore
- default { die $_ }
- };
-
-=head1 CAVEATS
-
-=over 4
-
-=item *
-
-C<@_> is not available within the C<try> block, so you need to copy your
-arglist. In case you want to work with argument values directly via C<@_>
-aliasing (i.e. allow C<$_[1] = "foo">), you need to pass C<@_> by reference:
-
- sub foo {
- my ( $self, @args ) = @_;
- try { $self->bar(@args) }
- }
-
-or
-
- sub bar_in_place {
- my $self = shift;
- my $args = \@_;
- try { $_ = $self->bar($_) for @$args }
- }
-
-=item *
-
-C<return> returns from the C<try> block, not from the parent sub (note that
-this is also how C<eval> works, but not how L<TryCatch> works):
-
- sub bar {
- try { return "foo" };
- return "baz";
- }
-
- say bar(); # "baz"
-
-=item *
-
-C<try> introduces another caller stack frame. L<Sub::Uplevel> is not used. L<Carp>
-will not report this when using full stack traces, though, because
-C<%Carp::Internal> is used. This lack of magic is considered a feature.
-
-=item *
-
-The value of C<$_> in the C<catch> block is not guaranteed to be the value of
-the exception thrown (C<$@>) in the C<try> block. There is no safe way to
-ensure this, since C<eval> may be used unhygenically in destructors. The only
-guarantee is that the C<catch> will be called if an exception is thrown.
-
-=item *
-
-The return value of the C<catch> block is not ignored, so if testing the result
-of the expression for truth on success, be sure to return a false value from
-the C<catch> block:
-
- my $obj = try {
- MightFail->new;
- } catch {
- ...
-
- return; # avoid returning a true value;
- };
-
- return unless $obj;
-
-=item *
-
-C<$SIG{__DIE__}> is still in effect.
-
-Though it can be argued that C<$SIG{__DIE__}> should be disabled inside of
-C<eval> blocks, since it isn't people have grown to rely on it. Therefore in
-the interests of compatibility, C<try> does not disable C<$SIG{__DIE__}> for
-the scope of the error throwing code.
-
-=item *
-
-Lexical C<$_> may override the one set by C<catch>.
-
-For example Perl 5.10's C<given> form uses a lexical C<$_>, creating some
-confusing behavior:
-
- given ($foo) {
- when (...) {
- try {
- ...
- } catch {
- warn $_; # will print $foo, not the error
- warn $_[0]; # instead, get the error like this
- }
- }
- }
-
-=back
-
-=head1 SEE ALSO
-
-=over 4
-
-=item L<TryCatch>
-
-Much more feature complete, more convenient semantics, but at the cost of
-implementation complexity.
-
-=item L<autodie>
-
-Automatic error throwing for builtin functions and more. Also designed to
-work well with C<given>/C<when>.
-
-=item L<Throwable>
-
-A lightweight role for rolling your own exception classes.
-
-=item L<Error>
-
-Exception object implementation with a C<try> statement. Does not localize
-C<$@>.
-
-=item L<Exception::Class::TryCatch>
-
-Provides a C<catch> statement, but properly calling C<eval> is your
-responsibility.
-
-The C<try> keyword pushes C<$@> onto an error stack, avoiding some of the
-issues with C<$@>, but you still need to localize to prevent clobbering.
-
-=back
-
-=head1 LIGHTNING TALK
-
-I gave a lightning talk about this module, you can see the slides (Firefox
-only):
-
-L<http://nothingmuch.woobling.org/talks/takahashi.xul?data=yapc_asia_2009/try_tiny.txt>
-
-Or read the source:
-
-L<http://nothingmuch.woobling.org/talks/yapc_asia_2009/try_tiny.yml>
-
-=head1 VERSION CONTROL
-
-L<http://github.com/nothingmuch/try-tiny/>
-
-=head1 AUTHOR
-
-Yuval Kogman E<lt>nothingmuch at woobling.orgE<gt>
-
-=head1 COPYRIGHT
-
- Copyright (c) 2009 Yuval Kogman. All rights reserved.
- This program is free software; you can redistribute
- it and/or modify it under the terms of the MIT license.
-
-=cut
-
diff --git a/t/role-long-package-name.t b/t/role-long-package-name.t
index 811758c..934370c 100644
--- a/t/role-long-package-name.t
+++ b/t/role-long-package-name.t
@@ -1,5 +1,5 @@
use strict;
-use warnings;
+use warnings FATAL => 'all';
use Test::More;
# using Role::Tiny->apply_roles_to_object with too many roles,
diff --git a/t/role-tiny.t b/t/role-tiny.t
index f93cc78..e95b5e8 100644
--- a/t/role-tiny.t
+++ b/t/role-tiny.t
@@ -97,4 +97,3 @@ ok(!Role::Tiny->is_role('MyClass'), 'is_role false for classes');
done_testing;
-
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/librole-tiny-perl.git
More information about the Pkg-perl-cvs-commits
mailing list