#  Copyright (c) 1997-2004
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
#  http://www.math.tu-berlin.de/polymake,  mailto:polymake@math.tu-berlin.de
#
#  This program is free software; you can redistribute it and/or modify it
#  under the terms of the GNU General Public License as published by the
#  Free Software Foundation; either version 2, or (at your option) any
#  later version: http://www.gnu.org/licenses/gpl.txt.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#-----------------------------------------------------------------------------
# $Project: polymake $$Id: Enum.pm 4714 2004-06-22 16:23:15Z gawrilow $

package Enum;

use integer;
use strict qw(vars subs);
use Carp;

my %named_enums;

sub import {
   shift;			# drop the own package name
   my $cnt=0;
   my ($pkg)=caller(0);

   my $cache;

   if (@_==1 && $_[0] =~ /::/) {
      my $src=shift;
      $cache=$named_enums{$src}
         or croak "Enum: unknown enumeration type $src";
      $src =~ s/[^:]+$//;
      foreach (@$cache) {
	 *{"$pkg\::$_"}=\${"$src$_"};
      }
      return;
   }

   my $prefix="";
   if ($_[0] =~ /:$/) {
      $prefix="$`_";
      $named_enums{"$pkg\::$`"}=$cache=[ ];
      shift;
   }

   foreach (@_) {
      my $name=$prefix.$_;
      if ($name =~ /=/) {
	 $cnt=eval("package $pkg; $'");
	 croak "Enum:: invalid initializer: $@\n" if $@;
	 $name=$`;
      }
      croak "Enum: redefinition of \$$name\n" if defined $ {"$pkg\::$name"};
      *{"$pkg\::$name"}=eval("\\$cnt");
      push @$cache, "$name" if defined $cache;
      $cnt++;
   }
}

1;
__END__

=head1 NAME

Enum - definition of enumeration constants

=head1 SYNOPSIS

  use Enum qw( a b c );          # $a=0, $b=1, $c=2;
  use Enum qw( d=10 e=$d*2 f );  # $d=10, $e=20, $f=21;

  package A;
  use Enum qw( x: a b c );	 # $x_a=0, $x_b=1, $x_c=2;
  package B;
  use Enum qw( A::x );		 # imports $A::x_{a,b,c}

=head1 AUTHOR

Ewgenij Gawrilow <gawrilow@math.tu-berlin.de>

=cut