From 1de96429c725bc8080db19c96c5b7c9e406bfffb Mon Sep 17 00:00:00 2001 From: Geoffrey Broadwell Date: Thu, 26 Dec 2013 21:37:15 -0800 Subject: [PATCH 1/9] Fix warnings for 'is rw' on private attributes ... by making the attributes public, like all the others in Net::IRC::Bot. --- lib/Net/IRC/Bot.pm | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/lib/Net/IRC/Bot.pm b/lib/Net/IRC/Bot.pm index 1575c56..81de91d 100644 --- a/lib/Net/IRC/Bot.pm +++ b/lib/Net/IRC/Bot.pm @@ -4,11 +4,11 @@ use Net::IRC::Parser; use Net::IRC::Event; class Net::IRC::Bot { - has $conn is rw; + has $.conn is rw; #Set some sensible defaults for the bot. #These are not stored as state, they are just used for the bot's "start state" - #Changing things like $nick and @channels are tracked in %state + #Changing things like $nick and @channels are tracked in %.state has $.nick = "Rakudobot"; has @.altnicks = $!nick X~ ("_","__",^10); has $.username = "Clunky"; @@ -27,7 +27,7 @@ class Net::IRC::Bot { #State variables. #TODO: Make this an object for cleaner syntax. - has %state is rw; + has %.state is rw; method new(|) { my $obj = callsame(); @@ -36,7 +36,7 @@ class Net::IRC::Bot { } method !resetstate() { - %state = ( + %.state = ( nick => $.nick, altnicks => @.altnicks, autojoin => @.channels, @@ -50,26 +50,26 @@ class Net::IRC::Bot { #Establish connection to server self!resetstate; say "Connecting to $.server on port $.port"; - $conn = IO::Socket::INET.new(host => $.server, port => $.port) + $.conn = IO::Socket::INET.new(host => $.server, port => $.port) but role { method sendln(Str $string){self.send($string~"\c13\c10")} }; #Send PASS if needed - $conn.sendln("PASS $.password") if $.password; + $.conn.sendln("PASS $.password") if $.password; #Send NICK & USER. #If the nick collides, we'll resend a new one when we recieve the error later. #USER Parameters: - $conn.sendln("NICK $.nick"); - $conn.sendln("USER $.username abc.xyz.net $.server :$.realname"); - %state = True; + $.conn.sendln("NICK $.nick"); + $.conn.sendln("USER $.username abc.xyz.net $.server :$.realname"); + %.state = True; } method !disconnect($quitmsg = "Leaving"){ - if %state { - $conn.sendln("QUIT :$quitmsg"); - $conn.close; + if %.state { + $.conn.sendln("QUIT :$quitmsg"); + $.conn.close; } } @@ -79,7 +79,7 @@ class Net::IRC::Bot { self!connect; loop { #XXX: Support for timed events? - my $line = $conn.get + my $line = $.conn.get or die "Connection error."; $line ~~ s/<[\n\r]>+$//; @@ -103,8 +103,8 @@ class Net::IRC::Bot { my $event = Net::IRC::Event.new( :raw($raw), :command(~$raw), - :conn($conn), - :state(%state), + :conn($.conn), + :state(%.state), :who($who), :where(~$raw[0]), :what(~$raw[$l ?? $l-1 !! 0]), From f97001cd4fc1c0a31fea8309c024c4f6bb8bbff3 Mon Sep 17 00:00:00 2001 From: Geoffrey Broadwell Date: Thu, 26 Dec 2013 21:39:10 -0800 Subject: [PATCH 2/9] Improve debugging of raw IRC protocol traffic Also allow commands that carry private information (such as passwords) to output scrubbed debugging info instead of raw traffic. --- lib/Net/IRC/Bot.pm | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/lib/Net/IRC/Bot.pm b/lib/Net/IRC/Bot.pm index 81de91d..f4cd324 100644 --- a/lib/Net/IRC/Bot.pm +++ b/lib/Net/IRC/Bot.pm @@ -50,13 +50,23 @@ class Net::IRC::Bot { #Establish connection to server self!resetstate; say "Connecting to $.server on port $.port"; + my role irc-connection[$debug] { + method sendln(Str $string, :$scrubbed = $string){ + say "»»» $scrubbed" if $debug; + self.send($string~"\c13\c10"); + } + method get(|){ + my $line = callsame(); + say "<-- $line" if $debug; + $line; + } + } $.conn = IO::Socket::INET.new(host => $.server, port => $.port) - but role { - method sendln(Str $string){self.send($string~"\c13\c10")} - }; + but irc-connection[$.debug]; #Send PASS if needed - $.conn.sendln("PASS $.password") if $.password; + $.conn.sendln("PASS $.password", scrubbed => 'PASS ...') + if $.password; #Send NICK & USER. #If the nick collides, we'll resend a new one when we recieve the error later. @@ -86,7 +96,6 @@ class Net::IRC::Bot { my $event = Net::IRC::Parser::RawEvent.parse($line) or $*ERR.say("Could not parse the following IRC event: $line.perl()") and next; - say ~$event if $.debug; self!dispatch($event); } } From 219b4c059569065b88920ea7f6e52c3096708b29 Mon Sep 17 00:00:00 2001 From: Geoffrey Broadwell Date: Thu, 26 Dec 2013 21:46:45 -0800 Subject: [PATCH 3/9] Scrub password from NS IDENTIFY debug info --- lib/Net/IRC/Modules/Autoident.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Net/IRC/Modules/Autoident.pm b/lib/Net/IRC/Modules/Autoident.pm index 0fba4e8..fcc41fd 100755 --- a/lib/Net/IRC/Modules/Autoident.pm +++ b/lib/Net/IRC/Modules/Autoident.pm @@ -5,7 +5,7 @@ class Net::IRC::Modules::Autoident { has $.password = die "Need to tell Autoident your password if you want it to work!"; multi method connected($ev) { say "Identifying with nickserv.."; - $ev.conn.sendln("NS IDENTIFY $.password"); + $ev.conn.sendln("NS IDENTIFY $.password", scrubbed => 'NS IDENTIFY ...'); } } From 54dc6d9c3ee388a6a0d5dff126e3f0a7878c5770 Mon Sep 17 00:00:00 2001 From: Geoffrey Broadwell Date: Thu, 26 Dec 2013 22:00:44 -0800 Subject: [PATCH 4/9] Factor out some text utilities into a separate module _s() for pluralizing and friendly-duration() for converting durations in seconds to appropriately larger units for display --- lib/Net/IRC/Modules/Tell.pm | 33 +++----------------------------- lib/Net/IRC/TextUtil.pm | 38 +++++++++++++++++++++++++++++++++++++ 2 files changed, 41 insertions(+), 30 deletions(-) create mode 100644 lib/Net/IRC/TextUtil.pm diff --git a/lib/Net/IRC/Modules/Tell.pm b/lib/Net/IRC/Modules/Tell.pm index 21644de..07efa2c 100755 --- a/lib/Net/IRC/Modules/Tell.pm +++ b/lib/Net/IRC/Modules/Tell.pm @@ -1,4 +1,6 @@ use v6; +use Net::IRC::TextUtil; + class Net::IRC::Modules::Tell { class Message { has $.sender; @@ -38,40 +40,11 @@ class Net::IRC::Modules::Tell { method !deliver-message( $ev ){ my $reciever = $ev.who; for @(%messages{$reciever.lc}) -> $msg { - my $elapsed = self!format-time(time - $msg.when); + my $elapsed = friendly-duration(time - $msg.when); $ev.msg("$reciever: <{$msg.sender}> {$msg.message} ::$elapsed ago"); } %messages{$reciever.lc} = []; } - - method !format-time($elapsed) { - given $elapsed { - when * < 60 { - return "$elapsed second"~($elapsed != 1 ?? 's' !! ''); - } - when * < 3570 { - my $mins = ($elapsed / 60).round; - return "$mins minute"~($mins != 1 ?? 's' !! ''); - } - when * < 84600 { - my $hours = ($elapsed / 60 / 60).round; - return "$hours hour"~($hours != 1 ?? 's' !! ''); - } - when * < 604800 { - my $days = ($elapsed / 60 / 60 / 24).round; - my $hours = ($elapsed % 86400 / 60 / 60).round; - return - "$days day" ~ - ($days != 1 ?? 's' !! '') ~ - $hours ?? (", $hours hour" ~ - ($hours != 1 ?? 's' !! '') ) !! ''; - } - default { - my $days = ($elapsed / 60 / 60 / 24).round; - return "$days day"~($days != 1 ?? 's' !! ''); - } - } - } } # vim: ft=perl6 tabstop=4 shiftwidth=4 diff --git a/lib/Net/IRC/TextUtil.pm b/lib/Net/IRC/TextUtil.pm new file mode 100644 index 0000000..06819b9 --- /dev/null +++ b/lib/Net/IRC/TextUtil.pm @@ -0,0 +1,38 @@ +use v6; + +module Net::IRC::TextUtil; + +sub _s($num, $plural = 's', $singular = '') is export { + $num == 1 ?? $singular !! $plural; +} + +sub friendly-duration($seconds) is export { + my $minute = 60; + my $hour = $minute * 60; + my $day = $hour * 24; + my $week = $day * 7; + + given $seconds.Int { + when * < $minute { + "$_ second{_s($_)}" + } + when * < 59.5 * $minute { + my $minutes = ($_ / $minute).round; + "$minutes minute{_s($minutes)}" + } + when * < 23.5 * $hour { + my $hours = ($_ / $hour).round; + "$hours hour{_s($hours)}" + } + when * < 6.5 * $day { + my $days = ($_ / $day).round; + "$days day{_s($days)}" + } + default { + my $weeks = ($_ / $week).round; + "$weeks week{_s($weeks)}" + } + } +} + +# vim: ft=perl6 tabstop=4 shiftwidth=4 From 65b99b615d2862a0f798e16f12532a1d17010ce2 Mon Sep 17 00:00:00 2001 From: Geoffrey Broadwell Date: Thu, 26 Dec 2013 22:05:49 -0800 Subject: [PATCH 5/9] Add a per-event cache so modules can avoid repeated work --- lib/Net/IRC/Event.pm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lib/Net/IRC/Event.pm b/lib/Net/IRC/Event.pm index 84da23a..33b3298 100644 --- a/lib/Net/IRC/Event.pm +++ b/lib/Net/IRC/Event.pm @@ -13,6 +13,9 @@ class Net::IRC::Event { has $.what is rw; has $.where is rw; + # Per-event cache to prevent many modules from repeating the same work + has %.cache; + ##Utility methods method msg($text, $to = $.where) { From 9a9e14108c5742f22d683fe365213b63086ebc85 Mon Sep 17 00:00:00 2001 From: Geoffrey Broadwell Date: Thu, 26 Dec 2013 22:14:58 -0800 Subject: [PATCH 6/9] Add a role for simplifying command-handler modules --- lib/Net/IRC/CommandHandler.pm | 48 +++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) create mode 100644 lib/Net/IRC/CommandHandler.pm diff --git a/lib/Net/IRC/CommandHandler.pm b/lib/Net/IRC/CommandHandler.pm new file mode 100644 index 0000000..970d46a --- /dev/null +++ b/lib/Net/IRC/CommandHandler.pm @@ -0,0 +1,48 @@ +use v6; + +enum RequiredIntro is export < + NONE + NICK + PREFIX + EITHER + BOTH + >; + +role Net::IRC::CommandHandler { + has Str $.prefix is rw = '!'; + has RequiredIntro $.required-intro is rw = EITHER; + + method recognized($handler: $ev) { + return $ev.cache{$handler.prefix} //= (gather { + $ev.what ~~ token { + # Intro + ^ + [ \s* $=("$ev.state()") [ <[':' ',']> | \s ] ]? \s* + $=("$handler.prefix()"?) \s* + + # Actual command (and optional params) + $=(\w+) [ | \s+ $=(.*) ] + $ + } or take False; + + given $.required-intro { + when NICK { take False unless $ } + when PREFIX { take False unless $ } + when EITHER { take False unless $ || $ } + when BOTH { take False unless $ && $ } + } + + take $/; + })[0]; + } + + multi method said ($ev where { $/ := $.recognized($ev) }) { + self.*"command_$"($ev, $/); + } + + method usage($ev, $usage) { + $ev.msg("Usage: $usage"); + } +} + +# vim: ft=perl6 tabstop=4 shiftwidth=4 From c425d4cd1f823cc7601c542b03f0e378937f5db0 Mon Sep 17 00:00:00 2001 From: Geoffrey Broadwell Date: Thu, 26 Dec 2013 22:15:52 -0800 Subject: [PATCH 7/9] Use CommandHandler role in Tell module Also fix an over-simplistic nick token and add a usage message. --- lib/Net/IRC/Modules/Tell.pm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lib/Net/IRC/Modules/Tell.pm b/lib/Net/IRC/Modules/Tell.pm index 07efa2c..74066ae 100755 --- a/lib/Net/IRC/Modules/Tell.pm +++ b/lib/Net/IRC/Modules/Tell.pm @@ -1,7 +1,8 @@ use v6; +use Net::IRC::CommandHandler; use Net::IRC::TextUtil; -class Net::IRC::Modules::Tell { +class Net::IRC::Modules::Tell does Net::IRC::CommandHandler { class Message { has $.sender; has $.message; @@ -9,9 +10,9 @@ class Net::IRC::Modules::Tell { } has %messages; - multi method said ( $ev where {$ev.what ~~ /^<{$ev.state}><.punct>?<.ws>'tell'/} ) { + method command_tell ( $ev, $match ) { my $from = $ev.who; - if $ev.what ~~ /tell <.ws> $=<-space -punct>+ <.punct>? <.ws> $=[.+]/ { + if $match ~~ /$=<+ alpha + [ \[..\] \{..\} ]>+ <.punct>? <.ws> $=[.+]/ { if $.lc eq $from.lc|'me' { $ev.msg("$from: I think you can tell yourself that!"); return; @@ -22,6 +23,9 @@ class Net::IRC::Modules::Tell { ); $ev.msg("$from: Noted. I'll pass that on when I see $"); } + else { + self.usage($ev, 'tell '); + } } multi method said ( $ev where {$ev.who.lc ~~ %messages} ) { From 9235c658486a46e0f4aef31e99dd6c4b9dbf27a9 Mon Sep 17 00:00:00 2001 From: Geoffrey Broadwell Date: Thu, 26 Dec 2013 22:19:13 -0800 Subject: [PATCH 8/9] Add a module implementing the seen command --- lib/Net/IRC/Modules/Seen.pm | 58 +++++++++++++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) create mode 100644 lib/Net/IRC/Modules/Seen.pm diff --git a/lib/Net/IRC/Modules/Seen.pm b/lib/Net/IRC/Modules/Seen.pm new file mode 100644 index 0000000..8300771 --- /dev/null +++ b/lib/Net/IRC/Modules/Seen.pm @@ -0,0 +1,58 @@ +use v6; +use Net::IRC::CommandHandler; +use Net::IRC::TextUtil; + +class Net::IRC::Modules::Seen does Net::IRC::CommandHandler { + class Seen { + has $.when = now; + has $.what; + has $.how; + } + has %!seen; + + multi method said ( $ev ) { + %!seen{~$ev.who} := Seen.new(:how('saying:'), :what(~$ev.what)); + } + + multi method emoted ( $ev ) { + %!seen{~$ev.who} := Seen.new(:how("emoting: * $ev.who()"), :what(~$ev.what)); + } + + multi method kicked ( $ev ) { + %!seen{~$ev.what} := Seen.new(:how('being kicked from'), :what(~$ev.where)); + } + + multi method joined ( $ev ) { + %!seen{~$ev.who} := Seen.new(:how('joining'), :what(~$ev.where)); + } + + multi method nickchange ( $ev ) { + %!seen{~$ev.who} := Seen.new(:how('changing nick to'), :what(~$ev.what)); + %!seen{~$ev.what} := Seen.new(:how('changing nick from'), :what(~$ev.who)); + } + + + method command_seen ( $ev, $/ ) { + my @params = ($ // '').comb(/\S+/); + if @params { + for @params -> $nick { + if %!seen{$nick} -> $seen { + my $dt = DateTime.new($seen.when); + my $stamp = $dt.Str.subst('T', ' '); + my $seconds = now - $seen.when; + my $elapsed = friendly-duration($seconds); + + $ev.msg("$nick was last seen at $stamp ($elapsed ago) $seen.how() $seen.what()"); + } + else { + $ev.msg("I haven't seen $nick."); + } + } + } + else { + self.usage($ev, 'seen [ ...]'); + } + } +} + +# vim: ft=perl6 tabstop=4 shiftwidth=4 From cf8d1b4bfd61259b86ac69653f23db9bba946818 Mon Sep 17 00:00:00 2001 From: Geoffrey Broadwell Date: Thu, 26 Dec 2013 22:29:23 -0800 Subject: [PATCH 9/9] Add some ACME classes to show use of prefix for commands --- Freenodebot.pl | 2 ++ lib/Net/IRC/Modules/ACME.pm | 14 ++++++++++++++ 2 files changed, 16 insertions(+) diff --git a/Freenodebot.pl b/Freenodebot.pl index 3848c11..f8151a7 100755 --- a/Freenodebot.pl +++ b/Freenodebot.pl @@ -9,6 +9,8 @@ server => 'irc.freenode.org', channels => <#bottest>, modules => ( + Net::IRC::Modules::ACME::Bark::LikeADog.new, + Net::IRC::Modules::ACME::Bark::LikeATree.new(prefix => '@'), Net::IRC::Modules::ACME::Eightball.new, #Net::IRC::Modules::ACME::Unsmith.new ), diff --git a/lib/Net/IRC/Modules/ACME.pm b/lib/Net/IRC/Modules/ACME.pm index 6422c14..6f7aa5a 100755 --- a/lib/Net/IRC/Modules/ACME.pm +++ b/lib/Net/IRC/Modules/ACME.pm @@ -1,4 +1,6 @@ use v6; +use Net::IRC::CommandHandler; + module Net::IRC::Modules::ACME; class Net::IRC::Modules::ACME::Eightball { @@ -30,5 +32,17 @@ class Net::IRC::Modules::ACME::Unsmith { } } +class Net::IRC::Modules::ACME::Bark::LikeADog does Net::IRC::CommandHandler { + method command_bark($ev, $match) { + $ev.msg("Woof!"); + } +} + +class Net::IRC::Modules::ACME::Bark::LikeATree does Net::IRC::CommandHandler { + method command_bark($ev, $match) { + $ev.msg("The bark is smooth and brown."); + } +} + # vim: ft=perl6 tabstop=4 shiftwidth=4