The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Bot::Backbone::DispatchSugar;
BEGIN {
  $Bot::Backbone::DispatchSugar::VERSION = '0.112500';
}
use v5.10;
use Moose();
use Moose::Exporter;
use Carp();

use Bot::Backbone::Dispatcher::Predicate;

# ABSTRACT: Shared sugar methods for dispatch


Moose::Exporter->setup_import_methods(
    with_meta => [ qw( 
        command not_command
        to_me not_to_me
        given_parameters
        also
        respond respond_by_method 
        run_this run_this_method
        redispatch_to 
    ) ],
    as_is => [ qw( parameter as ) ],
);

sub redispatch_to($) {
    my ($meta, $name) = @_;
    my $dispatcher = $meta->building_dispatcher;

    $dispatcher->add_predicate_or_return(
        Bot::Backbone::Dispatcher::Predicate::RedispatchTo->new(
            name            => $name,
        )
    );
}

sub also($) {
    my ($meta, $predicate) = @_;
    my $dispatcher = $meta->building_dispatcher;
    $dispatcher->add_also_predicate($predicate);
}

sub command($$) { 
    my ($meta, $match, $predicate) = @_;
    my $dispatcher = $meta->building_dispatcher;

    $dispatcher->add_predicate_or_return(
        Bot::Backbone::Dispatcher::Predicate::Command->new(
            match           => $match,
            next_predicate  => $predicate,
        )
    );
}

sub not_command($) {
    my ($meta, $predicate) = @_;
    my $dispatcher = $meta->building_dispatcher;

    $dispatcher->add_predicate_or_return(
        Bot::Backbone::Dispatcher::Predicate::NotCommand->new(
            next_predicate  => $predicate,
        )
    );
}

sub to_me($) {
    my ($meta, $predicate) = @_;
    my $dispatcher = $meta->building_dispatcher;

    $dispatcher->add_predicate_or_return(
        Bot::Backbone::Dispatcher::Predicate::ToMe->new(
            next_predicate  => $predicate,
        )
    );
}

sub not_to_me($) {
    my ($meta, $predicate) = @_;
    my $dispatcher = $meta->building_dispatcher;

    $dispatcher->add_predicate_or_return(
        Bot::Backbone::Dispatcher::Predicate::ToMe->new(
            negate          => 1,
            next_predicate  => $predicate,
        )
    );
}

our $WITH_ARGS;
sub given_parameters(&$) {
    my ($meta, $arg_code, $predicate) = @_;
    my $dispatcher = $meta->building_dispatcher;

    my @args;
    {
        local $WITH_ARGS = \@args;
        $arg_code->();
    }

    $dispatcher->add_predicate_or_return(
        Bot::Backbone::Dispatcher::Predicate::GivenParameters->new(
            parameters      => \@args,
            next_predicate  => $predicate,
        )
    );
}

sub parameter($@) {
    my ($name, %config) = @_;
    push @$WITH_ARGS, [ $name, \%config ];
}

sub as(&) { 
    my $code = shift;
    return $code;
}

sub _respond { 
    my ($meta, $code) = @_;
    my $dispatcher = $meta->building_dispatcher;

    $dispatcher->add_predicate_or_return(
        Bot::Backbone::Dispatcher::Predicate::Respond->new(
            dispatcher_type => $meta,
            the_code        => $code,
        )
    );
}

sub respond(&) {
    my ($meta, $code) = @_;
    _respond($meta, $code);
}

sub _run_this {
    my ($meta, $code) = @_;
    my $dispatcher = $meta->building_dispatcher;

    $dispatcher->add_predicate_or_return(
        Bot::Backbone::Dispatcher::Predicate::Run->new(
            dispatcher_type => $meta,
            the_code        => $code,
        )
    );
}

sub run_this(&) {
    my ($meta, $code) = @_;
    _run_this($meta, $code);
}

sub _by_method {
    my ($meta, $name) = @_;

    Carp::croak("no such method as $name found on ", $meta->name)
        unless defined $meta->find_method_by_name($name);

    return sub {
        my ($self, $message) = @_;

        my $method = $self->can($name);
        if (defined $method) {
            return $self->$method($message);
        }
        else {
            Carp::croak("no such method as $name found on ", $self->meta->name);
        }
    };
}

sub respond_by_method($) {
    my ($meta, $name) = @_;

    my $code = _by_method($meta, $name);
    _respond($meta, \&$code);
}

sub run_this_method($) {
    my ($meta, $name) = @_;

    my $code = _by_method($meta, $name);
    _run_this($meta, \&$code);
}

# These are documented in Bot::Backbone and Bot::Backbone::Service



1;

__END__
=pod

=head1 NAME

Bot::Backbone::DispatchSugar - Shared sugar methods for dispatch

=head1 VERSION

version 0.112500

=head1 DESCRIPTION

Do not use this package directly. 

See L<Bot::Backbone> and L<Bot::Backbone::Service>.

=for Pod::Coverage   also
  as
  command
  given_parameters
  not_command
  not_to_me
  parameter
  redispatch_to
  respond
  respond_by_method
  run_this
  run_this_method
  to_me

=head1 AUTHOR

Andrew Sterling Hanenkamp <hanenkamp@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2011 by Qubling Software LLC.

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