File Coverage

blib/lib/Class/Accessor/Complex.pm

Criterion	Covered	Total	%
statement	512	570	89.8
branch	136	246	55.2
condition	71	241	29.4
subroutine	97	101	96.0
pod	15	15	100.0
total	831	1173	70.8

use 5.008;
use strict;
use warnings;

package Class::Accessor::Complex;
our $VERSION = '1.100880';

# ABSTRACT: Arrays, hashes, booleans, integers, sets and more
use Carp qw(carp croak cluck);
use Data::Miscellany 'flatten';
use List::MoreUtils 'uniq';
use parent qw(Class::Accessor Class::Accessor::Installer);

sub mk_new {
    my ($self, @args) = @_;
    my $class = ref $self || $self;
    @args = ('new') unless @args;
    for my $name (@args) {
        $self->install_accessor(
            name => $name,
            code => sub {
                local $DB::sub = local *__ANON__ = "${class}::${name}"
                  if defined &DB::DB && !$Devel::DProf::VERSION;

                # don't use $class, as that's already defined above
                my $this_class = shift;
                my $self = ref($this_class) ? $this_class : bless {},
                  $this_class;
                my %args =
                  (scalar(@_ == 1) && ref($_[0]) eq 'HASH')
                  ? %{ $_[0] }
                  : @_;
                $self->$_($args{$_}) for keys %args;
                $self->init(%args) if $self->can('init');
                $self;
            },
        );
        $self->document_accessor(
            name    => $name,
            purpose => <<'EODOC',
Creates and returns a new object. The constructor will accept as arguments a
list of pairs, from component name to initial value. For each pair, the named
component is initialized by calling the method of the same name with the given
value. If called with a single hash reference, it is dereferenced and its
key/value pairs are set as described before.
EODOC
            examples => [
                "my \$obj = $class->$name;",
                "my \$obj = $class->$name(\%args);",
            ],
        );
    }
    $self;    # for chaining
}

sub mk_singleton {
    my ($self, @args) = @_;
    my $class = ref $self || $self;
    @args = ('new') unless @args;
    my $singleton;
    for my $name (@args) {
        $self->install_accessor(
            name => $name,
            code => sub {
                local $DB::sub = local *__ANON__ = "${class}::${name}"
                  if defined &DB::DB && !$Devel::DProf::VERSION;
                return $singleton if defined $singleton;

                # don't use $class, as that's already defined above
                my $this_class = shift;
                $singleton =
                  ref($this_class)
                  ? $this_class
                  : bless {}, $this_class;
                my %args =
                  (scalar(@_ == 1) && ref($_[0]) eq 'HASH')
                  ? %{ $_[0] }
                  : @_;
                $singleton->$_($args{$_}) for keys %args;
                $singleton->init(%args) if $singleton->can('init');
                $singleton;
            },
        );
        $self->document_accessor(
            name    => $name,
            purpose => <<'EODOC',
Creates and returns a new object. The object will be a singleton, so repeated
calls to the constructor will always return the same object. The constructor
will accept as arguments a list of pairs, from component name to initial
value. For each pair, the named component is initialized by calling the
method of the same name with the given value. If called with a single hash
reference, it is dereferenced and its key/value pairs are set as described
before.
EODOC
            examples => [
                "my \$obj = $class->$name;",
                "my \$obj = $class->$name(\%args);",
            ],
        );
    }
    $self;    # for chaining
}

sub mk_scalar_accessors {
    my ($self, @fields) = @_;
    my $class = ref $self || $self;
    for my $field (@fields) {
        $self->install_accessor(
            name => $field,
            code => sub {
                local $DB::sub = local *__ANON__ = "${class}::${field}"
                  if defined &DB::DB && !$Devel::DProf::VERSION;
                return $_[0]->{$field} if @_ == 1;
                $_[0]->{$field} = $_[1];
            },
        );
        $self->document_accessor(
            name    => $field,
            purpose => <<'EODOC',
A basic getter/setter method. If called without an argument, it returns the
value. If called with a single argument, it sets the value.
EODOC
            examples =>
              [ "my \$value = \$obj->$field;", "\$obj->$field(\$value);", ],
        );
        my @clear_methods = uniq "clear_${field}", "${field}_clear";
        for my $name (@clear_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    $_[0]->{$field} = undef;
                },
            );
        }
        $self->document_accessor(
            name       => \@clear_methods,
            purpose    => 'Clears the value.',
            examples   => ["\$obj->$clear_methods[0];"],
            belongs_to => $field,
        );
    }
    $self;    # for chaining
}

sub mk_class_scalar_accessors {
    my ($self, @fields) = @_;
    my $class = ref $self || $self;
    for my $field (@fields) {
        my $scalar;
        $self->install_accessor(
            name => $field,
            code => sub {
                local $DB::sub = local *__ANON__ = "${class}::${field}"
                  if defined &DB::DB && !$Devel::DProf::VERSION;
                return $scalar if @_ == 1;
                $scalar = $_[1];
            },
        );
        $self->document_accessor(
            name    => $field,
            purpose => <<'EODOC',
A basic getter/setter method. This is a class variable, so it is shared
between all instances of this class. Changing it in one object will change it
for all other objects as well. If called without an argument, it returns the
value. If called with a single argument, it sets the value.
EODOC
            examples =>
              [ "my \$value = \$obj->$field;", "\$obj->$field(\$value);", ],
        );
        my @clear_methods = uniq "clear_${field}", "${field}_clear";
        for my $name (@clear_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    $scalar = undef;
                },
            );
        }
        $self->document_accessor(
            name    => \@clear_methods,
            purpose => <<'EODOC',
Clears the value. Since this is a class variable, the value will be undefined
for all instances of this class.
EODOC
            example    => "\$obj->$clear_methods[0];",
            belongs_to => $field,
        );
    }
    $self;    # for chaining
}

