From: Jos I. Boumans <kane@dwim.org>
Date: Sat, 12 Aug 2006 23:57:58 +0000 (+0200)
Subject: Add Package::Constants to the core
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1a04e7910442e8e0183c57deb03b6804b9774f3c;p=p5sagit%2Fp5-mst-13.2.git

Add Package::Constants to the core
Message-ID: <9749.80.127.35.68.1155419878.squirrel@webmail.xs4all.nl>

p4raw-id: //depot/perl@28703
---

diff --git a/MANIFEST b/MANIFEST
index b24a54d..757c1b1 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2133,6 +2133,8 @@ lib/open.pm			Pragma to specify default I/O layers
 lib/open.t			See if the open pragma works
 lib/overload.pm			Module for overloading perl operators
 lib/overload.t			See if operator overloading works
+lib/Package/Constants.pm	Package::Constants
+lib/Package/Constants/t/01_list.t	Package::Constants tests
 lib/perl5db.pl			Perl debugging routines
 lib/PerlIO.pm			PerlIO support module
 lib/PerlIO/via/QuotedPrint.pm	PerlIO::via::QuotedPrint
diff --git a/lib/Package/Constants.pm b/lib/Package/Constants.pm
new file mode 100644
index 0000000..96a1409
--- /dev/null
+++ b/lib/Package/Constants.pm
@@ -0,0 +1,108 @@
+package Package::Constants;
+
+use strict;
+use vars qw[$VERSION $DEBUG];
+
+$VERSION    = '0.01';
+$DEBUG      = 0;
+
+=head1 NAME 
+
+Package::Constants -- List all constants declared in a package
+
+=head1 SYNOPSIS
+
+    use Package::Constants;
+    
+    ### list the names of all constants in a given package;
+    @const = Package::Constants->list( __PACKAGE__ );
+    @const = Package::Constants->list( 'main' );
+
+    ### enable debugging output
+    $Package::Constants::DEBUG = 1;
+
+=head1 DESCRIPTION
+
+C<Package::Constants> lists all the constants defined in a certain 
+package. This can be useful for, among others, setting up an 
+autogenerated C<@EXPORT/@EXPORT_OK> for a Constants.pm file.
+
+=head1 CLASS METHODS
+
+=head2 @const = Package::Constants->list( PACKAGE_NAME );
+
+Lists the names of all the constants defined in the provided package.
+
+=cut
+
+sub list {
+    my $class = shift;
+    my $pkg   = shift;
+    return unless defined $pkg; # some joker might use '0' as a pkg...
+    
+    _debug("Inspecting package '$pkg'");
+    
+    my @rv;
+    {   no strict 'refs';
+        my $stash = $pkg . '::';
+
+        for my $name (sort keys %$stash ) {
+        
+            _debug( "   Checking stash entry '$name'" );
+            
+            ### is it a subentry?
+            my $sub = $pkg->can( $name );
+            next unless defined $sub;
+                
+            _debug( "       '$name' is a coderef" );
+            
+            next unless defined prototype($sub) and 
+                     not length prototype($sub);
+
+            _debug( "       '$name' is a constant" );
+            push @rv, $name;
+        }
+    }
+    
+    return sort @rv;
+}
+
+=head1 GLOBAL VARIABLES
+
+=head2 $Package::Constants::DEBUG
+
+When set to true, prints out debug information to STDERR about the
+package it is inspecting. Helps to identify issues when the results
+are not as you expect.
+
+Defaults to false.
+
+=cut
+
+sub _debug { warn "@_\n" if $DEBUG; }
+
+1;
+
+=head1 AUTHOR
+
+This module by
+Jos Boumans E<lt>kane@cpan.orgE<gt>.
+
+=head1 COPYRIGHT
+
+This module is
+copyright (c) 2004-2005 Jos Boumans E<lt>kane@cpan.orgE<gt>.
+All rights reserved.
+
+This library is free software;
+you may redistribute and/or modify it under the same
+terms as Perl itself.
+
+=cut
+
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4:
diff --git a/lib/Package/Constants/t/01_list.t b/lib/Package/Constants/t/01_list.t
new file mode 100644
index 0000000..80f51fe
--- /dev/null
+++ b/lib/Package/Constants/t/01_list.t
@@ -0,0 +1,52 @@
+use strict;
+use Test::More 'no_plan';
+
+BEGIN { chdir 't' if -d 't' };
+use lib '../lib';
+
+my $Class   = 'Package::Constants';
+my $Func    = 'list';
+my $Pkg     = '_test';
+my @Good    = 'A'..'C';
+my @Bad     = 'D'..'E';
+
+use_ok( $Class );
+can_ok( $Class, $Func );
+
+### enable debug statements?
+$Package::Constants::DEBUG = $Package::Constants::DEBUG = @ARGV ? 1 : 0;
+
+
+### small test class 
+{   package _test;
+
+    ### mark us as loaded
+    $INC{'_test.pm'} = $0;
+    
+    use vars qw[$FOO];
+    $FOO = 1;
+    
+    ### define various subs.. the first 3 are constants, 
+    ### the others are not
+    use constant A => 1;
+    use constant B => sub { 1 };
+    sub C ()        { 1 };
+    
+    sub D           { 1 };
+    sub E (*)       { 1 };
+
+}    
+
+### get the list
+{   my @list = $Class->$Func( $Pkg );
+    ok( scalar(@list),          "Got a list of constants" );
+    is_deeply( \@list, \@Good,  "   Contains all expected entries" );
+}    
+
+
+# Local variables:
+# c-indentation-style: bsd
+# c-basic-offset: 4
+# indent-tabs-mode: nil
+# End:
+# vim: expandtab shiftwidth=4: