Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
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 rifling through the Monastery: (16)
As of 2014-09-18 17:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (120 votes), past polls