sub mk_concat_accessors {
    my ($self, @args) = @_;
    my $class = ref $self || $self;
    for my $arg (@args) {

        # defaults
        my $field = $arg;
        my $join  = '';
        if (ref $arg eq 'ARRAY') {
            ($field, $join) = @$arg;
        }
        $self->install_accessor(
            name => $field,
            code => sub {
                local $DB::sub = local *__ANON__ = "${class}::${field}"
                  if defined &DB::DB && !$Devel::DProf::VERSION;
                my ($self, $text) = @_;
                if (defined $text) {
                    if (defined $self->{$field}) {
                        $self->{$field} = $self->{$field} . $join . $text;
                    } else {
                        $self->{$field} = $text;
                    }
                }
                return $self->{$field};
            },
        );
        $self->document_accessor(
            name => $field,

            # FIXME use the current value of $join in the docs
            purpose => <<'EODOC',
A getter/setter method. If called without an argument, it returns the
value. If called with a single argument, it appends to the current value.
EODOC
            examples =>
              [ "my \$value = \$obj->$field;", "\$obj->$field(\$value);", ],
        );
        my @clear_methods = uniq "clear_${field}", "${field}_clear";
        for my $name (@clear_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    $_[0]->{$field} = undef;
                },
            );
        }
        $self->document_accessor(
            name    => \@clear_methods,
            purpose => <<'EODOC',
Clears the value.
EODOC
            example    => "\$obj->$clear_methods[0];",
            belongs_to => $field,
        );
    }
    $self;    # for chaining
}

sub mk_array_accessors {
    my ($self, @fields) = @_;
    my $class = ref $self || $self;
    for my $field (@fields) {
        $self->install_accessor(
            name => $field,
            code => sub {
                local $DB::sub = local *__ANON__ = "${class}::${field}"
                  if defined &DB::DB && !$Devel::DProf::VERSION;
                my ($self, @list) = @_;
                defined $self->{$field} or $self->{$field} = [];
                @{ $self->{$field} } =
                  map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @list
                  if @list;
                wantarray ? @{ $self->{$field} } : $self->{$field};
            },
        );
        $self->document_accessor(
            name    => $field,
            purpose => <<'EODOC',
Get or set the array values. If called without arguments, it returns the
array in list context, or a reference to the array in scalar context. If
called with arguments, it expands array references found therein and sets the
values.
EODOC
            examples => [
                "my \@values    = \$obj->$field;",
                "my \$array_ref = \$obj->$field;",
                "\$obj->$field(\@values);",
                "\$obj->$field(\$array_ref);",
            ],
        );
        my @push_methods = uniq "push_${field}", "${field}_push";
        for my $name (@push_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my $self = shift;
                    push @{ $self->{$field} } => @_;
                },
            );
        }
        $self->document_accessor(
            name       => \@push_methods,
            belongs_to => $field,
            purpose    => 'Pushes elements onto the end of the array.',
            examples   => ["\$obj->$push_methods[0](\@values);"],
        );
        my @pop_methods = uniq "pop_${field}", "${field}_pop";
        for my $name (@pop_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    pop @{ $_[0]->{$field} };
                },
            );
        }
        $self->document_accessor(
            name    => \@pop_methods,
            purpose => <<'EODOC',
Pops the last element off the array, returning it.
EODOC
            examples   => ["my \$value = \$obj->$pop_methods[0];"],
            belongs_to => $field,
        );
        my @unshift_methods = uniq "unshift_${field}", "${field}_unshift";
        for my $name (@unshift_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my $self = shift;
                    unshift @{ $self->{$field} } => @_;
                },
            );
        }
        $self->document_accessor(
            name    => \@unshift_methods,
            purpose => <<'EODOC',
Unshifts elements onto the beginning of the array.
EODOC
            examples   => ["\$obj->$unshift_methods[0](\@values);"],
            belongs_to => $field,
        );
        my @shift_methods = uniq "shift_${field}", "${field}_shift";
        for my $name (@shift_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    shift @{ $_[0]->{$field} };
                },
            );
        }
        $self->document_accessor(
            name    => \@shift_methods,
            purpose => <<'EODOC',
Shifts the first element off the array, returning it.
EODOC
            examples   => ["my \$value = \$obj->$shift_methods[0];"],
            belongs_to => $field,
        );
        my @clear_methods = uniq "clear_${field}", "${field}_clear";
        for my $name (@clear_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    $_[0]->{$field} = [];
                },
            );
        }
        $self->document_accessor(
            name    => \@clear_methods,
            purpose => <<'EODOC',
Deletes all elements from the array.
EODOC
            examples   => ["\$obj->$clear_methods[0];"],
            belongs_to => $field,
        );
        my @count_methods = uniq "count_${field}", "${field}_count";
        for my $name (@count_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    exists $_[0]->{$field} ? scalar @{ $_[0]->{$field} } : 0;
                },
            );
        }
        $self->document_accessor(
            name    => \@count_methods,
            purpose => <<'EODOC',
Returns the number of elements in the array.
EODOC
            examples   => ["my \$count = \$obj->$count_methods[0];"],
            belongs_to => $field,
        );
        my @splice_methods = uniq "splice_${field}", "${field}_splice";
        for my $name (@splice_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my ($self, $offset, $len, @list) = @_;
                    splice(@{ $self->{$field} }, $offset, $len, @list);
                },
            );
        }
        $self->document_accessor(
            name    => \@splice_methods,
            purpose => <<'EODOC',
Takes three arguments: An offset, a length and a list.

Removes the elements designated by the offset and the length from the array,
and replaces them with the elements of the list, if any. In list context,
returns the elements removed from the array. In scalar context, returns the
last element removed, or C if no elements are removed. The array grows
or shrinks as necessary. If the offset is negative then it starts that far
from the end of the array. If the length is omitted, removes everything from
the offset onward. If the length is negative, removes the elements from the
offset onward except for -length elements at the end of the array. If both the
offset and the length are omitted, removes everything. If the offset is past
the end of the array, it issues a warning, and splices at the end of the
array.
EODOC
            examples => [
                "\$obj->$splice_methods[0](2, 1, \$x, \$y);",
                "\$obj->$splice_methods[0](-1);",
                "\$obj->$splice_methods[0](0, -1);",
            ],
            belongs_to => $field,
        );
        my @index_methods = uniq "index_${field}", "${field}_index";
        for my $name (@index_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my ($self, @indices) = @_;
                    my @result = map { $self->{$field}[$_] } @indices;
                    return $result[0] if @indices == 1;
                    wantarray ? @result : \@result;
                },
            );
        }
        $self->document_accessor(
            name    => \@index_methods,
            purpose => <<'EODOC',
Takes a list of indices and returns the elements indicated by those indices.
If only one index is given, the corresponding array element is returned. If
several indices are given, the result is returned as an array in list context
or as an array reference in scalar context.
EODOC
            examples => [
                "my \$element   = \$obj->$index_methods[0](3);",
                "my \@elements  = \$obj->$index_methods[0](\@indices);",
                "my \$array_ref = \$obj->$index_methods[0](\@indices);",
            ],
            belongs_to => $field,
        );
        my @set_methods = uniq "set_${field}", "${field}_set";
        for my $name (@set_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${$name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my $self = shift;
                    my @args = @_;
                    croak
"${class}::${field}_set expects an even number of fields\n"
                      if @args % 2;
                    while (my ($index, $value) = splice @args, 0, 2) {
                        $self->{$field}->[$index] = $value;
                    }
                    return @_ / 2;
                },
            );
        }
        $self->document_accessor(
            name    => \@set_methods,
            purpose => <<'EODOC',
Takes a list of index/value pairs and for each pair it sets the array element
at the indicated index to the indicated value. Returns the number of elements
that have been set.
EODOC
            examples   => ["\$obj->$set_methods[0](1 => \$x, 5 => \$y);"],
            belongs_to => $field,
        );
    }
    $self;    # for chaining
}

