Advertisement
Guest User

Untitled

a guest
May 6th, 2017
92
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 10.00 KB | None | 0 0
  1. #!/usr/bin/perl
  2.  
  3. #Scissors version 0.0.1
  4. #Author: Grinnz
  5. #Usage: A perl bot running the MegaHAL script
  6. use strict;
  7. use warnings;
  8.  
  9. use Net::IRC;
  10. use AI::MegaHAL;
  11. use Data::Dumper;
  12.  
  13. my %command = (
  14.     'join' => { func => \&cmd_join, access => 2, on => 1, strip => 1 },
  15.     'leave' => { func => \&cmd_leave, access => 2, on => 1, strip => 1 },
  16.     'quit' => { func => \&cmd_quit, access => 2, on => 1, strip => 0 },
  17.     'say' => { func => \&cmd_say, access => 1, on => 1, strip => 0 },
  18.     'help' => { func => \&cmd_help, access => 0, on => 1, strip => 0 },
  19.     'version' => { func => \&cmd_version, access => 0, on => 1, strip => 0 },
  20.     'reload' => { func => \&cmd_reload, access => 2, on => 1, strip => 0 });
  21. my %cmdwhois = ( cmd => '' );
  22.  
  23. my $conffile = 'scissors.conf';
  24. my $conf = { debug => 1,
  25.          echo => 1,
  26.          trigger => '=',
  27.          master => 'Grinnz',
  28.          admins => [],
  29.          channels => [ '#bots', '#grinnz-chat' ],
  30.          freespeak => [ '#grinnz-chat' ],
  31.          version => '0.0.1',
  32.          server => 'socialgamer.net',
  33.          nick => 'Scissors',
  34.          username => 'scissors',
  35.          password => '',
  36.          ircname => 'Scissors',
  37.          awaymsg => 'I am a bot. Really.',
  38.          ssl => 0,
  39.          port => 6667 };
  40.  
  41. if (-e $conffile) {
  42.     print "Opening config...\n";
  43.     $conf = load($conffile);
  44. } else {
  45.     print "No config found. Using default configuration...\n";
  46.     save($conf,$conffile);
  47. }
  48.  
  49. my $megahal = AI::MegaHAL->new('Path' => './', 'Banner' => 0, 'Prompt' => 0, 'Wrap' => 0, 'AutoSave' => 1);
  50.  
  51. my $irc = new Net::IRC;
  52. my $conn = $irc->newconn(Nick     => $conf->{nick},
  53.              Server   => $conf->{server},
  54.              Port     => $conf->{port},
  55.              Ircname  => $conf->{ircname},
  56.              Username => $conf->{username},
  57.              SSL      => $conf->{ssl});
  58.  
  59. $conn->add_global_handler('public', \&on_public);
  60. $conn->add_global_handler('msg', \&on_msg);
  61. $conn->add_global_handler('kick', \&on_kick);
  62. $conn->add_global_handler('disconnect', \&on_disconnect);
  63. $conn->add_global_handler('376', \&on_connect);
  64. $conn->add_global_handler('320', \&on_whois_ident);
  65.  
  66. $SIG{TERM} = 'on_disconnect';
  67. $SIG{INT} = 'on_disconnect';
  68.  
  69. print "Starting connection to $conf->{server}/$conf->{port}...\n" if $conf->{debug};
  70. $irc->start;
  71.  
  72. # ********
  73. # Handlers
  74. # ********
  75.  
  76. # Executed upon successful connection to the IRC server
  77. sub on_connect {
  78.     my $conn = shift;
  79.     print "Connected. Identifying with Nickserv...\n" if $conf->{debug};
  80.     $conn->privmsg('NickServ',"identify $conf->{nick} $conf->{password}") if $conf->{password};
  81.     $conn->mode($conf->{nick},'+B');
  82.     $conn->away($conf->{awaymsg});
  83.     print "Attempting to join autojoin channels: @{$conf->{channels}}\n" if $conf->{debug};
  84.     $conn->join($_) foreach @{$conf->{channels}};
  85. }
  86.  
  87. sub on_disconnect {
  88.     exit(0);
  89. }
  90.  
  91. # Executed upon a kick
  92. sub on_kick {
  93.     my ($conn,$event) = @_;
  94.     my $kickee = $event->{to}[0];
  95.     my $channel = $event->{args}[0];
  96.     if (lc $kickee eq lc $conf->{nick} and
  97.     grep {lc $channel eq lc $_} @{$conf->{channels}}) {
  98.     print "Kicked from $channel, attempting to rejoin.\n" if $conf->{debug};
  99.     $conn->join($channel);
  100.     }
  101. }
  102.  
  103. # Executed for any public (channel) message
  104. sub on_public {
  105.     my ($conn,$event) = @_;
  106.     my $sender = $event->{nick};
  107.     my $channel = $event->{to}[0];
  108.     my $msg = $event->{args}[0];
  109.  
  110.     print "[$channel] $sender: $msg\n" if $conf->{echo};
  111.    
  112.     $megahal->learn($msg);
  113.  
  114.     my $reply = '';
  115.     if ($msg =~ /^$conf->{nick}/i) {
  116.     print "Someone's talking to me! Responding.\n" if $conf->{debug};
  117.     $reply = $sender.': '.$megahal->do_reply($msg);
  118.     }
  119.     elsif ($msg =~ /$conf->{nick}/i) {
  120.     print "Someone's talking about me!\n" if $conf->{debug};
  121.     $reply = $megahal->do_reply($msg);
  122.     }
  123.     elsif (grep {lc $channel eq lc $_} @{$conf->{freespeak}}) {
  124.     print "Someone's talking!\n" if $conf->{debug};
  125.     $reply = $megahal->do_reply($msg);
  126.     }
  127.     $conn->privmsg($channel,$reply) if $reply;
  128.    
  129.     parsecmd($conn,$sender,$channel,$msg);
  130. }
  131.  
  132. # Executed for any private message
  133. sub on_msg {
  134.     my ($conn,$event) = @_;
  135.     my $sender = $event->{nick};
  136.     my $msg = $event->{args}[0];
  137.    
  138.     print "[private] $sender: $msg\n" if $conf->{echo};
  139.    
  140.     parsecmd($conn,$sender,'private',$msg);
  141. }
  142.  
  143. # Parses a received message for a command
  144. sub parsecmd {
  145.     my ($conn,$sender,$channel,$msg) = @_;
  146.     if ((strip_formatting($msg) =~ /^\Q$conf->{trigger}\E([[:graph:]]+)/ or
  147.      ($channel eq 'private' and strip_formatting($msg) =~ /^([[:graph:]]+)/)) and
  148.     exists $command{lc $1}) {
  149.     my $cmd = lc $1;
  150.     my $args = '';
  151.     if ($msg =~ /^[[:graph:][:cntrl:]]+ +(.*?)$/) { $args = $1; }
  152.     $args = strip_formatting($args) if $command{$cmd}->{strip};
  153.     print "[$channel] $sender: (command) $cmd $args\n" if $conf->{debug};
  154.     if (!$command{$cmd}->{on}) {
  155.         if ($channel eq 'private') {
  156.         $conn->privmsg($sender,"Error: command $cmd has been disabled.");
  157.         } else {
  158.         $conn->privmsg($channel,"Error: command $cmd has been disabled.");
  159.         }
  160.     } elsif ($command{$cmd}->{access} == 0) {
  161.         print "No access required, executing command\n" if $conf->{debug};
  162.         $command{$cmd}->{func}($conn,$sender,$channel,$args);
  163.     } elsif ($cmdwhois{cmd}) {
  164.         if ($channel eq 'private') {
  165.         $conn->privmsg($sender,"Error: please repeat command in a few seconds.");
  166.         } else {
  167.         $conn->privmsg($channel,"Error: please repeat command in a few seconds.");
  168.         }
  169.     } else {
  170.         $cmdwhois{cmd} = $cmd;
  171.         $cmdwhois{user} = $sender;
  172.         $cmdwhois{chan} = $channel;
  173.         $cmdwhois{args} = $args;
  174.         $conn->whois($sender);
  175.     }
  176.     }
  177. }
  178.  
  179. # Color/formatting stripping for command parser
  180. sub strip_formatting {
  181.     # strip ALL user formatting from IRC input (color, bold, underline, plaintext marker)
  182.     my $arg = shift;
  183.     my $c_code = chr(3);      # how colors are read by us
  184.     my $u_code = chr(31);     # how underlines are read
  185.     my $b_code = chr(2);      # how bold is read
  186.     my $p_code = chr(15);     # how plaintext is read
  187.     $arg =~ s/(($c_code(\d\d?(\,\d\d?)?)?)|$u_code|$b_code|$p_code)//g;
  188.     return $arg;
  189. }
  190.  
  191. # Executed upon receiving the login information for an user
  192. sub on_whois_ident {
  193.     my ($conn,$event) = @_;
  194.     my $nick = $event->{args}[1];
  195.     my $lia = $event->{args}[2];
  196.    
  197.     if ($cmdwhois{cmd} and lc $cmdwhois{user} eq lc $nick) {
  198.     my $cmd = $cmdwhois{cmd};
  199.     my $chan = $cmdwhois{chan};
  200.     my $args = $cmdwhois{args};
  201.     my $isadmin = 0;
  202.     if ($lia =~ /is logged in as ([[:graph:]]+)/) {
  203.         print "$nick is logged in as $1\n" if $conf->{debug};
  204.         if (lc $1 eq lc $conf->{master} or
  205.         grep {lc $1 eq lc $_} @{$conf->{admins}}) {
  206.         print "$1 has admin access.\n" if $conf->{debug};
  207.         $isadmin = 1;
  208.         }
  209.     }
  210.     else {
  211.         print "$nick is an IRCop.\n" if $conf->{debug};
  212.         $isadmin = 1;
  213.     }
  214.    
  215.     if ($isadmin and $command{$cmd}->{access} < 3) {
  216.         $command{$cmd}->{func}($conn,$nick,$chan,$args);
  217.     }
  218.     $cmdwhois{cmd} = '';
  219.     }
  220. }
  221.  
  222. # ********
  223. # Commands
  224. # ********
  225.  
  226. sub cmd_join {
  227.     my ($conn,$sender,$channel,$args) = @_;
  228.     my @chans = split ' ',$args;
  229.     foreach (0..$#chans) {
  230.     $chans[$_] = '#'.$chans[$_] unless $chans[$_] =~ /^#/;
  231.     }
  232.     print "Attempting to join channel(s): @chans\n" if $conf->{debug};
  233.     $conn->join($_) foreach @chans;
  234. }
  235.  
  236. sub cmd_leave {
  237.     my ($conn,$sender,$channel,$args) = @_;
  238.     if ($channel eq 'private') {
  239.     unless ($args) {
  240.         $conn->privmsg($sender,"Please specify a channel");
  241.         return;
  242.     }
  243.     if ($args =~ /^([[:graph:]]+) ?(.*?)$/) {
  244.         my $chan = $1;
  245.         my $msg = $2;
  246.         $chan = '#'.$chan unless $chan =~ /^#/;
  247.         $conn->part("$chan $msg");
  248.     }
  249.     }
  250.     elsif ($args =~ /^(#[[:graph:]]+) ?(.*?)$/) {
  251.         my $chan = $1;
  252.         my $msg = $2;
  253.         $conn->part("$chan $msg");
  254.     }
  255.     else { $conn->part("$channel $args"); }
  256. }
  257.  
  258. sub cmd_quit {
  259.     my ($conn,$sender,$channel,$args) = @_;
  260.     print "Quitting: $args\n" if $conf->{debug};
  261.     $conn->quit($args);
  262. }
  263.  
  264. sub cmd_say {
  265.     my ($conn,$sender,$channel,$args) = @_;
  266.     $channel = $sender if $channel eq 'private';
  267.     $conn->privmsg($channel," - $args");
  268. }
  269.  
  270. sub cmd_help {
  271.     my ($conn,$sender,$channel,$args) = @_;
  272.     my @cmds = keys %command;
  273.     foreach (0..$#cmds) { $cmds[$_] = $conf->{trigger}.$cmds[$_]; }
  274.     $conn->notice($sender,"I respond to the following commands: @cmds");
  275. }
  276.  
  277. sub cmd_version {
  278.     my ($conn,$sender,$channel,$args) = @_;
  279.     $conn->notice($sender,"$conf->{nick} version $conf->{version} by Grinnz");
  280. }
  281.  
  282. sub cmd_reload {
  283.     my ($conn,$sender,$channel,$args) = @_;
  284.     $channel = $sender if $channel eq 'private';
  285.     $conn->privmsg($channel,'Reloading configuration.');
  286.     $conf = load($conffile);
  287. }
  288.  
  289. # ************
  290. # Data storage
  291. # ************
  292.  
  293. # Stores a data structure to a file in plaintext
  294. sub save {
  295.     my ($data,$filename) = @_;
  296.     unless ($data and $filename and ref($data) eq 'HASH') {
  297.     warn "Invalid parameters to store" and return;
  298.     }
  299.    
  300.     warn "Warning: file $filename will be overwritten\n" if -e $filename;
  301.     my $file;
  302.     unless (open $file, '>', $filename) {
  303.     warn "File could not be opened for saving. Aborting." and return;
  304.     }
  305.    
  306.     print $file "# Config file for SGBot\n";
  307.     while (my ($name,$item) = each %{$data}) {
  308.     # Only stores scalars and arrays with no spaces in values!
  309.     print $file "s $name $item\n" if !ref $item;
  310.     print $file "a $name @{$item}\n" if 'ARRAY' eq ref $item;
  311.     }
  312.     close $file;
  313. }
  314.  
  315. # Reads a plaintext file stored with 'store' into a data structure
  316. sub load {
  317.     my $filename = shift;
  318.     my $data = {};
  319.     unless ($filename and -e $filename) {
  320.     warn "Invalid filename specified for load" and return $data;
  321.     }
  322.    
  323.     my $file;
  324.     unless (open $file, '<', $filename) {
  325.     warn "File could not be opened for loading. Aborting." and return $data;
  326.     }
  327.    
  328.     while (<$file>) {
  329.     if (/^([s|a]) ([[:graph:]]+) ([[:print:]]+)\r?\n$/) {
  330.         $data->{$2} = $3 if $1 eq 's';
  331.         $data->{$2} = [ split ' ',$3 ] if $1 eq 'a';
  332.     }
  333.     }
  334.     close $file;
  335.     return $data;
  336. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement