bot.p6 5.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189
  1. #!/usr/bin/env perl6
  2. use Net::IRC::Bot;
  3. use Net::IRC::Modules::Autoident;
  4. use Net::IRC::Modules::Tell;
  5. use Net::IRC::CommandHandler;
  6. sub wikiLink($page is copy) {
  7. $page ~~ s:g/\s/_/; # quick and dirty
  8. return “https://oddmuse.org/wiki/$page”;
  9. }
  10. class Intermap {
  11. has $.intermapLink is rw = ‘https://oddmuse.org/wiki/Local_Intermap?raw=1’;
  12. has %!intermap;
  13. method update {
  14. # TODO https breaks HTTP::UserAgent, workaround with curl
  15. my $proc = run(‘curl’, $!intermapLink, :out);
  16. my $text = $proc.out.slurp-rest;
  17. $proc.out.close; # RT #126561
  18. return False unless $proc;
  19. for $text ~~ m:global〈 ^^ \h+ $<name>=\S+ \s+ $<value>=.+? $$ 〉 {
  20. %!intermap{~$_<name>} = ~$_<value>; # TODO map!
  21. }
  22. return True;
  23. }
  24. method said ($e) {
  25. self.update if not %!intermap or $e.what ~~ / ‘update intermap’ /; # lazy init
  26. for $e.what ~~ m:global〈 $<name>=<-[\s :]>+ ‘:’ $<value>=\S+ 〉 { # quick and dirty
  27. next unless %!intermap{.<name>}:exists;
  28. my $link = %!intermap{~.<name>};
  29. my $replacement = $_<value>;
  30. $link ~~ s{ \%s | $ } = $replacement;
  31. $e.msg: $link;
  32. }
  33. }
  34. }
  35. class Pages {
  36. method said ($e) {
  37. for $e.what ~~ m:global〈 ‘[[’ $<page>=<-[ \] ]>+ ‘]]’ 〉 { # quick and dirty
  38. $e.msg: wikiLink ~.<page>;
  39. }
  40. }
  41. }
  42. class Sorry {
  43. has $.answers is rw = « ‘I'm so sorry!’ ‘Please forgive me!’
  44. ‘I should have done better!’
  45. ‘I promise that it won't happen again!’ »;
  46. method said ($e) {
  47. if $e.what ~~ / ^ "{ $e.bot.nick }" [‘:’|‘,’] / {
  48. $e.msg: $!answers.pick;
  49. }
  50. }
  51. }
  52. class RecentChanges {
  53. has $.delay is rw = 30;
  54. has $.url is rw = ‘https://oddmuse.org/wiki?action=rss;all=0;showedit=0;rollback=1;from=’;
  55. has $!last = time;
  56. method joined ($e) {
  57. start loop {
  58. sleep $!delay;
  59. self.process: $e;
  60. }
  61. }
  62. method process ($e) {
  63. my $newLast = time;
  64. # TODO https breaks HTTP::UserAgent, workaround with curl
  65. my $proc = run(‘curl’, $!url ~ $!last, :out);
  66. my $xml = $proc.out.slurp-rest;
  67. $proc.out.close; # RT #126561
  68. return False unless $proc;
  69. $!last = $newLast;
  70. use XML;
  71. for from-xml($xml).elements(:TAG<item>, :RECURSE) {
  72. my $title = ~.elements(:TAG<title>, :SINGLE).contents;
  73. my $desc = ~.elements(:TAG<description>, :SINGLE).contents;
  74. my $author = ~.elements(:TAG<dc:contributor>, :SINGLE).contents;
  75. $e.msg: “Wiki: [$title] <$author> – $desc ({wikiLink $title})”;
  76. }
  77. return True;
  78. }
  79. }
  80. class RecentCommits {
  81. has $.delay is rw = 30;
  82. has $.url = ‘https://github.com/kensanata/oddmuse.git’;
  83. has $.repo = ‘repo’;
  84. method joined ($e) {
  85. start {
  86. if $!repo.IO !~~ :e {
  87. fail unless run(‘git’, ‘clone’, $!url, $!repo);
  88. }
  89. loop {
  90. sleep $!delay;
  91. self.process: $e;
  92. }
  93. }
  94. }
  95. method process ($e) {
  96. my $proc1 = run(‘git’, ‘--git-dir’, $!repo ~ ‘/.git’, ‘fetch’) ;
  97. return False unless $proc1;
  98. my $proc2 = run(‘git’, ‘--git-dir’, $!repo ~ ‘/.git’, ‘log’,
  99. ‘--pretty=format:Commit: %s (https://github.com/kensanata/oddmuse/commit/%h)’,
  100. ‘...origin’, :out);
  101. $e.msg: $_ for $proc2.out;
  102. $proc2.out.close; # RT #126561
  103. return False unless $proc2;
  104. run(‘git’, ‘--git-dir’, $!repo ~ ‘/.git’, ‘merge’, ‘-q’);
  105. return True;
  106. }
  107. }
  108. class Backlog does Net::IRC::CommandHandler {
  109. has $.limit is rw = 60 * 60 * 48;
  110. has $.delay is rw = 30; # seconds before file deletion
  111. has $.path is rw = ‘backlogs/’;
  112. has $.link is rw = ‘http://alexine.oddmuse.org/backlogs/’; # TODO https
  113. has %.messages = ();
  114. multi method said ($e) {
  115. %!messages{$e.where} = [] unless %!messages{$e.where}:exists;
  116. %!messages{$e.where}.push: { ‘when’ => time, ‘who’ => $e.who<nick>, ‘what’ => $e.what };
  117. self.clean;
  118. }
  119. method clean {
  120. for %!messages.values -> $value { # each channel
  121. for $value.kv -> $index, $elem { # each message
  122. last if time - $elem<when> < $!limit;
  123. LAST { $value.splice(0, $index) } # at least one message will be kept
  124. }
  125. }
  126. }
  127. method backlog ($e, $match) is cmd {
  128. self.clean;
  129. mkdir $!path unless $!path.IO ~~ :d;
  130. my $name = ^2**128 .pick.base(36);
  131. my $fh = open “$!path/$name”, :w;
  132. $fh.say(“<{.<who>}> {.<what>}”) for @(%!messages{$e.where});
  133. $fh.close;
  134. $e.msg: “$!link$name”;
  135. Promise.in($!delay).then: { unlink “$!path/$name” };
  136. }
  137. method forget ($e, $match) is cmd {
  138. %!messages{$e.where} = [];
  139. $e.msg: ‘OK, we didn't have this conversation.’;
  140. }
  141. }
  142. sub MAIN(Str :$nick = ‘alexine’, Str :$password is copy = ‘’, Str :$channel = ‘#oddmuse’) {
  143. $password = prompt ‘Nickserv password: ’ unless $password;
  144. Net::IRC::Bot.new(
  145. nick => $nick,
  146. username => $nick,
  147. realname => $nick,
  148. server => ‘irc.freenode.org’,
  149. channels => [ $channel ],
  150. debug => True,
  151. modules => (
  152. Intermap.new(),
  153. Pages.new(),
  154. Sorry.new(),
  155. RecentChanges.new(),
  156. #RecentCommits.new(),
  157. Backlog.new(prefix => ‘.’),
  158. Net::IRC::Modules::Tell.new(prefix => ‘.’),
  159. Net::IRC::Modules::Autoident.new(password => $password),
  160. ),
  161. ).run;
  162. }