sub mk_class_array_accessors {
    my ($self, @fields) = @_;
    my $class = ref $self || $self;
    for my $field (@fields) {
        my @array;
        $self->install_accessor(
            name => $field,
            code => sub {
                local $DB::sub = local *__ANON__ = "${class}::${field}"
                  if defined &DB::DB && !$Devel::DProf::VERSION;
                my ($self, @list) = @_;
                @array = map { ref $_ eq 'ARRAY' ? @$_ : ($_) } @list
                  if @list;
                wantarray ? @array : \@array;
            },
        );
        $self->document_accessor(
            name    => $field,
            purpose => <<'EODOC',
Get or set the array values. If called without an arguments, it returns the
array in list context, or a reference to the array in scalar context. If
called with arguments, it expands array references found therein and sets the
values.

This is a class variable, so it is shared between all instances of this class.
Changing it in one object will change it for all other objects as well.
EODOC
            examples => [
                "my \@values    = \$obj->$field;",
                "my \$array_ref = \$obj->$field;",
                "\$obj->$field(\@values);",
                "\$obj->$field(\$array_ref);",
            ],
        );
        my @push_methods = uniq "push_${field}", "${field}_push";
        for my $name (@push_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my $self = shift;
                    push @array => @_;
                },
            );
        }
        $self->document_accessor(
            name    => \@push_methods,
            purpose => <<'EODOC',
Pushes elements onto the end of the array. Since this is a class variable, the
value will be changed for all instances of this class.
EODOC
            examples   => ["\$obj->$push_methods[0](\@values);"],
            belongs_to => $field,
        );
        my @pop_methods = uniq "pop_${field}", "${field}_pop";
        for my $name (@pop_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    pop @array;
                },
            );
        }
        $self->document_accessor(
            name    => \@pop_methods,
            purpose => <<'EODOC',
Pops the last element off the array, returning it. Since this is a class
variable, the value will be changed for all instances of this class.
EODOC
            examples   => ["my \$value = \$obj->$pop_methods[0];"],
            belongs_to => $field,
        );
        my @field_methods = uniq "unshift_${field}", "${field}_unshift";
        for my $name (@field_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my $self = shift;
                    unshift @array => @_;
                },
            );
        }
        $self->document_accessor(
            name    => \@field_methods,
            purpose => <<'EODOC',
Unshifts elements onto the beginning of the array. Since this is a class
variable, the value will be changed for all instances of this class.
EODOC
            examples   => ["\$obj->$field_methods[0](\@values);"],
            belongs_to => $field,
        );
        my @shift_methods = uniq "shift_${field}", "${field}_shift";
        for my $name (@shift_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    shift @array;
                },
            );
        }
        $self->document_accessor(
            name    => \@shift_methods,
            purpose => <<'EODOC',
Shifts the first element off the array, returning it. Since this is a class
variable, the value will be changed for all instances of this class.
EODOC
            examples   => ["my \$value = \$obj->$shift_methods[0];"],
            belongs_to => $field,
        );
        my @clear_methods = uniq "clear_${field}", "${field}_clear";
        for my $name (@clear_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    @array = ();
                },
            );
        }
        $self->document_accessor(
            name    => \@clear_methods,
            purpose => <<'EODOC',
Deletes all elements from the array. Since this is a class variable, the value
will be changed for all instances of this class.
EODOC
            examples   => ["\$obj->$clear_methods[0];"],
            belongs_to => $field,
        );
        my @count_methods = uniq "count_${field}", "${field}_count";
        for my $name (@count_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    scalar @array;
                },
            );
        }
        $self->document_accessor(
            name    => \@count_methods,
            purpose => <<'EODOC',
Returns the number of elements in the array. Since this is a class variable,
the value will be changed for all instances of this class.
EODOC
            examples   => ["my \$count = \$obj->$count_methods[0];"],
            belongs_to => $field,
        );
        my @splice_methods = uniq "splice_${field}", "${field}_splice";
        for my $name (@splice_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my ($self, $offset, $len, @list) = @_;
                    splice(@array, $offset, $len, @list);
                },
            );
        }
        $self->document_accessor(
            name    => \@splice_methods,
            purpose => <<'EODOC',
Takes three arguments: An offset, a length and a list.

Removes the elements designated by the offset and the length from the array,
and replaces them with the elements of the list, if any. In list context,
returns the elements removed from the array. In scalar context, returns the
last element removed, or C if no elements are removed. The array grows
or shrinks as necessary. If the offset is negative then it starts that far
from the end of the array. If the length is omitted, removes everything from
the offset onward. If the length is negative, removes the elements from the
offset onward except for -length elements at the end of the array. If both the
offset and the length are omitted, removes everything. If the offset is past
the end of the array, it issues a warning, and splices at the end of the
array.

Since this is a class variable, the value will be changed for all instances of
this class.
EODOC
            examples => [
                "\$obj->$splice_methods[0](2, 1, \$x, \$y);",
                "\$obj->$splice_methods[0](-1);",
                "\$obj->$splice_methods[0](0, -1);",
            ],
            belongs_to => $field,
        );
        my @index_methods = uniq "index_${field}", "${field}_index";
        for my $name (@index_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my ($self, @indices) = @_;
                    my @result = map { $array[$_] } @indices;
                    return $result[0] if @indices == 1;
                    wantarray ? @result : \@result;
                },
            );
        }
        $self->document_accessor(
            name    => \@index_methods,
            purpose => <<'EODOC',
Takes a list of indices and returns the elements indicated by those indices.
If only one index is given, the corresponding array element is returned. If
several indices are given, the result is returned as an array in list context
or as an array reference in scalar context.

Since this is a class variable, the value will be changed for all instances of
this class.
EODOC
            examples => [
                "my \$element   = \$obj->$index_methods[0](3);",
                "my \@elements  = \$obj->$index_methods[0](\@indices);",
                "my \$array_ref = \$obj->$index_methods[0](\@indices);",
            ],
            belongs_to => $field,
        );
        my @set_methods = uniq "set_${field}", "${field}_set";
        for my $name (@set_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my $self = shift;
                    my @args = @_;
                    croak
"${class}::${field}_set expects an even number of fields\n"
                      if @args % 2;
                    while (my ($index, $value) = splice @args, 0, 2) {
                        $array[$index] = $value;
                    }
                    return @_ / 2;
                },
            );
        }
        $self->document_accessor(
            name    => \@set_methods,
            purpose => <<'EODOC',
Takes a list of index/value pairs and for each pair it sets the array element
at the indicated index to the indicated value. Returns the number of elements
that have been set. Since this is a class variable, the value will be changed
for all instances of this class.
EODOC
            examples   => ["\$obj->$set_methods[0](1 => \$x, 5 => \$y);"],
            belongs_to => $field,
        );
    }
    $self;    # for chaining
}

