Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

define.pm - a new pragma to declare global constants

by MeowChow (Vicar)
on Apr 02, 2002 at 20:33 UTC ( #156106=perlcraft: print w/ replies, xml ) Need Help??

   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

Comment on define.pm - a new pragma to declare global constants
Download Code
Re: define.pm - a new pragma to declare global constants
by rjray (Chaplain) on Apr 02, 2002 at 22:11 UTC

    In the first paragraph under DESCRIPTION, you say that there are three ways to call the pragma, but you only demonstrate two of them.

    --rjray

      Whoops, good catch. I had removed the third way, which was to simply call use define; with no arguments. This would have imported all global constants into the namespace. I decided that any constants that were actually used would get no define ... statements anyway, so this call was superfluous. Thoughts anyone?
         MeowChow                                   
                     s aamecha.s a..a\u$&owag.print
        Yeah, comment:   Requiring no define's is a forced use strict;.  Sure, use strict; makes for better maintanability/reusability, but it's not on by default (and if it were, it could be turned off).

        Having use define 'just work' seems like it would be a boon during development -- or for one-shots, prototypes, in-house utility hacks, whatever.

            p

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (20)
As of 2015-07-01 15:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (3 votes), past polls