Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Capture and Resolve Constants to Names

by chromatic (Archbishop)
on Oct 08, 2001 at 01:42 UTC ( #117349=perlcraft: print w/ replies, xml ) Need Help??

   1: # UPDATE: 
   2: #  this is currently available as Devel::Constants on CPAN
   3: #  but the name may change.  suggestions welcome.
   4: #
   5: # this is in response to node #117146, of course
   6: 
   7: package constant::flags;
   8: 
   9: use strict;
  10: use vars qw( $VERSION );
  11: 
  12: $VERSION = '0.10';
  13: 
  14: use constant;
  15: use subs ('oldimport');
  16: 
  17: {
  18: 	local $^W = 0;
  19: 	*oldimport = \&constant::import;
  20: 	*constant::import = \&newimport;
  21: }
  22: 
  23: 
  24: my %flags;
  25: 
  26: sub import {
  27: 	my $class = shift;
  28: 
  29: 	my $to_names;
  30: 	my $pkg = caller();
  31: 	my $flagholder = {};
  32: 
  33: 	while (my $arg = shift) {
  34: 		if (ref($arg) eq 'HASH') {
  35: 			$flagholder = $arg;
  36: 
  37: 		} elsif ($arg eq 'to_names') {
  38: 			$to_names = shift || 'to_names';
  39: 		} elsif ($arg eq 'package') {
  40: 			$pkg = shift if @_;
  41: 		}
  42: 	}
  43: 
  44: 	$flags{$pkg} = $flagholder;
  45: 
  46: 	if ($to_names) {
  47: 		no strict 'refs';
  48: 		*{ $pkg . "::$to_names" } = \&to_names;
  49: 	}
  50: }
  51: 
  52: sub newimport {
  53: 	my ($class, @args) = @_;
  54: 	my $pkg = caller();
  55: 
  56: 	if (defined $flags{$pkg}) {
  57: 		while (@args) {
  58: 			my ($name, $val) = splice(@args, 0, 2);
  59: 			last unless $val;
  60: 			$flags{$pkg}{$val} = $name;
  61: 		}
  62: 	}
  63: 
  64: 	goto &oldimport;
  65: }
  66: 
  67: sub to_names {
  68: 	my ($val, $pkg) = @_;
  69: 	$pkg ||= caller(); 
  70: 	
  71: 	my $flags = $flags{$pkg} or return;
  72: 
  73: 	my @flags;
  74: 	foreach my $flag (keys %$flags) {
  75: 		push @flags, $flags->{$flag} if $val & $flag;
  76: 	}
  77: 	return wantarray() ? @flags : join(' ', @flags);
  78: }
  79: 
  80: 1;
  81: __END__
  82: 
  83: =head1 NAME
  84: 
  85: constant::flags - Perl module to translate constants back to their named symbols
  86: 
  87: =head1 SYNOPSIS
  88: 
  89: 	# must precede use constant
  90: 	use constant::flags;
  91: 
  92: 	use constant A => 1;
  93: 	use constant B => 2;
  94: 	use constant C => 4;
  95: 
  96: 	my $flag = A | B;
  97: 	print "Flag is: ", join(' and ', to_names($flag) ), "\n";
  98: 
  99: =head1 DESCRIPTION
 100: 
 101: Declaring constants is very convenient for writing programs, but as they're
 102: often inlined by Perl, retrieving their symbolic names can be tricky.  This is
 103: made worse with lowlevel modules that use constants for bit-twiddling.
 104: 
 105: constant::flags makes this much more manageable.
 106: 
 107: It silently wraps around the L<constant> module, intercepting all constant
 108: declarations.  It builds a hash, associating the values to their names.  The
 109: names can then be retrieved as necessary.
 110: 
 111: Note that constant::flags B<must> be used B<before> L<constant> is, or the
 112: magic will not work and you will be very disappointed.  This is very important,
 113: and if you ignore this warning, the authors will feel free to laugh at you.  At
 114: least a little.
 115: 
 116: By default, constant::flags will only intercept constant declarations within
 117: the same package that used the module.  Also by default, it stores the
 118: constants for a package within a private (read, otherwise inaccessible)
 119: variable.  Both of these can be overridden.
 120: 
 121: By default, constant::flags exports one subroutine into the caller's namespace. 
 122: It is normally called C<to_names>.  This may change in future versions, and it
 123: may no longer be exported.  By passing the C<to_names> parameter to
 124: constant::flags, it is possible to change the name of this function:
 125: 
 126: 	use constant::flags to_names => 'resolve';
 127: 
 128: 	use constant FOO => 1;
 129: 	use constant BAR => 2;
 130: 
 131: 	print resolve(2);
 132: 
 133: Passing the C<package> flag to constant::flags with a valid package name will
 134: make the module intercept all constants subsequently declared within that
 135: package.  For example, in package main one might say:
 136: 
 137: 	use constant::flags package => NetPacket::TCP;
 138: 	use NetPacket::TCP;
 139: 
 140: All of the TCP flags declared within L<NetPacket::TCP> are now available.
 141: 
 142: It is also possible to pass in a hash reference where the constant values and
 143: names wil be stored:
 144: 
 145: 	my %constant_map;
 146: 	use constant::flags \%constant_map;
 147: 
 148: 	use constant NAME	=> 1;
 149: 	use constant RANK	=> 2;
 150: 	use constant SERIAL	=> 4;
 151: 
 152: 	print join(' ', values %constant_map), "\n";
 153: 
 154: =head2 EXPORT
 155: 
 156: C<to_names>, currently.  This may change in the future.  Note that L<constant>
 157: also exports, by design.
 158: 
 159: =head1 FUNCTIONS
 160: 
 161: =over 4
 162: 
 163: =item C<to_names($flag, [ $package ])>
 164: 
 165: This function resolves a flag into its component named bits.  This is generally
 166: only useful for flags known to be composed of named constants logically
 167: combined.  It can be very handy though.  The first parameter is required, and
 168: must be the flag to decompose.  It is not modified.  The second parameter is
 169: optional.  If provided, it will use flags set in another package.  In the
 170: L<NetPacket::TCP> example above, it could be used to find the symbolic names of
 171: TCP packets, such as SYN or RST set on a NetPacket::TCP object.
 172: 
 173: =back
 174: 
 175: =head1 HISTORY
 176: 
 177: =over 4
 178: 
 179: =item * 0.10 (7 October 2001)
 180: 
 181: Initial version.
 182: 
 183: =back
 184: 
 185: =head1 TODO
 186: 
 187: =over 4
 188: 
 189: =item * figure out a better way to handle C<to_names>
 190: 
 191: =item * allow potential capture lists?
 192: 
 193: =item * access only one constant at a time (more general than flags)
 194: 
 195: =item * sync up better with allowed constant names in C<constant>
 196: 
 197: =back
 198: 
 199: =head1 AUTHOR
 200: 
 201: chromatic <chromatic@wgz.org>, with thanks to "Benedict" at Perlmonks.org for
 202: the germ of the idea (L<http://perlmonks.org/index.pl?node_id=117146>).
 203: 
 204: Thanks also to Tim Potter and Stephanie Wehner for C<NetPacket::TCP>, though
 205: they don't know it yet.  :)
 206: 
 207: =head1 SEE ALSO
 208: 
 209: L<constant>
 210: 
 211: =cut

Comment on Capture and Resolve Constants to Names
Download Code
Re: Capture and Resolve Constants to Names
by NodeReaper (Curate) on Oct 12, 2001 at 05:11 UTC

    Reason: (davorg) oh, go away

    For more information on this node visit: this

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlcraft [id://117349]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (8)
As of 2014-07-30 11:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (230 votes), past polls