sub mk_hash_accessors {
    my ($self, @fields) = @_;
    my $class = ref $self || $self;
    for my $field (@fields) {
        $self->install_accessor(
            name => $field,
            code => sub {
                local $DB::sub = local *__ANON__ = "${class}::${field}"
                  if defined &DB::DB && !$Devel::DProf::VERSION;
                my ($self, @list) = @_;
                defined $self->{$field} or $self->{$field} = {};
                if (scalar @list == 1) {
                    my ($key) = @list;
                    if (my $type = ref $key) {
                        if ($type eq 'ARRAY') {
                            return @{ $self->{$field} }{@$key};
                        } elsif ($type eq 'HASH') {
                            while (my ($subkey, $value) = each %$key) {
                                $self->{$field}{$subkey} = $value;
                            }
                            return wantarray
                              ? %{ $self->{$field} }
                              : $self->{$field};
                        } else {
                            cluck
                              "Unrecognized ref type for hash method: $type.";
                        }
                    } else {
                        return $self->{$field}{$key};
                    }
                } else {
                    while (1) {
                        my $key = shift @list;
                        defined $key or last;
                        my $value = shift @list;
                        defined $value or carp "No value for key $key.";
                        $self->{$field}{$key} = $value;
                    }
                    return wantarray ? %{ $self->{$field} } : $self->{$field};
                }
            },
        );
        $self->document_accessor(
            name    => $field,
            purpose => <<'EODOC',
Get or set the hash values. If called without arguments, it returns the hash
in list context, or a reference to the hash in scalar context. If called
with a list of key/value pairs, it sets each key to its corresponding value,
then returns the hash as described before.

If called with exactly one key, it returns the corresponding value.

If called with exactly one array reference, it returns an array whose elements
are the values corresponding to the keys in the argument array, in the same
order. The resulting list is returned as an array in list context, or a
reference to the array in scalar context.

If called with exactly one hash reference, it updates the hash with the given
key/value pairs, then returns the hash in list context, or a reference to the
hash in scalar context.
EODOC
            examples => [
                "my \%hash     = \$obj->$field;",
                "my \$hash_ref = \$obj->$field;",
                "my \$value    = \$obj->$field(\$key);",
                "my \@values   = \$obj->$field([ qw(foo bar) ]);",
                "\$obj->$field(\%other_hash);",
                "\$obj->$field(foo => 23, bar => 42);",
            ],
        );
        my @clear_methods = uniq "clear_${field}", "${field}_clear";
        for my $name (@clear_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my $self = shift;
                    $self->{$field} = {};
                },
            );
        }
        $self->document_accessor(
            name    => \@clear_methods,
            purpose => <<'EODOC',
Deletes all keys and values from the hash.
EODOC
            examples   => ["\$obj->$clear_methods[0];"],
            belongs_to => $field,
        );
        my @keys_methods = uniq "keys_${field}", "${field}_keys";
        for my $name (@keys_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    keys %{ $_[0]->{$field} };
                },
            );
        }
        $self->document_accessor(
            name    => \@keys_methods,
            purpose => <<'EODOC',
Returns a list of all hash keys in no particular order.
EODOC
            examples   => ["my \@keys = \$obj->$keys_methods[0];"],
            belongs_to => $field,
        );
        my @count_methods = uniq "count_${field}", "${field}_count";
        for my $name (@count_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    scalar keys %{ $_[0]->{$field} };
                },
            );
        }
        $self->document_accessor(
            name    => \@count_methods,
            purpose => <<'EODOC',
Returns the number of keys in the hash.
EODOC
            examples   => ["my \$count = \$obj->$count_methods[0];"],
            belongs_to => $field,
        );
        my @values_methods = uniq "values_${field}", "${field}_values";
        for my $name (@values_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    values %{ $_[0]->{$field} };
                },
            );
        }
        $self->document_accessor(
            name    => \@values_methods,
            purpose => <<'EODOC',
Returns a list of all hash values in no particular order.
EODOC
            examples   => ["my \@values = \$obj->$values_methods[0];"],
            belongs_to => $field,
        );
        my @exists_methods = uniq "exists_${field}", "${field}_exists";
        for my $name (@exists_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my ($self, $key) = @_;
                    exists $self->{$field} && exists $self->{$field}{$key};
                },
            );
        }
        $self->document_accessor(
            name    => \@exists_methods,
            purpose => <<'EODOC',
Takes a key and returns a true value if the key exists in the hash, and a
false value otherwise.
EODOC
            examples   => ["if (\$obj->$exists_methods[0](\$key)) { ... }"],
            belongs_to => $field,
        );
        my @delete_methods = uniq "delete_${field}", "${field}_delete";
        for my $name (@delete_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my ($self, @keys) = @_;
                    delete @{ $self->{$field} }{@keys};
                },
            );
        }
        $self->document_accessor(
            name => \@delete_methods,
            purpose =>
              'Takes a list of keys and deletes those keys from the hash.',
            examples   => ["\$obj->$delete_methods[0](\@keys);"],
            belongs_to => $field,
        );
    }
    $self;    # for chaining
}

