### UPDATES ###
#
# 4-3-2002: per petral's feedback, "use define;" is back in
# 9-4-2004: updated to match CPAN version
#

package define;

use 5.008004;
use strict;
use warnings;

our $VERSION = '1.02';

my %AllPkgs;
my %DefPkgs;
my %Vals;

my %Forbidden = map { $_ => 1 } qw{ 
  BEGIN INIT CHECK END DESTROY AUTOLOAD 
  STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG 
};

sub import {
  my $class = shift;
  my $pkg = (caller)[0];
  if( @_ ) {
    if( ref $_[0] eq 'HASH' ) {
      while( my( $name, $val ) = each %{$_[0]} ) {
        do_import( $pkg, $name, $val );
      }
    }
    else {
      do_import( $pkg, @_ );
    }
  }
  else {
    require Carp;
    Carp::croak "Must call 'use define' with parameters";
  }
}

sub unimport {
  my $class = shift;
  my $pkg = (caller)[0];
  if( @_ ) {
    check_name( my $name = shift );
    $DefPkgs{$name}{$pkg} = 1;
    if( $Vals{$name} ) {
      makedef( $pkg, $name, @{$Vals{$name}} );
    }
    else {
      makedef( $pkg, $name );
    }
  }
  else {
    # export all Declared to pkg
    $AllPkgs{$pkg} = 1;
    while( my( $name, $val ) = each %Vals ) {
      # warn "Defining ALL $pkg:$name:$val";
      makedef( $pkg, $name, @$val );
    }
  }
}

sub check_name {
  my $name = shift;
  if( $name =~ /^__/ 
      or $name !~ /^_?[^\W_0-9]\w*\z/ 
      or $Forbidden{$name} ) {
    require Carp;
    Carp::croak "Define name '$name' is invalid";
  }
}

sub do_import {
  my( $pkg, $name, @vals ) = @_;
  check_name( $name );
  $DefPkgs{$name}{$pkg} = 1;
  $Vals{$name} = [ @vals ];
  my %pkgs = ( $pkg => 1, %AllPkgs, %{$DefPkgs{$name}} );
  for (keys %pkgs) {
    makedef( $_, $name, @vals );
  }
}

sub makedef {
  my ($pkg, $name, @Vals) = @_;
  my $subname = "${pkg}::$name";

  no strict 'refs';

  if (defined *{$subname}{CODE}) {
    require Carp;
    Carp::carp "Global constant $subname redefined";
  }

  if (@Vals > 1) {
    *$subname = sub () { @Vals };
  }
  elsif (@Vals == 1) {
    my $val = $Vals[0];
    *$subname = sub () { $val };
  }
  else {
    *$subname = sub () { };
  }
}
  
1;

__END__

=head1 NAME

define - Perl pragma to declare global constants

=head1 SYNOPSIS

    #--- in package/file main ---#
    package main;
    
    # the most frequenly used application of this pragma
    use define DEBUG => 0;
    
    # define a constant list
    use define DWARVES => qw(happy sneezy grumpy);
    
    # define several at a time via a hashref list, like constant.pm
    use define {
      FOO => 1,
      BAR => 2,
      BAZ => 3,
    };

    use Some::Module;
    use My::Module;
    
    #--- in package/file Some::Module ---#
    package Some::Module
    no define DEBUG =>;
    no define DWARVES =>;

    # define a master object that any package can import
    sub new { ... }
    use define OBJECT => __PACKAGE__->new;

    # if DEBUG is false, the following statement isn't even compiled
    warn "debugging stuff here" if DEBUG;
    
    my $title = "Snow white and the " . scalar DWARVES . " dwarves";

    #--- in package/file My::Module ---#
    package My::Module
    no define;

    warn "I prefer these dwarves: " join " ", DWARVES if DEBUG;
    OBJECT->method(DWARVES);

=head1 DESCRIPTION

Use this pragma to define global constants.

=head1 USAGE

=head2 Defining constants

Global constants are defined through the same calling conventions 
as C<constant.pm>:

  use define FOO => 3;
  use define BAR => ( 1, 2, 3 );
  use define { 
    BAZ => 'dogs',
    QUX => 'cats',
  };

=head2 Importing constants by name

To use a global constant, you import it into your package as follows:

  no define FOO =>;

If FOO has been defined, it gets set to its defined value, otherwise it is set
to undef. Note that the reason for the '=>' operator here is to parse FOO as 
a string literal rather than a bareword (you could also do C<no define 'FOO'>).

=head2 Importing constants willy-nilly

To import ALL defined constants into your package, you can do the following:

  no define;

This is quick, but messy, as you can't predict what symbols may clash with
those in your package's namespace.

=head1 NOTES

See L<constant/"constant.pm">. Most of the same caveats apply here.

Your code should be arranged so that any C<no define> statements are executed 
after the C<use define> statement for a given symbol. If the order is reversed,
a warning will be emitted.

As a rule, modules shouldn't be defining global constants; they should import
constants defined by the main body of your program.

If a module does define a global constant (eg. a master object), the module 
should be use'd before any other modules (or lines of code) that refer to the
constant.

If you <use define> the same symbol more than once, a warning will be emitted.

=head1 AUTHOR

  Gary Gurevich (garygurevich at gmail)

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2004 by Gary Gurevich

This library is free software; you can redistribute it and/or modify it under 
the same terms as Perl itself.

=head1 SEE ALSO

constant(3), perl(1).

=cut