Merge branch 'master' of github.com:perlbot/perlbuut

README.pod

@@ -13,8 +13,6 @@ This is the source code for perlbot, the resident infobot on Freenode’s
 
 =over 4
 
-=item * L<http://perl-begin.org/FAQs/freenode-perl/>
-
 =item * L<https://github.com/simcop2387/perlbuut>
 
 =back

etc/bb3.conf

@@ -37,46 +37,11 @@ http_plugin_port 1092
 </plugin_manager>
 
 <bot perlbot>
-	channel \#buubot
+	channel \#\#perl
-	channel \#\#turtles
-	channel \#perlcafe
-        channel \#webgui
-        channel \#citadel
-        channel \#modperl
-        channel \#perl
-        channel \#ipv6
-        channel \#perlbot
-        channel \#mrtg
-        channel \#ipv6-fr
-        channel \#freebsd-fr
-        channel \#botpark
-        channel \#css
-        channel \#modus
-	channel \#perl-cats
-	channel \#cout.dev
-        channel \#web-locals
-	channel \#regex
-	channel \#regexen
-
-	ignore buubot
-	ignore avarbot
-	ignore jeval
-	ignore gumbybrain
-	ignore perlbot
-	ignore buubot3
-	ignore loudbot
-	ignore serfbot
-	ignore farnsworth
-	ignore frogbot
-	ignore EvanCarroll
-	ignore EvanCarrol
-	ignore EvanCaroll
-	ignore EvanCarol
-	ignore EC
 
 	server 192.168.32.1
 	username perlbot
-	password sindarin
+	password UjecyickehumBevGixrejparpheyndoc
 	port 65432
 	root_mask p3m/member/simcop2387
 </bot>
@@ -84,6 +49,8 @@ http_plugin_port 1092
 <bot perlbot-magnet>
 	channel \#freenode-perl-cabal
         channel \#perl-help
+	channel \#perl
+	channel \#pdl
 
         ignore purl
         ignore perlbot
@@ -119,3 +86,20 @@ http_plugin_port 1092
 	port 65432
 	root_mask ~simcop238@simcop2387.info
 </bot>
+
+<bot perlbot-libera>
+	channel \#buubot
+        channel \#perl
+        channel \#perlbot
+        channel \#botpark
+	channel \#perl-cats
+
+	server 192.168.32.1
+	username perlbot-libera
+	password AtlyeSlognakjabDatCujatyijFeach9
+	port 65432
+	root_mask perlbot/patrician/simcop2387
+
+	ignore lambdabot
+	ignore lambdabot2
+</bot>

etc/plugins.conf