sub mk_class_hash_accessors {
    my ($self, @fields) = @_;
    my $class = ref $self || $self;
    for my $field (@fields) {
        my %hash;
        $self->install_accessor(
            name => $field,
            code => sub {
                local $DB::sub = local *__ANON__ = "${class}::${field}"
                  if defined &DB::DB && !$Devel::DProf::VERSION;
                my ($self, @list) = @_;
                if (scalar @list == 1) {
                    my ($key) = @list;
                    return $hash{$key} unless ref $key;
                    return @hash{@$key} if ref $key eq 'ARRAY';
                    if (ref($key) eq 'HASH') {
                        %hash = (%hash, %$key);
                        return wantarray ? %hash : \%hash;
                    }

                    # not a scalar, array or hash...
                    cluck sprintf
                      'Not a recognized ref type for static hash [%s]',
                      ref($key);
                } else {
                    while (1) {
                        my $key = shift @list;
                        defined $key or last;
                        my $value = shift @list;
                        defined $value or carp "No value for key $key.";
                        $hash{$key} = $value;
                    }
                    return wantarray ? %hash : \%hash;
                }
            },
        );
        $self->document_accessor(
            name    => $field,
            purpose => <<'EODOC',
Get or set the hash values. If called without arguments, it returns the hash
in list context, or a reference to the hash in scalar context. If called
with a list of key/value pairs, it sets each key to its corresponding value,
then returns the hash as described before.

If called with exactly one key, it returns the corresponding value.

If called with exactly one array reference, it returns an array whose elements
are the values corresponding to the keys in the argument array, in the same
order. The resulting list is returned as an array in list context, or a
reference to the array in scalar context.

If called with exactly one hash reference, it updates the hash with the given
key/value pairs, then returns the hash in list context, or a reference to the
hash in scalar context.

This is a class variable, so it is shared between all instances of this class.
Changing it in one object will change it for all other objects as well.
EODOC
            examples => [
                "my \%hash     = \$obj->$field;",
                "my \$hash_ref = \$obj->$field;",
                "my \$value    = \$obj->$field(\$key);",
                "my \@values   = \$obj->$field([ qw(foo bar) ]);",
                "\$obj->$field(\%other_hash);",
                "\$obj->$field(foo => 23, bar => 42);",
            ],
        );
        my @clear_methods = uniq "clear_${field}", "${field}_clear";
        for my $name (@clear_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    %hash = ();
                },
            );
        }
        $self->document_accessor(
            name    => \@clear_methods,
            purpose => <<'EODOC',
Deletes all keys and values from the hash. Since this is a class variable, the
value will be changed for all instances of this class.
EODOC
            examples => ["\$obj->$clear_methods[0];"],
        );
        my @keys_methods = uniq "keys_${field}", "${field}_keys";
        for my $name (@keys_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    keys %hash;
                },
            );
        }
        $self->document_accessor(
            name    => \@keys_methods,
            purpose => <<'EODOC',
Returns a list of all hash keys in no particular order. Since this is a class
variable, the value will be changed for all instances of this class.
EODOC
            examples   => ["my \@keys = \$obj->$keys_methods[0];"],
            belongs_to => $field,
        );
        my @values_methods = uniq "values_${field}", "${field}_values";
        for my $name (@values_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    values %hash;
                },
            );
        }
        $self->document_accessor(
            name    => \@values_methods,
            purpose => <<'EODOC',
Returns a list of all hash values in no particular order. Since this is a
class variable, the value will be changed for all instances of this class.
EODOC
            examples   => ["my \@values = \$obj->$values_methods[0];"],
            belongs_to => $field,
        );
        my @exists_methods = uniq "exists_${field}", "${field}_exists";
        for my $name (@exists_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    exists $hash{ $_[1] };
                },
            );
        }
        $self->document_accessor(
            name    => \@exists_methods,
            purpose => <<'EODOC',
Takes a key and returns a true value if the key exists in the hash, and a
false value otherwise. Since this is a class variable, the value will be
changed for all instances of this class.
EODOC
            examples   => ["if (\$obj->$exists_methods[0](\$key)) { ... }"],
            belongs_to => $field,
        );
        my @delete_methods = uniq "delete_${field}", "${field}_delete";
        for my $name (@delete_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my ($self, @keys) = @_;
                    delete @hash{@keys};
                },
            );
        }
        $self->document_accessor(
            name    => \@delete_methods,
            purpose => <<'EODOC',
Takes a list of keys and deletes those keys from the hash. Since this is a
class variable, the value will be changed for all instances of this class.
EODOC
            examples   => ["\$obj->$delete_methods[0](\@keys);"],
            belongs_to => $field,
        );
    }
    $self;    # for chaining
}

