This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add Package::Constants to the core
[perl5.git] / lib / Package / Constants.pm
1 package Package::Constants;
2
3 use strict;
4 use vars qw[$VERSION $DEBUG];
5
6 $VERSION    = '0.01';
7 $DEBUG      = 0;
8
9 =head1 NAME 
10
11 Package::Constants -- List all constants declared in a package
12
13 =head1 SYNOPSIS
14
15     use Package::Constants;
16     
17     ### list the names of all constants in a given package;
18     @const = Package::Constants->list( __PACKAGE__ );
19     @const = Package::Constants->list( 'main' );
20
21     ### enable debugging output
22     $Package::Constants::DEBUG = 1;
23
24 =head1 DESCRIPTION
25
26 C<Package::Constants> lists all the constants defined in a certain 
27 package. This can be useful for, among others, setting up an 
28 autogenerated C<@EXPORT/@EXPORT_OK> for a Constants.pm file.
29
30 =head1 CLASS METHODS
31
32 =head2 @const = Package::Constants->list( PACKAGE_NAME );
33
34 Lists the names of all the constants defined in the provided package.
35
36 =cut
37
38 sub list {
39     my $class = shift;
40     my $pkg   = shift;
41     return unless defined $pkg; # some joker might use '0' as a pkg...
42     
43     _debug("Inspecting package '$pkg'");
44     
45     my @rv;
46     {   no strict 'refs';
47         my $stash = $pkg . '::';
48
49         for my $name (sort keys %$stash ) {
50         
51             _debug( "   Checking stash entry '$name'" );
52             
53             ### is it a subentry?
54             my $sub = $pkg->can( $name );
55             next unless defined $sub;
56                 
57             _debug( "       '$name' is a coderef" );
58             
59             next unless defined prototype($sub) and 
60                      not length prototype($sub);
61
62             _debug( "       '$name' is a constant" );
63             push @rv, $name;
64         }
65     }
66     
67     return sort @rv;
68 }
69
70 =head1 GLOBAL VARIABLES
71
72 =head2 $Package::Constants::DEBUG
73
74 When set to true, prints out debug information to STDERR about the
75 package it is inspecting. Helps to identify issues when the results
76 are not as you expect.
77
78 Defaults to false.
79
80 =cut
81
82 sub _debug { warn "@_\n" if $DEBUG; }
83
84 1;
85
86 =head1 AUTHOR
87
88 This module by
89 Jos Boumans E<lt>kane@cpan.orgE<gt>.
90
91 =head1 COPYRIGHT
92
93 This module is
94 copyright (c) 2004-2005 Jos Boumans E<lt>kane@cpan.orgE<gt>.
95 All rights reserved.
96
97 This library is free software;
98 you may redistribute and/or modify it under the same
99 terms as Perl itself.
100
101 =cut
102
103 # Local variables:
104 # c-indentation-style: bsd
105 # c-basic-offset: 4
106 # indent-tabs-mode: nil
107 # End:
108 # vim: expandtab shiftwidth=4: