r38097 - in /branches/upstream/libuniversal-can-perl/current: Build.PL Changes MANIFEST META.yml Makefile.PL README SIGNATURE lib/UNIVERSAL/can.pm t/SUPER-can.t t/bad-input.t t/developer/
nhandler-guest at users.alioth.debian.org
nhandler-guest at users.alioth.debian.org
Sun Jun 14 14:32:47 UTC 2009
Author: nhandler-guest
Date: Sun Jun 14 14:32:41 2009
New Revision: 38097
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38097
Log:
[svn-upgrade] Integrating new upstream version, libuniversal-can-perl (1.14)
Added:
branches/upstream/libuniversal-can-perl/current/t/SUPER-can.t
Removed:
branches/upstream/libuniversal-can-perl/current/Makefile.PL
branches/upstream/libuniversal-can-perl/current/SIGNATURE
branches/upstream/libuniversal-can-perl/current/t/developer/
Modified:
branches/upstream/libuniversal-can-perl/current/Build.PL
branches/upstream/libuniversal-can-perl/current/Changes
branches/upstream/libuniversal-can-perl/current/MANIFEST
branches/upstream/libuniversal-can-perl/current/META.yml
branches/upstream/libuniversal-can-perl/current/README
branches/upstream/libuniversal-can-perl/current/lib/UNIVERSAL/can.pm
branches/upstream/libuniversal-can-perl/current/t/bad-input.t
Modified: branches/upstream/libuniversal-can-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libuniversal-can-perl/current/Build.PL?rev=38097&op=diff
==============================================================================
--- branches/upstream/libuniversal-can-perl/current/Build.PL (original)
+++ branches/upstream/libuniversal-can-perl/current/Build.PL Sun Jun 14 14:32:41 2009
@@ -1,52 +1,26 @@
#! perl
+
+BEGIN { require 5.006002 }
use Module::Build;
-my $class = Module::Build->subclass(
- class => 'Module::Build::FilterTests',
- code => <<'END_HERE',
-
- use File::Glob;
- use File::Spec::Functions;
-
- sub ACTION_disttest
- {
- my $self = shift;
- local $ENV{PERL_RUN_ALL_TESTS} = 1;
- $self->SUPER::ACTION_disttest( @_ );
- }
-
- sub find_test_files
- {
- my $self = shift;
- my $tests = $self->SUPER::find_test_files( @_ );
-
- return $tests unless $ENV{PERL_RUN_ALL_TESTS};
-
- my $test_pattern = catfile(qw( t developer *.t ) );
- unshift @$tests, File::Glob::bsd_glob( $test_pattern );
- return $tests;
- }
-END_HERE
-);
-
-my $builder = $class->new(
+my $builder = Module::Build->new(
module_name => 'UNIVERSAL::can',
license => 'perl',
dist_author => 'chromatic <chromatic at wgz.org>',
dist_version_from => 'lib/UNIVERSAL/can.pm',
- requires =>
- {
- 'perl' => '5.6.0',
- 'Scalar::Util' => '',
- },
- build_requires =>
- {
+ requires =>
+ {
+ 'perl' => '5.6.2',
+ 'Scalar::Util' => '',
'Test::Simple' => '0.60',
},
+ build_requires =>
+ {
+ 'Test::Simple' => '0.60',
+ 'Module::Build' => '0.33',
+ },
add_to_cleanup => [ 'UNIVERSAL-can-*' ],
- create_makefile_pl => 'traditional',
- sign => 1,
);
$builder->create_build_script();
Modified: branches/upstream/libuniversal-can-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libuniversal-can-perl/current/Changes?rev=38097&op=diff
==============================================================================
--- branches/upstream/libuniversal-can-perl/current/Changes (original)
+++ branches/upstream/libuniversal-can-perl/current/Changes Sun Jun 14 14:32:41 2009
@@ -1,33 +1,46 @@
Revision history for UNIVERSAL::can
+1.14 Fri Jun 12 19:43:21 UTC 2009
+ - released a new stable version
+ - removed developer tests, custom M::B subclass, and passthrough
+ Makefile.PL
+ - added build_requires
+ - fixed a documentation bug reported by Adam Kennedy (RT #17043)
+ - fixed interaction with SUPER::can() (patch by Peter du Marchie van
+ Voorthuysen in RT #25355)
+
+1.13_001 Sat Dec 29 02:28:33 UTC 2007
+ - warn only when someone has overridden can() but someone else called U::c
+ directly
+
1.12 Sat Apr 1 06:13:33 UTC 2006
- - really made Test::Warn optional
- - moved developer tests to t/developer/
+ - really made Test::Warn optional
+ - moved developer tests to t/developer/
1.11 Fri Feb 10 01:55:59 UTC 2006
- - made can() export *optional*, as it can break things...
- - fixed invocant check to use existing code and avoid infinite
- UNIVERSAL::isa loop
+ - made can() export *optional*, as it can break things...
+ - fixed invocant check to use existing code and avoid infinite
+ UNIVERSAL::isa loop
1.10 Fri Feb 10 01:17:56 UTC 2006
- - worked around weirdness with Test::Warn in the tests
- - fixed the invalid invocant bug reported by Mark Clements
- - fixed the tests to test for that bug too...
- - made the export of can() actually work
- - added the -always_warn flag to catch all dodgy uses of UNIVERSAL::can()
+ - worked around weirdness with Test::Warn in the tests
+ - fixed the invalid invocant bug reported by Mark Clements
+ - fixed the tests to test for that bug too...
+ - made the export of can() actually work
+ - added the -always_warn flag to catch all dodgy uses of UNIVERSAL::can()
1.03 Fri Jan 13 04:46:59 UTC 2006
- - mark minimum dependency on Perl 5.6 (reported by Adam Kennedy)
- - test for Really Bad Input (also suggested by Adam Kennedy)
- - fixed invalid input bugs
+ - mark minimum dependency on Perl 5.6 (reported by Adam Kennedy)
+ - test for Really Bad Input (also suggested by Adam Kennedy)
+ - fixed invalid input bugs
1.02 Wed Jan 11 00:58:57 UTC 2006
- - don't eat $@ in can() (RT #17008, reported by martin at hybyte dot com)
+ - don't eat $@ in can() (RT #17008, reported by martin at hybyte dot com)
1.01 Wed Dec 14 00:19:22 UTC 2005
- - check for uninitialized invocant (patch from Stevan Little)
- - squelch unnecessary warnings (wow, a typo!)
- - added a bit more advice to the documentation
+ - check for uninitialized invocant (patch from Stevan Little)
+ - squelch unnecessary warnings (wow, a typo!)
+ - added a bit more advice to the documentation
1.00 Sun Jul 3 21:38:47 UTC 2005
- - First version, released on an unsuspecting world.
+ - First version, released on an unsuspecting world.
Modified: branches/upstream/libuniversal-can-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libuniversal-can-perl/current/MANIFEST?rev=38097&op=diff
==============================================================================
--- branches/upstream/libuniversal-can-perl/current/MANIFEST (original)
+++ branches/upstream/libuniversal-can-perl/current/MANIFEST Sun Jun 14 14:32:41 2009
@@ -9,9 +9,5 @@
t/always_warn.t
t/bad-input.t
t/class.t
-t/developer/0-signature.t
-t/developer/pod-coverage.t
-t/developer/pod.t
t/object.t
-Makefile.PL # Do you feel retro?
-SIGNATURE Added here by Module::Build
+t/SUPER-can.t
Modified: branches/upstream/libuniversal-can-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libuniversal-can-perl/current/META.yml?rev=38097&op=diff
==============================================================================
--- branches/upstream/libuniversal-can-perl/current/META.yml (original)
+++ branches/upstream/libuniversal-can-perl/current/META.yml Sun Jun 14 14:32:41 2009
@@ -1,6 +1,6 @@
---
name: UNIVERSAL-can
-version: 1.12
+version: 1.14
author:
- 'chromatic <chromatic at wgz.org>'
abstract: Hack around people calling UNIVERSAL::can() as a function
@@ -9,14 +9,16 @@
license: http://dev.perl.org/licenses/
requires:
Scalar::Util: ''
- perl: 5.6.0
+ Test::Simple: 0.60
+ perl: 5.6.2
build_requires:
+ Module::Build: 0.33
Test::Simple: 0.60
provides:
UNIVERSAL::can:
file: lib/UNIVERSAL/can.pm
- version: 1.12
-generated_by: Module::Build version 0.2709
+ version: 1.14
+generated_by: Module::Build version 0.33
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.2.html
- version: 1.2
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: branches/upstream/libuniversal-can-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libuniversal-can-perl/current/README?rev=38097&op=diff
==============================================================================
--- branches/upstream/libuniversal-can-perl/current/README (original)
+++ branches/upstream/libuniversal-can-perl/current/README Sun Jun 14 14:32:41 2009
@@ -1,7 +1,7 @@
UNIVERSAL::can
--------------
-Version 1.12, Sat Apr 1 06:14:06 UTC 2006
+Version 1.14, Fri Jun 12 2009
This module attempts to work around people calling UNIVERSAL::can() as a
function, which it is not.
@@ -10,16 +10,16 @@
To install this module, run the following commands:
- perl Build.PL
- perl ./Build
- perl ./Build test
- perl ./Build install
+ $ perl Build.PL
+ $ perl ./Build
+ $ perl ./Build test
+ $ sudo perl ./Build install
There is also a Makefile.PL, but I don't use it.
COPYRIGHT AND LICENCE
-Copyright (C) 2005 - 2006 chromatic
+Copyright (C) 2005 - 2009 chromatic
This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
Modified: branches/upstream/libuniversal-can-perl/current/lib/UNIVERSAL/can.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libuniversal-can-perl/current/lib/UNIVERSAL/can.pm?rev=38097&op=diff
==============================================================================
--- branches/upstream/libuniversal-can-perl/current/lib/UNIVERSAL/can.pm (original)
+++ branches/upstream/libuniversal-can-perl/current/lib/UNIVERSAL/can.pm Sun Jun 14 14:32:41 2009
@@ -3,10 +3,8 @@
use strict;
use warnings;
-use 5.006;
-
use vars qw( $VERSION $recursing );
-$VERSION = '1.12';
+$VERSION = '1.14';
use Scalar::Util 'blessed';
use warnings::register;
@@ -16,87 +14,61 @@
BEGIN
{
- $orig = \&UNIVERSAL::can;
+ $orig = \&UNIVERSAL::can;
- no warnings 'redefine';
- *UNIVERSAL::can = \&can;
+ no warnings 'redefine';
+ *UNIVERSAL::can = \&can;
}
sub import
{
- my $class = shift;
- for my $import (@_)
- {
- $always_warn = 1 if $import eq '-always_warn';
- no strict 'refs';
- *{ caller() . '::can' } = \&can if $import eq 'can';
- }
+ my $class = shift;
+ for my $import (@_)
+ {
+ $always_warn = 1 if $import eq '-always_warn';
+ no strict 'refs';
+ *{ caller() . '::can' } = \&can if $import eq 'can';
+ }
}
sub can
{
- # can't call this on undef
- return _report_warning() unless defined $_[0];
+ my $caller = caller();
+ local $@;
- # don't get into a loop here
- goto &$orig if $recursing;
+ # don't get into a loop here
+ goto &$orig if $recursing
+ || ( defined $caller
+ && defined $_[0]
+ && eval { $caller->isa( $_[0] ); } );
- # call an overridden can() if it exists
- local $@;
- my $can = eval { $_[0]->$orig('can') || 0 };
+ # call an overridden can() if it exists
+ my $can = eval { $_[0]->$orig('can') || 0 };
- # but not if it inherited this one
- goto &$orig if $can == \&UNIVERSAL::can;
+ # but only if it's a real class
+ goto &$orig unless $can;
- # make sure the invocant is useful
- unless ( _is_invocant( $_[0] ) )
- {
- _report_warning();
- goto &$orig;
- }
+ # but not if it inherited this one
+ goto &$orig if $can == \&UNIVERSAL::can;
- # redirect to an overridden can, making sure not to recurse and warning
- local $recursing = 1;
- my $invocant = shift;
+ # redirect to an overridden can, making sure not to recurse and warning
+ local $recursing = 1;
+ my $invocant = shift;
- _report_warning();
- return $invocant->can(@_);
+ _report_warning();
+ return $invocant->can(@_);
}
sub _report_warning
{
- if ( $always_warn || warnings::enabled() )
- {
- my $calling_sub = ( caller(2) )[3] || '';
- warnings::warn("Called UNIVERSAL::can() as a function, not a method")
- if $calling_sub !~ /::can$/;
- }
+ if ( $always_warn || warnings::enabled() )
+ {
+ my $calling_sub = ( caller(2) )[3] || '';
+ warnings::warn("Called UNIVERSAL::can() as a function, not a method")
+ if $calling_sub !~ /::can$/;
+ }
- return;
-}
-
-sub _is_invocant
-{
- my $potential = shift;
- return unless length $potential;
- return 1 if blessed($potential);
-
- my $symtable = \%::;
- my $found = 1;
-
- for my $symbol ( split( /::/, $potential ) )
- {
- $symbol .= '::';
- unless ( exists $symtable->{$symbol} )
- {
- $found = 0;
- last;
- }
-
- $symtable = $symtable->{$symbol};
- }
-
- return $found;
+ return;
}
1;
@@ -108,7 +80,7 @@
=head1 VERSION
-Version 1.01
+Version 1.14
=head1 SYNOPSIS
@@ -128,40 +100,19 @@
break your good code.
This module replaces C<UNIVERSAL::can()> with a method that checks to see if
-the first argument is a valid invocant (whether an object -- a blessed referent
--- or the name of a class). If so, and if the invocant's class has its own
-C<can()> method, it calls that as a method. Otherwise, everything works as you
-might expect.
-
-If someone attempts to call C<UNIVERSAL::can()> as a function, this module will
-emit a lexical warning (see L<perllexwarn>) to that effect. You can disable it
-with C<no warnings;> or C<no warnings 'UNIVERSAL::isa';>, but don't do that;
-fix the code instead.
+the first argument is a valid invocant has its own C<can()> method. If so, it
+gives a warning and calls the overridden method, working around buggy code.
+Otherwise, everything works as you might expect.
Some people argue that you must call C<UNIVERSAL::can()> as a function because
you don't know if your proposed invocant is a valid invocant. That's silly.
Use C<blessed()> from L<Scalar::Util> if you want to check that the potential
invocant is an object or call the method anyway in an C<eval> block and check
-for failure.
+for failure (though check the exception I<returned>, as a poorly-written
+C<can()> method could break Liskov and throw an exception other than "You can't
+call a method on this type of invocant").
Just don't break working code.
-
-=head1 EXPORT
-
-This module can I<optionally> export a C<can()> subroutine that works exactly
-as described. It's a convenient shortcut for you. This actually works in
-version 1.11.
-
-Also, if you pass the C<-always_warn> flag on the import line, this module will
-warn about all incorrect uses of C<UNIVERSAL::can()>. This can help you change your code to be correct.
-
-=head2 can()
-
-The C<can()> method takes two arguments, a potential invocant and the name of a
-method that that invocant may be able to call. It attempts to divine whether
-the invocant is an object or a valid class name, whether there is an overridden
-C<can()> method for it, and then calls that. Otherwise, it calls
-C<UNIVERSAL::can()> directly, as if nothing had happened.
=head1 AUTHOR
@@ -184,11 +135,18 @@
Mark Clements helped to track down an invalid invocant bug.
+Curtis "Ovid" Poe finally provided the inspiration I needed to clean up the
+interface.
+
+Peter du Marchie van Voorthuysen identified and fixed a problem with calling
+C<SUPER::can>.
+
+The Perl QA list had a huge... discussion... which inspired my realization that
+this module needed to do what it does now.
+
=head1 COPYRIGHT & LICENSE
-Copyright (c) 2005 - 2006 chromatic. All rights reserved.
-
-This program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
+Artistic License 2.0, copyright (c) 2005 - 2009 chromatic. Some rights
+reserved.
=cut
Added: branches/upstream/libuniversal-can-perl/current/t/SUPER-can.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libuniversal-can-perl/current/t/SUPER-can.t?rev=38097&op=file
==============================================================================
--- branches/upstream/libuniversal-can-perl/current/t/SUPER-can.t (added)
+++ branches/upstream/libuniversal-can-perl/current/t/SUPER-can.t Sun Jun 14 14:32:41 2009
@@ -1,0 +1,34 @@
+use UNIVERSAL::can;
+
+use strict;
+use warnings;
+
+
+package MyClass;
+
+my @caller;
+
+sub can {
+ push @caller, caller;
+}
+
+sub test {
+ my ($invocant, $method) = @_;
+ $invocant->SUPER::can($method);
+}
+
+
+package main;
+
+use Test::More tests => 2;
+
+my @warning;
+local $SIG{__WARN__} = sub { push @warning, @_ };
+
+MyClass->test("foo");
+
+is_deeply(\@warning, [],
+ "CLASS->SUPER::can(METHOD) does not give a warning");
+
+is_deeply(\@caller, [],
+ "CLASS->SUPER::can(METHOD) does not invoke CLASS->can(METHOD)");
Modified: branches/upstream/libuniversal-can-perl/current/t/bad-input.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libuniversal-can-perl/current/t/bad-input.t?rev=38097&op=diff
==============================================================================
--- branches/upstream/libuniversal-can-perl/current/t/bad-input.t (original)
+++ branches/upstream/libuniversal-can-perl/current/t/bad-input.t Sun Jun 14 14:32:41 2009
@@ -1,4 +1,6 @@
#!perl
+
+package test;
use strict;
use warnings;
@@ -10,15 +12,14 @@
BEGIN
{
- @inputs =
- (
- undef, '', \'', {}, [], 0, sub {}, do { local *FH; *FH }, -1, 0.003, '.'
- );
+ @inputs =
+ (
+ undef, '', \'', {}, [], 0, sub {}, do { local *FH; *FH }, -1, 0.003, '.'
+ );
}
# don't hardcode the test number, but do check for premature death
use Test::More tests => ( @inputs * 2 ) + 1;
-use Test::SmallWarn;
# enable lexical warnings from module at compile time
BEGIN { use_ok( 'UNIVERSAL::can' ) }
@@ -59,12 +60,10 @@
# test didn't do The Right Thing
for my $bad ( @inputs )
{
- my $bad_name = defined $bad ? $bad : '(undef)';
+ my $bad_name = defined $bad ? $bad : '(undef)';
+ my $warnings = '';
+ local $SIG{__WARN__} = sub { $warnings = shift };
- my $flag;
-
- warning_like { $flag = eval { UNIVERSAL::can( $bad, 'id' ); 1 } }
- qr/^Called UNIVERSAL\:\:can\(\) as a function\, not a method/,
- "test received exactly one warning for bad input '$bad_name'";
- ok( $flag, '... and did not throw an exception' );
+ ok( ! UNIVERSAL::can( $bad, 'id' ), "$bad_name should be false" );
+ is( $warnings, '', '... and not throw a warning' );
}
More information about the Pkg-perl-cvs-commits
mailing list