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
AutoGreet Explained
004
2021-12-17
jrmu
005
2021-12-17
jrmu
The first 6 lines of autogreet.pl are similar to dicebot.pl from the
006
2021-12-17
jrmu
previous lesson:
007
2021-12-17
jrmu
008
2021-12-17
jrmu
#!/usr/bin/perl
009
2021-12-17
jrmu
use strict;
010
2021-12-17
jrmu
use warnings;
011
2021-12-17
jrmu
012
2021-12-17
jrmu
package GreetBot;
013
2021-12-17
jrmu
use base qw(Bot::BasicBot);
014
2021-12-17
jrmu
015
2021-12-17
jrmu
The only difference is we changed the package to GreetBot instead of
016
2021-12-17
jrmu
DiceBot.
017
2021-12-17
jrmu
018
2021-12-17
jrmu
Next, we have our first subroutine chanjoin, which greets new users
019
2021-12-17
jrmu
whenever one joins a channel.
020
2021-12-17
jrmu
021
2021-12-17
jrmu
sub chanjoin {
022
2021-12-17
jrmu
my $self = shift;
023
2021-12-17
jrmu
my $arguments = shift;
024
2021-12-17
jrmu
my $nick = $arguments->{who};
025
2021-12-17
jrmu
if ($nick eq $self->pocoirc->nick_name()) {
026
2021-12-17
jrmu
return;
027
2021-12-17
jrmu
}
028
2021-12-17
jrmu
$self->say(
029
2021-12-17
jrmu
channel => $arguments->{channel},
030
2021-12-17
jrmu
body => "Welcome, $nick!",
031
2021-12-17
jrmu
);
032
2021-12-17
jrmu
}
033
2021-12-17
jrmu
034
2021-12-17
jrmu
We store the user's nick in $nick:
035
2021-12-17
jrmu
036
2021-12-17
jrmu
my $nick = $arguments->{who};
037
2021-12-17
jrmu
038
2021-12-17
jrmu
Afterwards, we check if the new user's nick, $nick, is the same as our
039
2021-12-17
jrmu
bot's nick, $self->pocoirc->nick_name(). When the bot itself first joins
040
2021-12-17
jrmu
a channel, chanjoin is called. We don't want the bot to greet itself, so
041
2021-12-17
jrmu
we skip it with return.
042
2021-12-17
jrmu
043
2021-12-17
jrmu
if ($nick eq $self->pocoirc->nick_name()) {
044
2021-12-17
jrmu
return;
045
2021-12-17
jrmu
}
046
2021-12-17
jrmu
047
2021-12-17
jrmu
The return statement exits a subroutine without executing any
048
2021-12-17
jrmu
of the code that comes after it:
049
2021-12-17
jrmu
050
2021-12-17
jrmu
Next, we tell the bot to send a message to the channel to greet the new
051
2021-12-17
jrmu
user:
052
2021-12-17
jrmu
053
2021-12-17
jrmu
$self->say(
054
2021-12-17
jrmu
channel => $arguments->{channel},
055
2021-12-17
jrmu
body => "Welcome, $nick!",
056
2021-12-17
jrmu
);
057
2021-12-17
jrmu
058
2021-12-17
jrmu
Up next is the subroutine chanpart. It is called whenever a user parts from
059
2021-12-17
jrmu
a channel. It tells the bot to send a message whenever a user leaves:
060
2021-12-17
jrmu
061
2021-12-17
jrmu
sub chanpart {
062
2021-12-17
jrmu
my $self = shift;
063
2021-12-17
jrmu
my $arguments = shift;
064
2021-12-17
jrmu
$self->say(
065
2021-12-17
jrmu
channel => $arguments->{channel},
066
2021-12-17
jrmu
body => "I'm sad to see $arguments->{who} go.",
067
2021-12-17
jrmu
);
068
2021-12-17
jrmu
}
069
2021-12-17
jrmu
070
2021-12-17
jrmu
Take a closer look at the value of body:
071
2021-12-17
jrmu
072
2021-12-17
jrmu
body => "I'm sad to see $arguments->{who} go.",
073
2021-12-17
jrmu
074
2021-12-17
jrmu
Notice that $arguments->{who} is put right inside the quotation marks, but
075
2021-12-17
jrmu
the message does not literally have the string "$arguments->{who}". Instead,
076
2021-12-17
jrmu
perl evalutes $arguments->{who} to get the user's nick, then puts that value
077
2021-12-17
jrmu
into the string.
078
2021-12-17
jrmu
079
2021-12-17
jrmu
We do something different for the subroutine emoted. Instead of merely
080
2021-12-17
jrmu
sending a message, we will emote it (send an action message):
081
2021-12-17
jrmu
082
2021-12-17
jrmu
sub emoted {
083
2021-12-17
jrmu
my $self = shift;
084
2021-12-17
jrmu
my $arguments = shift;
085
2021-12-17
jrmu
086
2021-12-17
jrmu
$self->emote(
087
2021-12-17
jrmu
channel => $arguments->{channel},
088
2021-12-17
jrmu
body => "$arguments->{body} too",
089
2021-12-17
jrmu
);
090
2021-12-17
jrmu
}
091
2021-12-17
jrmu
092
2021-12-17
jrmu
On many irc clients, you can type /me <your-text-here> to emote.
093
2021-12-17
jrmu
Watch the bot emote back!
094
2021-12-17
jrmu
095
2021-12-17
jrmu
In the subroutine noticed, we use an array for @notices:
096
2021-12-17
jrmu
097
2021-12-17
jrmu
sub noticed {
098
2021-12-17
jrmu
my $self = shift;
099
2021-12-17
jrmu
my $arguments = shift;
100
2021-12-17
jrmu
101
2021-12-17
jrmu
my $nick = $arguments->{who};
102
2021-12-17
jrmu
103
2021-12-17
jrmu
my @notices = (
104
2021-12-17
jrmu
"$nick, please resend this in a normal message",
105
2021-12-17
jrmu
"I'm having a hard time reading your notice.",
106
2021-12-17
jrmu
"Good point, $nick.",
107
2021-12-17
jrmu
"Can you message on the public channel instead?",
108
2021-12-17
jrmu
);
109
2021-12-17
jrmu
110
2021-12-17
jrmu
$self->notice(
111
2021-12-17
jrmu
who => $nick,
112
2021-12-17
jrmu
channel => $arguments->{channel},
113
2021-12-17
jrmu
body => $notices[int(rand(4))],
114
2021-12-17
jrmu
);
115
2021-12-17
jrmu
}
116
2021-12-17
jrmu
117
2021-12-17
jrmu
When you send a notice to the bot or to a channel the bot is in, it will
118
2021-12-17
jrmu
reply with one of four different notices:
119
2021-12-17
jrmu
120
2021-12-17
jrmu
my @notices = (
121
2021-12-17
jrmu
"$nick, please resend this in a normal message",
122
2021-12-17
jrmu
"I'm having a hard time reading your notice.",
123
2021-12-17
jrmu
"Good point, $nick.",
124
2021-12-17
jrmu
"Can you message on the public channel instead?",
125
2021-12-17
jrmu
);
126
2021-12-17
jrmu
127
2021-12-17
jrmu
The sigil (the symbol before a variable) for an array is @. An array
128
2021-12-17
jrmu
can begin with an open and close parenthesis ( ) and the items inside are
129
2021-12-17
jrmu
separated with commas ,.
130
2021-12-17
jrmu
131
2021-12-17
jrmu
@notices has four strings. Those strings use double quotes so
132
2021-12-17
jrmu
that the variables inside will get interpolated.
133
2021-12-17
jrmu
134
2021-12-17
jrmu
An array stores many items, each one with a unique index. The first
135
2021-12-17
jrmu
element of the array @notices is $notices[0]. The second element is
136
2021-12-17
jrmu
$notices[1], and the third is $notices[2].
137
2021-12-17
jrmu
138
2021-12-17
jrmu
Arrays in Perl (like in most programming languages) begin with 0 as
139
2021-12-17
jrmu
the first index.
140
2021-12-17
jrmu
141
2021-12-17
jrmu
body => $notices[int(rand(4))],
142
2021-12-17
jrmu
143
2021-12-17
jrmu
rand(n) will return a random float between 0 and n. int() *truncates*
144
2021-12-17
jrmu
the float, meaning it drops everything after the decimal point. For
145
2021-12-17
jrmu
example, int(3.1415) gets *truncated* to 3: everything after the
146
2021-12-17
jrmu
decimal point gets ignored.
147
2021-12-17
jrmu
148
2021-12-17
jrmu
int(rand(4)) gives a random integer from 0 to 3, which we use as the
149
2021-12-17
jrmu
index for $notices. In other words, the body is a random notice chosen
150
2021-12-17
jrmu
from an array of four notices.
151
2021-12-17
jrmu
152
2021-12-17
jrmu
In the subroutine topic, anytime the topic is changed, the bot will
153
2021-12-17
jrmu
add a short warning to the end of it:
154
2021-12-17
jrmu
155
2021-12-17
jrmu
sub topic {
156
2021-12-17
jrmu
my $self = shift;
157
2021-12-17
jrmu
my $arguments = shift;
158
2021-12-17
jrmu
159
2021-12-17
jrmu
if ($arguments->{who} eq $self->pocoirc->nick_name()) {
160
2021-12-17
jrmu
return;
161
2021-12-17
jrmu
}
162
2021-12-17
jrmu
$self->pocoirc->yield('topic' => $arguments->{channel} => "$arguments->{topic} || Don't change the topic!");
163
2021-12-17
jrmu
}
164
2021-12-17
jrmu
165
2021-12-17
jrmu
If the new nick $arguments->{who} is the same as the bot's current nick
166
2021-12-17
jrmu
$self->pocoirc->nick_name(), then we return and do nothing. This line
167
2021-12-17
jrmu
is necessary to prevent an infinite loop. Without this line, if the bot
168
2021-12-17
jrmu
changes the topic, the subroutine topic will get called again, causing
169
2021-12-17
jrmu
the bot to again change the topic.
170
2021-12-17
jrmu
171
2021-12-17
jrmu
if ($arguments->{who} eq $self->pocoirc->nick_name()) {
172
2021-12-17
jrmu
return;
173
2021-12-17
jrmu
}
174
2021-12-17
jrmu
175
2021-12-17
jrmu
The bot will change the topic in the current channel to a new topic.
176
2021-12-17
jrmu
This topic contains the original topic plus "|| Don't change the topic!":
177
2021-12-17
jrmu
178
2021-12-17
jrmu
$self->pocoirc->yield('topic' => $arguments->{channel} => "$arguments->{topic} || Don't change the topic!");
179
2021-12-17
jrmu
180
2021-12-17
jrmu
The last subroutine is nick_change:
181
2021-12-17
jrmu
182
2021-12-17
jrmu
sub nick_change {
183
2021-12-17
jrmu
my $self = shift;
184
2021-12-17
jrmu
my $oldnick = shift;
185
2021-12-17
jrmu
my $newnick = shift;
186
2021-12-17
jrmu
187
2021-12-17
jrmu
if ($newnick eq $self->pocoirc->nick_name()) {
188
2021-12-17
jrmu
return;
189
2021-12-17
jrmu
}
190
2021-12-17
jrmu
191
2021-12-17
jrmu
$self->pocoirc->yield('nick' => "$oldnick");
192
2021-12-17
jrmu
$self->say(
193
2021-12-17
jrmu
who => "$newnick",
194
2021-12-17
jrmu
body => "If you don't mind, I'd like to use your old nick.",
195
2021-12-17
jrmu
);
196
2021-12-17
jrmu
}
197
2021-12-17
jrmu
198
2021-12-17
jrmu
Again, if the new nick is the same as the bot's current nick, we return
199
2021-12-17
jrmu
to prevent an infinite loop:
200
2021-12-17
jrmu
201
2021-12-17
jrmu
if ($newnick eq $self->pocoirc->nick_name()) {
202
2021-12-17
jrmu
return;
203
2021-12-17
jrmu
}
204
2021-12-17
jrmu
205
2021-12-17
jrmu
We change the bot's nick to $oldnick:
206
2021-12-17
jrmu
207
2021-12-17
jrmu
$self->pocoirc->yield('nick' => "$oldnick");
208
2021-12-17
jrmu
209
2021-12-17
jrmu
Then have the bot send a message to the user who changed his nick:
210
2021-12-17
jrmu
211
2021-12-17
jrmu
$self->say(
212
2021-12-17
jrmu
who => "$newnick",
213
2021-12-17
jrmu
body => "If you don't mind, I'd like to use your old nick.",
214
2021-12-17
jrmu
);
215
2021-12-17
jrmu
216
2021-12-17
jrmu
The last bit of code is similar to DiceBot. We create a GreetBot then run it:
217
2021-12-17
jrmu
218
2021-12-17
jrmu
package main;
219
2021-12-17
jrmu
220
2021-12-17
jrmu
my $bot = GreetBot->new(
221
2021-12-17
jrmu
server => 'irc.example.com',
222
2021-12-17
jrmu
port => '6667',
223
2021-12-17
jrmu
channels => ['#perl102'],
224
2021-12-17
jrmu
nick => 'nickname',
225
2021-12-17
jrmu
name => 'username',
226
2021-12-17
jrmu
);
227
2021-12-17
jrmu
$bot->run();
228
2021-12-17
jrmu
229
2021-12-17
jrmu
================================================================================
230
2021-12-17
jrmu
231
2021-12-17
jrmu
To learn more about the Bot::BasicBot framework, visit:
232
2021-12-17
jrmu
233
2021-12-17
jrmu
https://metacpan.org/pod/Bot::BasicBot
234
2021-12-17
jrmu
235
2021-12-17
jrmu
View the file ~/challenge to finish the lesson.
236
2021-12-17
jrmu
237
2021-12-17
jrmu
================================================================================
IRCNow