Hello community,
here is the log from the commit of package perl-Contextual-Return for
openSUSE:Factory checked in at 2017-01-22 00:18:48
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Contextual-Return (Old)
and /work/SRC/openSUSE:Factory/.perl-Contextual-Return.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Contextual-Return"
Changes:
--------
---
/work/SRC/openSUSE:Factory/perl-Contextual-Return/perl-Contextual-Return.changes
2012-12-21 10:31:45.000000000 +0100
+++
/work/SRC/openSUSE:Factory/.perl-Contextual-Return.new/perl-Contextual-Return.changes
2017-01-22 00:18:49.398756948 +0100
@@ -1,0 +2,52 @@
+Fri Dec 2 06:07:39 UTC 2016 - co...@suse.com
+
+- updated to 0.004010
+ see /usr/share/doc/packages/perl-Contextual-Return/Changes
+
+
+
+ 0.004010 Thu Dec 1 17:41:14 2016
+
+ - Spelling fix in POD (thanks, Salvatore)
+
+ - Improved DUMP behaviour when passed a non-CRV argument
+ (thanks, Mathew)
+
+-------------------------------------------------------------------
+Wed Nov 23 14:54:15 UTC 2016 - co...@suse.com
+
+- remove Build.PL, it's obsolete
+
+-------------------------------------------------------------------
+Fri Nov 18 06:12:51 UTC 2016 - co...@suse.com
+
+- updated to 0.004009
+ see /usr/share/doc/packages/perl-Contextual-Return/Changes
+
+
+
+ 0.004009 Fri Nov 18 08:34:19 2016
+
+ - Improved behaviour of FREEZE (Thanks, Mathew!)
+
+ - Improved output of DUMP
+
+-------------------------------------------------------------------
+Mon Sep 14 08:25:00 UTC 2015 - co...@suse.com
+
+- updated to 0.004008
+ see /usr/share/doc/packages/perl-Contextual-Return/Changes
+
+
+
+ 0.004008 Sat Sep 12 13:16:30 2015
+
+ - Promoted $VERSION variable to earlier in source to
+ attempt to placate cpanminus (thanks, Karen!)
+
+ - Added prototype to overridden caller()
+
+ - Changed way caller() is overridden, hopefully will no longer
+ clash with Sub::Uplevel
+
+-------------------------------------------------------------------
Old:
----
Build.PL
Contextual-Return-0.004007.tar.gz
New:
----
Contextual-Return-0.004010.tar.gz
cpanspec.yml
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Contextual-Return.spec ++++++
--- /var/tmp/diff_new_pack.qwmzrU/_old 2017-01-22 00:18:49.890687318 +0100
+++ /var/tmp/diff_new_pack.qwmzrU/_new 2017-01-22 00:18:49.894686752 +0100
@@ -1,7 +1,7 @@
#
# spec file for package perl-Contextual-Return
#
-# Copyright (c) 2012 SUSE LINUX Products GmbH, Nuernberg, Germany.
+# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -17,24 +17,21 @@
Name: perl-Contextual-Return
-Version: 0.004007
+Version: 0.004010
Release: 0
%define cpan_name Contextual-Return
Summary: Create context-sensitive return values
-License: GPL-1.0+ or Artistic-1.0
+License: Artistic-1.0 or GPL-1.0+
Group: Development/Libraries/Perl
Url: http://search.cpan.org/dist/Contextual-Return/
-Source:
http://www.cpan.org/authors/id/D/DC/DCONWAY/%{cpan_name}-%{version}.tar.gz
-Source1: Build.PL
+Source0:
http://www.cpan.org/authors/id/D/DC/DCONWAY/%{cpan_name}-%{version}.tar.gz
+Source1: cpanspec.yml
BuildArch: noarch
BuildRoot: %{_tmppath}/%{name}-%{version}-build
BuildRequires: perl
BuildRequires: perl-macros
-BuildRequires: perl(Module::Build)
BuildRequires: perl(Want)
BuildRequires: perl(version)
-#BuildRequires: perl(Contextual::Return)
-#BuildRequires: perl(Contextual::Return::Failure)
Requires: perl(Want)
Requires: perl(version)
%{perl_requires}
@@ -89,17 +86,17 @@
%prep
%setup -q -n %{cpan_name}-%{version}
-cp %{S:1} ./
%build
-%{__perl} Build.PL installdirs=vendor
-./Build build flags=%{?_smp_mflags}
+%{__perl} Makefile.PL INSTALLDIRS=vendor
+%{__make} %{?_smp_mflags}
%check
-./Build test
+%{__make} test
%install
-./Build install destdir=%{buildroot} create_packlist=0
+%perl_make_install
+%perl_process_packlist
%perl_gen_filelist
%files -f %{name}.files
++++++ Contextual-Return-0.004007.tar.gz -> Contextual-Return-0.004010.tar.gz
++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.004007/Changes
new/Contextual-Return-0.004010/Changes
--- old/Contextual-Return-0.004007/Changes 2012-10-06 00:05:05.000000000
+0200
+++ new/Contextual-Return-0.004010/Changes 2016-12-01 07:41:14.000000000
+0100
@@ -146,3 +146,29 @@
- Added BLESSED handler for better control over how blessed() lies
- Upgraded reimplementation of blessed() to make more sense
+
+
+0.004008 Sat Sep 12 13:16:30 2015
+
+ - Promoted $VERSION variable to earlier in source to
+ attempt to placate cpanminus (thanks, Karen!)
+
+ - Added prototype to overridden caller()
+
+ - Changed way caller() is overridden, hopefully will no longer
+ clash with Sub::Uplevel
+
+
+0.004009 Fri Nov 18 08:34:19 2016
+
+ - Improved behaviour of FREEZE (Thanks, Mathew!)
+
+ - Improved output of DUMP
+
+
+0.004010 Thu Dec 1 17:41:14 2016
+
+ - Spelling fix in POD (thanks, Salvatore)
+
+ - Improved DUMP behaviour when passed a non-CRV argument
+ (thanks, Mathew)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.004007/MANIFEST
new/Contextual-Return-0.004010/MANIFEST
--- old/Contextual-Return-0.004007/MANIFEST 2012-10-06 00:05:06.000000000
+0200
+++ new/Contextual-Return-0.004010/MANIFEST 2016-12-01 07:41:17.000000000
+0100
@@ -37,4 +37,5 @@
t/STRICT.t
t/blessed.t
t/confess.t
-META.yml Module meta-data (added by MakeMaker)
+META.yml Module YAML meta-data (added by
MakeMaker)
+META.json Module JSON meta-data (added by
MakeMaker)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.004007/META.json
new/Contextual-Return-0.004010/META.json
--- old/Contextual-Return-0.004007/META.json 1970-01-01 01:00:00.000000000
+0100
+++ new/Contextual-Return-0.004010/META.json 2016-12-01 07:41:17.000000000
+0100
@@ -0,0 +1,43 @@
+{
+ "abstract" : "Create context-sensitive return values",
+ "author" : [
+ "Damian Conway <dcon...@cpan.org>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter
version 2.142690",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec";,
+ "version" : "2"
+ },
+ "name" : "Contextual-Return",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "Test::More" : "0",
+ "Want" : "0",
+ "version" : "0"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "version" : "0.004010"
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.004007/META.yml
new/Contextual-Return-0.004010/META.yml
--- old/Contextual-Return-0.004007/META.yml 2012-10-06 00:05:06.000000000
+0200
+++ new/Contextual-Return-0.004010/META.yml 2016-12-01 07:41:17.000000000
+0100
@@ -1,24 +1,24 @@
---- #YAML:1.0
-name: Contextual-Return
-version: 0.004007
-abstract: Create context-sensitive return values
+---
+abstract: 'Create context-sensitive return values'
author:
- - Damian Conway <dcon...@cpan.org>
-license: perl
-distribution_type: module
-configure_requires:
- ExtUtils::MakeMaker: 0
+ - 'Damian Conway <dcon...@cpan.org>'
build_requires:
- ExtUtils::MakeMaker: 0
-requires:
- Test::More: 0
- version: 0
- Want: 0
-no_index:
- directory:
- - t
- - inc
-generated_by: ExtUtils::MakeMaker version 6.57_05
+ ExtUtils::MakeMaker: '0'
+configure_requires:
+ ExtUtils::MakeMaker: '0'
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version
2.142690'
+license: perl
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: '1.4'
+name: Contextual-Return
+no_index:
+ directory:
+ - t
+ - inc
+requires:
+ Test::More: '0'
+ Want: '0'
+ version: '0'
+version: '0.004010'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.004007/README
new/Contextual-Return-0.004010/README
--- old/Contextual-Return-0.004007/README 2012-10-06 00:05:05.000000000
+0200
+++ new/Contextual-Return-0.004010/README 2016-12-01 07:41:14.000000000
+0100
@@ -1,4 +1,4 @@
-Contextual::Return version 0.004007
+Contextual::Return version 0.004010
This module provides a collection of named blocks that allow a return
statement to return different values depending on the context in which it's
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.004007/lib/Contextual/Return.pm
new/Contextual-Return-0.004010/lib/Contextual/Return.pm
--- old/Contextual-Return-0.004007/lib/Contextual/Return.pm 2012-10-06
00:05:05.000000000 +0200
+++ new/Contextual-Return-0.004010/lib/Contextual/Return.pm 2016-12-01
07:41:14.000000000 +0100
@@ -1,39 +1,65 @@
package Contextual::Return;
+use warnings;
+use strict;
+our $VERSION = '0.004010';
my %attrs_of;
-# Fake out CORE::GLOBAL::caller, Carp::*, and Scalar::Util::blessed() very
early...
+# This is localized as caller to hide the interim blocks...
+my $smart_caller;
+
+# Fake out Carp::*, and Scalar::Util::blessed() very early...
BEGIN {
no warnings 'redefine';
my $fallback_caller = *CORE::GLOBAL::caller{CODE};
- *CORE::GLOBAL::caller = sub {
- my ($uplevels) = shift || 0;
+ if (!defined $fallback_caller) {
+ *CORE::GLOBAL::caller = sub (;$) {
+ my ($height) = @_;
+ $height++;
+ my @caller = CORE::caller($height);
+ if ( CORE::caller() eq 'DB' ) {
+ # Oops, redo picking up @DB::args
+ package DB;
+ @caller = CORE::caller($height);
+ }
+
+ return if ! @caller; # empty
+ return $caller[0] if ! wantarray; # scalar context
+ return @_ ? @caller : @caller[0..2]; # extra info or regular
+ };
+ }
+ $smart_caller = sub (;$) {
+ my ($uplevels) = $_[0] || 0;
+ my @caller;
if (CORE::caller eq 'DB') {
package DB;
if ($fallback_caller) {
- return $fallback_caller->($uplevels + 2 +
$Contextual::Return::uplevel)
+ @caller = $fallback_caller->($uplevels + 5 +
$Contextual::Return::uplevel)
if $Contextual::Return::uplevel;
- return $fallback_caller->($uplevels + 1);
+ @caller = $fallback_caller->($uplevels + 4);
}
else {
- return CORE::caller($uplevels + 2 +
$Contextual::Return::uplevel)
+ @caller = CORE::caller($uplevels + 5 +
$Contextual::Return::uplevel)
if $Contextual::Return::uplevel;
- return CORE::caller($uplevels + 1);
+ @caller = CORE::caller($uplevels + 4);
}
}
else {
if ($fallback_caller) {
- return $fallback_caller->($uplevels + 2 +
$Contextual::Return::uplevel)
+ @caller = $fallback_caller->($uplevels + 5 +
$Contextual::Return::uplevel)
if $Contextual::Return::uplevel;
- return $fallback_caller->($uplevels + 1);
+ @caller = $fallback_caller->($uplevels + 4);
}
else {
- return CORE::caller($uplevels + 2 +
$Contextual::Return::uplevel)
+ @caller = CORE::caller($uplevels + 5 +
$Contextual::Return::uplevel)
if $Contextual::Return::uplevel;
- return CORE::caller($uplevels + 1);
+ @caller = CORE::caller($uplevels + 4);
}
}
+ return if ! @caller; # empty
+ return $caller[0] if ! wantarray; # scalar context
+ return @_ ? @caller : @caller[0..2]; # extra info or regular
};
use Carp;
@@ -58,6 +84,8 @@
# ...and replace it...
*Scalar::Util::blessed = sub($) {
+ no warnings 'redefine'; local *CORE::GLOBAL::caller = $smart_caller;
+
# Are we operating on a CRV???
my $attrs = $attrs_of{refaddr $_[0] or q{}};
@@ -87,10 +115,6 @@
}
-our $VERSION = '0.004007';
-
-use warnings;
-use strict;
sub _in_context {
my $msg = join q{}, @_;
@@ -100,7 +124,7 @@
my ($package, $file, $line, $sub) = CORE::caller($stack_frame++);
my ($orig_package, $prev_package) = ($package) x 2;
- my $LOC = qq{at $file line $line};
+ my $LOC = qq{at $file line $line};
# Walk up stack...
STACK_FRAME:
@@ -114,7 +138,7 @@
next STACK_FRAME if $package =~ m{^Contextual::Return}xms;
# Track the call up the stack...
- $LOC = qq{at $file line $line};
+ $LOC = qq{at $file line $line};
# Ignore any @CARP_NOT'ed packages
next STACK_FRAME
@@ -219,11 +243,13 @@
if (!@selected) {
Carp::carp("use Contextual::Return $selector didn't export
anything");
}
+ no if $] >= 5.022, warnings => 'redundant';
return map { $_ => sprintf($renamer, $_) } @selected;
}
elsif ($selector_type eq 'literal') {
Carp::croak "Can't export $selector: no such handler"
if !exists $STD_NAME_FOR{$selector};
+ no if $] >= 5.022, warnings => 'redundant';
return ( $selector => sprintf($renamer, $selector) );
}
else {
@@ -258,9 +284,10 @@
}
# Hide from caller() and the enclosing eval{}...
-
+
# Evaluate block in context and cache result...
local $Contextual::Return::uplevel = $Contextual::Return::uplevel+1;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller = $smart_caller;
$Contextual::Return::__RESULT__
= $context ? [ $block->(@{$args}) ]
: defined $context ? [ scalar $block->(@{$args}) ]
@@ -311,6 +338,7 @@
if (!defined wantarray && $impl->{NVALUE}) {
# Fake out caller() and Carp...
local $Contextual::Return::uplevel = 1;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller =
$smart_caller;
# Call and clear handler...
local $Contextual::Return::__RETOBJ__ = $impl;
@@ -339,6 +367,7 @@
# Prepare for exception handling...
my $recover = $attrs->{RECOVER};
local $Contextual::Return::uplevel = 2;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller = $smart_caller;
# Handle list context directly, if possible...
if ($wantarray) {
@@ -346,7 +375,7 @@
# List or ancestral handlers...
handler:
for my $context (qw(LIST VALUE NONVOID DEFAULT)) {
- my $handler = $attrs->{$context}
+ my $handler = $attrs->{$context}
or $attrs->{STRICT} and last handler
or next handler;
@@ -467,6 +496,7 @@
# Prepare for exception handling...
my $recover = $attrs->{RECOVER};
local $Contextual::Return::uplevel = 2;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller = $smart_caller;
# Handle list context directly...
if ($wantarray) {
@@ -556,6 +586,7 @@
# Prepare for exception handling...
my $recover = $attrs->{RECOVER};
local $Contextual::Return::uplevel = 2;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller = $smart_caller;
# Handle list context directly, if possible...
if ($wantarray) {
@@ -563,7 +594,7 @@
# List or ancestral handlers...
handler:
for my $context (qw(LIST VALUE NONVOID DEFAULT)) {
- my $handler = $attrs->{$context}
+ my $handler = $attrs->{$context}
or $attrs->{STRICT} and last handler
or next handler;
@@ -677,6 +708,7 @@
# Prepare for exception handling...
my $recover = $attrs->{RECOVER};
local $Contextual::Return::uplevel = 2;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller = $smart_caller;
# Handle list context directly, if possible...
if ($wantarray) {
@@ -685,7 +717,7 @@
# List or ancestral handlers...
handler:
for my $context (qw(LIST VALUE NONVOID DEFAULT)) {
- my $handler = $attrs->{$context}
+ my $handler = $attrs->{$context}
or $attrs->{STRICT} and last handler
or next handler;
@@ -810,6 +842,7 @@
# Prepare for exception handling...
my $recover = $attrs->{RECOVER};
local $Contextual::Return::uplevel = 2;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller = $smart_caller;
# Handle list context directly, if possible...
if ($wantarray) {
@@ -930,10 +963,10 @@
my ($data_ref, $obj_ref) = @_;
my $type = ref $data_ref;
return if !$type;
- for my $value ( $type eq 'SCALAR' ? ${$data_ref} : @{$data_ref} ) {
+ for my $ref ( $type eq 'SCALAR' ? ${$data_ref} : $type eq 'ARRAY' ?
@{$data_ref} : ()) {
no warnings 'numeric', 'uninitialized';
- if ($value == $obj_ref) {
- $value = '<<<self-reference>>>';
+ if (refaddr($ref) == refaddr($obj_ref)) {
+ $ref = '<<<self-reference>>>';
}
}
}
@@ -958,13 +991,14 @@
push @no_handler, $context;
return ();
}
+ chomp $exception;
return { $context => "<<<Throws exception: $exception>>>" };
}
# Detect self-referential overloadings (to avoid infinite recursion)...
{
no warnings 'numeric', 'uninitialized';
- if (ref $retval eq 'REF' && ${$retval} == ${$self}) {
+ if (ref $retval eq 'REF' && eval{ ${$retval} == ${$self} }) {
return { $context => "<<<self-reference>>>" };
}
}
@@ -988,7 +1022,7 @@
}
# Generate list context value by "pretend" LIST handler...
- push @values, { LIST => [ _internal_LIST(sub{}, $self) ] };
+ push @values, { LIST => eval{ [ _internal_LIST(sub{}, $self) ] } // do{
chomp $@; "<<<Throws exception: $@>>>"} };
_flag_self_ref_in($values[-1]{LIST}, $self);
# Generate scalar context values by calling appropriate handler...
@@ -1006,7 +1040,7 @@
# Are there handlers for various "generic" super-contexts...
my @fallbacks = grep { $attrs_ref->{$_} }
qw< DEFAULT NONVOID SCALAR VALUE REF RECOVER >;
-
+
push @values, { NO_HANDLER => \@no_handler };
push @values, { FALLBACKS => \@fallbacks };
@@ -1017,10 +1051,18 @@
# Call this method on a contextual return value object to debug it...
sub DUMP {
- if (require Data::Dumper) {
+ if (eval{ require Data::Dumper; 1; }) {
my ($crv) = @_;
- FREEZE($crv);
- return Data::Dumper::Dumper($crv);
+ if (eval{ ref($crv)->isa('Contextual::Return::Value')}) {
+ Contextual::Return::FREEZE($crv);
+ }
+ local $Data::Dumper::Terse = 1;
+ local $Data::Dumper::Indent = 1;
+ my $dump = Data::Dumper::Dumper($crv);
+ $dump =~ s<,\n \{><,ZZZZ{>msg;
+ $dump =~ s<\n\s+>< >msg;
+ $dump =~ s<,ZZZZ\{><\n {>msg;
+ return $dump;
}
else {
Carp::carp("Can't DUMP contextual return value (no Data::Dumper!)");
@@ -1038,6 +1080,8 @@
q{""} => sub {
my ($self) = @_;
local $Contextual::Return::__RETOBJ__ = $self;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller =
$smart_caller;
+
my $attrs = $attrs_of{refaddr $self};
handler:
for my $context (qw(STR SCALAR LAZY VALUE NONVOID DEFAULT NUM)) {
@@ -1083,6 +1127,7 @@
q{0+} => sub {
my ($self) = @_;
local $Contextual::Return::__RETOBJ__ = $self;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller =
$smart_caller;
my $attrs = $attrs_of{refaddr $self};
handler:
for my $context (qw(NUM SCALAR LAZY VALUE NONVOID DEFAULT STR)) {
@@ -1128,6 +1173,7 @@
q{bool} => sub {
my ($self) = @_;
local $Contextual::Return::__RETOBJ__ = $self;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller =
$smart_caller;
my $attrs = $attrs_of{refaddr $self};
# Handle Calls in Pure Boolean context...
@@ -1183,6 +1229,7 @@
'${}' => sub {
my ($self) = @_;
local $Contextual::Return::__RETOBJ__ = $self;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller =
$smart_caller;
my $attrs = $attrs_of{refaddr $self};
handler:
for my $context (qw(SCALARREF REF NONVOID DEFAULT)) {
@@ -1240,6 +1287,7 @@
'@{}' => sub {
my ($self) = @_;
local $Contextual::Return::__RETOBJ__ = $self;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller =
$smart_caller;
my $attrs = $attrs_of{refaddr $self};
local $Contextual::Return::__RESULT__;
handler:
@@ -1325,6 +1373,7 @@
'%{}' => sub {
my ($self) = @_;
local $Contextual::Return::__RETOBJ__ = $self;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller =
$smart_caller;
my $attrs = $attrs_of{refaddr $self};
handler:
for my $context (qw(HASHREF REF NONVOID DEFAULT)) {
@@ -1374,6 +1423,7 @@
'&{}' => sub {
my ($self) = @_;
local $Contextual::Return::__RETOBJ__ = $self;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller =
$smart_caller;
my $attrs = $attrs_of{refaddr $self};
handler:
for my $context (qw(CODEREF REF NONVOID DEFAULT)) {
@@ -1423,6 +1473,7 @@
'*{}' => sub {
my ($self) = @_;
local $Contextual::Return::__RETOBJ__ = $self;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller =
$smart_caller;
my $attrs = $attrs_of{refaddr $self};
handler:
for my $context (qw(GLOBREF REF NONVOID DEFAULT)) {
@@ -1477,6 +1528,7 @@
sub DESTROY {
my ($id) = refaddr shift;
my $attrs = $attrs_of{$id};
+ no warnings 'redefine'; local *CORE::GLOBAL::caller = $smart_caller;
if (my $handler = $attrs->{CLEANUP}) {
$handler->(@{ $attrs->{args} });
}
@@ -1520,6 +1572,7 @@
my $attrs = $attrs_of{refaddr $self} || {};
local $Contextual::Return::__RETOBJ__ = $self;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller = $smart_caller;
# First, see if there is a method call handler...
if (my $context_handler = $attrs->{METHOD}) {
@@ -1649,6 +1702,7 @@
local *CALLER::_ = \$_;
local *_ = \$_[1];
local $Contextual::Return::uplevel = 1;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller = $smart_caller;
local $Contextual::Return::__RESULT__;
my $rv = $_[0]{LVALUE}( @{$_[0]{args}} );
@@ -1660,6 +1714,7 @@
# Handle calls that are rvalues...
sub FETCH {
local $Contextual::Return::uplevel = 1;
+ no warnings 'redefine'; local *CORE::GLOBAL::caller = $smart_caller;
local $Contextual::Return::__RESULT__;
my $rv = $_[0]{RVALUE} ? $_[0]{RVALUE}( @{$_[0]{args}} ) : undef;
@@ -1681,7 +1736,7 @@
=head1 VERSION
-This document describes Contextual::Return version 0.004007
+This document describes Contextual::Return version 0.004010
=head1 SYNOPSIS
@@ -1832,7 +1887,7 @@
=head2 Active contextual return values
-Once a return value has been lazily evaluated in a given context,
+Once a return value has been lazily evaluated in a given context,
the resulting value is cached, and thereafter reused in that same context.
However, you can specify that, rather than being cached, the value
@@ -1843,17 +1898,17 @@
return ACTIVE
SCALAR { ++$counter }
ARRAYREF { [1..$counter] }
- }
-
+ }
+
my $idx = make_counter();
-
+
print "$idx\n"; # 1
print "$idx\n"; # 2
print "[@$idx]\n"; # [1 2]
print "$idx\n"; # 3
print "[@$idx]\n"; # [1 2 3]
-
+
=head2 Semi-lazy contextual return values
Sometimes, single or repeated lazy evaluation of a scalar return value
@@ -1997,7 +2052,7 @@
calling the C<RETOBJ()> function. This is particularly useful for C<PUREBOOL>
and C<LIST> handlers. For example:
- return
+ return
PUREBOOL { $_ = RETOBJ; next handler; }
BOOL { !$failed; }
DEFAULT { $data; };
@@ -2384,7 +2439,7 @@
strict type checking on a return value.
Contextual::Returns allows that via the C<STRICT> specifier. If you include
-C<STRICT> anywhere in your return statement, the module disables all
+C<STRICT> anywhere in your return statement, the module disables all
fallbacks and will therefore through an exception if the return value is
used in any way not explicitly specified in the contextual return sequence.
@@ -2447,7 +2502,7 @@
PUREBOOL { $_ = $return_val; next handler; }
BOOL { defined $return_val && $return_val > 0 }
SCALAR { $return_val; }
-
+
Note that I<any> specific handler can defer to a more general one in
this same way. For example, you could provide consistent and
maintainable type-checking for a subroutine that returns references by
@@ -2467,7 +2522,7 @@
next handler;
}
REF { $retval }
-
+
If, at a later time, the process of returning a reference became more complex,
only the C<REF> handler would have to be updated.
@@ -2698,13 +2753,13 @@
within a given module X are only overridden for the current namespace
within the particular file from module X is loaded. This means that two
separate pieces of code (in separate files or separate namespaces) can
-each independently overide a module's C<FAIL> behaviour, without
+each independently override a module's C<FAIL> behaviour, without
interfering with each other.
=head2 Lvalue contexts
Recent versions of Perl offer (limited) support for lvalue subroutines:
-subroutines that return a modifiable variable, rather than a simple constant
+subroutines that return a modifiable variable, rather than a simple constant
value.
Contextual::Return can make it easier to create such subroutines, within the
@@ -2750,7 +2805,7 @@
baz(0) = 42; # same as: $baz = 42
- baz(1) = 84; # same as: bar() = 84
+ baz(1) = 84; # same as: bar() = 84
# which is the same as: foo() = 84
# which is the same as: $foo = 84
@@ -2794,7 +2849,7 @@
When the subroutine isn't used as an lvalue:
print verbosity();
-
+
the C<RVALUE> block is executed instead and its final value returned.
Within an C<RVALUE> block you can use any of the other features of
Contextual::Return. For example:
@@ -2855,7 +2910,7 @@
Typically, this requirement produces a slightly awkward code sequence
like this:
- return
+ return
VALUE {
$db->start_work();
my $result = $db->retrieve_query($query);
@@ -2867,7 +2922,7 @@
the return value to be context sensitive, in which case you have to
write either:
- return
+ return
LIST {
$db->start_work();
my @result = $db->retrieve_query($query);
@@ -2883,7 +2938,7 @@
or, worse:
- return
+ return
VALUE {
$db->start_work();
my $result = LIST ? [$db->retrieve_query($query)]
@@ -2896,7 +2951,7 @@
setting the result of a context block; a way that doesn't require that the
result be the last statement in the block:
- return
+ return
LIST {
$db->start_work();
RESULT { $db->retrieve_query($query) };
@@ -2917,7 +2972,7 @@
Better still, the C<RESULT> block always evaluates its final statement
in the same context as the surrounding C<return>, so you can just write:
- return
+ return
VALUE {
$db->start_work();
RESULT { $db->retrieve_query($query) };
@@ -2934,7 +2989,7 @@
if ($db->closed) {
RESULT { undef }; # Error: not in a context block
}
- return
+ return
VALUE {
$db->start_work();
RESULT { $db->retrieve_query($query) };
@@ -2963,7 +3018,7 @@
So, for example, you could implement a simple commit-or-revert
policy like so:
- return
+ return
LIST { $db->retrieve_all($query) }
SCALAR { $db->retrieve_next($query) }
RECOVER {
@@ -2981,7 +3036,7 @@
via the C<$@> variable. The exception may be rethrown out of the
C<RECOVER> block by calling C<die>:
- return
+ return
LIST { $db->retrieve_all($query) }
DEFAULT { croak "Invalid call (not in list context)" }
RECOVER {
@@ -2992,7 +3047,7 @@
A C<RECOVER> block can also access or replace the returned value, by
invoking a C<RESULT> block. For example:
- return
+ return
LIST { attempt_to_generate_list_for(@_) }
SCALAR { attempt_to_generate_count_for(@_) }
RECOVER {
@@ -3012,7 +3067,7 @@
Using Contextual::Return you can get the same effect, by providing a
C<CLEANUP> block in the contextual return sequence:
- return
+ return
LIST { $db->retrieve_all($query) }
SCALAR { $db->retrieve_next($query) }
CLEANUP { $db->commit() }
@@ -3102,7 +3157,7 @@
(C<Contextual::Return::FREEZE()>) for you to register, like so:
use Data::Dumper 'Dumper';
-
+
local $Data::Dumper::Freezer = 'Contextual::Return::FREEZE';
print Dumper $foo;
@@ -3136,15 +3191,15 @@
By default the module exports a large number of return context markers:
- DEFAULT REF LAZY
- VOID SCALARREF FIXED
- NONVOID ARRAYREF ACTIVE
- LIST CODEREF RESULT
+ DEFAULT REF LAZY
+ VOID SCALARREF FIXED
+ NONVOID ARRAYREF ACTIVE
+ LIST CODEREF RESULT
SCALAR HASHREF RECOVER
VALUE GLOBREF CLEANUP
- STR OBJREF RVALUE
- NUM METHOD LVALUE
- BOOL NVALUE
+ STR OBJREF RVALUE
+ NUM METHOD LVALUE
+ BOOL NVALUE
PUREBOOL
These are exported as subroutines, and so can conflict with existing
@@ -3159,7 +3214,7 @@
statement that loads the module as follows:
=over
-
+
=item *
Any string passed as an argument to C<use Contextual::Return>,
@@ -3204,7 +3259,7 @@
# Export a list of handlers, renaming them individually...
use Contextual::Return NUM => 'NUMERIC', STR => 'TEXT', BOOL => 'CR_%s';
-
+
# Export a list of handlers, renaming them collectively...
use Contextual::Return ['NUM', 'STR', 'BOOL'] => '%s_CONTEXT';
@@ -3217,11 +3272,11 @@
-=head1 INTERFACE
+=head1 INTERFACE
=head2 Context tests
-=over
+=over
=item C<< LIST() >>
@@ -3248,7 +3303,7 @@
=head2 Standard contexts
-=over
+=over
=item C<< LIST {...} >>
@@ -3424,7 +3479,7 @@
=item C<< Contextual::Return::FAIL_WITH >>
This subroutine is not exported, but may be called directly to reconfigure
-C<FAIL> behaviour in the caller's namespace.
+C<FAIL> behaviour in the caller's namespace.
The subroutine is called with an optional string (the I<flag>), followed
by a mandatory hash reference (the I<configurations hash>), followed by a
@@ -3475,9 +3530,9 @@
=head2 Explicit result blocks
-=over
+=over
-=item C<< RESULT >>
+=item C<< RESULT >>
This block may only appear inside a context handler block. It causes the
surrounding handler to return the final value of the C<RESULT>'s block,
@@ -3491,9 +3546,9 @@
=head2 Recovery blocks
-=over
+=over
-=item C<< RECOVER >>
+=item C<< RECOVER >>
If present in a context return sequence, this block grabs control after
any context handler returns or exits via an exception. If an exception
@@ -3503,9 +3558,9 @@
=head2 Clean-up blocks
-=over
+=over
-=item C<< CLEANUP >>
+=item C<< CLEANUP >>
If present in a context return sequence, this block grabs control when
a return value is garbage collected.
@@ -3536,19 +3591,21 @@
=item C<< $crv->Contextual::Return::DUMP() >>
-Dump a representation of the return value in all viable contexts
+Return a dumpable representation of the return value in all viable contexts.
+
+=item C<< local $Data::Dumper::Freezer = 'Contextual::Return::FREEZE'; >>
-=item C<< local $Data::Dumper::Freezer = 'Contextual::Return::FREEZE' >>
+=item C<< local $Data::Dumper::Freezer = \&Contextual::Return::FREEZE; >>
Configure Data::Dumper to correctly dump a representation of the
-return value.
+contextual return value.
=back
=head1 DIAGNOSTICS
-=over
+=over
=item C<Can't use %s as export specifier>
@@ -3710,7 +3767,7 @@
C<LVALUE>, C<RVALUE>, and C<NVALUE> do not work correctly under the Perl
debugger. This seems to be because the debugger injects code to capture
-the return values from subroutines, which interferes destructively with
+the return values from subroutines, which interferes destructively with
the optional final arguments that allow C<LVALUE>, C<RVALUE>, and C<NVALUE>
to cascade within a single return.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Contextual-Return-0.004007/t/caller.t
new/Contextual-Return-0.004010/t/caller.t
--- old/Contextual-Return-0.004007/t/caller.t 2012-08-05 08:28:04.000000000
+0200
+++ new/Contextual-Return-0.004010/t/caller.t 2014-06-26 16:08:01.000000000
+0200
@@ -8,8 +8,8 @@
};
*bar = sub {
- return [caller()], [caller(1)] if wantarray;
- return (caller()||q{}) . '|' . (caller(1)||q{});
+ return [CORE::caller()], [CORE::caller(1)] if wantarray;
+ return (CORE::caller()||q{}) . '|' . (CORE::caller(1)||q{});
};
# This has to be on one line so the caller lines are the same...
++++++ cpanspec.yml ++++++
---
#description_paragraphs: 3
#no_testing: broken upstream
#sources:
# - source1
# - source2
#patches:
# foo.patch: -p1
# bar.patch:
#preamble: |-
# BuildRequires: gcc-c++
#post_prep: |-
# hunspell=`pkg-config --libs hunspell | sed -e 's,-l,,; s, *,,g'`
# sed -i -e "s,hunspell-X,$hunspell," t/00-prereq.t Makefile.PL
#post_install: |-
# sed on %{name}.files
#license: SUSE-NonFree
#skip_noarch: 1
#custom_build: |-
#./Build build flags=%{?_smp_mflags} --myflag
#custom_test: |-
#startserver && make test
#ignore_requires: Bizarre::Module
