v4.0.0: Modular commands, NMDCClient fix, OPChat

NMDCClient.pm

@@ -73,37 +73,49 @@ sub connect {
     $self->_send("\$Key $key|");
     $self->_send("\$ValidateNick $self->{nick}|");
 
-    # Read response — might be $Hello, $GetPass, or $ValidateDenide
-    my $response = $self->_read_message(5);
-    if (!$response) {
-        $logger->error("No response after ValidateNick");
-        $self->disconnect();
-        return 0;
-    }
-
-    # Handle password request
-    if ($response =~ /\$GetPass/) {
-        if ($self->{password}) {
-            $self->_send("\$MyPass $self->{password}|");
-            $response = $self->_read_message(5);
-        } else {
-            $logger->error("Hub requires password but none configured");
+    # Read messages until we get $Hello, $GetPass, or $ValidateDenide.
+    # The hub may send $HubName, <Hub-Security> welcome, etc. first.
+    my $logged_in = 0;
+    my $attempts = 0;
+    while ($attempts < 20) {
+        my $response = $self->_read_message(5);
+        last unless defined $response;
+        $attempts++;
+
+        if ($response =~ /\$GetPass/) {
+            if ($self->{password}) {
+                $self->_send("\$MyPass $self->{password}|");
+                # Continue reading for $Hello or $BadPass
+                next;
+            } else {
+                $logger->error("Hub requires password but none configured");
+                $self->disconnect();
+                return 0;
+            }
+        }
+        elsif ($response =~ /\$ValidateDenide/) {
+            $logger->error("Nick validation denied by hub");
             $self->disconnect();
             return 0;
         }
+        elsif ($response =~ /\$BadPass/) {
+            $logger->error("Bad password for $self->{nick}");
+            $self->disconnect();
+            return 0;
+        }
+        elsif ($response =~ /\$Hello\s+\Q$self->{nick}\E/) {
+            $logged_in = 1;
+            last;
+        }
+        # Ignore $HubName, <Hub-Security>, $Supports, $NickList, etc.
     }
 
-    if ($response =~ /\$ValidateDenide/) {
-        $logger->error("Nick validation denied by hub");
+    unless ($logged_in) {
+        $logger->error("Login failed after $attempts messages");
         $self->disconnect();
         return 0;
     }
 
-    # Should have $Hello at this point (possibly in the response)
-    unless ($response =~ /\$Hello\s+\Q$self->{nick}\E/) {
-        $logger->warn("Expected \$Hello, got: $response (continuing anyway)");
-    }
-
     # Send our info
     $self->_send("\$Version 1,0091|");
     $self->_send("\$GetNickList|");

commands_v4/coin.pm

@@ -0,0 +1,14 @@
+package commands_v4::coin;
+use strict; use warnings;
+
+sub name { 'coin' }
+sub aliases { () }
+sub help { '!coin — Flip a coin' }
+
+sub run {
+    my ($from_nick, $args, $client, $gateway) = @_;
+    my @options = ('Heads!', 'Tails!');
+    return $options[int(rand(2))];
+}
+
+1;

commands_v4/lasercats.pm

@@ -0,0 +1,26 @@
+package commands_v4::lasercats;
+use strict; use warnings;
+
+sub name { 'lasercats' }
+sub aliases { () }
+sub help { '!lasercats — PEW PEW PEW (also kicks you)' }
+
+sub run {
+    my ($from_nick, $args, $client, $gateway) = @_;
+    $client->send_chat('  /\_/\  PEW PEW PEW');
+    $client->send_chat(' ( o.o ) ----=======');
+    $client->send_chat('  > ^ <');
+    # Kick the invoker (tradition!)
+    eval {
+        my $ua = $gateway->{ua};
+        my $url = "$gateway->{base_url}/api/v1/users/$from_nick/kick";
+        my $req = HTTP::Request->new(POST => $url);
+        $req->header('Content-Type' => 'application/json');
+        $req->header('X-API-Key' => $gateway->{api_key});
+        $req->content('{"reason":"LASERCATS PEW PEW PEW"}');
+        $ua->request($req);
+    };
+    return undef; # already sent
+}
+
+1;

commands_v4/magic_8ball.pm

@@ -0,0 +1,24 @@
+package commands_v4::magic_8ball;
+use strict; use warnings;
+
+sub name { 'magic_8ball' }
+sub aliases { ('8ball') }
+sub help { '!8ball <question> — Ask the Magic 8 Ball' }
+
+my @ANSWERS = (
+    "It is certain.", "It is decidedly so.", "Without a doubt.",
+    "Yes definitely.", "You may rely on it.", "As I see it, yes.",
+    "Most likely.", "Outlook good.", "Yes.", "Signs point to yes.",
+    "Reply hazy, try again.", "Ask again later.",
+    "Better not tell you now.", "Cannot predict now.",
+    "Concentrate and ask again.", "Don't count on it.",
+    "My reply is no.", "My sources say no.",
+    "Outlook not so good.", "Very doubtful.",
+);
+
+sub run {
+    my ($from_nick, $args, $client, $gateway) = @_;
+    return $ANSWERS[int(rand(scalar @ANSWERS))];
+}
+
+1;

commands_v4/roll.pm

@@ -0,0 +1,20 @@
+package commands_v4::roll;
+use strict; use warnings;
+
+sub name { 'roll' }
+sub aliases { () }
+sub help { '!roll [NdS] — Roll dice (e.g. !roll 2d6)' }
+
+sub run {
+    my ($from_nick, $args, $client, $gateway) = @_;
+    my ($count, $sides) = ($args =~ /^(\d+)?d(\d+)$/i);
+    $count ||= 1; $sides ||= 6;
+    $count = 10 if $count > 10;
+    $sides = 1000 if $sides > 1000;
+    my @rolls = map { int(rand($sides)) + 1 } 1..$count;
+    my $total = 0; $total += $_ for @rolls;
+    return sprintf("%s rolled %dd%d: %s (total: %d)",
+        $from_nick, $count, $sides, join(', ', @rolls), $total);
+}
+
+1;

commands_v4/russianroulette.pm

@@ -0,0 +1,27 @@
+package commands_v4::russianroulette;
+use strict; use warnings;
+
+sub name { 'russianroulette' }
+sub aliases { ('rr') }
+sub help { '!rr — Play Russian roulette (1/6 chance of kick)' }
+
+sub run {
+    my ($from_nick, $args, $client, $gateway) = @_;
+    if (int(rand(6)) == 0) {
+        $client->send_chat("*BANG* $from_nick is dead!");
+        # Kick via gateway API
+        eval {
+            my $ua = $gateway->{ua};
+            my $url = "$gateway->{base_url}/api/v1/users/$from_nick/kick";
+            my $req = HTTP::Request->new(POST => $url);
+            $req->header('Content-Type' => 'application/json');
+            $req->header('X-API-Key' => $gateway->{api_key});
+            $req->content('{"reason":"Russian roulette"}');
+            $ua->request($req);
+        };
+        return undef; # already sent
+    }
+    return "*click* $from_nick survives!";
+}
+
+1;

commands_v4/time.pm

@@ -0,0 +1,14 @@
+package commands_v4::time;
+use strict; use warnings;
+use POSIX qw(strftime);
+
+sub name { 'time' }
+sub aliases { () }
+sub help { '!time — Show current UTC time' }
+
+sub run {
+    my ($from_nick, $args, $client, $gateway) = @_;
+    return strftime("Current time: %Y-%m-%d %H:%M:%S UTC", gmtime);
+}
+
+1;