File Coverage

blib/lib/Class/Methodist.pm

Criterion	Covered	Total	%
statement	308	327	94.1
branch	77	94	81.9
condition	7	9	77.7
subroutine	59	64	92.1
pod	2	13	15.3
total	453	507	89.3

package Class::Methodist;

use strict;
use warnings;
use Carp;

=head1 NAME

Class::Methodist - define methods for instance variables in a class

=head1 SYNOPSIS

  package My::Shiny::New::Class;

  use Class::Methodist
  (
   scalar => 'global_config_path',
   hash => 'unique_words',
   list => 'file_names',
   object => { name => 'thing', class => 'My::Thing:Class' },
   enum => { name => 'color', domain => [ 'red', 'green', 'blue' ] },
   scalars => [ 'alpha', 'beta' ]
  );

  sub new {
    my ($class, $alpha) = @_;
    $class->beget(alpha => $alpha, beta => 42);
  }

=head1 DESCRIPTION

This package creates instance variables and methods on a class for
accessing and manipulating those instance variables.
C is similar in spirit to C, but
with a simpler interface and more sensible semantics.

Instance variables to be defined are given as a list of I
variable specifications> (a.k.a. I) when the module is
used.  A specification consists of a pair whose first element is the
I of the variable (e.g., C, C, C) and whose
second element is the I of the variable to be defined.  The
latter must be a valid Perl identifier name.

For each specification, the module defines a type-specific set of
methods on the calling class.  The names of these methods usually
include the name of the instance variable.  In the following sections,
we refer to the instance variable name by the generic identifier
I.

In your constructor you must call the C class method to
instantiate and initialize each instance of the class.

=head1 CLASS METHODS

=over

=item beget()

This class method instantiates and initializes an object of the class.
It takes the place of an explicit call to the Perl C function
(which it invokes under the hood).

You may pass arguments to C to initialize the new object.
These arguments must appear in pairs (as for a hash initializer).  The
first item in each pair should be the name of an attribute defined by
your use of C and the second item in each pair
should be the value to which that attribute is initialized.  Note that
if you initialize I or I attributes, you must pass the
initializer value as a I to an array or hash, respectively.

The C method blesses the new object into the class and returns
the blessed object.  You can either assign the return value to a
variable (often, C) for further construction, or may simply
invoke C as the final statement in your constructor, which
arranges to return the newly minted object to the caller.

=item import()

This method satisfies the C semantics required of any module
that uses C.  It takes as arguments the list of
specifications provided in the C directive in the calling module.
The method defines the instance variables and their associated methods
in the namespace of the I, also referred to as the
I.

=cut

sub import {
  my ($my_class, @args) = @_;
  my $dest_class = caller;	# Caller's class for importing methods.

  while (my ($type, $spec) = splice(@args, 0, 2)) {
  SWITCH:
    for ($type) {
      /ctor/ and do {
	define_constructor($dest_class, $spec);
	last SWITCH;
      };

      /enum/ and do {
	define_enum_methods($dest_class, $spec);
	last SWITCH;
      };

      /hash$/ and do {
	define_hash_methods($dest_class, $spec);
	last SWITCH;
      };

      /hash_of_lists/ and do {
	define_hash_of_lists_methods($dest_class, $spec);
	last SWITCH;
      };

      /list/ and do {
	define_list_methods($dest_class, $spec);
	last SWITCH;
      };

      /object/ and do {
	define_object_methods($dest_class, $spec);
	last SWITCH;
      };

      /scalar$/ and do {
	define_scalar_methods($dest_class, $spec);
	last SWITCH;
      };

      /scalars/ and do {
	define_scalar_methods($dest_class, $_) foreach @$spec;
	last SWITCH;
      };

      confess "Invalid type '$type'";
    }
  }

  define_utility_methods($dest_class);
}

#----------------------------------------------------------------

=item verify_method_not_defined($dest_class, $method)