sub mk_abstract_accessors {
    my ($self, @fields) = @_;
    my $class = ref $self || $self;
    for my $field (@fields) {
        $self->install_accessor(
            name => $field,
            code => sub {
                local $DB::sub = local *__ANON__ = "${class}::${field}"
                  if defined &DB::DB && !$Devel::DProf::VERSION;
                my $method = "${class}::${field}";
                eval "require Error::Hierarchy::Internal::AbstractMethod";
                if ($@) {

                    # Error::Hierarchy not installed?
                    die sprintf "called abstract method [%s]", $method;
                } else {

                    # need to pass method because caller() still doesn't see the
                    # anonymously named sub's name
                    throw Error::Hierarchy::Internal::AbstractMethod(
                        method => $method,);
                }
            }
        );
    }
    $self;    # for chaining
}

sub mk_boolean_accessors {
    my ($self, @fields) = @_;
    my $class = ref $self || $self;
    for my $field (@fields) {
        $self->install_accessor(
            name => $field,
            code => sub {
                local $DB::sub = local *__ANON__ = "${class}::${field}"
                  if defined &DB::DB && !$Devel::DProf::VERSION;
                return $_[0]->{$field} if @_ == 1;
                $_[0]->{$field} = $_[1] ? 1 : 0;    # normalize
            },
        );
        $self->document_accessor(
            name    => $field,
            purpose => <<'EODOC',
If called without an argument, returns the boolean value (0 or 1). If called
with an argument, it normalizes it to the boolean value. That is, the values
0, undef and the empty string become 0; everything else becomes 1.
EODOC
            examples =>
              [ "\$obj->$field(\$value);", "my \$value = \$obj->$field;", ],
        );
        my @set_methods = uniq "set_${field}", "${field}_set";
        for my $name (@set_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    $_[0]->{$field} = 1;
                },
            );
        }
        $self->document_accessor(
            name       => \@set_methods,
            purpose    => 'Sets the boolean value to 1.',
            examples   => ["\$obj->$set_methods[0];"],
            belongs_to => $field,
        );
        my @clear_methods = uniq "clear_${field}", "${field}_clear";
        for my $name (@clear_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    $_[0]->{$field} = 0;
                },
            );
        }
        $self->document_accessor(
            name       => \@clear_methods,
            purpose    => 'Clears the boolean value by setting it to 0.',
            examples   => ["\$obj->$clear_methods[0];"],
            belongs_to => $field,
        );
    }
    $self;    # for chaining
}

