#!/usr/bin/perl my $test = 0; # VERSION: 3.9.3 #use lib '/home/ventz/perldata'; use Bot::BasicBot; package CCSBot; use base qw(Bot::BasicBot); ############################################################################### # Note: enables you to use unicode IN your programs - NOT output it. #use utf8; use YAML::Tiny; use IO::Select; use LWP::UserAgent; use JSON; use WWW::Mechanize; use WWW::Shorten::Bitly; use HTML::Strip; use Term::ANSIColor qw(:constants); use Net::Twitter::Lite; use XML::FeedPP; use Tie::File; use DBI; ############################################################################### ############################################################################### my $yaml = YAML::Tiny->read( 'ccsbot.yml' ); if($test) { $channel = $yaml->[0]->{test_channel}; $channel_connect = $yaml->[0]->{test_channel_connect}; } # Basic settings for the BOT our $server = $yaml->[0]->{server}; our $channel = $yaml->[0]->{channel}; our $channel_connect = $yaml->[0]->{channel_connect}; our $bot_name = $yaml->[0]->{bot_name}; our $admin_name = $yaml->[0]->{admin_name}; # Important - autocheck should be '0' to remove errors! # Otherwise it sends a 'die' after triggered alarm our $mech = WWW::Mechanize->new( autocheck => 0, ssl_opts => { SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE, verify_hostname => 0, # this key is likely going to be removed in future LWP >6.04 } ); #our $mech = WWW::Mechanize->new( autocheck => 0 ); $mech->timeout(5); $mech->quiet(1); $mech->agent_alias( 'Mac Safari' ); # DB for Log and DB for Quotes my $db_log = $yaml->[0]->{db_log}; my $dsn_log = "dbi:SQLite:dbname=$db_log"; my $dbiopts = { AutoCommit => 1, PrintError => 1, }; my $dbh_log = DBI->connect($dsn_log,"","", $dbiopts); my $dbh_karma = DBI->connect($dsn_log,"","", $dbiopts); # SCHEMA for DB #CREATE TABLE logs(id INTEGER primary key, d TEXT DEFAULT (strftime('%Y-%m-%d','now', 'localtime')), t TEXT DEFAULT (strftime('%H:%M:%S', 'now', 'localtime')), time VARCHAR(20), username VARCHAR(20), action VARCHAR(10), log TEXT); #CREATE INDEX logs_d_dx ON logs(d); #CREATE INDEX logs_t_tx ON logs(t); #CREATE INDEX logs_time_timex ON logs(time); #CREATE INDEX logs_username_usernamex ON logs(username); #CREATE INDEX logs_action_actionx ON logs(action); #CREATE INDEX logs_log_logx ON logs(log); #CREATE TABLE karma(id INTEGER primary key, username VARCHAR(20), karma INTEGER, karma_msg TEXT); #CREATE UNIQUE INDEX karma_username_usernamex ON karma(username); #CREATE INDEX karma_karma_karmax ON karma(karma); #CREATE INDEX karma_karma_msg_karma_msgx ON karma(karma_msg); # Log File my $log_file = $yaml->[0]->{log_file}; open(OUT, ">>$log_file"); # Quotes File my $quotes_file = $yaml->[0]->{quotes_file}; tie our @quotes, 'Tie::File', "$quotes_file"; # Channel our $password = $yaml->[0]->{bitly_password}; # Bitly our $username = $yaml->[0]->{bitly_username}; our $apikey = $yaml->[0]->{bitly_apikey}; # Twitter my %consumer_tokens = ( consumer_key => $yaml->[0]->{twitter_key}, consumer_secret => $yaml->[0]->{twitter_secret}, ); my $nt = Net::Twitter::Lite->new(%consumer_tokens, legacy_lists_api => 0); $nt->access_token($yaml->[0]->{twitter_access_token}); $nt->access_token_secret($yaml->[0]->{twitter_access_token_secret}); # Define IRC color constants for ease of use later my $BOLD = chr(2); my $COLOR = chr(3); my $UNDERLINE = chr(31); ############################################################################### sub said { my $self = shift; my $mess = shift; my $msg = $mess->{body}; my $who = $mess->{who}; my $to = $mess->{address}; my $action = 'said'; my $date = date(); # LOG EVERYTHING! my $old_fh = select(OUT); $| = 1; select($old_fh); binmode(OUT, ":utf8"); my $r = "$date < $who> $msg"; print OUT "$r\n"; my $sth_log = $dbh_log->prepare("insert into logs ( time, username, action, log ) values (?,?,?,?)"); $sth_log->execute($date,$who,$action,$r); # KILL SERVER if( ($to) and (($to =~ /^$bot_name/) or ($to =~ /^msg/)) ) { if( ($who eq "$admin_name") and ($msg eq "die") ) { close(OUT); $dbh_log->disconnect; $dbh_karma->disconnect; untie(@quotes); $self->quit("Good Bye Cruel World"); exit(0); } } # Add Karma if($msg =~ /^([^\s]+)([+-]{2})$/ || $msg =~ /^([^\s]+)([+-]{2})(\s*#\s*)(.*)$/) { my $username = lc($1); s/[^ \.a-zA-Z0-9_'!\/\(\)#\?:-]//g; # prune all but these my $k = $2; my $k_text = ''; my ($karma, $old_karma) = (0,0); my ($karma_msg, $old_karma_msg) = ('N/A','N/A'); if(defined($4)) { $karma_msg = substr($4, 0, 120); $karma_msg =~ s/^(\s*)//; } my $fst_karma = $dbh_karma->selectall_arrayref("SELECT karma,karma_msg from KARMA where USERNAME = ?", undef, $username); foreach my $row (@$fst_karma) { my @t = @$row; $karma = $t[0]; $old_karma_msg = $t[1]; $old_karma = $karma;} # When we pull the karma from the DB, increase it, and label it if($k eq '++') { $karma++; $k_text = 'ADD'; } elsif($k eq '--') { $karma--; $k_text = 'REMOVE'; } # If we didn't get a karma_msg, and there is an old karma MSG, and it's NOT N/A, use it! #if($karma_msg eq 'N/A' && $old_karma_msg ne 'N/A') { $karma_msg = $old_karma_msg; } my $sth_karma = $dbh_karma->prepare('INSERT or REPLACE into KARMA ( username, karma, karma_msg ) values (?,?,?)'); $sth_karma->execute($username,$karma,$karma_msg); $karma_msg =~ s/[^ \.a-zA-Z0-9_'!\/\(\)#\?:-]//g; # prune all but these if($karma_msg ne '') { $karma_msg = "| $karma_msg"; } my $r = "${COLOR}3** Karma${COLOR} ${COLOR}5$k_text${COLOR} for $username | Karma: $old_karma => $karma $karma_msg"; $self->say(channel => $channel, body => "$r"); } # Pull Karma if($msg =~ /^!karma ([^\s]+)$/) { my $username = lc($1); $username =~ s/[^a-zA-Z0-9_\/\(\):-]//g; # prune all but these my $karma = 0; my $karma_msg = ''; my ($karma_msg, $old_karma_msg) = ('N/A','N/A'); my $fst_karma = $dbh_karma->selectall_arrayref("SELECT karma,karma_msg from KARMA where USERNAME = ?", undef, $username); foreach my $row (@$fst_karma) { my @t = @$row; $karma = $t[0]; $old_karma_msg = $t[1];} # If there is an old karma MSG, and it's NOT N/A, use it! if($old_karma_msg ne 'N/A') { $karma_msg = $old_karma_msg; } my $r = "${COLOR}3** Karma${COLOR} for $username: $karma | $karma_msg"; $self->say(channel => $channel, body => "$r"); } # RSS Support if($msg =~ /^!n tech$/) { my $source = 'http://rss.cnn.com/rss/cnn_tech.rss'; rss($source, $self); } elsif($msg =~ /^!n crime$/) { my $source = 'http://rss.cnn.com/rss/cnn_crime.rss'; rss($source, $self); } elsif($msg =~ /^!n sports$/) { my $source = 'http://rss.cnn.com/rss/si_topstories.rss'; rss($source, $self); } elsif($msg =~ /^!n us$/) { my $source = 'http://rss.cnn.com/rss/cnn_us.rss'; rss($source, $self); } elsif($msg =~ /^!n sec$/) { my $source = 'http://blogs.technet.com/b/msrc/rss.aspx'; rss($source, $self); } elsif($msg =~ /^!r (.*)$/) { my $source = $1; rss($source, $self); } # Google Search Support elsif($msg =~ /^!g (\w*)$/) { my $query = $1; google($query, $self); } # Weather Support elsif($msg =~ /^!w (\d\d\d\d\d)$/) { my $zipcode = $1; my $source = "http://rss.accuweather.com/rss/liveweather_rss.asp?metric=0&locCode=$zipcode"; my $feed = XML::FeedPP->new( $source ); my $location = $feed->title(); $location =~ s/ - AccuWeather.com Forecast//; my @items = $feed->get_item(); my $weather = $items[0]->title; $self->say(channel => $channel, body => "$weather ($location)"); my $old_fh = select(OUT); $| = 1; select($old_fh); my $r = "$date < $bot_name> $weather ($location)"; print OUT "$r\n"; my $sth_log = $dbh_log->prepare("insert into logs ( time, username, action, log ) values (?,?,?,?)"); $sth_log->execute($date,$bot_name,$action,$r); } # BS phrases - verb adjective noun elsif($msg =~ /^!bs$/) { my $mech = WWW::Mechanize->new(); my $url = "http://vpetkov.net/cgi-bin/bs.cgi"; $mech->agent_alias( 'Mac Safari' ); $mech->get( $url ); my $page = $mech->content; $self->say(channel => $channel, body => "$page"); my $old_fh = select(OUT); $| = 1; select($old_fh); my $r = "$date < $bot_name> $page"; print OUT "$r\n"; my $sth_log = $dbh_log->prepare("insert into logs ( time, username, action, log ) values (?,?,?,?)"); $sth_log->execute($date,$bot_name,$action,$r); } # Twitter Support elsif($msg =~ /^!t (\w*)$/) { my $twitter_user = $1; eval { my $statuses = $nt->user_timeline({ screen_name => "$twitter_user", count => 1 }); for my $status ( @$statuses ) { my $t_time = $status->{created_at}; my $t_user = $status->{user}{screen_name}; my $t_text = $status->{text}; $self->say(channel => $channel, body => "$t_time <$t_user> $t_text"); } }; } # Save funny Bash.org Quotes elsif($msg =~ /^!s (\d*)$/) { my $quote = $1; my $mech = WWW::Mechanize->new(); my $url = "http://bash.org/?$quote"; $mech->agent_alias( 'Mac Safari' ); $mech->get( $url ); my $page = $mech->content; if($page =~ /.*(Quote #$quote does not exist\.).*/) { $self->say(channel => $channel, who => $who, address => 1, body => "Quote #$quote does not exist! Sorry!"); } else { if ( grep { $_ eq $quote} @quotes ) { $self->say(channel => $channel, who => $who, address => 1, body => "Bash.org quote #$quote has already been saved."); } else { push(@quotes, $quote); $self->say(channel => $channel, who => $who, address => 1, body => "Bash.org quote #$quote saved."); } } } # Load funny Bash.org Quotes elsif($msg =~ /^!br$/) { my $length = $#quotes + 1; my $random = int(rand($length)); my $quote = $quotes[$random]; my $clean_text = &bash($quote); $self->say(channel => $channel, body => "$clean_text"); } # Bash.org Support elsif($msg =~ /^!b(\s?)(.*)$/) { my $quote = $2; if($quote eq "") { $quote = 'random1'; } my $clean_text = &bash($quote); $self->say(channel => $channel, body => "$clean_text"); } # Shorten Links! if(($msg =~ /(\w+:\/\/\S+)/) && ($who ne "$bot_name")) { #print STDERR "MSG: $msg\n"; my @text = split(" ", $msg); for my $link (@text) { chomp($link); if($link =~ /(\w+:\/\/\S+)/) { my $title = ''; my $type = ''; my $msg = ''; #print STDERR "LINK: $link\n"; #next if ($link !~ /^http(s?)/); eval { local $SIG{ALRM} = sub {die "alarm"}; my $alarm = 5; alarm $alarm; # Note - even within alarm, need to set 'new( autocheck => 0 )' for www::mech # Otherwise, it takes down main thread. # Another solution is using a seperate thread for this (my guess) $mech->get("$link"); alarm 0; }; if ($@) { #print STDERR "COULD NOT GET LINK\n"; $msg = 'Could NOT retrieve URL'; #if ($@ eq "alarm") { # print STDERR "Timeout ($alarm) Reached...\n"; #} else { # # it was some other unexpected failure... better # # either handle it or propagate it: # print STDERR "Unknown Timeout: $@"; #} } else { eval { $type = $mech->ct(); }; if ($@) { #print STDERR "COULD NOT CONTENT TYPE\n"; $title = 'Could NOT even retrieve Content-Type'; } else { #print STDERR "TYPE: $type\n"; # Ok, at least we got the type. # Take care of the title. Try getting it, if not, stay with the type if($type =~ /(text|html)/) { eval { $title = $mech->title; #print STDERR "TITLE: $title\n"; }; if ($@) { #print STDERR "GOT CONTENT TYPE, but CAN'T PULL TITLE\n"; $title = $type; } else { # This is needed for cases like 'text/calendar' # It contains 'text', it's valid, but # comes back with no Title. if(!defined($title)) { $title = $type; } # If the title is over 50 characters, get only first 50 if(length($title) > 50) { $title = substr ($title,0,50); } } } else { $title = $type; } # Shorten URL my $shorturl; if($link =~ /http:\/\/(www\.)?bit.ly\.com/) { $shorturl = $link; } else { unless (length($link) < 60) { $shorturl = makeashorterlink($link,$username,$apikey); if(!defined($shorturl)) { $shorturl = $link; } #$msg = "$shorturl ($title)"; # Filter out crap from the title # (debugging: TimMc) # This says "match anything EXCEPT these" # So, it really is: remove anything EXCEPT these # NOTE: dash has to be first or last or escaped $title =~ s/[^ .a-zA-Z0-9_\/\(\):-]//g; $msg = "${COLOR}3${UNDERLINE}$shorturl${COLOR}${UNDERLINE} (${COLOR}5 $title$COLOR )"; #print STDERR "TITLE-right-before: $title\n"; $self->say(channel => $channel, body => "$msg"); } } } } } } } return undef; } sub emoted { my $self = shift; my $mess = shift; my $msg = $mess->{body}; my $who = $mess->{who}; my $to = $mess->{address}; my $action = 'emoted'; my $date = date(); my $old_fh = select(OUT); $| = 1; select($old_fh); my $r = "$date * $who $msg"; print OUT "$r\n"; my $sth_log = $dbh_log->prepare("insert into logs ( time, username, action, log ) values (?,?,?,?)"); $sth_log->execute($date,$who,$action,$r); return undef; } sub chanjoin { my $self = shift; my $mess = shift; my $who = $mess->{who}; my $channel = $mess->{channel}; my $action = 'chanjoin'; my $date = date(); my $old_fh = select(OUT); $| = 1; select($old_fh); my $r = "$date -!- $who has joined $channel"; print OUT "$r\n"; my $sth_log = $dbh_log->prepare("insert into logs ( time, username, action, log ) values (?,?,?,?)"); $sth_log->execute($date,$who,$action,$r); return undef; } sub chanpart { my $self = shift; my $mess = shift; my $who = $mess->{who}; my $channel = $mess->{channel}; my $action = 'chanpart'; my $date = date(); my $old_fh = select(OUT); $| = 1; select($old_fh); my $r = "$date -!- $who has quit"; print OUT "$r\n"; my $sth_log = $dbh_log->prepare("insert into logs ( time, username, action, log ) values (?,?,?,?)"); $sth_log->execute($date,$who,$action,$r); return undef; } sub userquit { my $self = shift; my $mess = shift; my $who = $mess->{who}; my $msg = $mess->{msg}; my $action = 'userquit'; my $date = date(); if(!defined($date)) { $date = "N/A"; } if(!defined($who)) { $who = "N/A"; } if(!defined($msg)) { $msg = "N/A"; } my $old_fh = select(OUT); $| = 1; select($old_fh); my $r = "$date -!- $who has quit [\"$msg\"]"; print OUT "$r\n"; my $sth_log = $dbh_log->prepare("insert into logs ( time, username, action, log ) values (?,?,?,?)"); $sth_log->execute($date,$who,$action,$r); return undef; } sub topic { my $self = shift; my $mess = shift; my $topic = $mess->{topic}; my $who = $mess->{who}; my $channel = $mess->{channel}; my $action = 'topic'; my $date = date(); if(!defined($who)) { $who = "N/A"; } if(!defined($channel)) { $channel = "N/A"; } if(!defined($topic)) { $topic = "N/A"; } my $old_fh = select(OUT); $| = 1; select($old_fh); my $r = "$date -!- $who changed the topic of $channel to: $topic"; print OUT "$r\n"; my $sth_log = $dbh_log->prepare("insert into logs ( time, username, action, log ) values (?,?,?,?)"); $sth_log->execute($date,$who,$action,$r); return undef; } sub nick_change { my $self = shift; my $mess = shift; my $from = $mess->{from}; my $to = $mess->{to}; my $action = 'nickchange'; my $date = date(); if(!defined($from)) { $from = "N/A"; } if(!defined($to)) { $to = "N/A"; } if(!defined($date)) { $date = "N/A"; } my $old_fh = select(OUT); $| = 1; select($old_fh); my $r = "$date -!- $from is now known as $to"; print OUT "$r\n"; my $sth_log = $dbh_log->prepare("insert into logs ( time, username, action, log ) values (?,?,?,?)"); $sth_log->execute($date,$who,$action,$r); return undef; } #sub irc_001_state { sub connected { my $self = shift; $self->log("Identifying with NickServ\n"); $self->say(channel => 'msg', who => "NickServ", body => "identify $password"); sleep 6; $self->log("Trying to connect to '$channel_connect'\n"); $self->join("$channel_connect"); } sub bash { my $quote = shift; my $mech = WWW::Mechanize->new( autocheck => 0 ); my $url = "http://bash.org/?$quote"; $mech->agent_alias( 'Mac Safari' ); eval { local $SIG{ALRM} = sub {die "alarm"}; my $alarm = 5; alarm $alarm; $mech->get( $url ); alarm 0; }; if ($@) { return "Cannot retrieve bash.org currently..."; } else { my $page = $mech->content; my $clean_text = &bash_parse($page, $quote); # Grab only the first line. $clean_text = ( split /\n/, $clean_text )[0]; return $clean_text; } } sub bash_parse() { my $page = shift; my $quote = shift; my $hs = HTML::Strip->new(); if($page =~ /.*(Quote #$quote does not exist\.).*/) { return $1; } $page =~ s/.*
(.*)<\/p>.*/$1/s; my $clean_text = $hs->parse( $1 ); $hs->eof; $clean_text =~ s/#\((.*)\)/$1/g; $clean_text =~ s/#(.*)\[X\]/${COLOR}3http:\/\/bash.org\/?$1${COLOR}\n/g; my $length = length($clean_text); if($length >= 400) { $clean_text = substr($clean_text, 0, 350)."\n${COLOR}5[...READ MORE...]${COLOR};"; } chomp($clean_text); return $clean_text } sub rss { my $source = shift; my $self = shift; my $action = 'said'; my $feed = XML::FeedPP->new( $source ); #my $rss_date = $feed->pubDate(); my @items = $feed->get_item(); my $rss_title = $items[0]->title; my $rss_url = $items[0]->link; my $rss_shorturl = makeashorterlink($rss_url,$username,$apikey); $self->say(channel => $channel, body => "$rss_title ($rss_shorturl)"); my $old_fh = select(OUT); $| = 1; select($old_fh); my $r = "$date < $bot_name> $r\n"; print OUT "$r\n"; my $sth_log = $dbh_log->prepare("insert into logs ( time, username, action, log ) values (?,?,?,?)"); $sth_log->execute($date,$who,$action,$r); } sub google { my $query = shift; my $self = shift; my $action = 'said'; my $url = "http://ajax.googleapis.com/ajax/services/search/web?v=1.0&rsz=3&q=$query&userip=8.8.8.8"; my $ua = LWP::UserAgent->new(); $ua->default_header("HTTP_REFERER" => 'google-search'); my $body = $ua->get($url); # process the json string my $json = from_json($body->decoded_content); # have some fun with the results my $i = 0; my $r = ''; my $r_log = ''; foreach my $result (@{$json->{responseData}->{results}}){ $i++; my $title = $result->{titleNoFormatting}; my $url = $result->{url}; $msg = "${COLOR}3${UNDERLINE}$url${COLOR}${UNDERLINE} (${COLOR}5 $title$COLOR )"; $r .= $i.".)>>> $msg \n"; } if(!$i){ $r = "Sorry, but there were no results.\n"; } $self->say(channel => $channel, body => "$r"); my $old_fh = select(OUT); $| = 1; select($old_fh); my $r = "$date < $bot_name> $r\n"; binmode STDOUT, ":encoding(UTF-8)"; print OUT "$r\n"; } sub date { # Calculate the date for the time stamp my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); $year = $year + 1900; $mon = $mon + 1; #my $date = sprintf("%02d/%02d/%04d - %02d:%02d:%02d", ($mon, $mday, $year, $hour, $min, $sec)); #return $date; my $date = sprintf("%02d:%02d", ($hour, $min)); return $date; } ############################################################## our $bot = CCSBot->new( server => "$server", # channels => [ $channel_connect ], nick => $bot_name, alt_nicks => $bot_name, quit_message => "Good Bye!", ); $bot->run();