We don't want to overwrite methods already defined in the calling
class.  Check whether C<$method> is defined in the destination class.
If so, throw an exception.

=cut

sub verify_method_not_defined {
  my ($dest_class, $method) = @_;

  use Devel::Symdump;
  my @functions = Devel::Symdump->new($dest_class)->functions();

  if (grep { $_ eq $method } @functions) {
    confess "Method '$method' already exists in class '$dest_class'";
  }
}

#----------------------------------------------------------------

=item define_method($dest_class, $method, $sub_ref)

Define a method named C<$method> in the destination class
C<$dest_class> to be the subroutine refererenced by C<$sub_ref>.  It
is an error to define a method that already exists.  This method is
the business end of this module in that all the following
type-specific methods invoke C in order to create the
method(s) associated with each instance variable.

=back

=cut

sub define_method {
  my ($dest_class, $method, $sub_ref) = @_;

  # Try turning this off for now.  Called a *lot*.  May not be of much
  # benefit.
  #
  # verify_method_not_defined($dest_class, $method);

  my $fq_name = sprintf('%s::%s', $dest_class, $method);
  {
    no strict 'refs';
    *{$fq_name} = $sub_ref;
  }
}

#----------------------------------------------------------------

{
  my %methodist_info;

  ## Return whether the named class has Methodist-internal data.  This
  ## subroutine was added to allow us to handle properly inheritance
  ## from classes that don't use Methodist (e.g., Class::Singleton).
  sub _has_methodist_info {
    my $dest_class = shift;
    exists $methodist_info{$dest_class};
  }

  ## Add @values to the list stored under $key in the Methodist-internal
  ## data for this class.
  sub _add_methodist_info {
    my ($dest_class, $key, @values) = @_;
    push @{$methodist_info{$dest_class}{$key}}, @values;
  }

  ## Return the list of values stored under $key in the
  ## Methodist-internal data for this class.  If no data are stored
  ## under that key, return an empty list.
  sub _get_methodist_info {
    my ($dest_class, $key) = @_;
    $methodist_info{$dest_class}{$key} ||= [ ];
    return @{$methodist_info{$dest_class}{$key}};
  }
}

#----------------------------------------------------------------

=head2 Constructor

Define a constructor in the destination class as follows:

   ctor => 'new'

The generated constructor simply blesses an anonymous hash into the
destination class.

=cut

sub define_constructor {
  my ($dest_class, $name) = @_;

  ## Bless a hash reference into the destination class.
  define_method($dest_class, $name,
		sub {
		  $dest_class->beget();
		});
}

#----------------------------------------------------------------

=head2 Enum

Define methods in the destination class for a scalar-valued instance
variable that is constrained to take one of an enumerated series of
values.

   enum => { name => 'colors',
             domain => [ qw/red green blue/ ],
             default => 'blue' }

The C and C attributes are required.  If the C
attribute is provided, its value must evaluate to a member of the
domain.

=over

=cut

sub define_enum_methods {
  my ($dest_class, $spec) = @_;

  my $name = $spec->{name};
  my @domain = @{$spec->{domain}};

  _add_methodist_info($dest_class, attributes => [ enum => $name ]);

  if (defined $spec->{default}) {
    croak sprintf("Default (%s) not among %s",
		  $spec->{default}, join(', ', @domain))
      unless (grep(/$spec->{default}/, @domain));
    _add_methodist_info($dest_class,
			default => [ $name => $spec->{default} ]);
  }

=item I(...)

The method named the same as the instance variable is the setter and
getter.  If called with no arguments, returns the current value of the
enumerated attribute.  If called with an argument, the scalar is set
to that value, provided the value is one of the values enumerated in
the C list.  If the value is not in the domain, throws an
error.

=back

=cut

  define_method($dest_class, $name,
		sub {
		  my ($self, $arg) = @_;
		  if (defined($arg)) {
		    if (grep(/$arg/, @domain)) {
		      $self->{$name} = $arg;
		    } else {
		      croak sprintf("%s not among %s",
				    $arg, join(', ', @domain));
		    }
		  }
		  $self->{$name};
		});
}

