view release on metacpan or  search on metacpan

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

sub new {
  my ($class, %args) = @_;

  my $self = {
    token => delete($args{token}),
    api_root => delete($args{api_root}) // 'https://discordapp.com/api',
    prefix => delete($args{prefix}) // "!",
    commands => delete($args{commands}) // {},

    ua => LWP::UserAgent->new(),
    api_useragent => "DiscordBot (https://github.com/topaz/perl-AnyEvent-Discord-Client, 0)",

    user => undef,
    guilds => {},
    channels => {},
    roles => {},

    gateway => undef,
    conn => undef,
    websocket => undef,
    heartbeat_timer => undef,
    last_seq => undef,
    reconnect_delay => 1,
  };

  die "cannot construct new $class without a token parameter" unless defined $self->{token};
  die "unrecognized extra parameters were given to $class->new" if %args;

  return bless $self, $class;
}

sub commands { $_[0]{commands} }
sub user     { $_[0]{user}     }
sub guilds   { $_[0]{guilds}   }
sub channels { $_[0]{channels} }
sub roles    { $_[0]{roles}    }

my %event_handler = (
  READY => sub {
    my ($self, $d) = @_;
    $self->{user} = $d->{user};
    print "logged in as $self->{user}{username}.\n";
    print "ready!\n";
  },
  GUILD_CREATE => sub {
    my ($self, $d) = @_;
    $self->{guilds}{$d->{id}} = $d;
    $self->{channels}{$_->{id}} = {%$_, guild_id=>$d->{id}} for @{$d->{channels}};
    $self->{roles}{$_->{id}}    = {%$_, guild_id=>$d->{id}} for @{$d->{roles}};
    print "created guild $d->{id} ($d->{name})\n";
  },
  CHANNEL_CREATE => sub {
    my ($self, $d) = @_;
    $self->{channels}{$d->{id}} = $d;
    push @{$self->{guilds}{$d->{guild_id}}{channels}}, $d if $d->{guild_id};
    print "created channel $d->{id} ($d->{name}) of guild $d->{guild_id} ($self->{guilds}{$d->{guild_id}}{name})\n";
  },
  CHANNEL_UPDATE => sub {
    my ($self, $d) = @_;
    %{$self->{channels}{$d->{id}}} = %$d;
    print "updated channel $d->{id} ($d->{name}) of guild $d->{guild_id} ($self->{guilds}{$d->{guild_id}}{name})\n";
  },
  CHANNEL_DELETE => sub {
    my ($self, $d) = @_;
    @{$self->{guilds}{$d->{guild_id}}{channels}} = grep {$_->{id} != $d->{id}} @{$self->{guilds}{$d->{guild_id}}{channels}} if $d->{guild_id};
    delete $self->{channels}{$d->{id}};
    print "deleted channel $d->{id} ($d->{name}) of guild $d->{guild_id} ($self->{guilds}{$d->{guild_id}}{name})\n";
  },
  GUILD_ROLE_CREATE => sub {
    my ($self, $d) = @_;
    $self->{roles}{$d->{role}{id}} = $d->{role};
    push @{$self->{guilds}{$d->{guild_id}}{roles}}, $d->{role} if $d->{guild_id};
    print "created role $d->{role}{id} ($d->{role}{name}) of guild $d->{guild_id} ($self->{guilds}{$d->{guild_id}}{name})\n";
  },
  GUILD_ROLE_UPDATE => sub {
    my ($self, $d) = @_;
    %{$self->{roles}{$d->{role}{id}}} = %{$d->{role}};
    print "updated role $d->{role}{id} ($d->{role}{name}) of guild $d->{guild_id} ($self->{guilds}{$d->{guild_id}}{name})\n";
  },
  GUILD_ROLE_DELETE => sub {
    my ($self, $d) = @_;
    @{$self->{guilds}{$d->{guild_id}}{roles}} = grep {$_->{role}{id} != $d->{role}{id}} @{$self->{guilds}{$d->{guild_id}}{roles}} if $d->{guild_id};
    delete $self->{roles}{$d->{role}{id}};
    print "deleted role $d->{role}{id} ($d->{role}{name}) of guild $d->{guild_id} ($self->{guilds}{$d->{guild_id}}{name})\n";
  },
  TYPING_START => sub {},
  MESSAGE_CREATE => sub {
    my ($self, $msg) = @_;
    my $channel = $self->{channels}{$msg->{channel_id}};
    my $guild = $self->{guilds}{$channel->{guild_id}};

    #(my $hrcontent = $msg->{content) =~ s/[\x00-\x
    print "[$guild->{name} ($guild->{id}) / $channel->{name} ($channel->{id})] <$msg->{author}{username}> $msg->{content}\n";
    #print STDERR join(",",unpack("U*", $msg->{content}))."\n";
    return if $msg->{author}{id} == $self->{user}{id};

    if ($msg->{content} =~ /^\Q$self->{prefix}\E(\S+)(?:\s+(.*?))?\s*$/ || $msg->{content} =~ /^\s*(.*?)\s*$/) {
      my ($cmd, $args) = (lc $1, defined $2 ? $2 : "");
      if (exists $self->{commands}{$cmd}) {
        $self->{commands}{$cmd}($self, $args, $msg, $channel, $guild);
      }
    }
  },
);

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

  if (!defined $self->{gateway}) {
    # look up gateway url
    my $gateway_data = $self->api_sync(GET => "/gateway");
    my $gateway = $gateway_data->{url};
    die 'invalid gateway' unless $gateway =~ /^wss\:\/\//;
    $gateway = new URI($gateway);
    $gateway->path("/") unless length $gateway->path;
    $gateway->query_form(v=>6, encoding=>"json");
    $self->{gateway} = "$gateway";
  }

  print "Connecting to $self->{gateway}...\n";

  $self->{reconnect_delay} *= 2;
  $self->{reconnect_delay} = 5*60 if $self->{reconnect_delay} > 5*60;

  $self->{websocket} = AnyEvent::WebSocket::Client->new(max_payload_size => 1024*1024);
  $self->{websocket}->connect($self->{gateway})->cb(sub {
    $self->{conn} = eval { shift->recv };
    if($@) {
      print "$@\n";
      return;
    }

    print "websocket connected to $self->{gateway}.\n";
    $self->{reconnect_delay} = 1;

    # send "identify" op
    $self->websocket_send(2, {
      token => $self->{token},