r20536 - in /branches/upstream/libsub-identify-perl: ./ current/ current/lib/ current/lib/Sub/ current/t/
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Fri May 30 09:41:11 UTC 2008
Author: eloy
Date: Fri May 30 09:41:11 2008
New Revision: 20536
URL: http://svn.debian.org/wsvn/?sc=1&rev=20536
Log:
[svn-inject] Installing original source of libsub-identify-perl
Added:
branches/upstream/libsub-identify-perl/
branches/upstream/libsub-identify-perl/current/
branches/upstream/libsub-identify-perl/current/Changes
branches/upstream/libsub-identify-perl/current/MANIFEST
branches/upstream/libsub-identify-perl/current/MANIFEST.SKIP
branches/upstream/libsub-identify-perl/current/META.yml
branches/upstream/libsub-identify-perl/current/Makefile.PL
branches/upstream/libsub-identify-perl/current/lib/
branches/upstream/libsub-identify-perl/current/lib/Sub/
branches/upstream/libsub-identify-perl/current/lib/Sub/Identify.pm
branches/upstream/libsub-identify-perl/current/t/
branches/upstream/libsub-identify-perl/current/t/01basic.t
branches/upstream/libsub-identify-perl/current/t/02errors.t
branches/upstream/libsub-identify-perl/current/t/pod.t
Added: branches/upstream/libsub-identify-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-identify-perl/current/Changes?rev=20536&op=file
==============================================================================
--- branches/upstream/libsub-identify-perl/current/Changes (added)
+++ branches/upstream/libsub-identify-perl/current/Changes Fri May 30 09:41:11 2008
@@ -1,0 +1,15 @@
+Rafael Garcia-Suarez (13):
+ Import Sub-Identify 0.02
+ Add MANIFEST.SKIP file
+ Add get_code_info, as suggested by Shawn M Moore
+ Export get_code_info()
+ Add tests for get_code_info()
+ More tests for undefined subroutines
+ Fix email address
+ New tests for errors
+ Merge branch 'moose'
+ Add pod test file
+ Pre-require Test::More
+ Add copyright and license
+ Bump version and regenerate the META.yml
+
Added: branches/upstream/libsub-identify-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-identify-perl/current/MANIFEST?rev=20536&op=file
==============================================================================
--- branches/upstream/libsub-identify-perl/current/MANIFEST (added)
+++ branches/upstream/libsub-identify-perl/current/MANIFEST Fri May 30 09:41:11 2008
@@ -1,0 +1,9 @@
+lib/Sub/Identify.pm
+t/01basic.t
+t/02errors.t
+t/pod.t
+Makefile.PL
+MANIFEST
+MANIFEST.SKIP
+Changes
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libsub-identify-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-identify-perl/current/MANIFEST.SKIP?rev=20536&op=file
==============================================================================
--- branches/upstream/libsub-identify-perl/current/MANIFEST.SKIP (added)
+++ branches/upstream/libsub-identify-perl/current/MANIFEST.SKIP Fri May 30 09:41:11 2008
@@ -1,0 +1,5 @@
+^\.git/
+^MANIFEST\.bak
+^Makefile$
+^blib/
+^pm_to_blib$
Added: branches/upstream/libsub-identify-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-identify-perl/current/META.yml?rev=20536&op=file
==============================================================================
--- branches/upstream/libsub-identify-perl/current/META.yml (added)
+++ branches/upstream/libsub-identify-perl/current/META.yml Fri May 30 09:41:11 2008
@@ -1,0 +1,11 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Sub-Identify
+version: 0.03
+version_from: lib/Sub/Identify.pm
+installdirs: site
+requires:
+ Test::More: 0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.30_01
Added: branches/upstream/libsub-identify-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-identify-perl/current/Makefile.PL?rev=20536&op=file
==============================================================================
--- branches/upstream/libsub-identify-perl/current/Makefile.PL (added)
+++ branches/upstream/libsub-identify-perl/current/Makefile.PL Fri May 30 09:41:11 2008
@@ -1,0 +1,9 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => "Sub::Identify",
+ VERSION_FROM => "lib/Sub/Identify.pm",
+ PREREQ_PM => {
+ 'Test::More' => 0,
+ },
+);
Added: branches/upstream/libsub-identify-perl/current/lib/Sub/Identify.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-identify-perl/current/lib/Sub/Identify.pm?rev=20536&op=file
==============================================================================
--- branches/upstream/libsub-identify-perl/current/lib/Sub/Identify.pm (added)
+++ branches/upstream/libsub-identify-perl/current/lib/Sub/Identify.pm Fri May 30 09:41:11 2008
@@ -1,0 +1,80 @@
+package Sub::Identify;
+
+use B ();
+use Exporter;
+
+$VERSION = '0.03';
+ at ISA = ('Exporter');
+%EXPORT_TAGS = (all => [ @EXPORT_OK = qw(sub_name stash_name sub_fullname get_code_info) ]);
+
+use strict;
+
+sub _cv {
+ my ($coderef) = @_;
+ ref $coderef or return undef;
+ my $cv = B::svref_2object($coderef);
+ $cv->isa('B::CV') ? $cv : undef;
+}
+
+sub sub_name {
+ my $cv = &_cv or return undef;
+ $cv->GV->NAME;
+}
+
+sub stash_name {
+ my $cv = &_cv or return undef;
+ $cv->GV->STASH->NAME;
+}
+
+sub sub_fullname {
+ my $cv = &_cv or return undef;
+ $cv->GV->STASH->NAME . '::' . $cv->GV->NAME;
+}
+
+sub get_code_info {
+ my $cv = &_cv or return undef;
+ ($cv->GV->STASH->NAME, $cv->GV->NAME);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Sub::Identify - Retrieve names of code references
+
+=head1 SYNOPSIS
+
+ use Sub::Identify ':all';
+ my $subname = sub_name( $some_coderef );
+ my $p = stash_name( $some_coderef );
+ my $fully_qualified_name = sub_fullname( $some_coderef );
+ defined $subname
+ and print "this coderef points to sub $subname in package $p\n";
+
+=head1 DESCRIPTION
+
+C<Sub::Identify> allows you to retrieve the real name of code references. For
+this, it uses perl's introspection mechanism, provided by the C<B> module.
+
+It provides four functions : C<sub_name> returns the name of the
+subroutine (or C<__ANON__> if it's an anonymous code reference),
+C<stash_name> returns its package, and C<sub_fullname> returns the
+concatenation of the two.
+
+The fourth function, C<get_code_info>, returns a list of two elements,
+the package and the subroutine name (in case of you want both and are worried
+by the speed.)
+
+In case of subroutine aliasing, those functions always return the
+original name.
+
+=head1 LICENSE
+
+(c) Rafael Garcia-Suarez (rgarciasuarez at gmail dot com) 2005, 2008
+
+This program is free software; you may redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libsub-identify-perl/current/t/01basic.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-identify-perl/current/t/01basic.t?rev=20536&op=file
==============================================================================
--- branches/upstream/libsub-identify-perl/current/t/01basic.t (added)
+++ branches/upstream/libsub-identify-perl/current/t/01basic.t Fri May 30 09:41:11 2008
@@ -1,0 +1,48 @@
+#!perl
+
+use Test::More tests => 30;
+
+BEGIN { use_ok 'Sub::Identify', ':all' }
+
+sub buffy { }
+sub vamp::spike { }
+*slayer = *buffy;
+*human::william = \&vamp::spike;
+
+is( sub_name( \&sub_name ), 'sub_name' );
+is( sub_name( \&buffy ), 'buffy' );
+is( sub_name( \&vamp::spike ), 'spike' );
+is( sub_name( \&slayer ), 'buffy' );
+is( sub_name( \&human::william ), 'spike' );
+
+is( stash_name( \&stash_name ), 'Sub::Identify' );
+is( stash_name( \&buffy ), 'main' );
+is( stash_name( \&vamp::spike ), 'vamp' );
+is( stash_name( \&slayer ), 'main' );
+is( stash_name( \&human::william ), 'vamp' );
+
+is( sub_fullname( \&sub_fullname ), 'Sub::Identify::sub_fullname' );
+is( sub_fullname( \&buffy ), 'main::buffy' );
+is( sub_fullname( \&vamp::spike ), 'vamp::spike' );
+is( sub_fullname( \&slayer ), 'main::buffy' );
+is( sub_fullname( \&human::william ), 'vamp::spike' );
+
+is( join('*', get_code_info( \&sub_fullname )), 'Sub::Identify*sub_fullname' );
+is( join('*', get_code_info( \&buffy )), 'main*buffy' );
+is( join('*', get_code_info( \&vamp::spike )), 'vamp*spike' );
+is( join('*', get_code_info( \&slayer )), 'main*buffy' );
+is( join('*', get_code_info( \&human::william )), 'vamp*spike' );
+
+sub xander;
+sub vamp::drusilla;
+is( sub_name( \&xander ), 'xander', 'undefined subroutine' );
+is( sub_fullname( \&xander ), 'main::xander', 'undefined subroutine' );
+is( join('*', get_code_info( \&xander )), 'main*xander', 'undefined subroutine' );
+is( sub_name( \&vamp::drusilla ), 'drusilla', 'undefined subroutine' );
+is( sub_fullname( \&vamp::drusilla ), 'vamp::drusilla', 'undefined subroutine' );
+
+is( sub_name( sub {} ), '__ANON__' );
+my $anon = sub {};
+is( stash_name( $anon ), 'main' );
+is( sub_fullname( $anon ), 'main::__ANON__' );
+is( join('*', get_code_info( sub { 'ah non' } )), 'main*__ANON__' );
Added: branches/upstream/libsub-identify-perl/current/t/02errors.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-identify-perl/current/t/02errors.t?rev=20536&op=file
==============================================================================
--- branches/upstream/libsub-identify-perl/current/t/02errors.t (added)
+++ branches/upstream/libsub-identify-perl/current/t/02errors.t Fri May 30 09:41:11 2008
@@ -1,0 +1,14 @@
+#!perl
+
+use Test::More tests => 8;
+use Sub::Identify ':all';
+
+ok( !defined sub_name( undef ) );
+ok( !defined sub_name( "scalar" ) );
+ok( !defined sub_name( \"scalar ref" ) );
+ok( !defined sub_name( \@INC ) );
+
+ok( !defined stash_name( undef ) );
+ok( !defined stash_name( "scalar" ) );
+ok( !defined stash_name( \"scalar ref" ) );
+ok( !defined stash_name( \@INC ) );
Added: branches/upstream/libsub-identify-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-identify-perl/current/t/pod.t?rev=20536&op=file
==============================================================================
--- branches/upstream/libsub-identify-perl/current/t/pod.t (added)
+++ branches/upstream/libsub-identify-perl/current/t/pod.t Fri May 30 09:41:11 2008
@@ -1,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
More information about the Pkg-perl-cvs-commits
mailing list