#----------------------------------------------------------------

=head2 Hash

Define methods in the destination class for a hash-valued instance
variable called I as follows:

   hash => 'inst_var'

This specification defines the following methods in the destination
class:

=over

=cut

sub define_hash_methods {
  my ($dest_class, $name) = @_;

  _add_methodist_info($dest_class, attributes => [ hash => $name ]);

=item I($key, [$value])

The method having the same name as the instance variable is the setter
and getter:

   my $value = $obj->inst_var('key');
   $obj->inst_var(key => 'value');

When called with a single argument, there are two cases.  First, if
the argument is a hash reference, replace the contents of the hash
with that of the referenced hash.  Second, if it is not a hash
reference, treat it as a key; the method returns the value stored
under that key.

When called with more than one argument, treat the arguments as
key-value pairs and store them in the hash.  There must be an even
number of arguments (i.e., they must be pairs).  Return the value of
the last pair.

=cut

  define_method($dest_class, $name,
		sub {
		  my ($self, @args) = @_;
		  my $rtn = undef;

		  if (@args == 1) {
		    if (ref $args[0] eq 'HASH') {
		      $self->{$name} = $args[0];
		    } else {
		      $rtn = $self->{$name}{$args[0]};
		    }
		  } else {
		    while (my ($key, $val) = splice(@args, 0, 2)) {
		      $rtn = $self->{$name}{$key} = $val;
		    }
		  }
		  return $rtn;
		});

=item I_exists($key)

Method that returns whether a key exists in the hash.

   if ($obj->inst_var_exists('key')) { ... }

=cut

  define_method($dest_class, "${name}_exists",
		sub {
		  my ($self, $key) = @_;
		  confess "Must supply key" unless defined $key;
		  exists $self->{$name}{$key} ? 1 : undef;
		});

=item I_keys()

Method that returns the list of keys in the hash.

   my @keys = $obj->inst_var_keys();

=cut

  define_method($dest_class, "${name}_keys",
		sub {
		  my $self = shift;
		  sort keys %{$self->{$name}};
		});

=item I_values()

Method that returns the list of values in the hash.

   my @values = $obj->inst_var_values();

=cut

  define_method($dest_class, "${name}_values",
		sub {
		  my $self = shift;
		  sort values %{$self->{$name}}
		});

=item I_clear()

Method that clears the hash.

   $obj->inst_var_clear();

=cut

  define_method($dest_class, "${name}_clear",
		sub {
		  my $self = shift;
		  $self->{$name} = { };
		});

=item I_delete($key)

Delete the hash element with the given key.

   $obj->inst_var_delete($key)

=cut

  define_method($dest_class, "${name}_delete",
		sub {
		  my ($self, $key) = @_;
		  delete $self->{$name}{$key};
		});

=item I_size()

Return the number of key-value pairs stored in the hash.

   my $size = inst_var_size();

=cut

  define_method($dest_class, "${name}_size",
		sub {
		  my $self = shift;
		  scalar keys %{$self->{$name}};
		});

=item I_inc($key, [$n])

Add the value of C<$n> to the value found under C<$key> in the hash.
The value of C<$n> defaults to one, yielding a simple increment
operation.  Return the new value.

=back

=cut

  define_method($dest_class, "${name}_inc",
		sub {
		  my ($self, $key, $n) = @_;
		  $n = 1 unless defined $n;
		  $self->{$name}{$key} += $n;
		});
}

#----------------------------------------------------------------

=head2 Hash of Lists

Define methods in the destination class for a hash-of-lists instance
variable called I as follows:

   hash_of_lists => 'inst_var'

This specification defines the following methods in the destination
class:

=over

=cut

