r2649 - in /packages/libuniversal-isa-perl: ./ branches/
branches/upstream/
branches/upstream/current/ branches/upstream/current/lib/
branches/upstream/current/lib/UNIVERSAL/ branches/upstream/current/t/ tags/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Fri Apr 28 14:14:51 UTC 2006
Author: eloy
Date: Fri Apr 28 14:14:50 2006
New Revision: 2649
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=2649
Log:
[svn-inject] Installing original source of libuniversal-isa-perl
Added:
packages/libuniversal-isa-perl/
packages/libuniversal-isa-perl/branches/
packages/libuniversal-isa-perl/branches/upstream/
packages/libuniversal-isa-perl/branches/upstream/current/
packages/libuniversal-isa-perl/branches/upstream/current/Build.PL
packages/libuniversal-isa-perl/branches/upstream/current/Changes
packages/libuniversal-isa-perl/branches/upstream/current/MANIFEST
packages/libuniversal-isa-perl/branches/upstream/current/META.yml
packages/libuniversal-isa-perl/branches/upstream/current/Makefile.PL
packages/libuniversal-isa-perl/branches/upstream/current/README
packages/libuniversal-isa-perl/branches/upstream/current/SIGNATURE
packages/libuniversal-isa-perl/branches/upstream/current/lib/
packages/libuniversal-isa-perl/branches/upstream/current/lib/UNIVERSAL/
packages/libuniversal-isa-perl/branches/upstream/current/lib/UNIVERSAL/isa.pm
packages/libuniversal-isa-perl/branches/upstream/current/t/
packages/libuniversal-isa-perl/branches/upstream/current/t/basic.t
packages/libuniversal-isa-perl/branches/upstream/current/t/bugs.t
packages/libuniversal-isa-perl/tags/
Added: packages/libuniversal-isa-perl/branches/upstream/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libuniversal-isa-perl/branches/upstream/current/Build.PL?rev=2649&op=file
==============================================================================
--- packages/libuniversal-isa-perl/branches/upstream/current/Build.PL (added)
+++ packages/libuniversal-isa-perl/branches/upstream/current/Build.PL Fri Apr 28 14:14:50 2006
@@ -1,0 +1,16 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Module::Build;
+
+Module::Build->new(
+ module_name => 'UNIVERSAL::isa',
+ license => 'perl',
+ requires => {
+ 'perl' => '5.006',
+ 'Scalar::Util' => 0,
+ },
+ create_makefile_pl => 'traditional',
+ sign => 1,
+)->create_build_script;
Added: packages/libuniversal-isa-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libuniversal-isa-perl/branches/upstream/current/Changes?rev=2649&op=file
==============================================================================
--- packages/libuniversal-isa-perl/branches/upstream/current/Changes (added)
+++ packages/libuniversal-isa-perl/branches/upstream/current/Changes Fri Apr 28 14:14:50 2006
@@ -1,0 +1,20 @@
+Changes for UNIVERSAL::isa
+--------------------------
+
+0.06 Fri Feb 24 06:47:14 UTC 2006
+ - allowed for overridden can()
+ - allowed backwards-compatible use of isa() to check reftype
+ - added Changes and README files
+ - revised internal code for readability
+ - improved documentation slightly
+
+0.05 Nov 07 2005
+
+0.04 Sep 11 2005
+
+0.03 Sep 05 2005
+
+0.02 Jul 03 2005
+
+0.01 Jun 30 2005
+ - initial release
Added: packages/libuniversal-isa-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libuniversal-isa-perl/branches/upstream/current/MANIFEST?rev=2649&op=file
==============================================================================
--- packages/libuniversal-isa-perl/branches/upstream/current/MANIFEST (added)
+++ packages/libuniversal-isa-perl/branches/upstream/current/MANIFEST Fri Apr 28 14:14:50 2006
@@ -1,0 +1,11 @@
+Build.PL
+Changes
+lib/UNIVERSAL/isa.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+t/basic.t
+t/bugs.t
+README
+SIGNATURE Added here by Module::Build
+SIGNATURE Added here by Module::Build
Added: packages/libuniversal-isa-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libuniversal-isa-perl/branches/upstream/current/META.yml?rev=2649&op=file
==============================================================================
--- packages/libuniversal-isa-perl/branches/upstream/current/META.yml (added)
+++ packages/libuniversal-isa-perl/branches/upstream/current/META.yml Fri Apr 28 14:14:50 2006
@@ -1,0 +1,16 @@
+---
+name: UNIVERSAL-isa
+version: 0.06
+author: ~
+abstract: |-
+ Attempt to recover from people calling UNIVERSAL::isa as a
+ function
+license: perl
+requires:
+ Scalar::Util: 0
+ perl: 5.006
+provides:
+ UNIVERSAL::isa:
+ file: lib/UNIVERSAL/isa.pm
+ version: 0.06
+generated_by: Module::Build version 0.2611
Added: packages/libuniversal-isa-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libuniversal-isa-perl/branches/upstream/current/Makefile.PL?rev=2649&op=file
==============================================================================
--- packages/libuniversal-isa-perl/branches/upstream/current/Makefile.PL (added)
+++ packages/libuniversal-isa-perl/branches/upstream/current/Makefile.PL Fri Apr 28 14:14:50 2006
@@ -1,0 +1,13 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+ 'NAME' => 'UNIVERSAL::isa',
+ 'VERSION_FROM' => 'lib/UNIVERSAL/isa.pm',
+ 'PREREQ_PM' => {
+ 'Scalar::Util' => '0'
+ },
+ 'INSTALLDIRS' => 'site',
+ 'PL_FILES' => {}
+ )
+;
Added: packages/libuniversal-isa-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libuniversal-isa-perl/branches/upstream/current/README?rev=2649&op=file
==============================================================================
--- packages/libuniversal-isa-perl/branches/upstream/current/README (added)
+++ packages/libuniversal-isa-perl/branches/upstream/current/README Fri Apr 28 14:14:50 2006
@@ -1,0 +1,42 @@
+UNIVERSAL::isa
+--------------
+
+Version 0.06 - Fri Feb 24 06:57:52 UTC 2006
+
+Attempt to recover from people calling UNIVERSAL::isa as a function
+
+ # from the shell
+ echo 'export PERL5OPT=-MUNIVERSAL::isa' >> /etc/profile
+
+ # within your program
+ use UNIVERSAL::isa;
+
+INSTALLATION
+
+ $ perl Build.PL
+ $ perl ./Build
+ $ perl ./Build test
+ $ sudo perl ./Build install
+
+APOLOGIA
+
+ Whenever you use "isa" in UNIVERSAL as a function, a kitten using
+Test::MockObject dies. Normally, the kittens would be helpless, but if they use
+UNIVERSAL::isa (the module whose docs you are reading), the kittens can live
+long and prosper.
+
+ This module replaces "UNIVERSAL::isa" with a version that makes sure that,
+when called as a function on objects which override "isa", "isa" will call the
+appropriate method on those objects
+
+ In all other cases, the real "UNIVERSAL::isa" gets called directly.
+
+AUTHORS
+ Autrijus Tang <autrijus at autrijus.org>
+
+ chromatic <chromatic at wgz.org>
+
+ Yuval Kogman <nothingmuch at woobling.org>
+
+COPYRIGHT & LICENSE
+ Same as Perl, (c) 2005 - 2006.
Added: packages/libuniversal-isa-perl/branches/upstream/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libuniversal-isa-perl/branches/upstream/current/SIGNATURE?rev=2649&op=file
==============================================================================
--- packages/libuniversal-isa-perl/branches/upstream/current/SIGNATURE (added)
+++ packages/libuniversal-isa-perl/branches/upstream/current/SIGNATURE Fri Apr 28 14:14:50 2006
@@ -1,0 +1,32 @@
+This file contains message digests of all files listed in MANIFEST,
+signed via the Module::Signature module, version 0.53.
+
+To verify the content in this distribution, first make sure you have
+Module::Signature installed, then type:
+
+ % cpansign -v
+
+It will check each file's integrity, as well as the signature's
+validity. If "==> Signature verified OK! <==" is not displayed,
+the distribution may already have been compromised, and you should
+not run its Makefile.PL or Build.PL.
+
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+SHA1 b22373febb9100af8545be3ea75de041ac1a68d9 Build.PL
+SHA1 3b015afbb2eea645af7325bef88d432d78dea84b Changes
+SHA1 6906d5429c1c587b0a367ff859221391ae737144 MANIFEST
+SHA1 a7823dbd767289a81802df7eb1cdfbdc09093d4e META.yml
+SHA1 5cf0c1336517270a31f2b893775bb284130b672e Makefile.PL
+SHA1 8a07646b7947303fa906328af862b869eaec2df3 README
+SHA1 b10e64eb47b3a51316d5495da37e1e25cf6faadb lib/UNIVERSAL/isa.pm
+SHA1 0c87875d0c75e64fbb8cd0145e106368807ea182 t/basic.t
+SHA1 b0901afa698b6109ecc70994e66c1f0b54e56b01 t/bugs.t
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.2.1 (GNU/Linux)
+
+iD8DBQFD/q92qX/z6NoU2UoRAt6yAJ9d48RZsvk98HBNg7YCxre25E1ubACcD5j6
+3rbH0qgUMhtJdjJmGChmcyE=
+=eP1K
+-----END PGP SIGNATURE-----
Added: packages/libuniversal-isa-perl/branches/upstream/current/lib/UNIVERSAL/isa.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libuniversal-isa-perl/branches/upstream/current/lib/UNIVERSAL/isa.pm?rev=2649&op=file
==============================================================================
--- packages/libuniversal-isa-perl/branches/upstream/current/lib/UNIVERSAL/isa.pm (added)
+++ packages/libuniversal-isa-perl/branches/upstream/current/lib/UNIVERSAL/isa.pm Fri Apr 28 14:14:50 2006
@@ -1,0 +1,150 @@
+#!/usr/bin/perl -w
+
+package UNIVERSAL::isa;
+
+use strict;
+use vars qw/$VERSION $recursing/;
+
+use UNIVERSAL ();
+
+use Scalar::Util qw/blessed/;
+use warnings::register;
+
+$VERSION = "0.06";
+
+my $orig;
+BEGIN { $orig = \&UNIVERSAL::isa };
+
+no warnings 'redefine';
+
+sub import
+{
+ no strict 'refs';
+ *{caller() . "::isa"} = \&UNIVERSAL::isa if (@_ > 1 and $_[1] eq "isa");
+}
+
+sub UNIVERSAL::isa
+{
+ goto &$orig if $recursing;
+ my $type = invocant_type( @_ );
+ $type->( @_ );
+}
+
+sub invocant_type
+{
+ my $invocant = shift;
+ return \&nonsense unless defined( $invocant );
+ return \&object_or_class if blessed( $invocant );
+ return \&reference if ref( $invocant );
+ return \&nonsense unless $invocant;
+ return \&object_or_class;
+}
+
+sub nonsense
+{
+ report_warning( 'on invalid invocant' );
+ return;
+}
+
+sub object_or_class
+{
+ report_warning();
+
+ local $@;
+ local $recursing = 1;
+
+ if ( my $override = eval { $_[0]->can( 'isa' ) } )
+ {
+ unless ( $override == \&UNIVERSAL::isa )
+ {
+ my $obj = shift;
+ return $obj->$override( @_ );
+ }
+ }
+
+ goto &$orig;
+}
+
+sub reference
+{
+ report_warning( "Did you mean to use Scalar::Util::reftype() instead?" );
+ goto &$orig;
+}
+
+sub report_warning
+{
+ my $extra = shift;
+ $extra = $extra ? " ($extra)" : '';
+
+ if (warnings::enabled())
+ {
+ my $calling_sub = ( caller( 2 ) )[3] || '';
+ return if $calling_sub =~ /::isa$/;
+ warnings::warn(
+ "Called UNIVERSAL::isa() as a function, not a method$extra"
+ )
+ }
+}
+
+__PACKAGE__;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+UNIVERSAL::isa - Attempt to recover from people calling UNIVERSAL::isa as a
+function
+
+=head1 SYNOPSIS
+
+ # from the shell
+ echo 'export PERL5OPT=-MUNIVERSAL::isa' >> /etc/profile
+
+ # within your program
+ use UNIVERSAL::isa;
+
+=head1 DESCRIPTION
+
+Whenever you use L<UNIVERSAL/isa> as a function, a kitten using
+L<Test::MockObject> dies. Normally, the kittens would be helpless, but if they
+use L<UNIVERSAL::isa> (the module whose docs you are reading), the kittens can
+live long and prosper.
+
+This module replaces C<UNIVERSAL::isa> with a version that makes sure that,
+when called as a function on objects which override C<isa>, C<isa> will call
+the appropriate method on those objects
+
+In all other cases, the real C<UNIVERSAL::isa> gets called directly.
+
+=head1 WARNINGS
+
+If the lexical warnings pragma is available, this module will emit a warning
+for each naughty invocation of C<UNIVERSAL::isa>. Silence these warnings by
+saying:
+
+ no warnings 'UNIVERSAL::isa';
+
+in the lexical scope of the naughty code.
+
+=head1 SEE ALSO
+
+L<UNIVERSAL::can> for a more mature discussion of the problem at hand.
+
+L<Test::MockObject> for one example of a module that really needs to override
+C<isa()>.
+
+=head1 AUTHORS
+
+Autrijus Tang <autrijus at autrijus.org>
+
+chromatic <chromatic at wgz.org>
+
+Yuval Kogman <nothingmuch at woobling.org>
+
+=head1 COPYRIGHT & LICENSE
+
+Same as Perl, (c) 2005 - 2006.
+
+=cut
Added: packages/libuniversal-isa-perl/branches/upstream/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libuniversal-isa-perl/branches/upstream/current/t/basic.t?rev=2649&op=file
==============================================================================
--- packages/libuniversal-isa-perl/branches/upstream/current/t/basic.t (added)
+++ packages/libuniversal-isa-perl/branches/upstream/current/t/basic.t Fri Apr 28 14:14:50 2006
@@ -1,0 +1,65 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More tests => 18;
+
+BEGIN { use_ok("UNIVERSAL::isa", "isa") };
+
+# no warnings "UNIVERSAL::isa";
+use warnings;
+
+{
+ package Foo;
+
+ sub isa {
+ 1;
+ }
+}
+
+{
+ package Bar;
+}
+
+{
+ package Gorch;
+ sub isa {
+ my $self = shift;
+ my $class = shift;
+ ($class eq "Dung") || $self->SUPER::isa($class);
+ }
+}
+
+{
+ package Baz;
+ sub isa {
+ my $self = shift;
+ my $class = shift;
+ ($class eq "Dung") || UNIVERSAL::isa($self, $class);
+ }
+}
+
+my ($f,$b,$g,$x) = map { bless [], $_ } qw/Foo Bar Gorch Baz/;
+
+ok(isa([], "ARRAY"), "10 is a scalar");
+ok(isa($b, "Bar"), "bar is a bar");
+ok(isa($f, "Foo"), "foo is a foo");
+ok(!isa($b, "Crap"), "bar isn't full of crap");
+ok(isa($f, "Crap"), "foo is full of crap");
+ok(isa($g, "Gorch"), "gorch is itself");
+ok(!isa($g, "Crap"), "gorch isn't crap");
+ok(isa($g, "Dung"), "it's dung");
+ok(isa($x, "Baz"), "baz is itself");
+ok(!isa($x, "Crap"), "baz isn't crap");
+ok(isa($x, "Dung"), "it's dung");
+{
+ use warnings 'UNIVERSAL::isa';
+ no warnings 'once';
+
+ ok( isa( {}, 'HASH' ), 'hash reference isa HASH' );
+ ok( isa( [], 'ARRAY' ), 'array reference isa ARRAY' );
+ ok( isa( sub {}, 'CODE' ), 'code reference isa CODE' );
+ ok( isa( \my $a, 'SCALAR' ), 'scalar reference isa SCALAR' );
+ ok( isa( qr//, 'Regexp' ), 'regexp reference isa Regexp' );
+ ok( isa( \local *FOO, 'GLOB' ), 'glob reference isa GLOB' );
+}
Added: packages/libuniversal-isa-perl/branches/upstream/current/t/bugs.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libuniversal-isa-perl/branches/upstream/current/t/bugs.t?rev=2649&op=file
==============================================================================
--- packages/libuniversal-isa-perl/branches/upstream/current/t/bugs.t (added)
+++ packages/libuniversal-isa-perl/branches/upstream/current/t/bugs.t Fri Apr 28 14:14:50 2006
@@ -1,0 +1,111 @@
+#!/usr/bin/perl
+
+use strict;
+
+use Test::More tests => 8;
+
+BEGIN { use_ok('UNIVERSAL::isa', 'isa') };
+
+no warnings 'UNIVERSAL::isa';
+
+# class method
+
+{
+ package Foo;
+
+ sub new
+ {
+ bless \(my $self), shift;
+ }
+
+ sub isa {
+ 1;
+ }
+}
+
+# delegates calls to Foo
+{
+ package Bar;
+
+ sub isa
+ {
+ return 1 if $_[1] eq 'Foo';
+ }
+}
+
+# really delegates calls to Foo
+{
+ package FooProxy;
+
+ sub new
+ {
+ my $class = shift;
+ my $foo = Foo->new( @_ );
+ bless \$foo, $class;
+ }
+
+ sub can
+ {
+ my $self = shift;
+ return $$self->can( @_ );
+ }
+}
+
+# wraps a Foo object
+{
+ package Quux;
+
+ use vars '$AUTOLOAD';
+ sub isa;
+
+ sub new
+ {
+ my $class = shift;
+ my $foo = Foo->new();
+ bless \$foo, $class;
+ }
+
+ sub can
+ {
+ my $self = shift;
+ return $$self->can( @_ );
+ }
+
+ sub AUTOLOAD
+ {
+ my $self = shift;
+ my ($method) = $AUTOLOAD =~ /::(\w+)$/;
+ $$self->$method( @_ );
+ }
+
+ sub DESTROY {}
+}
+
+my $quux = Quux->new();
+
+ok( isa( 'Bar', 'Foo' ), 'isa() should work on class methods too' );
+ok( ! isa( 'Baz', 'Foo' ), '... but not for non-existant classes' );
+ok( isa( $quux, 'Foo' ), '... and should work on delegated wrappers' );
+
+is( scalar(isa(undef, 'Foo')), undef, 'isa on undef returns undef');
+
+eval { require CGI };
+
+unless ($@) {
+ isa_ok(CGI->new(''), "CGI");
+}
+
+# overloaded objects
+{
+ package Qibble;
+ use overload '""' => sub { die };
+ no warnings 'once';
+ *new = \&Foo::new;
+}
+
+my $qibble = Qibble->new();
+
+ok( isa( $qibble, 'Qibble' ), '... can test ISA on landmines');
+
+my $proxy = FooProxy->new();
+isa_ok( $proxy, 'Foo' );
More information about the Pkg-perl-cvs-commits
mailing list