lib/Class/Fields.pm

   1 package Class::Fields;
   2 use Carp;
   3
   4 sub import {
   5     my $class = shift;
   6     my ($package) = caller;
   7     my $fields = \%{"$package\::FIELDS"};
   8     my $i = $fields->{__MAX__};
   9     foreach my $f (@_) {
  10         if (defined($fields->{$f})) {
  11             croak "Field name $f already used by a base class"
  12         }
  13         $fields->{$f} = ++$i;
  14     }
  15     $fields->{__MAX__} = $i;
  16     push(@{"$package\::ISA"}, "Class::Fields");
  17 }
  18
  19 sub new {
  20     my $class = shift;
  21     bless [\%{"$class\::FIELDS"}, @_], $class;
  22 }
  23
  24 sub ISA {
  25     my ($class, $package) = @_;
  26     my $from_fields = \%{"$class\::FIELDS"};
  27     my $to_fields = \%{"$package\::FIELDS"};
  28     return unless defined %$from_fields;
  29     croak "Ambiguous inheritance for %FIELDS" if defined %$to_fields;
  30     %$to_fields = %$from_fields;
  31 }
  32
  33 1;