sub mk_integer_accessors {
    my ($self, @fields) = @_;
    my $class = ref $self || $self;
    for my $field (@fields) {
        $self->install_accessor(
            name => $field,
            code => sub {
                local $DB::sub = local *__ANON__ = "${class}::${field}"
                  if defined &DB::DB && !$Devel::DProf::VERSION;
                my $self = shift;
                return $self->{$field} || 0 unless @_;
                $self->{$field} = shift;
            },
        );
        $self->document_accessor(
            name    => $field,
            purpose => <<'EODOC',
A basic getter/setter method. If called without an argument, it returns the
value, or 0 if there is no previous value. If called with a single argument,
it sets the value.
EODOC
            examples =>
              [ "\$obj->$field(\$value);", "my \$value = \$obj->$field;", ],
        );
        my @reset_methods = uniq "reset_${field}", "${field}_reset";
        for my $name (@reset_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    $_[0]->{$field} = 0;
                },
            );
        }
        $self->document_accessor(
            name       => \@reset_methods,
            purpose    => 'Resets the value to 0.',
            examples   => ["\$obj->$reset_methods[0];"],
            belongs_to => $field,
        );
        my @inc_methods = uniq "inc_${field}", "${field}_inc";
        for my $name (@inc_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    $_[0]->{$field}++;
                },
            );
        }
        $self->document_accessor(
            name       => \@inc_methods,
            purpose    => 'Increases the value by 1.',
            examples   => ["\$obj->$inc_methods[0];"],
            belongs_to => $field,
        );
        my @dec_methods = uniq "dec_${field}", "${field}_dec";
        for my $name (@dec_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    $_[0]->{$field}--;
                },
            );
        }
        $self->document_accessor(
            name       => \@dec_methods,
            purpose    => 'Decreases the value by 1.',
            examples   => ["\$obj->$dec_methods[0];"],
            belongs_to => $field,
        );
    }
    $self;    # for chaining
}

sub mk_set_accessors {
    my ($self, @fields) = @_;
    my $class = ref $self || $self;
    for my $field (@fields) {
        my $insert_method   = "${field}_insert";
        my $elements_method = "${field}_elements";
        $self->install_accessor(
            name => $field,
            code => sub {
                local $DB::sub = local *__ANON__ = "${class}::${field}"
                  if defined &DB::DB && !$Devel::DProf::VERSION;
                my $self = shift;
                if (@_) {
                    $self->$insert_method(@_);
                } else {
                    $self->$elements_method;
                }
            },
        );
        $self->document_accessor(
            name    => $field,
            purpose => <<'EODOC',
A set is like an array except that each element can occur only one. It is,
however, not ordered. If called with a list of arguments, it adds those
elements to the set. If the first argument is an array reference, the values
contained therein are added to the set. If called without arguments, it
returns the elements of the set.
EODOC
            examples => [
                "my \@elements = \$obj->$field;",
                "\$obj->$field(\@elements);",
            ],
        );
        my @insert_methods = uniq "insert_${field}", $insert_method;
        for my $name (@insert_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my $self = shift;
                    $self->{$field}{$_}++ for flatten(@_);
                },
            );
        }
        $self->document_accessor(
            name    => \@insert_methods,
            purpose => <<'EODOC',
If called with a list of arguments, it adds those elements to the set. If the
first argument is an array reference, the values contained therein are added
to the set.
EODOC
            examples   => ["\$obj->$insert_methods[0](\@elements);"],
            belongs_to => $field,
        );
        my @elements_methods = uniq "elements_${field}", $elements_method;
        for my $name (@elements_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my $self = shift;
                    $self->{$field} ||= {};
                    keys %{ $self->{$field} };
                },
            );
        }
        $self->document_accessor(
            name       => \@elements_methods,
            purpose    => 'Returns the elements of the set.',
            examples   => ["my \@elements = \$obj->$elements_methods[0];"],
            belongs_to => $field,
        );
        my @delete_methods = uniq "delete_${field}", "${field}_delete";
        for my $name (@delete_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my $self = shift;
                    delete $self->{$field}{$_} for @_;
                },
            );
        }
        $self->document_accessor(
            name    => \@delete_methods,
            purpose => <<'EODOC',
If called with a list of values, it deletes those elements from the set.
EODOC
            examples   => ["\$obj->$delete_methods[0](\@elements);"],
            belongs_to => $field,
        );
        my @clear_methods = uniq "clear_${field}", "${field}_clear";
        for my $name (@clear_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    $_[0]->{$field} = {};
                },
            );
        }
        $self->document_accessor(
            name       => \@clear_methods,
            purpose    => 'Deletes all elements from the set.',
            examples   => ["\$obj->$clear_methods[0];"],
            belongs_to => $field,
        );
        my @contains_methods = uniq "contains_${field}", "${field}_contains";
        for my $name (@contains_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my ($self, $key) = @_;
                    return unless defined $key;
                    exists $self->{$field}{$key};
                },
            );
        }
        $self->document_accessor(
            name    => \@contains_methods,
            purpose => <<'EODOC',
Takes a single key and returns a boolean value indicating whether that key is
an element of the set.
EODOC
            examples => ["if (\$obj->$contains_methods[0](\$element)) { ... }"],
            ,
            belongs_to => $field,
        );
        my @is_empty_methods = uniq "is_empty_${field}", "${field}_is_empty";
        for my $name (@is_empty_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my $self = shift;
                    keys %{ $self->{$field} || {} } == 0;
                },
            );
        }
        $self->document_accessor(
            name => \@is_empty_methods,
            purpose =>
'Returns a boolean value indicating whether the set is empty of not.',
            examples   => ["\$obj->$is_empty_methods[0];"],
            belongs_to => $field,
        );
        my @size_methods = uniq "size_${field}", "${field}_size";
        for my $name (@size_methods) {
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my $self = shift;
                    scalar keys %{ $self->{$field} || {} };
                },
            );
        }
        $self->document_accessor(
            name       => \@size_methods,
            purpose    => 'Returns the number of elements in the set.',
            examples   => ["my \$size = \$obj->$size_methods[0];"],
            belongs_to => $field,
        );
    }
    $self;    # for chaining
}

