Mercurial > hg > skillbot
view skillbot.pl @ 54:9ed1e53a8d3e
Safety checks in hash sort
author | Dominic Cleal <dominic@computerkb.co.uk> |
---|---|
date | Sat, 27 Dec 2008 23:45:55 +0000 |
parents | d5872370102a |
children | c5ce2fff9b85 |
line wrap: on
line source
#!/usr/bin/perl # vim:set ts=4 shiftwidth=4 cindent: =pod skillbot Provides notifications of EVE Online skill completions over IRC. Based on Andy Smith's twitfolk bot: $Id: twitfolk.pl 802 2008-11-29 00:07:38Z andy $ Copyright ©2008 Andy Smith <andy+twitfolk.pl@bitfolk.com> Portions copyright ©2008 Dominic Cleal <dominic@computerkb.co.uk> Artistic license same as Perl. =cut use strict; use warnings; use WebService::EveOnline; use Data::Dumper; use Net::IRC; use POSIX; use Encode; use DateTime; require 'timers.pl'; # Config variables my %config; my %frienduids; my @friends; open(CONFIG, "< skillbot.conf") or die "can't open skillbot.conf for reading: $!"; while(<CONFIG>) { chomp; s/#.*//; s/^\s+//; s/\s+$//; next unless length; my ($var, $value) = split(/\s*=\s*/, $_, 2); $config{$var} = $value; } close(CONFIG) or die "can't close skillbot.conf: $!"; my $version = '0.02'; my $ircname = "skillbot v$version"; my $DEBUG = $ENV{'IRC_DEBUG'} || 0; my $time_to_die = 0; justme(); daemonize(); open(PIDFILE, "> $config{'pidfile'}") or die "can't write $config{'pidfile'}: $!"; print PIDFILE "$$\n"; close(PIDFILE) or die "can't close $config{'pidfile'}: $!"; update_friends(undef); my $irc = new Net::IRC; my $conn = $irc->newconn(Server => $config{'target_server'}, Port => $config{'target_port'}, Nick => $config{'nick'}, Ircname => $ircname, Username => $config{'username'}, Password => $config{'target_pass'}) or die "can't connect to $config{'target_server'}:$config{'target_port'}: $@\n"; binmode $conn->{_socket}, ":bytes"; init_handlers($conn); init_timers(); until ($time_to_die) { $irc->do_one_loop(); do_timers_once($conn); do_timers_repeat($conn); } if ($conn) { $conn->quit("Caught SIGINT, bye."); } cleanup_and_die(); sub cleanup_and_die { unlink($config{'pidfile'}); exit(); } sub init_handlers { my ($self) = shift; $self->add_handler('notice', \&on_notice); $self->add_handler([ 251,252,253,254,302,255 ], \&on_init); $self->add_handler('disconnect', \&on_disconnect); $self->add_handler(376, \&on_connect); $self->add_handler(433, \&on_nick_taken); $self->add_handler('cversion', \&on_cversion); $self->add_handler('cping', \&on_ping); $self->add_handler('join', \&on_join); $self->add_handler('public', \&on_public); } sub irc_debug { my ($fmt, @args) = @_; return unless $DEBUG; $fmt = '%s| *** ' . $fmt . "\n"; print sprintf($fmt, scalar gmtime(), @args); } =pod Timers to set going when we start. =cut sub init_timers { # Join channels for the first time, ~15 secs after connect add_one_shot_timer(15, sub { my ($timer, $self) = @_; join_channels($self); }); # Check we are in the right channels every 10 minutes add_repeat_timer(600, sub { my ($timer, $self) = @_; join_channels($self); }); # Read the "friends" config file every 6 minutes and make sure we have # API sessions for them all add_repeat_timer(360, sub { my ($timer, $self) = @_; update_friends($self); }); # Check for new skills every 60 minutes. add_repeat_timer(3600, sub { my ($timer, $self) = @_; check_training($self); }); } sub nickserv_id_now { my ($self) = shift; $self->privmsg("NickServ", sprintf("IDENTIFY %s", $config{nick_pass})); } sub nickserv_release { my ($self) = shift; $self->privmsg("NickServ", sprintf("RELEASE %s %s", $config{nick}, $config{nick_pass})); } sub on_connect { my $self = shift; =pod $twit->update(sprintf("Connected to irc://%s/, joining channels", $config{target_server})); $twit->http_code == 200 or print sprintf("%s| *** %s\n", scalar gmtime(), $twit->http_message); =cut $self->away($config{away}) if ($config{away}); join_channels($self); } sub join_channels { my $self = shift; $self->join('#' . $config{channel}, $config{chankey}); } sub on_join { my ($self, $event) = @_; # print Dumper($event); if ($event->nick eq $config{nick}) { =pod $twit->update("In channel, checking for tweets"); $twit->http_code == 200 or print sprintf("%s| *** %s\n", scalar gmtime(), $twit->http_message); =cut # Now we're in, check for tweets as a one-off add_one_shot_timer(10, sub { my ($timer, $self) = @_; check_training($self); }); } } sub on_ping { my ($self, $event) = @_; my $their_nick = $event->nick; $self->ctcp_reply($their_nick, "PING " . join (' ', ($event->args))); } sub on_init { my ($self, $event) = @_; my (@args) = ($event->args); shift (@args); # irc_debug(@args); } sub on_disconnect { my ($self, $event) = @_; irc_debug("Disconnected from %s (%s). Attempting to reconnect...", $event->from, ($event->args())[0]); while (! $self->connect()) { irc_debug("%s", $@); } } sub on_public { my ($self, $event) = @_; my ($their_nick, $msg) = ($event->nick, $event->args); # lists the current chars in training of the caller if ($msg =~ /^\!eta(\s+(.+))?/i) { my $found = 0; my @filtered = sort { (defined $a->{skill} && defined $b->{skill}) ? $a->{skill}->finish_time <=> $b->{skill}->finish_time : 0 } grep { ((defined $2 && (lc($_->{char}->name) eq lc($2) || lc($2) eq 'all' || lc($2) eq '*')) || (!defined $2 && $_->{nick} eq $their_nick)) } @friends; for my $f (@filtered) { check_friend($self, $f); my $text; if (defined $f->{skill}) { my $downtime = ''; if (skill_finish_in_downtime($f->{skill})) { $downtime = ", coincides with downtime"; } my $finish = DateTime->from_epoch( epoch => $f->{skill}->finish_time, time_zone => $f->{tz}); $text = sprintf("Currently training %s %s ". "(finish in %s, %s %s%s)", $f->{skill}->name, $f->{skill}->level, $f->{skill}->time_remaining, $finish->strftime("%A %R"), $finish->time_zone_short_name(), $downtime); } else { $text = "No skill currently training"; } $self->privmsg('#' . $config{channel}, sprintf( "\002%s:\002 %s", $f->{char}->name, encode("utf8", $text))); $found++; } if ($found == 0) { $self->privmsg('#' . $config{channel}, "No characters found"); } } # lists the chars in order of shortest training time elsif ($msg =~ /^\!next/i) { my $nreply = "Training: "; check_training($self); my @training = sort { $a->{skill}->finish_time <=> $b->{skill}->finish_time } grep { defined $_->{skill} } @friends; for my $f (@training) { $nreply .= sprintf("\002%s\002 (%s) | ", $f->{char}->name, $f->{skill}->time_remaining); } $self->privmsg('#' . $config{channel}, substr($nreply, 0, -3)); } } sub on_notice { my ($self, $event) = @_; my ($their_nick) = $event->nick; my ($notice_txt) = join(' ', $event->args); $_ = $their_nick; irc_debug("Got notice from %s: %s", $_, $notice_txt); if (/^NickServ$/i) { do_nickserv_notice($self, $notice_txt); } } sub do_nickserv_notice { my ($self, $notice) = @_; $_ = $notice; if (/This nick is owned by someone else/ || /This nickname is registered and protected/i) { irc_debug("ID to NickServ at request of NickServ"); nickserv_id_now($self); } elsif (/Your nick has been recovered/i) { irc_debug("NickServ told me I recovered my nick, RELEASE'ing now"); nickserv_release($self); } elsif (/Your nick has been released from custody/i) { irc_debug("NickServ told me my nick is released, /nick'ing now"); $self->nick($config{nick}); } else { irc_debug("Ignoring NickServ notice: %s", $notice); } } sub on_nick_taken { my ($self) = shift; $self->nick($config{nick} . $$); nickserv_recover($self); } sub on_cversion { my ($self, $event) = @_; my $vstring = sprintf("VERSION %s", $ircname); $self->ctcp_reply($event->nick, $vstring); } sub justme { if (open(PIDFILE, "< $config{pidfile}")) { my $pid; chop($pid = <PIDFILE>); close(PIDFILE) or die "couldn't close $config{pidfile}: $1"; if (kill(0, $pid)) { print "$0 already running (pid $pid), bailing out\n"; cleanup_and_die(); } } } sub handle_sig_int_term { $time_to_die = 1; } =pod Splurge the perl error to IRC for the amusement of others. =cut sub handle_perl_death { die @_ if $^S; my $msg = shift; if ($conn) { $conn->quit($msg . ", died"); } } sub daemonize { $SIG{__DIE__} = \&handle_perl_death; $SIG{INT} = $SIG{TERM} = \&handle_sig_int_term; # Only daemonize if not running debug mode return if ($DEBUG); my $pid = fork(); exit if $pid; die "Couldn't fork: $!" unless defined($pid); close(STDOUT); close(STDERR); POSIX::setsid() or die "Can't start a new session: $!"; } =pod Read a list of friends from the friends_file. Format is: user_id api_key IRC_nick timezone character_name Start a line with # for a comment. Character name is optional, if left out then all characters will be monitored. =cut sub update_friends { my $self = shift; open(FF, "< $config{friends_file}") or die "Couldn't open friends_file: $!"; while (<FF>) { chomp; next if (/^#/); if (/^([0-9]+)\s+([a-z0-9]{64})\s+(\S+)\s+(\S+)(\s+(.+))?/i) { my $uid = $1; my $key = $2; my $nick = $3; my $tz = $4; my $c = $6; if (! $frienduids{$uid}) { unless (DateTime::TimeZone->is_valid_name($tz)) { irc_debug("Invalid timezone (%s) supplied for friend %s". ", using UTC", $tz, $nick); $tz = 'UTC'; } my $api = WebService::EveOnline->new( { user_id => $uid, api_key => $key } ); my $loaded = 0; foreach my $character ($api->characters) { next if defined $c && $c ne $character->name; push @friends, { char => $character, api => $api, nick => $nick, tz => $tz }; $loaded++; } if (defined $c && $loaded eq 0) { irc_debug("Unable to find character %s for ID %lu", $c, $uid); next; } $frienduids{$uid} = $loaded; irc_debug("Adding new friend %s (%lu), %lu characters", $nick, $uid, $loaded); } } } close(FF) or warn "Something weird occured when closing friends_file: $!"; } =pod Check for any characters that aren't known to be training, then call the API to see if they've started, setting timers. =cut sub check_training { my $self = shift; check_friend($self, $_) foreach (@friends); } sub check_friend { my $self = shift; my $f = shift; my $skill = $f->{char}->skill->in_training; # Nothing training unless (defined $skill) { # If the char was training before and now has stopped then cancel # the announcement if (defined $f->{timer}) { del_one_shot_timer($f->{timer}); delete $f->{timer}; } return; } # Check for changes in the skill, skip or cancel announcement if (defined $f->{skill}) { return if $skill->id eq $f->{skill}->id; del_one_shot_timer($f->{timer}); delete $f->{timer}; } my $finish = $skill->finish_time - time(); my $prefinish = $finish - 60; irc_debug("Character %s is training %s %d (%s == %d sec)", $f->{char}->name, $skill->name, $skill->level, $skill->time_remaining, $finish); # Ignore bad data if ($finish < 0) { irc_debug("Unreasonable finish time given of %s seconds, ignoring", $finish); return; } $f->{skill} = $skill; # Check if the finish time is within scheduled EVE downtime if (skill_finish_in_downtime($f->{skill})) { $self->privmsg('#' . $config{channel}, sprintf( "\002%s:\002 Completion time of %s's %s %lu " . "skill will coincide with scheduled downtime at %s", $f->{nick}, $f->{char}->name, $f->{skill}->name, $f->{skill}->level, scalar(gmtime($f->{skill}->finish_time)))); } my $text = sprintf("%s has completed training skill %s %s", $f->{char}->name, $skill->name, $skill->level); if ($text =~ /[\n\r]/) { $text =~ s/[\n\r]/ /g; } # Add a timer shortly before the end to ensure the user's still training if ($prefinish > 0) { add_one_shot_timer($prefinish, sub { check_friend($self, $f); }); } $f->{timer} = add_one_shot_timer($skill->finish_time - time(), sub { $self->privmsg('#' . $config{channel}, sprintf( "\002%s:\002 %s", $f->{nick}, encode("utf8", $text))); delete $f->{skill}; }); } =pod Indicate whether the passed skill object is due to finish during a normal, scheduled downtime window. =cut sub skill_finish_in_downtime { my $skill = shift; # Check if the finish time is within 11:00-11:59 (EVE downtime) return ([gmtime($skill->finish_time)]->[2] == 11); } END { cleanup_and_die(); }