view release on metacpan or  search on metacpan

lib/Discord/Client.pm  view on Meta::CPAN

}

sub _receive_gateway_event {
    my ( $self, $event, $data, $gateway, $packet, $received_at ) = @_;

    # Publish READY state before startup observers or application handlers run.
    $self->{cache}->apply( $event, $data ) if $self->{cache};
    if ( $event eq 'READY' ) {
        $self->{user} = $data->{user};
        $self->{commands}->application_id( $data->{application}{id} )
            if ref( $data->{application} ) eq 'HASH' && defined( $data->{application}{id} );
    }

    # Interaction admission has its own limit, independent of event callbacks.
    $self->_dispatch_interaction( $data, $received_at ) if $event eq 'INTERACTION_CREATE';
    return;
}

sub _dispatch_interaction {
    my ( $self, $data, $received_at ) = @_;

    # Pass receipt time through so queue delays count toward acknowledgement expiry.
    my %options = ( acknowledgement_only => 1 );
    $options{received_at} = $received_at if defined $received_at;
    my $acknowledgement = $self->{interactions}->handle( $data, %options );
    my $weak = $self;
    weaken($weak);

    # Report admission errors here; the dispatcher reports admitted handler errors.
    $acknowledgement->on_fail(
        sub {
            my ( undef, undef, $error ) = @_;
            return unless $weak && !$weak->{closed} && blessed($error);
            if ( $error->category eq 'protocol' || $error->category eq 'queue_full' ) {
                $weak->_report($error);
            }
        }
    );

    return $acknowledgement;
}

# These accessors expose shared components without fetching or copying resources.
sub loop { $_[0]->{loop} }
sub rest { $_[0]->{rest} }
sub gateway { $_[0]->{gateway} }
sub commands { $_[0]->{commands} }
sub interactions { $_[0]->{interactions} }
sub user { $_[0]->{user} }
sub cache { $_[0]->{cache} }

sub model {
    my ( $self, $type, $data ) = @_;
    require Discord::Client::Model;
    return Discord::Client::Model->wrap( $type, $data, rest => $self->{rest} );
}

sub stats {
    my ($self) = @_;

    # Expose counters without including credentials or event payloads.
    return {
        rest => $self->{rest}->stats,
        gateway => $self->{gateway}->stats,
        callbacks => scalar( keys %{ $self->{callbacks} } ),
        ( $self->{cache} ? ( cache => $self->{cache}->stats ) : () )
    };
}

sub command {
    my ( $self, @args ) = @_;
    $self->{commands}->define(@args);
    return $self;
}

sub component {
    my ( $self, @args ) = @_;
    $self->{commands}->component(@args);
    return $self;
}

sub on {
    my ( $self, $event, $callback ) = @_;

    # Normalize event names once so registration and delivery use the same keys.
    croak 'Event and callback are required' unless defined($event) && !ref($event) && ref($callback) eq 'CODE';
    push @{ $self->{handlers}{ uc($event) } }, $callback;
    return $self;
}

sub on_message {
    my ( $self, $callback ) = @_;
    croak 'Message callback must be a code reference' unless ref($callback) eq 'CODE';

    # Reuse event lifetime/error handling while presenting a REST-backed snapshot.
    return $self->on(
        MESSAGE_CREATE => sub {
            my ( $data, $packet, $bot ) = @_;
            my $message = $bot->model( message => $data );
            return $callback->( $message, $bot );
        }
    );
}

sub _emit {
    my ( $self, $event, @data ) = @_;
    return if $self->{closed};

    # Bound pending work before invoking another application callback.
    for my $callback ( @{ $self->{handlers}{ uc($event) } // [] } ) {
        last if $self->{closed};
        if ( keys( %{ $self->{callbacks} } ) >= $self->{max_callbacks} ) {
            $self->_report_error( 'Client event callback capacity exceeded', 'queue_full' );
            last;
        }

        # Isolate synchronous exceptions so later listeners can still run.
        my $future = eval { $callback->( @data, $self ) };
        if ($@) {
            $self->_report_error( 'Client event handler failed', 'handler' );
            next;

lib/Discord/Client.pm  view on Meta::CPAN

updates and command dispatch precede this queue; command dispatch is separately
bounded by C<interaction_options>.
C<on(error =E<gt> CODE)> receives the same arguments as C<on_error>.

=head2 on_message

    # Ignore bot messages and return the reply Future.
    $bot->on_message(sub {
        my ($message, $bot) = @_;
        return if $message->is_from_bot;
        return unless $message->content eq '!ping';
        return $message->reply('Pong!');
    });

Registers a callback receiving C<($message, $bot)> and returns the client.
The message is a L<Discord::Client::Model::Message> snapshot using the client's
REST transport. Wrapping performs no request and needs no cache.
Set message intents explicitly and enable Message Content in the Developer
Portal when reading message text. Bot messages are not filtered automatically.
Raw C<MESSAGE_CREATE> callbacks still receive hashrefs.

=head2 model

    my $channel = $bot->model(channel => {id => $channel_id});

Synchronously wraps data with the client's REST transport. Types are C<message>,
C<channel>, C<user> and C<guild>; see L<Discord::Client::Model/wrap>.
Invalid data throws. Wrapping performs no request.

=head2 rest

Returns the L<Discord::Client::REST> client.

=head2 gateway

Returns the L<Discord::Client::Gateway> or L<Discord::Client::Gateway::Shards>.

=head2 commands

Returns the L<Discord::Client::Commands> registry.

=head2 interactions

Returns the L<Discord::Client::Interactions> dispatcher.

=head2 loop

Returns the IO::Async::Loop.

=head2 user

Returns the bot user hashref after READY, or undef before it.

=head2 cache

Returns the configured Cache object, or undef when disabled.

=head2 stats

Returns a hashref of REST, Gateway, pending callback and optional cache counters.
It does not include payloads or credentials.

=head1 EXAMPLES

From a source checkout, set C<DISCORD_BOT_TOKEN> and C<TEST_GUILD_ID>.
Invite the bot with C<bot> and C<applications.commands> scopes and leave the
Interactions Endpoint URL empty for Gateway delivery.

    # Deploy /ping once, then run the bot.
    perl examples/sync-commands.pl examples/ping.pl
    perl examples/ping.pl

Deployment replaces this application's commands in the test server, removing
commands absent from the example. Run one example receiver per bot token.

The L<example scripts|https://github.com/viasnake/Discord-Client/tree/main/examples>
cover arguments, buttons, forms, channels, messages and asynchronous work.
Replace C<ping.pl> in both commands to run a slash-command example.
C<messages.pl> needs no deployment; it selects C<GUILDS>, C<GUILD_MESSAGES>,
C<DIRECT_MESSAGES> and C<MESSAGE_CONTENT>. Enable Message Content in the portal.
C<workflow-await.pl> additionally needs C<cpanm Future::AsyncAwait>.
For dependencies under C<local/>, prefix commands with C<PERL5LIB=local/lib/perl5>.

=head1 LICENSE

Apache License 2.0.

=cut