sub mk_object_accessors {
    my ($self, @args) = @_;
    my $class = ref $self || $self;
    while (@args) {
        my $type = shift @args;
        my $list = shift @args or die "No slot names for $class";

        # Allow a list of hashrefs.
        my @list = ref($list) eq 'ARRAY' ? @$list : ($list);
        for my $obj_def (@list) {
            my ($name, @composites);
            if (!ref $obj_def) {
                $name = $obj_def;
            } else {
                $name = $obj_def->{slot};
                my $composites = $obj_def->{comp_mthds};
                @composites =
                    ref($composites) eq 'ARRAY' ? @$composites
                  : defined $composites ? ($composites)
                  :                       ();
            }
            for my $meth (@composites) {
                $self->install_accessor(
                    name => $meth,
                    code => sub {
                        local $DB::sub = local *__ANON__ = "${class}::{$meth}"
                          if defined &DB::DB && !$Devel::DProf::VERSION;
                        my ($self, @args) = @_;
                        $self->$name()->$meth(@args);
                    },
                );
                $self->document_accessor(
                    name    => $meth,
                    purpose => <
Calls $meth() with the given arguments on the object stored in the $name slot.
If there is no such object, a new $type object is constructed - no arguments
are passed to the constructor - and stored in the $name slot before forwarding
$meth() onto it.
EODOC
                    examples => [ "\$obj->$meth(\@args);", "\$obj->$meth;", ],
                );
            }
            $self->install_accessor(
                name => $name,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${name}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my ($self, @args) = @_;
                    if (ref($args[0]) && UNIVERSAL::isa($args[0], $type)) {
                        $self->{$name} = $args[0];
                    } else {
                        defined $self->{$name}
                          or $self->{$name} = $type->new(@args);
                    }
                    $self->{$name};
                },
            );
            $self->document_accessor(
                name    => $name,
                purpose => <
If called with an argument object of type $type it sets the object; further
arguments are discarded. If called with arguments but the first argument is
not an object of type $type, a new object of type $type is constructed and the
arguments are passed to the constructor.

If called without arguments, it returns the $type object stored in this slot;
if there is no such object, a new $type object is constructed - no arguments
are passed to the constructor in this case - and stored in the $name slot
before returning it.
EODOC
                examples => [
                    "my \$object = \$obj->$name;", "\$obj->$name(\$object);",
                    "\$obj->$name(\@args);",
                ],
            );
            my @clear_methods = uniq "clear_${name}", "${name}_clear";
            for my $meth (@clear_methods) {
                $self->install_accessor(
                    name => $meth,
                    code => sub {
                        local $DB::sub = local *__ANON__ = "${class}::${meth}"
                          if defined &DB::DB && !$Devel::DProf::VERSION;
                        delete $_[0]->{$name};
                    },
                );
            }
            $self->document_accessor(
                name       => \@clear_methods,
                purpose    => 'Deletes the object.',
                examples   => "\$obj->$clear_methods[0];",
                belongs_to => $name,
            );
        }
    }
    $self;    # for chaining
}

sub mk_forward_accessors {
    my ($self, %args) = @_;
    my $class = ref $self || $self;
    while (my ($slot, $methods) = each %args) {
        my @methods = ref $methods eq 'ARRAY' ? @$methods : ($methods);
        for my $field (@methods) {
            $self->install_accessor(
                name => $field,
                code => sub {
                    local $DB::sub = local *__ANON__ = "${class}::${field}"
                      if defined &DB::DB && !$Devel::DProf::VERSION;
                    my ($self, @args) = @_;
                    $self->$slot()->$field(@args);
                },
            );
            $self->document_accessor(
                name    => $field,
                purpose => <
Calls $field() with the given arguments on the object stored in the $slot
slot.
EODOC
                examples => [ "\$obj->$field(\@args);", "\$obj->$field;", ],
            );
        }
    }
    $self;    # for chaining
}
1;


__END__