package Class::AppendMethods;

use strict;
use warnings;
use vars qw(@ISA @EXPORT_OK $VERSION %METHODS);

require Exporter;

@ISA = qw(Exporter);
@EXPORT_OK = qw(append_method);
$VERSION = '0.01';

sub append_method {
    my $method_name = shift;
    my $method_to_install = shift;
    no strict 'refs';
    no warnings 'redefine';

    # If I was given a method name then fetch the code
    # reference from the named slot
    unless (ref $method_to_install ) {
        # symref
        $method_to_install = \&{$method_to_install};
    }

    # Track the list of references to install
    unless (exists $METHODS{$method_name}) {
        $METHODS{$method_name} = [];
    }
    my $pre_existing_methods = $METHODS{$method_name};
    push @$pre_existing_methods, $method_to_install;

    # Install the new methods
    if (*{$method_name}{CODE}) {
        # If the pre-existing method isn't in the local cache then copy it over
        # first.
        unless (grep $_ == *{$method_name}{CODE}, @$pre_existing_methods) {
            unshift @$pre_existing_methods, *{$method_name}{CODE};
        }

        # Already existing method
        *{$method_name} = sub {
            $_[0]->$_( @_[1 .. $#_] ) for @$pre_existing_methods;
        };
    } else {
        # Single method - no special calling
        *{$method_name} = $method_to_install;
    }


    # Return the method as a convenience (for who knows what, I don't know)
    return *{$method_name}{CODE};
}

1;
__END__

=head1 NAME

Class::AppendMethods - Install multiple methods into a single slot

=head1 SYNOPSIS

  use Class::AppendMethods 'append_method';

  # This installs both versioning_hook and auditing_hook into the
  # method Object::pre_insert.
  for my $hook (qw(versioning auditing)) {
      append_method( 'Object::pre_insert', "${hook}_hook" );
  }

  sub versioning_hook { ... }
  sub auditing_hook { ... }

=head1 DESCRIPTION

This allows you to install more than one method into a single method name.
I created this so I could install both versioning and auditing hooks into
another module's object space. So instead of creating a single larger method
which incorporates the functionality of both hooks I created
C<Class::AppendMethods::append_method> to install a wrapper method as needed.

If only one method is ever installed into a space, it is installed directly
with no wrapper. If you install more than one then C<append_method> creates a
wrapper which calls each of the specified methods in turn.

=head1 PUBLIC METHODS

=over 4

=item append_method

 append_method( $method_name, $method );

This function takes two parameters - the fully qualified name of the method
to install into and the method to install.

C<$method_name> must be the fully qualified method name. This means that for
the method C<pre_insert> of a C<Foo::Bar> object you must pass in
C<'Foo::Bar::pre_insert'>.

C<$method> may be either a code reference or the fully qualified name of the
method to use.

=back

=head2 EXAMPLES

=over 4

=item Example 1

 use Class::AppendMethods 'append_method';

 # This installs both versioning_hook and auditing_hook into the
 # method Object::pre_insert.
 for my $hook (qw(versioning auditing)) {
     append_method( 'Object::pre_insert', "${hook}_hook" );
 }

 sub versioning_hook { ... }
 sub auditing_hook { ... }

=item Example 2

 use Class::AppendMethods 'append_method';

 my @versioned_tables = ( .... );
 my @audited_tables = ( .... );

 for my $table_list ( { tables => \ @versioned_tables,
                        prefix => 'versioned' },
                      { tables => \ @audited_tables,
                        prefix => 'audited' } ) {
     my $tables = $table_list->{'tables'};
     my $prefix = $table_list->{'prefix'};

     for my $table ( @$tables ) {
         for my $hook ( qw[pre_insert pre_update pre_delete]) {

             my $method_name = "GreenPartyDB::Database::${table}::${hook}";
             my $method_inst = __PACKAGE__ . "::${prefix}_${hook}";
             append_method( $method_name, $method_inst );
         }
     }
 }

 sub versioned_pre_insert { ... }
 sub versioned_pre_update { ... }
 sub versioned_pre_delete { ... }
 sub audited_pre_insert { ... }
 sub audited_pre_update { ... }
 sub audited_pre_delete { ... }

=back

=head2 EXPORT

This class optionally exports the C<append_method> function.

=cut