go ahead... be a heretic | |
PerlMonks |
1: ### UPDATES ### 2: # 3: # 4-3-2002: per petral's feedback, "use define;" is back in 4: # 9-4-2004: updated to match CPAN version 5: # 6: 7: package define; 8: 9: use 5.008004; 10: use strict; 11: use warnings; 12: 13: our $VERSION = '1.02'; 14: 15: my %AllPkgs; 16: my %DefPkgs; 17: my %Vals; 18: 19: my %Forbidden = map { $_ => 1 } qw{ 20: BEGIN INIT CHECK END DESTROY AUTOLOAD 21: STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG 22: }; 23: 24: sub import { 25: my $class = shift; 26: my $pkg = (caller)[0]; 27: if( @_ ) { 28: if( ref $_[0] eq 'HASH' ) { 29: while( my( $name, $val ) = each %{$_[0]} ) { 30: do_import( $pkg, $name, $val ); 31: } 32: } 33: else { 34: do_import( $pkg, @_ ); 35: } 36: } 37: else { 38: require Carp; 39: Carp::croak "Must call 'use define' with parameters"; 40: } 41: } 42: 43: sub unimport { 44: my $class = shift; 45: my $pkg = (caller)[0]; 46: if( @_ ) { 47: check_name( my $name = shift ); 48: $DefPkgs{$name}{$pkg} = 1; 49: if( $Vals{$name} ) { 50: makedef( $pkg, $name, @{$Vals{$name}} ); 51: } 52: else { 53: makedef( $pkg, $name ); 54: } 55: } 56: else { 57: # export all Declared to pkg 58: $AllPkgs{$pkg} = 1; 59: while( my( $name, $val ) = each %Vals ) { 60: # warn "Defining ALL $pkg:$name:$val"; 61: makedef( $pkg, $name, @$val ); 62: } 63: } 64: } 65: 66: sub check_name { 67: my $name = shift; 68: if( $name =~ /^__/ 69: or $name !~ /^_?[^\W_0-9]\w*\z/ 70: or $Forbidden{$name} ) { 71: require Carp; 72: Carp::croak "Define name '$name' is invalid"; 73: } 74: } 75: 76: sub do_import { 77: my( $pkg, $name, @vals ) = @_; 78: check_name( $name ); 79: $DefPkgs{$name}{$pkg} = 1; 80: $Vals{$name} = [ @vals ]; 81: my %pkgs = ( $pkg => 1, %AllPkgs, %{$DefPkgs{$name}} ); 82: for (keys %pkgs) { 83: makedef( $_, $name, @vals ); 84: } 85: } 86: 87: sub makedef { 88: my ($pkg, $name, @Vals) = @_; 89: my $subname = "${pkg}::$name"; 90: 91: no strict 'refs'; 92: 93: if (defined *{$subname}{CODE}) { 94: require Carp; 95: Carp::carp "Global constant $subname redefined"; 96: } 97: 98: if (@Vals > 1) { 99: *$subname = sub () { @Vals }; 100: } 101: elsif (@Vals == 1) { 102: my $val = $Vals[0]; 103: *$subname = sub () { $val }; 104: } 105: else { 106: *$subname = sub () { }; 107: } 108: } 109: 110: 1; 111: 112: __END__ 113: 114: =head1 NAME 115: 116: define - Perl pragma to declare global constants 117: 118: =head1 SYNOPSIS 119: 120: #--- in package/file main ---# 121: package main; 122: 123: # the most frequenly used application of this pragma 124: use define DEBUG => 0; 125: 126: # define a constant list 127: use define DWARVES => qw(happy sneezy grumpy); 128: 129: # define several at a time via a hashref list, like constant.pm 130: use define { 131: FOO => 1, 132: BAR => 2, 133: BAZ => 3, 134: }; 135: 136: use Some::Module; 137: use My::Module; 138: 139: #--- in package/file Some::Module ---# 140: package Some::Module 141: no define DEBUG =>; 142: no define DWARVES =>; 143: 144: # define a master object that any package can import 145: sub new { ... } 146: use define OBJECT => __PACKAGE__->new; 147: 148: # if DEBUG is false, the following statement isn't even compiled 149: warn "debugging stuff here" if DEBUG; 150: 151: my $title = "Snow white and the " . scalar DWARVES . " dwarves"; 152: 153: #--- in package/file My::Module ---# 154: package My::Module 155: no define; 156: 157: warn "I prefer these dwarves: " join " ", DWARVES if DEBUG; 158: OBJECT->method(DWARVES); 159: 160: =head1 DESCRIPTION 161: 162: Use this pragma to define global constants. 163: 164: =head1 USAGE 165: 166: =head2 Defining constants 167: 168: Global constants are defined through the same calling conventions 169: as C<constant.pm>: 170: 171: use define FOO => 3; 172: use define BAR => ( 1, 2, 3 ); 173: use define { 174: BAZ => 'dogs', 175: QUX => 'cats', 176: }; 177: 178: =head2 Importing constants by name 179: 180: To use a global constant, you import it into your package as follows: 181: 182: no define FOO =>; 183: 184: If FOO has been defined, it gets set to its defined value, otherwise it is set 185: to undef. Note that the reason for the '=>' operator here is to parse FOO as 186: a string literal rather than a bareword (you could also do C<no define 'FOO'>). 187: 188: =head2 Importing constants willy-nilly 189: 190: To import ALL defined constants into your package, you can do the following: 191: 192: no define; 193: 194: This is quick, but messy, as you can't predict what symbols may clash with 195: those in your package's namespace. 196: 197: =head1 NOTES 198: 199: See L<constant/"constant.pm">. Most of the same caveats apply here. 200: 201: Your code should be arranged so that any C<no define> statements are executed 202: after the C<use define> statement for a given symbol. If the order is reversed, 203: a warning will be emitted. 204: 205: As a rule, modules shouldn't be defining global constants; they should import 206: constants defined by the main body of your program. 207: 208: If a module does define a global constant (eg. a master object), the module 209: should be use'd before any other modules (or lines of code) that refer to the 210: constant. 211: 212: If you <use define> the same symbol more than once, a warning will be emitted. 213: 214: =head1 AUTHOR 215: 216: Gary Gurevich (garygurevich at gmail) 217: 218: =head1 COPYRIGHT AND LICENSE 219: 220: Copyright (C) 2004 by Gary Gurevich 221: 222: This library is free software; you can redistribute it and/or modify it under 223: the same terms as Perl itself. 224: 225: =head1 SEE ALSO 226: 227: constant(3), perl(1). 228: 229: =cut
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: define.pm - a new pragma to declare global constants
by rjray (Chaplain) on Apr 02, 2002 at 22:11 UTC | |
by MeowChow (Vicar) on Apr 02, 2002 at 22:16 UTC | |
by petral (Curate) on Apr 03, 2002 at 14:58 UTC | |
by MeowChow (Vicar) on Apr 03, 2002 at 18:51 UTC |