Getting list of fields back from 'use fields' pragma?

Question

So I'm familiar with the fields pragma in Perl that can be used to restrict the fields that are stored in a class:

package Fruit;
use fields qw( color shape taste );

sub new {
  my ( $class, $params ) = @_;
  my $self = fields::new( $class ) unless ref $class;
  foreach my $name ( keys %$params ) {
    $self->{ $name } = $params->{ $name };
  }
  return $self;
}

Once I've declared the fields at the top, how I can get the list back, say because I want to generate accessors dynamically? Is keys %FIELDS the only way?

Secondarily, is there a more efficient way to pre-populate the fields in the constructor than looping through and assigning each parameter as I am doing above?

Answer 1

If you are working in Perl 5.10 and up (really 5.9 and up, but I don't count development releases), fields creates a restricted hash. See Hash::Util for info on restricted hashes.

To get all the fields available to a restricted hash, use the legal_keys or legal_ref_keys functions:

use Hash::Util qw( legal_ref_keys );

my $froot = Fruit->new();
my @attribs = legal_ref_keys($froot);

You could do a number of things to generate your methods automatically:

1. Create a temporary object during construction and query it for legal keys so that you can create attributes --- UGLY
2. AUTOLOAD attributes by querying the object for a list of legal keys. CODE SMELL ALERT: this assumes that all subclasses will use the same underlying data structure.
3. Access the %FIELDS hash in the module to generate methods at compile time or through AUTOLOAD. MORE PROBLEMS - assumes that an unpublished bit of fields pragma will remain.
4. Define an array of attributes at compile time and autogenerate methods and set fields based on the value.
5. Give up on writing all this boilerplate and use Moose.

Option 4:

package Fruit;
use strict; 
use warnings;

my @ATTRIBUTES;
BEGIN { @ATTRIBUTES =  qw( color shape taste ); }

use fields @ATTRIBUTES;

for my $attrib ( @ATTRIBUTES ) {
    my $getset = sub {
        my $self = shift;

        if( @_ ) {
            $self->{$attrib} = shift;
        }

        return $self->{$attrib};
    };

    {    no strict 'refs';
         *{$attrib} = $getset;
    }
}


sub new {
  my ( $class, $params ) = @_;
  my $self = fields::new( $class ) unless ref $class;
  foreach my $name ( keys %$params ) {
    $self->{ $name } = $params->{ $name };
  }
  return $self;
}

Option 5.

package Fruit;
use Moose;

has 'color' => (
    is => 'rw',
    isa => 'Str',
);

has 'shape' => (
    is => 'rw',
    isa => 'Str',
);

has 'taste' => (
    is => 'rw',
    isa => 'Str',
);