File Coverage

lib/Package/Constants.pm
Criterion Covered Total %
statement 29 29 100.0
branch 6 8 75.0
condition 3 3 100.0
subroutine 6 6 100.0
pod 1 1 100.0
total 45 47 95.7


line stmt bran cond sub pod time code
1             package Package::Constants;
2              
3 1     1   16675 use if $] >= 5.019006, 'deprecate';
  1         70  
  1         6  
4              
5 1     1   8577 use strict;
  1         7  
  1         51  
6 1     1   19 use vars qw[$VERSION $DEBUG];
  1         2  
  1         189  
7              
8             $VERSION = '0.04';
9             $DEBUG = 0;
10              
11             =head1 NAME
12              
13             Package::Constants - List all constants declared in a package
14              
15             =head1 SYNOPSIS
16              
17             use Package::Constants;
18              
19             ### list the names of all constants in a given package;
20             @const = Package::Constants->list( __PACKAGE__ );
21             @const = Package::Constants->list( 'main' );
22              
23             ### enable debugging output
24             $Package::Constants::DEBUG = 1;
25              
26             =head1 DESCRIPTION
27              
28             C lists all the constants defined in a certain
29             package. This can be useful for, among others, setting up an
30             autogenerated C<@EXPORT/@EXPORT_OK> for a Constants.pm file.
31              
32             =head1 CLASS METHODS
33              
34             =head2 @const = Package::Constants->list( PACKAGE_NAME );
35              
36             Lists the names of all the constants defined in the provided package.
37              
38             =cut
39              
40             sub list {
41 1     1 1 2334 my $class = shift;
42 1         2 my $pkg = shift;
43 1 50       6 return unless defined $pkg; # some joker might use '0' as a pkg...
44              
45 1         5 _debug("Inspecting package '$pkg'");
46              
47 1         2 my @rv;
48 1     1   6 { no strict 'refs';
  1         2  
  1         238  
  1         1  
49 1         3 my $stash = $pkg . '::';
50              
51 1         9 for my $name (sort keys %$stash ) {
52              
53 8         13 _debug( " Checking stash entry '$name'" );
54              
55             ### is it a subentry?
56 8         199 my $sub = $pkg->can( $name );
57 8 100       18 next unless defined $sub;
58              
59 5         11 _debug( " '$name' is a coderef" );
60              
61 5 100 100     39 next unless defined prototype($sub) and
62             not length prototype($sub);
63              
64 3         7 _debug( " '$name' is a constant" );
65 3         5 push @rv, $name;
66             }
67             }
68              
69 1         5 return sort @rv;
70             }
71              
72             =head1 GLOBAL VARIABLES
73              
74             =head2 $Package::Constants::DEBUG
75              
76             When set to true, prints out debug information to STDERR about the
77             package it is inspecting. Helps to identify issues when the results
78             are not as you expect.
79              
80             Defaults to false.
81              
82             =cut
83              
84 17 50   17   32 sub _debug { warn "@_\n" if $DEBUG; }
85              
86             1;
87              
88             =head1 BUG REPORTS
89              
90             Please report bugs or other issues to Ebug-package-constants@rt.cpan.org.
91              
92             =head1 AUTHOR
93              
94             This module by Jos Boumans Ekane@cpan.orgE.
95              
96             =head1 COPYRIGHT
97              
98             This library is free software; you may redistribute and/or modify it
99             under the same 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: