r38099 - in /trunk/libuniversal-can-perl: ./ debian/ lib/UNIVERSAL/ t/ t/developer/

nhandler-guest at users.alioth.debian.org nhandler-guest at users.alioth.debian.org
Sun Jun 14 16:46:00 UTC 2009


Author: nhandler-guest
Date: Sun Jun 14 16:45:55 2009
New Revision: 38099

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=38099
Log:
TODO: Waiting on some licensing clarification since the debian/copyright file
      is being updated. [rt.cpan.org #46934]
* New upstream release
* debian/watch:
  - Remove comment
* debian/control:
  - Add myself to list of Uploaders
  - Bump Standards-Version to 3.8.1
  - Bump debhelper Build-Depends to >= 7
* debian/compat:
  - Bump to 7
* debian/changelog:
  - Update to use new machine readable format

Added:
    trunk/libuniversal-can-perl/debian/copyright.bak
    trunk/libuniversal-can-perl/t/SUPER-can.t
      - copied unchanged from r38098, branches/upstream/libuniversal-can-perl/current/t/SUPER-can.t
Removed:
    trunk/libuniversal-can-perl/Makefile.PL
    trunk/libuniversal-can-perl/SIGNATURE
    trunk/libuniversal-can-perl/t/developer/
Modified:
    trunk/libuniversal-can-perl/Build.PL
    trunk/libuniversal-can-perl/Changes
    trunk/libuniversal-can-perl/MANIFEST
    trunk/libuniversal-can-perl/META.yml
    trunk/libuniversal-can-perl/README
    trunk/libuniversal-can-perl/debian/changelog
    trunk/libuniversal-can-perl/debian/compat
    trunk/libuniversal-can-perl/debian/control
    trunk/libuniversal-can-perl/debian/copyright
    trunk/libuniversal-can-perl/debian/rules
    trunk/libuniversal-can-perl/debian/watch
    trunk/libuniversal-can-perl/lib/UNIVERSAL/can.pm
    trunk/libuniversal-can-perl/t/bad-input.t

Modified: trunk/libuniversal-can-perl/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libuniversal-can-perl/Build.PL?rev=38099&op=diff
==============================================================================
--- trunk/libuniversal-can-perl/Build.PL (original)
+++ trunk/libuniversal-can-perl/Build.PL Sun Jun 14 16:45:55 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: trunk/libuniversal-can-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libuniversal-can-perl/Changes?rev=38099&op=diff
==============================================================================
--- trunk/libuniversal-can-perl/Changes (original)
+++ trunk/libuniversal-can-perl/Changes Sun Jun 14 16:45:55 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: trunk/libuniversal-can-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libuniversal-can-perl/MANIFEST?rev=38099&op=diff
==============================================================================
--- trunk/libuniversal-can-perl/MANIFEST (original)
+++ trunk/libuniversal-can-perl/MANIFEST Sun Jun 14 16:45:55 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: trunk/libuniversal-can-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libuniversal-can-perl/META.yml?rev=38099&op=diff
==============================================================================
--- trunk/libuniversal-can-perl/META.yml (original)
+++ trunk/libuniversal-can-perl/META.yml Sun Jun 14 16:45:55 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: trunk/libuniversal-can-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libuniversal-can-perl/README?rev=38099&op=diff
==============================================================================
--- trunk/libuniversal-can-perl/README (original)
+++ trunk/libuniversal-can-perl/README Sun Jun 14 16:45:55 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: trunk/libuniversal-can-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libuniversal-can-perl/debian/changelog?rev=38099&op=diff
==============================================================================
--- trunk/libuniversal-can-perl/debian/changelog (original)
+++ trunk/libuniversal-can-perl/debian/changelog Sun Jun 14 16:45:55 2009
@@ -1,4 +1,7 @@
-libuniversal-can-perl (1.12-2) UNRELEASED; urgency=low
+libuniversal-can-perl (1.14-1) UNRELEASED; urgency=low
+
+  TODO: Waiting on some licensing clarification since the debian/copyright file
+        is being updated. [rt.cpan.org #46934]
 
   [ gregor herrmann ]
   * debian/control: Added: Vcs-Svn field (source stanza); Vcs-Browser
@@ -9,11 +12,7 @@
   * [debian/watch] Stop capturing file extension
 
   [ gregor herrmann ]
-  * Refresh debian/rules, no functional changes; except: don't create
-    .packlist file any more.
   * debian/watch: use dist-based URL.
-  * Set debhelper compatibility level to 5.
-  * Set Standards-Version to 3.8.0 (no changes).
   * Slightly improve short description.
   * debian/copyright: use version-independet upstream source URL and wrap a
     long line.
@@ -21,9 +20,19 @@
     (source stanza).
 
   [ Nathan Handler ]
-  * debian/watch: Update to ignore development releases.
+  * New upstream release
+  * debian/watch:
+    - Remove comment
+  * debian/control:
+    - Add myself to list of Uploaders
+    - Bump Standards-Version to 3.8.1
+    - Bump debhelper Build-Depends to >= 7
+  * debian/compat:
+    - Bump to 7
+  * debian/changelog:
+    - Update to use new machine readable format
 
- -- Damyan Ivanov <dmn at debian.org>  Tue, 06 Nov 2007 11:01:26 +0200
+ -- Nathan Handler <nhandler at ubuntu.com>  Sun, 14 Jun 2009 16:39:49 +0000
 
 libuniversal-can-perl (1.12-1) unstable; urgency=low
 

Modified: trunk/libuniversal-can-perl/debian/compat
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libuniversal-can-perl/debian/compat?rev=38099&op=diff
==============================================================================
--- trunk/libuniversal-can-perl/debian/compat (original)
+++ trunk/libuniversal-can-perl/debian/compat Sun Jun 14 16:45:55 2009
@@ -1,1 +1,1 @@
-5
+7

Modified: trunk/libuniversal-can-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libuniversal-can-perl/debian/control?rev=38099&op=diff
==============================================================================
--- trunk/libuniversal-can-perl/debian/control (original)
+++ trunk/libuniversal-can-perl/debian/control Sun Jun 14 16:45:55 2009
@@ -1,11 +1,12 @@
 Source: libuniversal-can-perl
 Section: perl
 Priority: optional
-Build-Depends: debhelper (>= 5), libmodule-build-perl
+Build-Depends: debhelper (>= 7), libmodule-build-perl
 Build-Depends-Indep: perl (>= 5.8.0-7)
 Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Krzysztof Krzyzaniak (eloy) <eloy at debian.org>
-Standards-Version: 3.8.0
+Uploaders: Krzysztof Krzyzaniak (eloy) <eloy at debian.org>,
+ Nathan Handler <nhandler at ubuntu.com>
+Standards-Version: 3.8.1
 Homepage: http://search.cpan.org/dist/UNIVERSAL-can/
 Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libuniversal-can-perl/
 Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libuniversal-can-perl/

Modified: trunk/libuniversal-can-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libuniversal-can-perl/debian/copyright?rev=38099&op=diff
==============================================================================
--- trunk/libuniversal-can-perl/debian/copyright (original)
+++ trunk/libuniversal-can-perl/debian/copyright Sun Jun 14 16:45:55 2009
@@ -1,26 +1,34 @@
-This is the debian package for the UNIVERSAL-can module.
-It was created by Krzysztof Krzyzaniak (eloy) <eloy at debian.org> using
-dh-make-perl.
+Format-Specification:
+    http://wiki.debian.org/Proposals/CopyrightFormat?action=recall&rev=196
+Upstream-Maintainer: chromatic <chromatic at wgz.org>
+Upstream-Source: http://search.cpan.org/dist/UNIVERSAL-can/
+Upstream-Name: UNIVERSAL-can
+Disclaimer: This copyright info was automatically extracted 
+    from the perl module. It may not be accurate, so you better 
+    check the module sources in order to ensure the module for its 
+    inclusion in Debian or for general legal information. Please, 
+    if licensing information is incorrectly generated, file a bug 
+    on dh-make-perl.
 
-Upstream source location: http://search.cpan.org/dist/UNIVERSAL-can/
+Files: *
+Copyright: chromatic <chromatic at wgz.org>
+License-Alias: Perl
+License: Artistic | GPL-1+
 
-The upstream author is: chromatic <chromatic at wgz.org>.
+Files: debian/*
+Copyright: 2009, Nathan Handler <nhandler at ubuntu.com>
+License: Artistic | GPL-1+
 
-Inspired by UNIVERSAL::isa by Yuval Kogman, Autrijus Tang, and myself.
+License: Artistic
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the Artistic License, which comes with Perl.
+    On Debian GNU/Linux systems, the complete text of the Artistic License
+    can be found in /usr/share/common-licenses/Artistic
 
-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.
-
-Perl is distributed under licenses:
-
-    a) the GNU General Public License as published by the Free Software
-       Foundation; either version 1, or (at your option) any later
-       version, or
-  
-    b) the "Artistic License" which comes with Perl.
-  
+License: GPL-1+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by 
+    the Free Software Foundation; either version 1, or (at your option)
+    any later version.
     On Debian GNU/Linux systems, the complete text of the GNU General
-    Public License can be found in /usr/share/common-licenses/GPL' and
-    the Artistic Licence in /usr/share/common-licenses/Artistic'.
+    Public License can be found in `/usr/share/common-licenses/GPL'

Added: trunk/libuniversal-can-perl/debian/copyright.bak
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libuniversal-can-perl/debian/copyright.bak?rev=38099&op=file
==============================================================================
--- trunk/libuniversal-can-perl/debian/copyright.bak (added)
+++ trunk/libuniversal-can-perl/debian/copyright.bak Sun Jun 14 16:45:55 2009
@@ -1,0 +1,26 @@
+This is the debian package for the UNIVERSAL-can module.
+It was created by Krzysztof Krzyzaniak (eloy) <eloy at debian.org> using
+dh-make-perl.
+
+Upstream source location: http://search.cpan.org/dist/UNIVERSAL-can/
+
+The upstream author is: chromatic <chromatic at wgz.org>.
+
+Inspired by UNIVERSAL::isa by Yuval Kogman, Autrijus Tang, and myself.
+
+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.
+
+Perl is distributed under licenses:
+
+    a) the GNU General Public License as published by the Free Software
+       Foundation; either version 1, or (at your option) any later
+       version, or
+  
+    b) the "Artistic License" which comes with Perl.
+  
+    On Debian GNU/Linux systems, the complete text of the GNU General
+    Public License can be found in /usr/share/common-licenses/GPL' and
+    the Artistic Licence in /usr/share/common-licenses/Artistic'.

Modified: trunk/libuniversal-can-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libuniversal-can-perl/debian/rules?rev=38099&op=diff
==============================================================================
--- trunk/libuniversal-can-perl/debian/rules (original)
+++ trunk/libuniversal-can-perl/debian/rules Sun Jun 14 16:45:55 2009
@@ -1,60 +1,23 @@
 #!/usr/bin/make -f
-# This debian/rules file is provided as a template for normal perl
-# packages. It was created by Marc Brockschmidt <marc at dch-faq.de> for
-# the Debian Perl Group (http://pkg-perl.alioth.debian.org/) but may
-# be used freely wherever it is useful.
-#
-# It was later modified by Jason Kohles <email at jasonkohles.com>
-# http://www.jasonkohles.com/ to support Module::Build installed modules
-
-# Uncomment this to turn on verbose mode.
-#export DH_VERBOSE=1
-
-# If set to a true value then MakeMaker's prompt function will
-# always return the default without waiting for user input.
-export PERL_MM_USE_DEFAULT=1
-
-PERL   ?= /usr/bin/perl
-PACKAGE = $(shell dh_listpackages)
-TMP     = $(CURDIR)/debian/$(PACKAGE)
 
 build: build-stamp
 build-stamp:
-	dh_testdir
-	$(PERL) Build.PL installdirs=vendor
-	$(PERL) Build
-	$(PERL) Build test
+	dh build
 	touch $@
 
 clean:
-	dh_testdir
-	dh_testroot
-	dh_clean build-stamp install-stamp
-	[ ! -f Build ] || $(PERL) Build --allow_mb_mismatch 1 distclean
+	dh $@
 
 install: install-stamp
 install-stamp: build-stamp
-	dh_testdir
-	dh_testroot
-	dh_clean -k
-	$(PERL) Build install destdir=$(TMP) create_packlist=0
+	dh install
 	touch $@
 
 binary-arch:
-# We have nothing to do here for an architecture-independent package
 
-binary-indep: build install
-	dh_testdir
-	dh_testroot
-	dh_installdocs README
-	dh_installchangelogs Changes
-	dh_perl
-	dh_compress
-	dh_fixperms
-	dh_installdeb
-	dh_gencontrol
-	dh_md5sums
-	dh_builddeb
+binary-indep: install
+	dh $@
 
-binary: binary-indep binary-arch
-.PHONY: build clean binary-indep binary-arch binary install
+binary: binary-arch binary-indep
+
+.PHONY: binary binary-arch binary-indep install clean build

Modified: trunk/libuniversal-can-perl/debian/watch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libuniversal-can-perl/debian/watch?rev=38099&op=diff
==============================================================================
--- trunk/libuniversal-can-perl/debian/watch (original)
+++ trunk/libuniversal-can-perl/debian/watch Sun Jun 14 16:45:55 2009
@@ -1,4 +1,3 @@
-# format version number, currently 2; this line is compulsory!
 version=3
 opts=uversionmangle=s/_/./ \
-http://search.cpan.org/dist/UNIVERSAL-can/   .*/UNIVERSAL-can-v?(\d[\d.]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)
+http://search.cpan.org/dist/UNIVERSAL-can/   .*/UNIVERSAL-can-v?(\d[\d_.]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)

Modified: trunk/libuniversal-can-perl/lib/UNIVERSAL/can.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libuniversal-can-perl/lib/UNIVERSAL/can.pm?rev=38099&op=diff
==============================================================================
--- trunk/libuniversal-can-perl/lib/UNIVERSAL/can.pm (original)
+++ trunk/libuniversal-can-perl/lib/UNIVERSAL/can.pm Sun Jun 14 16:45:55 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

Modified: trunk/libuniversal-can-perl/t/bad-input.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libuniversal-can-perl/t/bad-input.t?rev=38099&op=diff
==============================================================================
--- trunk/libuniversal-can-perl/t/bad-input.t (original)
+++ trunk/libuniversal-can-perl/t/bad-input.t Sun Jun 14 16:45:55 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