sub define_hash_of_lists_methods {
  my ($dest_class, $name) = @_;

  _add_methodist_info($dest_class, attributes => [ hash => $name ]);

=item I(...)

The method having the same name as the instance variable is the setter
and getter.  Its behavior depends on the number of arguments passed to
the method.

When called with no arguments, the method returns all the values
stored in all the lists.

When called with one argument, it is treated as a key into the hash
and returns the values stored in the list having that hash key.

The method returns a list in array context and a reference to a list
in scalar context.

=cut

  define_method($dest_class, $name,
		sub {
		  my ($self, @args) = @_;

		  my @rtn;
		  if (@args == 0) {
		    # Called with no arguments.  Return all the values
		    # stored in all the lists.
		    push @rtn, @$_ foreach values %{$self->{$name}};
		  } elsif (@args == 1) {
		    # Called with one argument.  Return all the values
		    # stored in the list having that value as a key
		    my $key = $args[0];
		    $self->{$name}{$key} = [ ]
		      unless defined $self->{$name}{$key};
		    @rtn = @{$self->{$name}{$key}};
		  } else {
		    confess "Must have zero or one arguments";
		  }

		  # Return values as a list in list context and as a
		  # list reference in scalar context.
		  if (wantarray) {
		    return @rtn;
		  } else {
		    return \@rtn;
		  }
		});

=item I_push($key, @args)

Push C<@args> on the list stored under C<$key>.

=cut

  define_method($dest_class, "${name}_push",
		sub {
		  my ($self, $key, @args) = @_;
		  push @{$self->{$name}{$key}}, @args;
		});

=item I_keys()

Return a list of all the keys in the hash.

=back

=cut

  define_method($dest_class, "${name}_keys",
		sub {
		  my $self = shift;
		  keys %{$self->{$name}};
		});
}

#----------------------------------------------------------------

=head2 List

Define methods in the destination class for a list-valued instance
variable called I as follows:

   list => 'inst_var'

This specification defines the following methods in the destination
class:

=over

=cut

sub define_list_methods {
  my ($dest_class, $name) = @_;

  _add_methodist_info($dest_class, attributes => [ list => $name ]);

=item I(...)

The method named the same as the instance variable is the setter and
getter.  Its behavior depends on the number of arguments with which it
is invoked.

When called with no arguments, return the contents of the list (when
called in array context) or a reference to the list (when called in
scalar context).

When called with one argument that is a I to a list,
I the contents of the list with the contents of the
referenced list.  Otherwise, I the contents of the list with
the arguments.

=cut

  define_method($dest_class, $name,
		sub {
		  my ($self, @args) = @_;

		  if (@args == 0) {
		    # Called without arguments.  Return the contents
		    # of the list. as a list in list context and as a
		    # list reference in scalar context.
		    if (wantarray) {
		      return @{$self->{$name}};
		    } else {
		      return $self->{$name};
		    }
		  } elsif (@args == 1 and ref $args[0] eq 'ARRAY') {
		    # Called with reference to a list.  Replace the
		    # contents of the list with the elements
		    # referenced.
		    $self->{$name} = $args[0];
		  } else {
		    ## Called with multiple arguments. Replace the
		    ## contents of the list with those arguments
		    $self->{$name} = \@args;
		  }
		});

=item push_I(@args)

Given a list of values, push them on to the end of the list.  Return
the new number of list elements.

=cut

  define_method($dest_class, "push_$name",
		sub {
		  my ($self, @args) = @_;
		  push @{$self->{$name}}, @args;
		  scalar @{$self->{$name}};
		});

=item push_I_if_new(@args)

Given a list of values, push them on to the end of the list unless
they already exist on he list.  Returns the new number of list
elements.  Note that this method uses Perl's C function and so
is only suitable for short lists.

=cut

  define_method($dest_class, "push_${name}_if_new",
		sub {
		  my ($self, @args) = @_;
		  foreach my $arg (@args) {
		    push @{$self->{$name}}, $arg
		      unless grep($_ eq $arg, @{$self->{$name}});
		  }
		  scalar @{$self->{$name}};
		});

=item pop_I

Pop a single value from the end of the list and return it.

=cut

  define_method($dest_class, "pop_$name",
		sub {
		  my $self = shift;
		  pop @{$self->{$name}};
		});

=item unshift_I(@args)

Given a list of values, unshift them on to the front of the list.
Return the new number of list elements.

=cut

  define_method($dest_class, "unshift_$name",
		sub {
		  my ($self, @args) = @_;
		  unshift @{$self->{$name}}, @args;
		  scalar @{$self->{$name}};
		});

=item shift_I()

Shift a single value from the front of the list and return it.

=cut

  define_method($dest_class, "shift_$name",
		sub {
		  my $self = shift;
		  shift @{$self->{$name}};
		});

=item first_of_I()

Return (but do not remove) the first element in the list.  If the list
is empty, return undef.

=cut

  define_method($dest_class, "first_of_$name",
		sub {
		  my $self = shift;
		  @{$self->{$name}} ? $self->{$name}[0] : undef;
		});

=item last_of_I()

Return (but do not remove) the last element in the list.  If the list
is empty, return undef.

=cut

  define_method($dest_class, "last_of_$name",
		sub {
		  my $self = shift;
		  @{$self->{$name}} ? $self->{$name}[-1] : undef;
		});

=item count_I()

Return the number of elements currently on the list.

=cut

  define_method($dest_class, "count_$name",
		sub {
		  my $self = shift;
		  scalar @{$self->{$name}};
		});

=item clear_I()

Delete the contents of the list.

=cut

  define_method($dest_class, "clear_$name",
		sub {
		  my $self = shift;
		  $self->{$name} = [ ];
		});

=item join_I([$glue])

Return the join of the list.  The list is not modified.  If C<$glue>
is defined, join the list with the given glue.  Otherwise, join the
list with the empty string.

=cut

  define_method($dest_class, "join_$name",
		sub {
		  my ($self, $glue) = @_;
		  $glue = '' unless defined $glue;
		  join($glue, @{$self->{$name}});
		});

=item grep_I($re)

Return the list generated by grepping the list against C<$re>, which
must be a compiled regular express (usually using C).

=back

=cut

  define_method($dest_class, "grep_$name",
		sub {
		  my ($self, $re) = @_;
		  grep(/$re/, @{$self->{$name}});
		});
}

#----------------------------------------------------------------

=head2 Object

Define methods in the destination class for an object-valued instance
variable called I.

For specifications of this form (scalar-valued):

   object => 'inst_var'

the scalar is used as the name of the instance variable.

For specifications of this form (hash-reference-valued), the instance
variable is defined by attribute-value pairs in the referenced hash:

   object => { name => 'inst_var',
               class => 'Class::Name',
               delegate => [ 'method1', 'method2' ] }

The I C attribute gives the name of the instance
variable.

The I C attribute gives the name of the class (or one
of its superclasses) whose objects can be assigned to this instance
variable.  Attempting to set the instance variable to instances of
other classes throws an exception.

The I C attribute takes a reference to a list of
method names.  These methods are defined in the destination class as
methods that invoke the identically-named methods on the object
referenced by the instance variable.

This specification defines the following methods in the destination
class:

=over

=cut

