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