view release on metacpan or  search on metacpan

lib/Enumeration.pm  view on Meta::CPAN

=for gpg
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

=head1 NAME

Enumeration - Yet Another enumeration class implementation.

=head1 VERSION

This is version 0.03 of Enumeration, of March 26, 2008.

=cut

use strict;
use warnings;
package Enumeration;
$Enumeration::VERSION = '0.03';

use Scalar::Util qw(refaddr);

use overload '""' => \&value,
             'eq' => \&equals,
             'ne' => \&not_equals;

# Auto-croaking saves program startup time:
sub croak { require Carp; goto &Carp::croak }

# Enumeration constants for each subclass
my %class_symbols;

# This should ONLY be called by subclasses.
# Call as:    __PACKAGE__->set_enumerations(@list_of_symbols);
sub set_enumerations
{
    my $class = shift;
    $class_symbols{$class}{$_} = 1 for @_;
    return 1;
}

# Return a list of enumerations allowable in the given class.
sub enumerations
{
    my $class = shift;
    return keys %{ $class_symbols{$class} };
}

sub import
{
    my $class = shift;
    my $import = @_ && $_[0] eq ':all';

    my $cpkg = caller;
    foreach my $sym (keys %{$class_symbols{$class}})
    {
        no strict 'refs';
        my $full_name  = $cpkg  . '::' . $sym;
        my $local_name = $class . '::' . $sym;

        *$full_name  = sub () { $sym } if $import;
        *$local_name = sub () { $sym }

lib/Enumeration.pm  view on Meta::CPAN

=head1 EXAMPLE

 # File: Color.pm
 #
 package Color;
 use base 'Enumeration';
 __PACKAGE__->set_enumerations(qw(red yellow blue brown black green white));

 # File: some_program.pl
 #
 use strict;
 use warnings;
 use Color ':all';
 #
 #
 my $color = new Color(red);
 print "Color is currently $color\n";
 #
 $color->set(white);
 print "Color is now $color\n";
 #
 print "I TOLD you it's white!\n" if $color eq white;
 #
 $color->set('purple');   # dies.


=head1 EXPORTS

None.  But if you subclass this module, then people who use your
module will have the option to have symbols imported into their
namespace.

=head1 AUTHOR/COPYRIGHT

Copyright (c) 2008 by Eric J. Roode, ROODE I<-at-> cpan I<-dot-> org

All rights reserved.

To avoid my spam filter, please include "Perl", "module", or this
module's name in the message's subject line, and/or GPG-sign your
message.

This module is copyrighted only to ensure proper attribution of
authorship and to ensure that it remains available to all.  This
module is free, open-source software.  This module may be freely used
for any purpose, commercial, public, or private, provided that proper
credit is given, and that no more-restrictive license is applied to
derivative (not dependent) works.

Substantial efforts have been made to ensure that this software meets
high quality standards; however, no guarantee can be made that there
are no undiscovered bugs, and no warranty is made as to suitability to
any given use, including merchantability.  Should this module cause
your house to burn down, your dog to collapse, your heart-lung machine
to fail, your spouse to desert you, or George Bush to be re-elected, I
can offer only my sincere sympathy and apologies, and promise to
endeavor to improve the software.

=cut

=begin gpg

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.8 (Cygwin)

iEYEARECAAYFAkfqxEIACgkQwoSYc5qQVqrvSwCcDFVRb/5BAIVrA/QB6An8v6UM
srQAoInszO8WzxLTNqpdiwFLHMTyHGSn
=O1zc
-----END PGP SIGNATURE-----

=end gpg