@@ -1,7 +1,7 @@
 server "*" {
     channel "*" {
         plugin "*" { addressed: true }
-        plugin "join" { access: op; addressed: true }
+        plugin "join" { access: root; addressed: true }
         plugin "allowpaste" { access: op; addressed: true }
         plugin "pastebinadmin" { access: op; addressed: true }
         plugin "part" { access: op }
@@ -13,6 +13,20 @@ server "*" {
         plugin "karma_modify" { addressed: false; }
         plugin "seen" {addressed: false; }
     }
+    channel "##perl" {
+        plugin "factoids" {
+            addressed: false;
+        }
+        plugin "eval" {addressed: true; }
+        plugin "deparse" {addressed: true; }
+        plugin "perldoc" {addressed: true; }
+        plugin "corelist" {addressed: true; }
+	plugin "default" {plugin: "factoids";}
+    }
+    channel "#pdl" {
+        plugin "eval" {addressed: false; }
+        plugin "deparse" {addressed: false; }
+    }
     channel "#perl" {
         plugin "eval" {addressed: false; }
         plugin "deparse" {addressed: false; }
@@ -50,6 +64,24 @@ server "*" {
         plugin "eval" {addressed: false; }
         plugin "deparse" {addressed: false; }
     }
+    channel "#regex" {
+        plugin "factoids" {
+            addressed: false;
+        }
+        plugin "default" {plugin: "factoids"; }
+    }
+    channel "#regexen" {
+        plugin "factoids" {
+            addressed: false;
+        }
+        plugin "default" {plugin: "factoids"; }
+    }
+    channel "#reg3x" {
+        plugin "factoids" {
+            addressed: false;
+        }
+        plugin "default" {plugin: "factoids"; }
+    }
 }
 server "discord.gg" {
   channel "*" {
@@ -65,12 +97,34 @@ server "matrix.org" {
   }
 }
 server "*.freenode.net" {
+    channel {
+        plugin "*" { addressed: true }
+        plugin "join" { access: root; addressed: true }
+        plugin "allowpaste" { access: op; addressed: true }
+        plugin "pastebinadmin" { access: op; addressed: true }
+        plugin "part" { access: op }
+        plugin "reload_plugins" { access: root }
+        plugin "restart" { access: root }
+        plugin "conf_dump" { access: root; }
+        plugin "save_config" { access: root; }
+        plugin "conf" { access: root; }
+        plugin "karma_modify" { addressed: false; }
+        plugin "seen" {addressed: false; }
+    }
+    channel "##perl" {
+        plugin "factoids" {
+            addressed: false;
+        }
+	plugin "default" {plugin: "factoids";}
+        plugin "eval" {addressed: true; }
+        plugin "deparse" {addressed: true; }
+        plugin "perldoc" {addressed: true; }
+        plugin "corelist" {addressed: true; }
+    }
+} 
+server "*.libera.chat" {
     channel "#perlbot" {
         plugin "factoids" {
-            namespaced: true;
-            prefix_command: "!";
-            chanspace: "#perlbot";
-            serverspace: "freenode.net";
             filtersep: true;
             addressed: false;
         }
@@ -79,31 +133,19 @@ server "*.freenode.net" {
     channel "#regex" {
         plugin "factoids" {
             addressed: false;
-            namespaced: true;
-            chanspace: "#regex";
-            serverspace: "freenode.net";
-            prefix_command: "!";
-            filtersep: true;
         }
         plugin "default" {plugin: "factoids"; }
     }
     channel "#regexen" {
         plugin "factoids" {
             addressed: false;
-            namespaced: true;
-            chanspace: "#regex";
-            serverspace: "freenode.net";
-            prefix_command: "!";
-            filtersep: true;
         }
         plugin "default" {plugin: "factoids"; }
     }
-    channel "#lpmc" {
+    channel "#reg3x" {
-        plugin "eval" {addressed: false; }
+        plugin "factoids" {
-        plugin "deparse" {addressed: false; }
+            addressed: false;
         }
-    channel "#learnprogramming" {
+        plugin "default" {plugin: "factoids"; }
-        plugin "eval" {addressed: false; }
-        plugin "deparse" {addressed: false; }
     }
 }

lib/Bot/BB3/PluginManager.pm

@@ -7,6 +7,7 @@ use Data::Dumper;
 use Text::Glob qw/match_glob/;
 use Memoize;
 use Regexp::Assemble;
+use Scalar::Util qw/blessed/;
 use strict;
 
 sub new {
@@ -453,6 +454,13 @@ sub _execute_plugin_chain {
 
 	for my $command ( @$commands ) {
 		local $@;
+    
+    unless (blessed($command)) {
+      use Data::Dumper;
+      warn "Unblessed command! ".Dumper($command);
+      next;
+    };
+
 		my( $return, $output ) = eval { $command->command( $said, $self ) };
 
     use Data::Dumper;

lib/Bot/BB3/Roles/Evalpastebin.pm

@@ -50,7 +50,7 @@ sub _start {
     # TODO setup TCP server.
     $self->{server} = POE::Component::Server::TCP->new(
         Port => 1784,
-        Address =>'192.168.32.1',
+        Address =>'192.168.196.2',
         ClientFilter => "POE::Filter::Line",
         ClientInput => \&receive_paste,
     );

plugins/factoids.pm

@@ -224,7 +224,10 @@ sub handle ($self, $said, $pm) {
 
     $said->{body} =~ s/^\s*(what|who|where|how|when|why)\s+($COPULA_RE)\s+(?<fact>.*?)\??\s*$/$+{fact}/i;
 
+
     my $prefix = $conf->{command_prefix};
+    
+    warn "Checking for prefix: $prefix in ".Dumper($conf); 
     return unless $prefix;
 
     $said->{nosuggest} = 1;

plugins/pastebinadmin.pm

@@ -22,11 +22,12 @@ sub dbh {
 		return $self->{$env . "dbh"};
 	}
   
-  if ($env =~ /^www|dev$/) {
+  my $dbnames = {
-    $self->{$env . "dbh"} = DBI->connect( "dbi:SQLite:dbname=/var/www/domains/perl.bot/".$env."/pastes.db", "", "", { PrintError => 0, RaiseError => 1 } );
+    www => "perlbot_pastes",
-  } elsif ($env eq 'asn') {
+    dev => "perlbot_pastes_dev",
-    $self->{$env . "dbh"} = DBI->connect( "dbi:SQLite:dbname=var/asn.db", "", "", { PrintError => 0, RaiseError => 1 } );
+  };
-  }
+
+  $self->{$env . "dbh"} = DBI->connect( "dbi:Pg:dbname=".$dbnames->{$env}, "perlbot_pastebin", "ignored", { PrintError => 2, RaiseError => 1 } );
 
 	return $self->{$env."dbh"};
 }
@@ -35,7 +36,6 @@ sub postload {
 	
 	delete $self->{wwwdbh}; # UGLY HAX GO.
   delete $self->{devdbh};
-  delete $self->{asndbh};
 	                     # Basically we delete the dbh we cached so we don't fork
                          # with one active
 }
@@ -43,13 +43,13 @@ sub postload {
 sub add_ban_word {
   my ($self, $env, $who, $where, $word) = @_;
 
-  $self->dbh($env)->do("INSERT INTO banned_words (word, who, 'where') VALUES (?, ?, ?)", {}, $word, $who, $where);
+  $self->dbh($env)->do(q{INSERT INTO banned_words (word, who, "where") VALUES (?, ?, ?)}, {}, $word, $who, $where);
 }
 
 sub get_ip_for_paste {
   my ($self, $env, $id) = @_;
 
-  my ($ip) = @{$self->dbh($env)->selectrow_arrayref("SELECT ip FROM posts p JOIN slugs s ON s.post_id = p.id WHERE s.slug = ? or p.id = ?", {}, $id, $id) || ['0.0.0.0']};
+  my ($ip) = @{$self->dbh($env)->selectrow_arrayref("SELECT ip FROM posts p JOIN slugs s ON s.post_id = p.id WHERE s.slug = ?", {}, $id) || ['0.0.0.0']};
 
   return sprintf("%03d.%03d.%03d.%03d", split(/\./,$ip));
 }
@@ -59,7 +59,7 @@ sub get_asn_for_paste {
 
   my $ip = $self->get_ip_for_paste($env, $id);
 
-  my ($asn) = @{$self->dbh('asn')->selectrow_arrayref("SELECT asn FROM asn WHERE ? >= start AND ? <= end", {}, $ip, $ip) || []}[0];
+  my ($asn) = @{$self->dbh('www')->selectrow_arrayref('SELECT asn FROM asn WHERE ? >= start AND ? <= "end"', {}, $ip, $ip) || []}[0];
   return $asn;
 }
 
@@ -69,7 +69,7 @@ sub ban_user_paste {
   my $ip = $self->get_ip_for_paste($env, $id);
 
   if ($ip) {
-    $self->dbh($env)->do("INSERT INTO banned_ips (ip, who, 'where') VALUES (?, ?, ?);", {}, $ip, $who, $where);
+    $self->dbh($env)->do(q{INSERT INTO banned_ips (ip, who, "where") VALUES (?, ?, ?);}, {}, $ip, $who, $where);
     return "USER WAS BANNED FOR THIS POST";
   } else {
     return "Failed to find IP for paste in db";
@@ -83,7 +83,7 @@ sub ban_asn_paste {
   my $asn = $self->get_asn_for_paste($env, $id);
 
   if ($asn) {
-    $self->dbh($env)->do("INSERT INTO banned_asns (asn, who, 'where') VALUES (?, ?, ?);", {}, $asn, $who, $where);
+    $self->dbh($env)->do(q{INSERT INTO banned_asns (asn, who, "where") VALUES (?, ?, ?);}, {}, $asn, $who, $where);
     return "ISP WAS BANNED FOR THIS POST";
   } else {
     return "Failed to find ISP for paste in db. yell at simcop2387; ".encrypt("[$id][$ip][$asn]");

plugins/supereval.pm

@@ -171,6 +171,11 @@ sub command {
     $type = "perl6"
   }
   
+  # we were addressed, but not nested, in #perl6.  Switch to perl6, otherwise use perl5
+  if ($said->{channel} eq "#pdl" && !$said->{nested} && $orig_type =~ /^[ws]*$/) {
+    $type = "perl5.34"
+  }
+
   if ($command eq 'r' && (!$said->{addressed} && !$said->{nested} && ($said->{channel} ne "#perl6" && $said->{channel} eq '#raku'))) {
     return ("handled", "");
   }
@@ -264,7 +269,7 @@ sub command {
             "Columbus Day" => {prob => 0.00, chars => []},
 "Confederate Memorial Day" => {prob => 0.00, chars => []},
                "Earth Day" => {prob => 0.50, chars => ["\x{1F30E}", "\x{1F30D}", "\x{1F30F}"]},
-            "Election Day" => {prob => 1.00, chars => ["\x{1F5F3}"]},
+            "Election Day" => {prob => 1.00, chars => ["\x{1F5F3}\x{FE0F}"]},
         "Emancipation Day" => {prob => 0.00, chars => []},
              "Fathers Day" => {prob => 0.00, chars => []},
                 "Flag Day" => {prob => 0.00, chars => []}, # TODO all country flags

plugins/translate.pm

@@ -1,23 +1,30 @@
 use strict;
 use warnings;
-#use Bing::Translate;
+use LWP::UserAgent;
+use JSON::MaybeXS qw/decode_json encode_json/;
+use Data::Dumper;
 
+my $ua = LWP::UserAgent->new();
 
 
 return sub {
 	my( $said ) = @_;
 
-open(my $fh, "<etc/bing_secret.txt") or die "Couldn't read $!";
-my $cid = "Perlbot";
-my $secret = <$fh>;
-chomp $secret;
-close($fh);
-
-my $tro = Bing::Translate->new($cid, $secret);
 
     if ($said->{body} =~ /^\s*(?<from>\S+)\s+(?<to>\S+)\s+(?<text>.*)$/) {
-#        print $secret;
+      my $json = {
-        print $tro->translate($+{text}, $+{from}, $+{to});
+        source_language => $+{from},
+        target_language => $+{to},
+        text => $+{text}
+      };
+
+      my $resp = $ua->post("http://192.168.1.229:10000/translate_text", Content => encode_json($json));
+
+      my $cont = $resp->decoded_content();
+      my $output = decode_json($cont);
+
+      print Dumper $output;
+
     } else {
         print "help text";
     }