|
0
|
1 package enum;
|
|
|
2 use strict;
|
|
|
3 no strict 'refs'; # Let's just make this very clear right off
|
|
|
4
|
|
|
5 use Carp;
|
|
|
6 use vars qw($VERSION);
|
|
|
7 $VERSION = do { my @r = (q$Revision: 1.16 $ =~ /\d+/g); sprintf '%d.%03d'.'%02d' x ($#r-1), @r};
|
|
|
8
|
|
|
9 my $Ident = '[^\W_0-9]\w*';
|
|
|
10
|
|
|
11 sub ENUM () { 1 }
|
|
|
12 sub BITMASK () { 2 }
|
|
|
13
|
|
|
14 sub import {
|
|
|
15 my $class = shift;
|
|
|
16 @_ or return; # Ignore 'use enum;'
|
|
|
17 my $pkg = caller() . '::';
|
|
|
18 my $prefix = ''; # default no prefix
|
|
|
19 my $index = 0; # default start index
|
|
|
20 my $mode = ENUM; # default to enum
|
|
|
21
|
|
|
22 ## Pragmas should be as fast as they can be, so we inline some
|
|
|
23 ## pieces.
|
|
|
24 foreach (@_) {
|
|
|
25 ## Plain tag is most common case
|
|
|
26 if (/^$Ident$/o) {
|
|
|
27 my $n = $index;
|
|
|
28
|
|
|
29 if ($mode == ENUM) {
|
|
|
30 $index++;
|
|
|
31 }
|
|
|
32 elsif ($mode == BITMASK) {
|
|
|
33 $index ||= 1;
|
|
|
34 $index *= 2;
|
|
|
35 if ( $index & ($index - 1) ) {
|
|
|
36 croak (
|
|
|
37 "$index is not a valid single bitmask "
|
|
|
38 . " (Maybe you overflowed your system's max int value?)"
|
|
|
39 );
|
|
|
40 }
|
|
|
41 }
|
|
|
42 else {
|
|
|
43 confess qq(Can't Happen: mode $mode invalid);
|
|
|
44 }
|
|
|
45
|
|
|
46 *{"$pkg$prefix$_"} = sub () { $n };
|
|
|
47 }
|
|
|
48
|
|
|
49 ## Index change
|
|
|
50 elsif (/^($Ident)=(-?)(.+)$/o) {
|
|
|
51 my $name= $1;
|
|
|
52 my $neg = $2;
|
|
|
53 $index = $3;
|
|
|
54
|
|
|
55 ## Convert non-decimal numerics to decimal
|
|
|
56 if ($index =~ /^0x[\da-f]+$/i) { ## Hex
|
|
|
57 $index = hex $index;
|
|
|
58 }
|
|
|
59 elsif ($index =~ /^0\d/) { ## Octal
|
|
|
60 $index = oct $index;
|
|
|
61 }
|
|
|
62 elsif ($index !~ /[^\d_]/) { ## 123_456 notation
|
|
|
63 $index =~ s/_//g;
|
|
|
64 }
|
|
|
65
|
|
|
66 ## Force numeric context, but only in numeric context
|
|
|
67 if ($index =~ /\D/) {
|
|
|
68 $index = "$neg$index";
|
|
|
69 }
|
|
|
70 else {
|
|
|
71 $index = "$neg$index";
|
|
|
72 $index += 0;
|
|
|
73 }
|
|
|
74
|
|
|
75 my $n = $index;
|
|
|
76
|
|
|
77 if ($mode == BITMASK) {
|
|
|
78 ($index & ($index - 1))
|
|
|
79 and croak "$index is not a valid single bitmask";
|
|
|
80 $index *= 2;
|
|
|
81 }
|
|
|
82 elsif ($mode == ENUM) {
|
|
|
83 $index++;
|
|
|
84 }
|
|
|
85 else {
|
|
|
86 confess qq(Can't Happen: mode $mode invalid);
|
|
|
87 }
|
|
|
88
|
|
|
89 *{"$pkg$prefix$name"} = sub () { $n };
|
|
|
90 }
|
|
|
91
|
|
|
92 ## Prefix/option change
|
|
|
93 elsif (/^([A-Z]*):($Ident)?(=?)(-?)(.*)/) {
|
|
|
94 ## Option change
|
|
|
95 if ($1) {
|
|
|
96 if ($1 eq 'ENUM') { $mode = ENUM; $index = 0 }
|
|
|
97 elsif ($1 eq 'BITMASK') { $mode = BITMASK; $index = 1 }
|
|
|
98 else { croak qq(Invalid enum option '$1') }
|
|
|
99 }
|
|
|
100
|
|
|
101 my $neg = $4;
|
|
|
102
|
|
|
103 ## Index change too?
|
|
|
104 if ($3) {
|
|
|
105 if (length $5) {
|
|
|
106 $index = $5;
|
|
|
107
|
|
|
108 ## Convert non-decimal numerics to decimal
|
|
|
109 if ($index =~ /^0x[\da-f]+$/i) { ## Hex
|
|
|
110 $index = hex $index;
|
|
|
111 }
|
|
|
112 elsif ($index =~ /^0\d/) { ## Oct
|
|
|
113 $index = oct $index;
|
|
|
114 }
|
|
|
115 elsif ($index !~ /[^\d_]/) { ## 123_456 notation
|
|
|
116 $index =~ s/_//g;
|
|
|
117 }
|
|
|
118
|
|
|
119 ## Force numeric context, but only in numeric context
|
|
|
120 if ($index =~ /\D/) {
|
|
|
121 $index = "$neg$index";
|
|
|
122 }
|
|
|
123 else {
|
|
|
124 $index = "$neg$index";
|
|
|
125 $index += 0;
|
|
|
126 }
|
|
|
127
|
|
|
128 ## Bitmask mode must check index changes
|
|
|
129 if ($mode == BITMASK) {
|
|
|
130 ($index & ($index - 1))
|
|
|
131 and croak "$index is not a valid single bitmask";
|
|
|
132 }
|
|
|
133 }
|
|
|
134 else {
|
|
|
135 croak qq(No index value defined after "=");
|
|
|
136 }
|
|
|
137 }
|
|
|
138
|
|
|
139 ## Incase it's a null prefix
|
|
|
140 $prefix = defined $2 ? $2 : '';
|
|
|
141 }
|
|
|
142
|
|
|
143 ## A..Z case magic lists
|
|
|
144 elsif (/^($Ident)\.\.($Ident)$/o) {
|
|
|
145 ## Almost never used, so check last
|
|
|
146 foreach my $name ("$1" .. "$2") {
|
|
|
147 my $n = $index;
|
|
|
148
|
|
|
149 if ($mode == BITMASK) {
|
|
|
150 ($index & ($index - 1))
|
|
|
151 and croak "$index is not a valid single bitmask";
|
|
|
152 $index *= 2;
|
|
|
153 }
|
|
|
154 elsif ($mode == ENUM) {
|
|
|
155 $index++;
|
|
|
156 }
|
|
|
157 else {
|
|
|
158 confess qq(Can't Happen: mode $mode invalid);
|
|
|
159 }
|
|
|
160
|
|
|
161 *{"$pkg$prefix$name"} = sub () { $n };
|
|
|
162 }
|
|
|
163 }
|
|
|
164
|
|
|
165 else {
|
|
|
166 croak qq(Can't define "$_" as enum type (name contains invalid characters));
|
|
|
167 }
|
|
|
168 }
|
|
|
169 }
|
|
|
170
|
|
|
171 1;
|
|
|
172
|
|
|
173 __END__
|
|
|
174
|
|
|
175
|
|
|
176 =head1 NAME
|
|
|
177
|
|
|
178 enum - C style enumerated types and bitmask flags in Perl
|
|
|
179
|
|
|
180 =head1 SYNOPSIS
|
|
|
181
|
|
|
182 use enum qw(Sun Mon Tue Wed Thu Fri Sat);
|
|
|
183 # Sun == 0, Mon == 1, etc
|
|
|
184
|
|
|
185 use enum qw(Forty=40 FortyOne Five=5 Six Seven);
|
|
|
186 # Yes, you can change the start indexs at any time as in C
|
|
|
187
|
|
|
188 use enum qw(:Prefix_ One Two Three);
|
|
|
189 ## Creates Prefix_One, Prefix_Two, Prefix_Three
|
|
|
190
|
|
|
191 use enum qw(:Letters_ A..Z);
|
|
|
192 ## Creates Letters_A, Letters_B, Letters_C, ...
|
|
|
193
|
|
|
194 use enum qw(
|
|
|
195 :Months_=0 Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
|
|
|
196 :Days_=0 Sun Mon Tue Wed Thu Fri Sat
|
|
|
197 :Letters_=20 A..Z
|
|
|
198 );
|
|
|
199 ## Prefixes can be changed mid list and can have index changes too
|
|
|
200
|
|
|
201 use enum qw(BITMASK:LOCK_ SH EX NB UN);
|
|
|
202 ## Creates bitmask constants for LOCK_SH == 1, LOCK_EX == 2,
|
|
|
203 ## LOCK_NB == 4, and LOCK_UN == 8.
|
|
|
204 ## NOTE: This example is only valid on FreeBSD-2.2.5 however, so don't
|
|
|
205 ## actually do this. Import from Fnctl instead.
|
|
|
206
|
|
|
207 =head1 DESCRIPTION
|
|
|
208
|
|
|
209 Defines a set of symbolic constants with ordered numeric values ala B<C> B<enum> types.
|
|
|
210
|
|
|
211 Now capable of creating creating ordered bitmask constants as well. See the B<BITMASKS>
|
|
|
212 section for details.
|
|
|
213
|
|
|
214 What are they good for? Typical uses would be for giving mnemonic names to indexes of
|
|
|
215 arrays. Such arrays might be a list of months, days, or a return value index from
|
|
|
216 a function such as localtime():
|
|
|
217
|
|
|
218 use enum qw(
|
|
|
219 :Months_=0 Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
|
|
|
220 :Days_=0 Sun Mon Tue Wed Thu Fri Sat
|
|
|
221 :LC_=0 Sec Min Hour MDay Mon Year WDay YDay Isdst
|
|
|
222 );
|
|
|
223
|
|
|
224 if ((localtime)[LC_Mon] == Months_Jan) {
|
|
|
225 print "It's January!\n";
|
|
|
226 }
|
|
|
227 if ((localtime)[LC_WDay] == Days_Fri) {
|
|
|
228 print "It's Friday!\n";
|
|
|
229 }
|
|
|
230
|
|
|
231 This not only reads easier, but can also be typo-checked at compile time when
|
|
|
232 run under B<use strict>. That is, if you misspell B<Days_Fri> as B<Days_Fry>,
|
|
|
233 you'll generate a compile error.
|
|
|
234
|
|
|
235 =head1 BITMASKS, bitwise operations, and bitmask option values
|
|
|
236
|
|
|
237 The B<BITMASK> option allows the easy creation of bitmask constants such as
|
|
|
238 functions like flock() and sysopen() use. These are also very useful for your
|
|
|
239 own code as they allow you to efficiently store many true/false options within
|
|
|
240 a single integer.
|
|
|
241
|
|
|
242 use enum qw(BITMASK: MY_ FOO BAR CAT DOG);
|
|
|
243
|
|
|
244 my $foo = 0;
|
|
|
245 $foo |= MY_FOO;
|
|
|
246 $foo |= MY_DOG;
|
|
|
247
|
|
|
248 if ($foo & MY_DOG) {
|
|
|
249 print "foo has the MY_DOG option set\n";
|
|
|
250 }
|
|
|
251 if ($foo & (MY_BAR | MY_DOG)) {
|
|
|
252 print "foo has either the MY_BAR or MY_DOG option set\n"
|
|
|
253 }
|
|
|
254
|
|
|
255 $foo ^= MY_DOG; ## Turn MY_DOG option off (set its bit to false)
|
|
|
256
|
|
|
257 When using bitmasks, remember that you must use the bitwise operators, B<|>, B<&>, B<^>,
|
|
|
258 and B<~>. If you try to do an operation like C<$foo += MY_DOG;> and the B<MY_DOG> bit
|
|
|
259 has already been set, you'll end up setting other bits you probably didn't want to set.
|
|
|
260 You'll find the documentation for these operators in the B<perlop> manpage.
|
|
|
261
|
|
|
262 You can set a starting index for bitmasks just as you can for normal B<enum> values,
|
|
|
263 but if the given index isn't a power of 2 it won't resolve to a single bit and therefor
|
|
|
264 will generate a compile error. Because of this, whenever you set the B<BITFIELD:>
|
|
|
265 directive, the index is automatically set to 1. If you wish to go back to normal B<enum>
|
|
|
266 mode, use the B<ENUM:> directive. Similarly to the B<BITFIELD> directive, the B<ENUM:>
|
|
|
267 directive resets the index to 0. Here's an example:
|
|
|
268
|
|
|
269 use enum qw(
|
|
|
270 BITMASK:BITS_ FOO BAR CAT DOG
|
|
|
271 ENUM: FALSE TRUE
|
|
|
272 ENUM: NO YES
|
|
|
273 BITMASK: ONE TWO FOUR EIGHT SIX_TEEN
|
|
|
274 );
|
|
|
275
|
|
|
276 In this case, B<BITS_FOO, BITS_BAR, BITS_CAT, and BITS_DOG> equal 1, 2, 4 and
|
|
|
277 8 respectively. B<FALSE and TRUE> equal 0 and 1. B<NO and YES> also equal
|
|
|
278 0 and 1. And B<ONE, TWO, FOUR, EIGHT, and SIX_TEEN> equal, you guessed it, 1,
|
|
|
279 2, 4, 8, and 16.
|
|
|
280
|
|
|
281 =head1 BUGS
|
|
|
282
|
|
|
283 Enum names can not be the same as method, function, or constant names. This
|
|
|
284 is probably a Good Thing[tm].
|
|
|
285
|
|
|
286 No way (that I know of) to cause compile time errors when one of these enum names get
|
|
|
287 redefined. IMHO, there is absolutely no time when redefining a sub is a Good Thing[tm],
|
|
|
288 and should be taken out of the language, or at least have a pragma that can cause it
|
|
|
289 to be a compile time error.
|
|
|
290
|
|
|
291 Enumerated types are package scoped just like constants, not block scoped as some
|
|
|
292 other pragma modules are.
|
|
|
293
|
|
|
294 It supports A..Z nonsense. Can anyone give me a Real World[tm] reason why anyone would
|
|
|
295 ever use this feature...?
|
|
|
296
|
|
|
297 =head1 HISTORY
|
|
|
298
|
|
|
299 $Log: enum.pm,v $
|
|
|
300 Revision 1.16 1999/05/27 16:00:35 byron
|
|
|
301
|
|
|
302
|
|
|
303 Fixed bug that caused bitwise operators to treat enum types as strings
|
|
|
304 instead of numbers.
|
|
|
305
|
|
|
306 Revision 1.15 1999/05/27 15:51:27 byron
|
|
|
307
|
|
|
308
|
|
|
309 Add support for negative values.
|
|
|
310
|
|
|
311 Added stricter hex value checks.
|
|
|
312
|
|
|
313 Revision 1.14 1999/05/13 15:58:18 byron
|
|
|
314
|
|
|
315
|
|
|
316 Fixed bug in hex index code that broke on 0xA.
|
|
|
317
|
|
|
318 Revision 1.13 1999/05/13 10:52:30 byron
|
|
|
319
|
|
|
320
|
|
|
321 Fixed auto-index bugs in new non-decimal numeric support.
|
|
|
322
|
|
|
323 Revision 1.12 1999/05/13 10:00:45 byron
|
|
|
324
|
|
|
325
|
|
|
326 Added support for non-decimal numeric representations ala 0x123, 0644, and
|
|
|
327 123_456.
|
|
|
328
|
|
|
329 First version committed to CVS.
|
|
|
330
|
|
|
331
|
|
|
332 Revision 1.11 1998/07/18 17:53:05 byron
|
|
|
333 -Added BITMASK and ENUM directives.
|
|
|
334 -Revamped documentation.
|
|
|
335
|
|
|
336 Revision 1.10 1998/06/12 20:12:50 byron
|
|
|
337 -Removed test code
|
|
|
338 -Released to CPAN
|
|
|
339
|
|
|
340 Revision 1.9 1998/06/12 00:21:00 byron
|
|
|
341 -Fixed -w warning when a null tag is used
|
|
|
342
|
|
|
343 Revision 1.8 1998/06/11 23:04:53 byron
|
|
|
344 -Fixed documentation bugs
|
|
|
345 -Moved A..Z case to last as it's not going to be used
|
|
|
346 as much as the other cases.
|
|
|
347
|
|
|
348 Revision 1.7 1998/06/10 12:25:04 byron
|
|
|
349 -Changed interface to match original design by Tom Phoenix
|
|
|
350 as implemented in an early version of enum.pm by Benjamin Holzman.
|
|
|
351 -Changed tag syntax to not require the 'PREFIX' string of Tom's
|
|
|
352 interface.
|
|
|
353 -Allow multiple prefix tags to be used at any point.
|
|
|
354 -Allowed index value changes from tags.
|
|
|
355
|
|
|
356 Revision 1.6 1998/06/10 03:37:57 byron
|
|
|
357 -Fixed superfulous -w warning
|
|
|
358
|
|
|
359 Revision 1.4 1998/06/10 01:07:03 byron
|
|
|
360 -Changed behaver to closer resemble C enum types
|
|
|
361 -Changed docs to match new behaver
|
|
|
362
|
|
|
363 =head1 AUTHOR
|
|
|
364
|
|
|
365 Zenin <zenin@archive.rhps.org>
|
|
|
366
|
|
|
367 aka Byron Brummer <byron@omix.com>.
|
|
|
368
|
|
|
369 Based off of the B<constant> module by Tom Phoenix.
|
|
|
370
|
|
|
371 Original implementation of an interface of Tom Phoenix's
|
|
|
372 design by Benjamin Holzman, for which we borrow the basic
|
|
|
373 parse algorithm layout.
|
|
|
374
|
|
|
375 =head1 COPYRIGHT
|
|
|
376
|
|
|
377 Copyright 1998 (c) Byron Brummer.
|
|
|
378 Copyright 1998 (c) OMIX, Inc.
|
|
|
379
|
|
|
380 Permission to use, modify, and redistribute this module granted under
|
|
|
381 the same terms as B<Perl>.
|
|
|
382
|
|
|
383 =head1 SEE ALSO
|
|
|
384
|
|
|
385 constant(3), perl(1).
|
|
|
386
|
|
|
387 =cut
|
