Creating accessors from AUTOLOAD

Randy W. Sims Mon, 08 Mar 2004 07:16:10 -0800

I have the code below in a module I'm writing (Complete module is at <www.thepierianspring.org/CPAN-Metadata-0.00_01.tar.gz>). The three methods _mk_*_accessor are nearly identical. I would like to simplify this code, but I want to avoid a giant eval since it makes code more difficult to maintain. Any ideas?

Thanks,
Randy.


sub AUTOLOAD {
  my $self = shift;
  (my $attr = $AUTOLOAD) =~ s/.*:://;
  return if $attr eq 'DESTROY';

  my ($type) = $self->{_spec_impl}->attr_data($attr);
  my $sub;

  if ($type eq 'SCALAR') {
    $sub = $self->_mk_scalar_accessor($attr);
  } elsif ($type eq 'ARRAY') {
    $sub = $self->_mk_array_accessor($attr);
  } elsif ($type eq 'HASH') {
    $sub = $self->_mk_hash_accessor($attr);
  } else {
    croak "Unsupported attribute '$attr'";
  }

  { no strict 'refs';
    *{$AUTOLOAD} = $sub;
    $sub->($self, @_);
  }
}

sub _mk_scalar_accessor {
  my $self = shift;
  my $attr = shift;

  return sub {
    my $self = shift;
    my $arg  = shift;

my $ret = $self->{_metadata}{$attr};

    if ($arg) {
      my $spec = $self->{_spec_impl};

      if ($self->{auto_check} && $spec->can("C_$attr")) {
        my $changing = eval "\$spec->C_$attr(\$arg)";
        carp sprintf($changing, $attr) if $changing;
      }

      if ($self->{auto_validate} && $spec->can("V_$attr")) {
        my $is_valid = eval "\$spec->V_$attr(\$arg)";
        if ($is_valid) {
          $self->{_metadata}{$attr} = $arg;
        } else {
          carp "Invalid value for $attr: '$arg'";
        }
      } else {
        $self->{_metadata}{$attr} = $arg;
      }
    }
    return $ret;
  }
}

sub _mk_array_accessor {
  my $self = shift;
  my $attr = shift;

  return sub {
    my $self = shift;
    my @arg  = @_;

my $ret = $self->{_metadata}{$attr} || [];

    if (@arg) {
      my $spec = $self->{_spec_impl};

      if ($self->{auto_check} && $spec->can("C_$attr")) {
        my $changing = eval "\$spec->C_$attr(\$arg)";
        carp sprintf($changing, $attr) if $changing;
      }

      if ($self->{auto_validate} && $spec->can("V_$attr")) {
        my $is_valid = eval "\$spec->V_$attr([EMAIL PROTECTED])";
        if ($is_valid) {
          $self->{_metadata}{$attr} = [EMAIL PROTECTED];
        } else {
          carp "Invalid value for $attr: [EMAIL PROTECTED]";
        }
      } else {
        $self->{_metadata}{$attr} = [EMAIL PROTECTED];
      }
    }
    return @$ret;
  }
}

sub _mk_hash_accessor {
  my $self = shift;
  my $attr = shift;

  return sub {
    my $self = shift;
    my %arg  = @_;

my $ret = $self->{_metadata}{$attr} || {};

    if (%arg) {
      my $spec = $self->{_spec_impl};

      if ($self->{auto_check} && $spec->can("C_$attr")) {
        my $changing = eval "\$spec->C_$attr(\$arg)";
        carp sprintf($changing, $attr) if $changing;
      }

      if ($self->{auto_validate} && $spec->can("V_$attr")) {
        my $is_valid = eval "\$spec->V_$attr(\%arg)";
        if ($is_valid) {
          $self->{_metadata}{$attr} = \%arg;
        } else {
          carp "Invalid value for $attr: {%arg}";
        }
      } else {
        $self->{_metadata}{$attr} = \%arg;
      }
    }
    return %$ret;
  }
}

--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
<http://learn.perl.org/> <http://learn.perl.org/first-response>

Creating accessors from AUTOLOAD

Reply via email to