#!/usr/bin/pugs
use v6;
use Net::IRC;
# Parse @*ARGS
my $nick = @*ARGS[0] // "blechbot";
my $server = @*ARGS[1] // "localhost";
my $interval = @*ARGS[2] // 300;
my $repository = @*ARGS[3] // ".";
my ($host, $port) = split ":", $server;
$port //= 6667;
debug "svnbot started. Summary of configuration:";
debug " Will connect as... $nick";
debug " to... $host:$port";
debug " checking for new revisions every... $interval seconds.";
debug "To change any of these parameters, restart $*PROGRAM_NAME";
debug "and supply appropriate arguments:";
debug " $*PROGRAM_NAME nick host[:port] interval";
# Initialize $cur_svnrev. $cur_svnrev contains the last revision seen, and is
# set by svn_headrev() and svn_commits().
my $cur_svnrev = 0;
svn_headrev();
# Create new bot "object"
my $bot = new_bot(nick => $nick, host => $host, port => $port, debug_raw => 0);
$bot<add_handler>("INVITE", &on_invite); # We want to invite our bot
$bot<add_handler>("PRIVMSG", &on_privmsg); # Remote control
$bot<add_handler>("runloop", &svn_check); # Check for new revisions
$bot<connect>();
$bot<login>();
$bot<run>();
# Join all channels we're invited to.
sub on_invite($event) {
my ($from, $chan) = $event<from rest>;
debug "Got an invitation from \"$from\" to join channel \"$chan\".";
$bot<join>($chan);
}
# Remote control
sub on_privmsg($event) {
given $event<rest> {
debug "Received a ?-request from $event<from>: $event<rest>"
if substr($event<rest>, 0, 1) eq "?";
my $reply_to = substr($event<object>, 0, 1) eq "#" ?? $event<object> :: $event<from_nick>;
my $reply = { $bot<privmsg>(to => $reply_to, text => $^text) };
when rx:P5/^\?help/ {
$reply("svnbot6 -- ?help | ?quit [reason] | ?raw ... | ?join #chan | ?uptime | ?check");
}
when rx:P5/^\?quit\s*(.*)$/ {
if substr($reply_to, 0, 1) eq "#" {
$reply("?quit only available per private message so other bots don't quit as well.");
} else {
$bot<quit>($0);
}
}
when rx:P5/^\?raw\s+(.+)$/ {
$bot<raw>($0);
}
when rx:P5/^\?join\s+(.+)$/ {
$bot<join>($0);
}
when rx:P5/^\?uptime$/ {
my $start_time = INIT { time };
$bot<privmsg>(to => $reply_to, text => "Running for {time() - $start_time} seconds.");
}
when rx:P5/^\?check$/ {
svn_check "now";
}
}
}
# This sub checks for new commits.
sub svn_check($event) {
state $last_check = time;
$last_check = 0 if $event eq "now";
# We don't want to flood poor openfoundry.
if time() - $last_check >= $interval {
$last_check = time;
debug "Checking for new commits (ignore error messages)... ";
# svn_commits() sets $cur_svnrev, if needed.
my $commits = svn_commits();
unless $commits {
debug "done, no new commits (current HEAD revision: $cur_svnrev)";
return;
} else {
debug "done, new commits (current HEAD revision: $cur_svnrev)";
}
my @lines = split("\n", $commits).grep:{ $_ };
# We inform all channels we've joined of new commits.
my $chans = join ",", $bot<channels>();
return unless $chans;
# Finally, send the announcement.
$bot<privmsg>($chans, $_) for @lines;
}
}
# This queries "svn".
sub svn_commits() {
# Pipes not yet supported in Pugs.
my $tempfile = BEGIN { "temp-svnbot-$*PID-{int rand 1000}" };
END { unlink $tempfile }
# If this is an incremental update...
if $cur_svnrev {
# ...only query for new commits since we last checked.
my $from = $cur_svnrev + 1;
# Hack to prevent "-3:HEAD", resulting in a syntax error, resulting in
# svn not outputting the log, resulting in svnbot not saying anything.
$from = "HEAD" if $from <= 0;
system "svn log -r $from:HEAD $repository > $tempfile";
} else {
# Else query only for the newest commit.
system "svn log -r HEAD $repository > $tempfile";
}
my $commits;
my $fh = open $tempfile;
for =$fh -> $_ {
state $cur_entry;
when rx:P5/^-----+/ {
# ignore
}
when rx:P5/^r(\d+) \| (\w+)/ {
$cur_entry = "r$0, $1++";
# Break the loop if we see $cur_svnrev -- that means, there're no new
# commits.
next if $0 == $cur_svnrev;
$cur_svnrev = +$0 if $0 > $cur_svnrev;
}
when rx:P5/\S/ {
if $cur_entry {
$_ ~~ rx:P5/^(.*)$/;
$commits ~= "$cur_entry | $0\n";
}
}
}
return $commits;
}
# Just a thin wrapper around svn_commits().
sub svn_headrev() {
debug "Retrieving current HEAD revision... ";
svn_commits();
debug "done, current HEAD revision: $cur_svnrev";
}