forked from schacon/perl
-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathConstants.pm
108 lines (70 loc) · 2.3 KB
/
Constants.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
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>[email protected]<gt>.
=head1 COPYRIGHT
This module is
copyright (c) 2004-2005 Jos Boumans E<lt>[email protected]<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: