MooseX/Automethod.pm
package MooseX::Automethod;

our $VERSION = '1.0.0';

use Moose::Exporter;

# Saying "use MooseX::Automethod" applies the following
# role package to the base class.

Moose::Exporter->setup_import_methods
   (
    base_class_roles => ['MooseX::Automethod::Role::Object'],
   );

# END OF package MooseX::Automethod
# ---------------------------------

# -------------------------------------------------
# Create the role to add AUTOLOAD to the base class

package MooseX::Automethod::Role::Object;

use Moose::Role;
use Carp;

sub AUTOLOAD
{
   my @method_params = @_;
   my $invocant      = shift @method_params; # Who or what called me?

   # Class of object or "bare" class
   my $invocant_class = ref $invocant || $invocant;

   # Separate the name of the calling method from its package name
   my ($package_name, $method_name) = our $AUTOLOAD =~ m/ (.*) :: (.*) /xms;

   # Look in class hierarchy (left-depth-first) for defined AUTOMETHODs to handle the calling method
   foreach my $automethod ( Class::MOP::class_of($invocant)->find_all_methods_by_name('AUTOMETHOD') )
   {
      # Found an AUTOMETHOD
      # Execute the AUTOMETHOD to see if it can handle the method name.
      no strict 'refs';
      my $method_handler_ref
         = $automethod->{code}->execute
            ($invocant,
             {'method'  => $method_name,
              'package' => $package_name},
             @method_params);

      # If the AUTOMETHOD recognizes the calling method, it returned
      # a handler (CODE) reference...
      if ($method_handler_ref)
      {
         # Verify that a CODE reference was returned.
         my $method_handler_ref_type = ref $method_handler_ref;
         if ($method_handler_ref_type eq 'CODE')
         {
            # Classic AUTOLOAD execution; method handled
            # (passes @_ on to handler method).
            goto &$method_handler_ref;
         }
         else
         {
            # Returned non-CODE reference.
            # Die complaining about it.
            my $automethod_loc = $automethod->{class};
            croak qq{AUTOMETHOD found in $automethod_loc returned non-CODE ref ($method_handler_ref_type)};
         }

      } # End if ($method_handler_ref)

      # Otherwise, the AUTOMETHOD didn't recognize the calling method
      # and returned undef; try the next found AUTOMETHOD.

   } # End of foreach

   # None of the found AUTOMETHODs recognized the calling method.
   # Die complaining about it.
   my $type = ref $invocant ? 'object' : 'class';
   croak qq{Can't locate $type method "$method_name" via class hierarchy of "$package_name"};

} # End of sub AUTOLOAD

# Modules return true
1;
__END__

=head1 NAME

MooseX::Automethod - Deferrable AUTOLOAD methods for use with Moose classes.  From the same concept in L<Class::Std>.

=head1 SYNOPSIS

    package MyBaseClass;
    use Moose;              # MyBaseClass is now a class
    use MooseX::Automethod; # Only need to use with base class

    sub AUTOMETHOD
    {
       my $invocant   = shift;
       my $caller_ref = shift;
       my @method_params = @_;
       if ($caller_ref->{'method'} eq 'baz')
       {
          return sub
          {
             my $invocant       = shift;
             my @handler_params = @_;
             # Handler code for 'baz'...
          }
       }
       # MyBaseClass doesn't handle $caller_ref->{'method'}
       return;
    }

    __PACKAGE__->meta->make_immutable;

    package MyLeftSubclass;
    use Moose; # MyLeftSubclass is now a class

    extends 'MyBaseClass';

    sub AUTOMETHOD
    {
       my $invocant   = shift;
       my $caller_ref = shift;
       my @method_params = @_;
       if ($caller_ref->{'method'} eq 'foo')
       {
          return \&namedHandlerFunc;
       }
       # MyLeftSubclass doesn't handle $caller_ref->{'method'}
       return;
    }

    sub namedHandlerFunc
    {
       my $invocant       = shift;
       my @handler_params = @_;
       # Handler code for 'foo'...
    }

    __PACKAGE__->meta->make_immutable;

    package MyRightSubclass;
    use Moose; # MyRightSubclass is now a class

    extends 'MyBaseClass';

    sub AUTOMETHOD
    {
       my $invocant   = shift;
       my $caller_ref = shift;
       my @method_params = @_;
       if ($caller_ref->{'method'} eq 'bar')
       {
          return sub
          {
             my $invocant       = shift;
             my @handler_params = @_;
             # Handler code for 'bar'...
          }
       }
       # MyRightSubclass doesn't handle $caller_ref->{'method'}
       return;
    }

    __PACKAGE__->meta->make_immutable;

    package MyMultiInheritSubclass;
    use Moose; # MyMultiInheritSubclass is now a class

    extends 'MyLeftSubclass', 'MyRightSubclass';

    sub AUTOMETHOD
    {
       my $invocant   = shift;
       my $caller_ref = shift;
       my @method_params = @_;
       if ($caller_ref->{'method'} eq 'foobar')
       {
          return \&namedHandlerMethod;
       }
       # MyMultiInheritSubclass doesn't handle $caller_ref->{'method'}
       return;
    }

    sub namedHandlerMethod
    {
       my $invocant       = shift;
       my @handler_params = @_;
       # Handler code for 'foobar'...
    }

    __PACKAGE__->meta->make_immutable;

=head1 DESCRIPTION

This L<Moose> extension is I<nearly> identical to the feature in L<Class::Std> 
(please see the AUTOMETHOD description there under the B<Methods that can 
be supplied by the developer> subheading).

By adding C<use MooseX::Automethod;> to a base class using Moose, the base
class and any subclass in the hierarchy can specify an AUTOMETHOD method
that can handle (actually specify a handler for) unrecognized method calls...
or gracefully defer them.  Specifying an AUTOMETHOD is not required for
every class in the hierarchy - just the classes that make sense to handle
the variable method names.

When an object calls an unrecognized method, the AUTOLOAD will start searching
for AUTOMETHODs, starting with the object's class and working back up the
class hierarchy (depth-first, left-to-right).  For each AUTOMETHOD found, it is
called with C<@_> containing the following:

=over 4

=item C<$_[0]>

The invocant (a.k.a. "self", "this") object reference

=item C<$_[1]>

HASH reference with the following key-value pairs:

=over 8

=item B<'method'>

I<String>. The (unrecognized) method name that was called.

=item B<'package'>

I<String>. The package of the calling method.

=back

=item C<@_> REMAINING ITEMS

Any remaining items in C<@_> (index 2+) are the parameters originally
passed to the calling method.

=back

The developer-implemented AUTOMETHOD should then (at a minimum) inspect
the value of the HASH's B<'method'> key to determine if it a method name
that the class recognizes and expects to handle.  If the class recognizes
the method name as a method it can handle, the AUTOMETHOD is expected
to return a CODE reference of the subroutine (anonymous or named) that
treats the method called as a normal class method.  Otherwise, if the class
B<doesn't> recognize the method name as a method it can handle, then
the AUTOMETHOD is expected to C<return; #undef>, as if to say "I won't
handle this method, but maybe another class's AUTOMETHOD will."

So the basic structure of an AUTOMETHOD is...

    sub AUTOMETHOD
    {
       my $invocant   = shift;
       my $caller_ref = shift;
       my @method_params = @_;

       # Inspect $caller_ref->{'method'} to determine if it is
       # a method name I recognize.

          # If it is a method I can handle,
          # return method CODE reference

          return sub { ... } # Anonymous
          # ... or ...
          return \&foo; # Named

       # ...or, if its a method I can't handle...

          return; #undef
    }

If the AUTOMETHOD returns a CODE reference, that CODE reference
is then called as if it were the method called to begin with (including
the contents of C<@_>).  And as stated before, if the AUTOMETHOD
returns C<undef>, then the AUTOLOAD moves on to the next
AUTOMETHOD it found.

If the AUTOLOAD runs out of AUTOMETHODs (i.e. they all returned
C<undef>), it croaks.

=head1 AUTHORS

Original author: Jess Odum

=head1 COPYRIGHT AND LICENSE

This software is copyright © 2011 Jess Odum.

This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.

=cut
Unless otherwise stated, the content of this page is licensed under Creative Commons Attribution-ShareAlike 3.0 License