Constant-Generate-0.17/0000755000175000017500000000000012470377527015214 5ustar mnunbergmnunbergConstant-Generate-0.17/Makefile.PL0000644000175000017500000000227512470377406017170 0ustar mnunbergmnunberguse strict; use warnings; use ExtUtils::MakeMaker; my $mm_ver = $ExtUtils::MakeMaker::VERSION; if ($mm_ver =~ /_/) { # developer version? $mm_ver = eval $mm_ver; die $@ if $@; } WriteMakefile( NAME => 'Constant::Generate', AUTHOR => q{M. Nunberg }, VERSION_FROM => 'lib/Constant/Generate.pm', ABSTRACT_FROM => 'lib/Constant/Generate.pm', ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE'=> 'perl') : ()), PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, 'constant' => 1.17, 'Scalar::Util' => 1.20 }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Constant-Generate-*' }, ($mm_ver <= 6.45 ? () : (META_MERGE => { 'meta-spec' => { version => 2 }, resources => { repository => { type => 'git', web => 'https://github.com/mnunberg/Constant-Generate', url => 'https://github.com/mnunberg/Constant-Generate.git', }, }, }) ), ); Constant-Generate-0.17/lib/0000755000175000017500000000000012470377527015762 5ustar mnunbergmnunbergConstant-Generate-0.17/lib/Constant/0000755000175000017500000000000012470377527017553 5ustar mnunbergmnunbergConstant-Generate-0.17/lib/Constant/Generate/0000755000175000017500000000000012470377527021305 5ustar mnunbergmnunbergConstant-Generate-0.17/lib/Constant/Generate/Dualvar.pm0000644000175000017500000000255611707461510023235 0ustar mnunbergmnunbergpackage Constant::Generate::Dualvar::_Overloaded; use constant { FLD_INT => 0, FLD_STR => 1 }; #Stolen from: #http://perldoc.perl.org/overload.html sub new { my $p = shift; bless [@_], $p } use overload '""' => \&str, '0+' => \&num, fallback => 1; sub num {shift->[0]} sub str {shift->[1]} BEGIN { $INC{'Constant/Generate/Dualvar/_Overloaded.pm'} = 1; } package Constant::Generate::Dualvar; use strict; use warnings; use Scalar::Util; use base qw(Exporter); our @EXPORT_OK = qw(CG_dualvar); our $USE_SCALAR_UTIL; sub CG_dualvar($$); BEGIN { $USE_SCALAR_UTIL = eval 'use List::Util::XS 1.20; $List::Util::XS::VERSION;'; if($USE_SCALAR_UTIL) { *CG_dualvar = \&Scalar::Util::dualvar; } else { require Constant::Generate::Stringified::_Overloaded; warn "Scalar::Util::XS not available. Falling back to using overload"; *CG_dualvar = sub($$) { my ($num,$string) = @_; return Constant::Generate::Stringified::_Overloaded->new( $num,$string); } } } sub import { my ($cls,$symspec,%options) = @_; if($symspec) { #We're being imported as user.. require 'Constant/Generate.pm'; $options{dualvar} = 1; @_ = ('Constant::Generate', $symspec, %options); goto &Constant::Generate::import; } else { goto &Exporter::import; } }Constant-Generate-0.17/lib/Constant/Generate/Stringified.pm0000644000175000017500000000022011707461671024100 0ustar mnunbergmnunbergpackage Constant::Generate::Stringified; require Constant::Generate::Dualvar; sub import { goto &Constant::Generate::Dualvar::import; } 1;Constant-Generate-0.17/lib/Constant/Generate.pm0000644000175000017500000004071012470377406021641 0ustar mnunbergmnunbergpackage Constant::Generate; use strict; use warnings; our $VERSION = '0.17'; use Data::Dumper; use Carp qw(confess); use Constant::Generate::Dualvar; use Scalar::Util qw(looks_like_number); #these two functions produce reverse mapping, one for simple constants, and #one for bitfields use constant { CONST_BITFLAG => 1, CONST_SIMPLE => 2, CONST_STRING => 3 }; sub _gen_bitfield_fn { no strict "refs"; my ($name,$rhash) = @_; *{$name} = sub($) { my $flag = $_[0]; join("|", @{$rhash}{( grep($flag & $_, keys %$rhash) )} ); }; } sub _gen_int_fn { no strict 'refs'; my ($name,$rhash) = @_; *{$name} = sub ($) { $rhash->{$_[0] + 0} || "" }; } sub _gen_str_fn { no strict 'refs'; my ($name,$rhash) = @_; *{$name} = sub ($) { $rhash->{ $_[0] } || "" }; } sub _gen_integer_syms { my ($uarr, $symhash, $start) = @_; foreach my $sym (@$uarr) { $symhash->{$sym} = $start; $start++; } } sub _gen_bitflag_syms { my ($uarr,$symhash,$start) = @_; foreach my $sym (@$uarr) { $symhash->{$sym} = 1 << $start; $start++; } } sub _gen_string_syms { my ($uarr,$symhash,$prefix) = @_; foreach my $sym (@$uarr) { $symhash->{$sym} = $sym; } } sub _gen_constant { my ($pkg,$name,@values) = @_; no strict 'refs'; my $fqname = $pkg . "::$name"; if(@values == 1) { my $value = $values[0]; *{$fqname} = sub () { $value }; } else { *{$fqname} = sub () { @values }; } } sub _gen_map_rhash { my ($symhash, $prefix, $display_prefix) = @_; my (%maphash,%rhash); if($prefix && $display_prefix) { while (my ($sym,$val) = each %$symhash) { $maphash{$prefix.$sym} = $val; } } else { %maphash = %$symhash; } #Check for duplicate constants pointing to the same value while (my ($sym,$val) = each %maphash) { push @{$rhash{$val}}, $sym; } while (my ($val,$syms) = each %rhash) { if(@$syms > 1) { $rhash{$val} = sprintf("(%s)", join(",", @$syms)); } else { $rhash{$val} = $syms->[0]; } } return \%rhash; } sub _mangle_exporter { my ($pkg, $symlist, $tag, $uspec_export, $uspec_export_ok, $uspec_export_tags) = @_; my @emap = ( [$uspec_export, \my $my_export, 'EXPORT', 'ARRAY'], [$uspec_export_ok, \my $my_export_ok, 'EXPORT_OK', 'ARRAY'], [$uspec_export_tags, \my $my_export_tags, 'EXPORT_TAGS', 'HASH', \$tag] ); foreach (@emap) { my ($uspec,$myspec,$pvar,$vtype,$depvar) = @$_; if(!$uspec) { next; } if (defined $depvar && !$$depvar) { next; } if(ref $uspec) { $$myspec = $uspec; } else { no strict 'refs'; if(!defined ($$myspec = *{$pkg."::$pvar"}{$vtype})) { confess "Requested mangling of $pvar, but $pvar not yet declared!"; } } } if($uspec_export_ok) { push @$my_export_ok, @$symlist; } if($uspec_export) { push @$my_export, @$symlist; } if($uspec_export_tags) { $my_export_tags->{$tag} = [ @$symlist ]; } #Verify the required variables } my $FN_CONST_TBL = { CONST_BITFLAG, \&_gen_bitflag_syms, CONST_SIMPLE, \&_gen_integer_syms, CONST_STRING, \&_gen_string_syms }; my $FN_RMAP_TBL = { CONST_BITFLAG, \&_gen_bitfield_fn, CONST_SIMPLE, \&_gen_int_fn, CONST_STRING, \&_gen_str_fn, }; sub utype2const { my $utype = shift; if(!$utype || $utype =~ /int/i) { return CONST_SIMPLE; } elsif ($utype =~ /bit/i) { return CONST_BITFLAG; } elsif ($utype =~ /str/i) { return CONST_STRING; } else { die "Unrecognized type '$utype'"; } } sub _getopt(\%$) { my ($h,$opt) = @_; foreach ($opt,"-$opt") { return delete $h->{$_} if exists $h->{$_} } } sub import { my ($cls,$symspecs,%opts) = @_; return 1 unless $symspecs; my $reqpkg = caller(); my $type = utype2const(_getopt(%opts, "type")); #Determine our tag for %EXPORT_TAGS and reverse mapping my $mapname = _getopt(%opts, "mapname"); my $export_tag = _getopt(%opts, "tag"); my $prefix = _getopt(%opts, "prefix") || ""; my $display_prefix = _getopt(%opts, "show_prefix"); my $start = _getopt(%opts, "start_at") || 0; my $stringy = _getopt(%opts, "stringy_vars") || _getopt(%opts, "dualvar"); my $listname = _getopt(%opts, "allvalues"); my $symsname = _getopt(%opts, "allsyms"); if((!$mapname) && $export_tag) { $mapname = $export_tag . "_to_str"; } #Generate the values. my %symhash; #Initial value ref $symspecs eq 'HASH' ? %symhash = %$symspecs : $FN_CONST_TBL->{$type}->($symspecs, \%symhash, $start); #tie it all together while (my ($symname,$symval) = each %symhash) { if($stringy && looks_like_number($symval)) { my $dv_name = $display_prefix ? $prefix . $symname : $symname; $symval = Constant::Generate::Dualvar::CG_dualvar( $symval, $dv_name); } _gen_constant($reqpkg, $prefix.$symname, $symval); } #After we have determined values for all the symbols, we can establish our #reverse mappings, if so requested if($mapname) { my $rhash = _gen_map_rhash(\%symhash, $prefix, $display_prefix); $FN_RMAP_TBL->{$type}->($reqpkg."::$mapname", $rhash); } if($prefix) { foreach my $usym (keys %symhash) { my $v = delete $symhash{$usym}; $symhash{$prefix.$usym} = $v; } } my $auto_export = _getopt(%opts, "export"); my $auto_export_ok = _getopt(%opts, "export_ok"); my $h_etags = _getopt(%opts, "export_tags"); my @symlist = keys %symhash; if($listname) { my %tmp = reverse %symhash; _gen_constant($reqpkg, $listname, keys %tmp); push @symlist, $listname; } if($symsname) { _gen_constant($reqpkg, $symsname, keys %symhash); push @symlist, $symsname; } push @symlist, $mapname if $mapname; _mangle_exporter($reqpkg, \@symlist, $export_tag, $auto_export, $auto_export_ok, $h_etags || $export_tag); if(%opts) { die "Unknown keys " . join(",", keys %opts); } } __END__ =head1 NAME Constant::Generate - Common tasks for symbolic constants =head2 SYNOPSIS Simplest use use Constant::Generate [ qw(CONST_FOO CONST_BAR) ]; printf( "FOO=%d, BAR=%d\n", CONST_FOO, CONST_BAR ); Bitflags: use Constant::Generate [qw(ANNOYING STRONG LAZY)], type => 'bits'; my $state = (ANNOYING|LAZY); $state & STRONG == 0; With reverse mapping: use Constant::Generate [qw(CLIENT_IRSSI CLIENT_XCHAT CLIENT_PURPLE)], type => "bits", mapname => "client_type_to_str"; my $client_type = CLIENT_IRSSI | CLIENT_PURPLE; print client_type_to_str($client_type); #prints 'CLIENT_IRSSI|CLIENT_PURPLE'; Generate reverse maps, but do not generate values. also, push to exporter #Must define @EXPORT_OK and tags beforehand our @EXPORT_OK; our %EXPORT_TAGS; use Constant::Generate { O_RDONLY => 00, O_WRONLY => 01, O_RDWR => 02, O_CREAT => 0100 }, tag => "openflags", type => 'bits'; my $oflags = O_RDWR|O_CREAT; print openflags_to_str($oflags); #prints 'O_RDWR|O_CREAT'; DWIM Constants use Constant::Generate { RDONLY => 00, WRONLY => 01, RDWR => 02, CREAT => 0100 }, prefix => 'O_', dualvar => 1; my $oflags = O_RDWR|O_CREAT; O_RDWR eq 'RDWR'; Export to other packages package My::Constants BEGIN { $INC{'My/Constants.pm} = 1; } use base qw(Exporter); our (@EXPORT_OK,@EXPORT,%EXPORT_TAGS); use Constant::Generate [qw(FOO BAR BAZ)], tag => "my_constants", export_ok => 1; package My::User; use My::Constants qw(:my_constants); FOO == 0 && BAR == 1 && BAZ == 2 && my_constants_to_str(FOO eq 'FOO') && my_constants_to_str(BAR eq 'BAR') && my_constants_to_str(BAZ eq 'BAZ'); =head2 DESCRIPTION C provides useful utilities for handling, debugging, and generating opaque, 'magic-cookie' type constants as well as value-significant constants. Using its simplest interface, it will generate a simple enumeration of names passed to it on import. Read import options to use. =head2 USAGE All options and configuration for this module are specified at import time. The canonical usage of this module is use Constant::Generate $symspec, %options; =head3 Symbol Specifications This is passed as the first argument to C and can exist as a reference to either a hash or an array. In the case of an array reference, the array will just contain symbol names whose values will be automatically assigned in order, with the first symbol being C<0> and each subsequent symbol incrementing on the value of the previous. The default starting value can be modified using the C option (see L). If the symbol specification is a hashref, then keys are symbol names and values are the symbol values, similar to what L uses. By default, symbols are assumed to correlate to a single independent integer value, and any reverse mapping performed will only ever map a symbol value to a single symbol name. For bitflags, it is possible to specify C 'bits'> in the L which will modify the auto-generation of the constants as well as provide suitable output for reverse mapping functions. =head3 Basic Options The second argument to the import function is a hash of options. All options may be prefixed by a dash (C<-option>) or in their 'bare' form (C