sub define_object_methods {
  my ($dest_class, $spec) = @_;

  my $name = undef;
  my $required_class = undef;
  my @delegate;

  if (ref($spec) eq 'HASH') {
    $name = $spec->{name};
    $required_class = $spec->{class};
    @delegate = @{$spec->{delegate}} if exists $spec->{delegate};
  } else {
    $name = $spec;
  }

  confess "No name specified" unless defined $name;

=item I(...)

The method named the same as the instance variable is its getter and
setter.  When called with an argument, the instance variable is set to
that value.  If the specification includes a C attribute, the
argument must be an object of that class or its subclasses (tested
using Perl's C built-in).  Returns the value of the instance
variable (which may have just been set).

=cut

  define_method($dest_class, $name,
		sub {
		  my ($self, $arg) = @_;

		  if (defined $arg) {
		    # Called with an argument.
		    confess "Must pass an object as value" unless ref $arg;
		    if ($required_class) {
		      # The 'class' attribute was supplied; the
		      # argument must be of the specified class.
		      my $arg_class = ref $arg;
		      confess "Requires '$required_class', not '$arg_class'"
			unless $arg->isa($required_class);
		    }
		    # Assign the value to the argument.
		    $self->{$name} = $arg;
		  }

		  # Return the current object (whether arguments or not).
		  $self->{$name};
		});

  # Created delegates, if any.
  foreach my $delegate (@delegate) {
    define_method($dest_class, $delegate,
		  sub {
		    my ($self, @args) = @_;
		    $self->{$name}->$delegate(@args);
		  });
  }

=item clear_I()

Undefine the object instance variable.  This method is so named to
make it consistent with other methods defined by this module.

=back

=cut

  define_method($dest_class, "clear_$name",
		sub {
		  my $self = shift;
		  $self->{$name} = undef;
		});
}

#----------------------------------------------------------------

=head2 Scalar

Define methods in the destination class for a scalar-valued instance
variable called I as follows:

   scalar => 'inst_var'

Alternatively, you may supply a hash reference as the argument to the
C specification as follows:

  scalar => { name => 'inst_var', default => 42 }

In this case, the I C attribute gives the name of the
scalar in the destination class.  The I C attribute
supplies an initial value for the scalar in the destination class.

This specification defines the following methods in the destination
class:

=over

=cut

sub define_scalar_methods {
  my ($dest_class, $spec) = @_;

  my $name = undef;

  if (ref($spec) eq 'HASH') {
    $name = $spec->{name};

    if (defined $spec->{default}) {
      _add_methodist_info($dest_class,
			  default => [ $name => $spec->{default} ]);
    }
  } else {
    $name = $spec;
  }

  _add_methodist_info($dest_class, attributes => [ scalar => $name ]);

=item I(...)

The method named the same as the instance variable is the setter and
getter.  If called with no arguments, returns the current value of the
scalar.  If called with an argument, the scalar is assigned that
value.

=cut

  define_method($dest_class, $name,
		sub {
		  my ($self, $arg) = @_;
		  if (defined $arg) {
		    return $self->{$name} = $arg;
		  }
		  $self->{$name};
		});

=item clear_I()

Undefine the instance variable.  This method is so named to make it
consistent with other methods defined by this module.

=cut

  define_method($dest_class, "clear_$name",
		sub {
		  my $self = shift;
		  $self->{$name} = undef;
		});

=item add_to_I($val)

Add numeric $val to the current contents of the scalar.

=cut

  define_method($dest_class, "add_to_$name",
		sub {
		  my ($self, $val) = @_;
		  $self->{$name} += $val;
		});

=item inc_I()

Increment the scalar by one and return its new value.

=cut

  define_method($dest_class, "inc_$name",
		sub {
		  my $self = shift;
		  $self->{$name}++;
		});

=item dec_I()

Decrement the scalar by one and return its new value.

=cut

  define_method($dest_class, "dec_$name",
		sub {
		  my $self = shift;
		  $self->{$name}--;
		});

=item append_to_I($val)

Append string $val to the current contents of the scalar.

=back

=cut

  define_method($dest_class, "append_to_$name",
		sub {
		  my ($self, $val) = @_;
		  $self->{$name} .= $val;
		});
}

#----------------------------------------------------------------

=head2 Scalars

Define methods in the destination class for multiple scalar-valued
instance variables as follows:

   scalars => [ 'alpha', 'beta', 'gamma' ]

This specification is a convenience for defining multiple
scalar-valued instance variables.  It takes a reference to a list of
names and invokes the C specification for each.  Hence, the
above specification is entirely equivalent to this one:

   scalar => 'alpha',
   scalar => 'beta',
   scalar => 'gamma'

Note that there is no way to define a default value for each scalar in
the C construct; use multiple C specifications
instead.

=cut

#----------------------------------------------------------------

=head2 Utility

Define various utility methods.

=over

=cut

{
  use Class::ISA;

  # Cache previous results from self_and_super_path, which takes a
  # fair amount of time and is called a *lot* because it's in beget().
  my %self_and_super;

  # Invoke self_and_super_path (which returns the ordered list of
  # names of classes that Perl would search in order to find a
  # method).  Cache and return results.
  sub _self_and_super {
    my $class = shift;

    my $rtn = undef;
    if (exists $self_and_super{$class}) {
      $rtn = $self_and_super{$class};
    } else {
      my @self_and_super = Class::ISA::self_and_super_path($class);
      $rtn = $self_and_super{$class} = \@self_and_super;
    }

    return $rtn;
  }
}

sub define_utility_methods {
  my $dest_class = shift;

  define_method($dest_class, 'beget',
		sub {
		  my ($dest_class, %initializers) = @_;

		  my $self = bless { }, $dest_class;
		  $self->equip(%initializers);
		});

  define_method($dest_class, 'equip',
		sub {
		  my ($self, %initializers) = @_;

		  foreach my $class (@{_self_and_super(ref $self)}) {
		    next unless _has_methodist_info($class);

		    foreach my $pair (_get_methodist_info($class,
							  'attributes')) {
		      my ($type, $name) = @$pair;
		    SWITCH:
		      for ($type) {
			/scalar|enum/ and do {
			  $self->{$name} = undef;
			  last SWITCH;
			};
			/list/ and do {
			  $self->{$name} = [ ];
			  last SWITCH;
			};
			/hash/ and do {
			  $self->{$name} = { };
			  last SWITCH;
			};
			confess "Invalid type '$type'";
		      }
		    }

		    foreach my $pair (_get_methodist_info($class,
							  'default')) {
		      my ($name, $default) = @$pair;
		      $self->{$name} = $default;
		    }
		  }

		  while (my ($key, $value) = each %initializers) {
		    $self->$key($value);
		  }

		  return $self;
		});

  use Data::Dumper;
  $Data::Dumper::Indent = 1;

=item toString()

Define a method to convert an object to a string using
C.

=cut

  define_method($dest_class, 'toString',
		sub {
		  my $self = shift;
		  Data::Dumper->Dump([ $self ], [ ref $self ]);
		});

=item attributes_as_string(@attributes)

Return a string representation of the object, including attribute
name-value pairs for attributes named in parameter list.

=cut

  sub ansi_magenta { "\e[35m" }
  sub ansi_underline { "\e[4m" }
  sub ansi_reset { "\e[0m" }

  define_method($dest_class, 'attributes_as_string',
		sub {
		  my ($self, @attributes) = @_;
		  my @pairs;
		  foreach my $attribute (@attributes) {
		    my $value = $self->{$attribute} || 'UNDEF';

		    if (ref($value) eq 'ARRAY') {
		      $value = sprintf('[%s]', join(',', @$value));

		    } elsif (ref($value) eq 'HASH') {
		      my @contents =
			map { sprintf("%s=%s", $_, $value->{$_} || 'UNDEF') }
			  sort keys %$value;
		      $value = sprintf('{%s}', join(',', @contents));
		    }

		    # Use ANSI colorization for attribute name.
		    push @pairs,
		      sprintf('%s%s%s=%s',
			      ansi_magenta, $attribute, ansi_reset, $value)
		  }
		  sprintf('(%s %s)', ref($self), join(',', @pairs));
		});

=item dump([$msge])

Define a method to dump an object using C.  If C<$msge>
is defined, print it as a brief descriptive message before dumping the
object.  These methods are defined on all classes that use
C.

=cut

  define_method($dest_class, 'dump',
		sub {
		  my ($self, $msge) = @_;

		  print "==== $msge ====\n" if $msge;
		  print $self->toString();
		});
}

'SDG';				# Return true

__END__