Blame
Date:
Fri Dec 17 14:15:53 2021 UTC
Message:
Import sources
001
2021-12-17
jrmu
================================================================================
002
2021-12-17
jrmu
003
2021-12-17
jrmu
Log Bot Explained
004
2021-12-17
jrmu
005
2021-12-17
jrmu
logbot.pl joins a channel and then logs activity to logbot.log:
006
2021-12-17
jrmu
007
2021-12-17
jrmu
#!/usr/bin/perl
008
2021-12-17
jrmu
use strict;
009
2021-12-17
jrmu
use warnings;
010
2021-12-17
jrmu
011
2021-12-17
jrmu
open(my $fh, ">>logbot.log") or die "Unable to write to logbot.log";
012
2021-12-17
jrmu
select((select($fh), $|=1)[0]);
013
2021-12-17
jrmu
014
2021-12-17
jrmu
open() attempts to append to logbot.log (>> for append, > for write).
015
2021-12-17
jrmu
We append because we want to add new logs to the end of the file, not
016
2021-12-17
jrmu
overwrite an existing file.
017
2021-12-17
jrmu
018
2021-12-17
jrmu
If open succeeds, the filehandle will be assigned to $fh.
019
2021-12-17
jrmu
If open() fails, it returns false, which means that perl to immediately
020
2021-12-17
jrmu
quit with the message "Unable to write to logbot.log".
021
2021-12-17
jrmu
022
2021-12-17
jrmu
package LogBot;
023
2021-12-17
jrmu
use base qw(Bot::BasicBot);
024
2021-12-17
jrmu
025
2021-12-17
jrmu
sub date {
026
2021-12-17
jrmu
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
027
2021-12-17
jrmu
my $localtime = sprintf("%04d%02d%02d %02d:%02d", $year+1900, $mon+1, $mday, $hour, $min);
028
2021-12-17
jrmu
return $localtime;
029
2021-12-17
jrmu
}
030
2021-12-17
jrmu
031
2021-12-17
jrmu
We define the subroutine date(). WHen it is called, it returns the date and time
032
2021-12-17
jrmu
as a string in YYYYMMDD HH:MM format, where YYYY is the year, MM is the month,
033
2021-12-17
jrmu
DD is the day, HH is the hour, and MM is the minute.
034
2021-12-17
jrmu
035
2021-12-17
jrmu
If someone sends a message, we append this to the end of the log:
036
2021-12-17
jrmu
037
2021-12-17
jrmu
sub said {
038
2021-12-17
jrmu
my $self = shift;
039
2021-12-17
jrmu
my $arguments = shift;
040
2021-12-17
jrmu
print $fh date()." <$arguments->{who}> $arguments->{body}\n";
041
2021-12-17
jrmu
return;
042
2021-12-17
jrmu
}
043
2021-12-17
jrmu
044
2021-12-17
jrmu
To append, we simply print a string to $fh. The string starts with
045
2021-12-17
jrmu
the date and time, followed by the nickname of the sender of the message,
046
2021-12-17
jrmu
then the message itself.
047
2021-12-17
jrmu
048
2021-12-17
jrmu
Emotes and notices are also appended with the date and time, nickname, and
049
2021-12-17
jrmu
message.
050
2021-12-17
jrmu
051
2021-12-17
jrmu
sub emoted {
052
2021-12-17
jrmu
my $self = shift;
053
2021-12-17
jrmu
my $arguments = shift;
054
2021-12-17
jrmu
print $fh date()." *$arguments->{who} $arguments->{body}\n";
055
2021-12-17
jrmu
return;
056
2021-12-17
jrmu
}
057
2021-12-17
jrmu
058
2021-12-17
jrmu
sub noticed {
059
2021-12-17
jrmu
my $self = shift;
060
2021-12-17
jrmu
my $arguments = shift;
061
2021-12-17
jrmu
print $fh date()." [$arguments->{who} notice]: $arguments->{body}\n";
062
2021-12-17
jrmu
return;
063
2021-12-17
jrmu
}
064
2021-12-17
jrmu
065
2021-12-17
jrmu
If a user joins or parts a channel, we record their full hostmask (rather
066
2021-12-17
jrmu
than just the nickname) using $arguments->{raw_nick}:
067
2021-12-17
jrmu
068
2021-12-17
jrmu
sub chanjoin {
069
2021-12-17
jrmu
my $self = shift;
070
2021-12-17
jrmu
my $arguments = shift;
071
2021-12-17
jrmu
print $fh date()." -!- $arguments->{raw_nick} has joined $arguments->{channel}\n";
072
2021-12-17
jrmu
return;
073
2021-12-17
jrmu
}
074
2021-12-17
jrmu
075
2021-12-17
jrmu
sub chanpart {
076
2021-12-17
jrmu
my $self = shift;
077
2021-12-17
jrmu
my $arguments = shift;
078
2021-12-17
jrmu
print $fh date()." -!- $arguments->{raw_nick} has left $arguments->{channel} $arguments->{body}\n";
079
2021-12-17
jrmu
return;
080
2021-12-17
jrmu
}
081
2021-12-17
jrmu
082
2021-12-17
jrmu
If the topic is changed, we first check if the sender's nickname is defined.
083
2021-12-17
jrmu
If so, we log the nickname, channel, and topic:
084
2021-12-17
jrmu
085
2021-12-17
jrmu
sub topic {
086
2021-12-17
jrmu
my $self = shift;
087
2021-12-17
jrmu
my $arguments = shift;
088
2021-12-17
jrmu
my $who = $arguments->{who};
089
2021-12-17
jrmu
if (defined($who)) {
090
2021-12-17
jrmu
print $fh date()." -!- $who changed the topic of $arguments->{channel} to: $arguments->{topic}\n";
091
2021-12-17
jrmu
}
092
2021-12-17
jrmu
return;
093
2021-12-17
jrmu
}
094
2021-12-17
jrmu
095
2021-12-17
jrmu
If the user changes nicks, we log both the old and new nick:
096
2021-12-17
jrmu
097
2021-12-17
jrmu
sub nickchange {
098
2021-12-17
jrmu
my $self = shift;
099
2021-12-17
jrmu
my $oldnick = shift;
100
2021-12-17
jrmu
my $newnick = shift;
101
2021-12-17
jrmu
print $fh "$oldnick is now known as $newnick\n";
102
2021-12-17
jrmu
return;
103
2021-12-17
jrmu
}
104
2021-12-17
jrmu
105
2021-12-17
jrmu
Mode changes are a bit more complex to log because each mode change can
106
2021-12-17
jrmu
have multiple operands. For example, a channel op can op two users with one
107
2021-12-17
jrmu
command.
108
2021-12-17
jrmu
109
2021-12-17
jrmu
First, we check if the mode change came from a channel ($chan ne "msg"). Then,
110
2021-12-17
jrmu
we check to make sure there is at least one operand. If so, we append the date,
111
2021-12-17
jrmu
the changer's nick, the changes, and the operands. We use join(", ", @$operands)
112
2021-12-17
jrmu
to join all the operands together.
113
2021-12-17
jrmu
114
2021-12-17
jrmu
sub mode_change {
115
2021-12-17
jrmu
my $self = shift;
116
2021-12-17
jrmu
my $arguments = shift;
117
2021-12-17
jrmu
my $chan = $arguments->{channel};
118
2021-12-17
jrmu
my $operands = $arguments->{mode_operands};
119
2021-12-17
jrmu
if (defined($chan) && $chan ne "msg" && scalar(@$operands)) {
120
2021-12-17
jrmu
print $fh date()." -!- mode/$chan $arguments->{who} [$arguments->{mode_changes}] ".join(", ", @$operands)."\n";
121
2021-12-17
jrmu
}
122
2021-12-17
jrmu
return;
123
2021-12-17
jrmu
}
124
2021-12-17
jrmu
125
2021-12-17
jrmu
Finally, we log when a user is kicked or quits:
126
2021-12-17
jrmu
127
2021-12-17
jrmu
sub kicked {
128
2021-12-17
jrmu
my $self = shift;
129
2021-12-17
jrmu
my $arguments = shift;
130
2021-12-17
jrmu
print $fh date()." -!- $arguments->{who} kicks $arguments->{kicked} [$arguments->{reason}]\n";
131
2021-12-17
jrmu
}
132
2021-12-17
jrmu
133
2021-12-17
jrmu
sub userquit {
134
2021-12-17
jrmu
my $self = shift;
135
2021-12-17
jrmu
my $arguments = shift;
136
2021-12-17
jrmu
print $fh " -!- $arguments->{raw_nick} quits [$arguments->{body}]\n";
137
2021-12-17
jrmu
}
138
2021-12-17
jrmu
139
2021-12-17
jrmu
package main;
140
2021-12-17
jrmu
141
2021-12-17
jrmu
my $bot = LogBot->new(
142
2021-12-17
jrmu
server => 'irc.example.com',
143
2021-12-17
jrmu
port => '6667',
144
2021-12-17
jrmu
channels => ['#perl104'],
145
2021-12-17
jrmu
nick => 'nickname',
146
2021-12-17
jrmu
name => 'username',
147
2021-12-17
jrmu
);
148
2021-12-17
jrmu
149
2021-12-17
jrmu
Because we opened a file descriptor, we also need to close it once we're
150
2021-12-17
jrmu
done with the program. To do this, we assign a subroutine to $SIG{INT}.
151
2021-12-17
jrmu
This subroutine will get called whenever the bot receives an INTerrupt
152
2021-12-17
jrmu
signal (ctrl+c). Inside the subroutine, we close the filehandle $fh
153
2021-12-17
jrmu
and then shut down the bot.
154
2021-12-17
jrmu
155
2021-12-17
jrmu
local $SIG{INT} = sub {
156
2021-12-17
jrmu
close($fh);
157
2021-12-17
jrmu
print "Quitting program...\n";
158
2021-12-17
jrmu
$bot->shutdown("Quitting...");
159
2021-12-17
jrmu
};
160
2021-12-17
jrmu
161
2021-12-17
jrmu
$bot->run();
162
2021-12-17
jrmu
163
2021-12-17
jrmu
================================================================================
164
2021-12-17
jrmu
165
2021-12-17
jrmu
Further Reading
166
2021-12-17
jrmu
167
2021-12-17
jrmu
XML::RSS::Parser module: https://metacpan.org/pod/XML::RSS::Parser
168
2021-12-17
jrmu
169
2021-12-17
jrmu
================================================================================
170
2021-12-17
jrmu
171
2021-12-17
jrmu
Learn about Loops
172
2021-12-17
jrmu
173
2021-12-17
jrmu
View the file ~/control to learn about control structures for perl.
174
2021-12-17
jrmu
175
2021-12-17
jrmu
================================================================================
IRCNow