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
Challenge
004
2021-12-17
jrmu
005
2021-12-17
jrmu
Let's take our original Auto Greet bot and turn it into a simple Chat bot.
006
2021-12-17
jrmu
The goal is to make the chat seem realistic in order to trick a user into
007
2021-12-17
jrmu
thinking that a real human is talking with him.
008
2021-12-17
jrmu
009
2021-12-17
jrmu
As part of this task, we will add new replies for when a user joins a
010
2021-12-17
jrmu
channel, parts a channel, changes the topic, and says something. Just like
011
2021-12-17
jrmu
the way we handled notices, we should use one reply at random.
012
2021-12-17
jrmu
013
2021-12-17
jrmu
We will remove the nick_change subroutine because stealing someone's old
014
2021-12-17
jrmu
nick is annoying.
015
2021-12-17
jrmu
016
2021-12-17
jrmu
When a user says something, we will search for the keywords in the chat
017
2021-12-17
jrmu
and repeat it back to the user, to pretend like the bot is listening.
018
2021-12-17
jrmu
019
2021-12-17
jrmu
================================================================================
020
2021-12-17
jrmu
021
2021-12-17
jrmu
Modifying greetbot.pl
022
2021-12-17
jrmu
023
2021-12-17
jrmu
Once again, we're going to change the name of GreetBot to ChatBot. Here
024
2021-12-17
jrmu
is the diff:
025
2021-12-17
jrmu
026
2021-12-17
jrmu
--- /home/perl102/autogreet.pl Sun Aug 29 06:53:39 2021
027
2021-12-17
jrmu
+++ /home/perl103/chatbot.pl Sun Aug 29 07:11:13 2021
028
2021-12-17
jrmu
@@ -2,9 +2,12 @@
029
2021-12-17
jrmu
use strict;
030
2021-12-17
jrmu
use warnings;
031
2021-12-17
jrmu
032
2021-12-17
jrmu
-package GreetBot;
033
2021-12-17
jrmu
+package ChatBot;
034
2021-12-17
jrmu
use base qw(Bot::BasicBot);
035
2021-12-17
jrmu
+use Lingua::EN::Tagger;
036
2021-12-17
jrmu
037
2021-12-17
jrmu
+my $logs;
038
2021-12-17
jrmu
039
2021-12-17
jrmu
A diff is a short way of showing what changed in a file. The + plus
040
2021-12-17
jrmu
symbol at the left of the screen means a line was added, and
041
2021-12-17
jrmu
the - minus symbol at the left of the screen means that a line was deleted.
042
2021-12-17
jrmu
043
2021-12-17
jrmu
First, we delete the line with GreetBot and replace it with ChatBot.
044
2021-12-17
jrmu
045
2021-12-17
jrmu
Next, we add a new line: use Lingua::EN::Tagger. This loads a new module,
046
2021-12-17
jrmu
Lingua::EN::Tagger, to help us recognize the parts of speech in a sentence.
047
2021-12-17
jrmu
See: https://metacpan.org/pod/Lingua::EN::Tagger
048
2021-12-17
jrmu
049
2021-12-17
jrmu
This module comes from CPAN, the Comprehensive Perl Archive Network.
050
2021-12-17
jrmu
CPAN is similar to other package managers like npm from Node.js or
051
2021-12-17
jrmu
pip from python. It contains an enormous collection of perl modules
052
2021-12-17
jrmu
that you can use. See: http://www.cpan.org
053
2021-12-17
jrmu
054
2021-12-17
jrmu
Lingua::EN::Tagger helps us easily find the noun phrases of a sentence.
055
2021-12-17
jrmu
These noun phrases are the keywords that our bot will repeat back to
056
2021-12-17
jrmu
pretend like it is listening. For example, in the sentence:
057
2021-12-17
jrmu
058
2021-12-17
jrmu
Some of the monks at the Perl monastery observe a vow of silence.
059
2021-12-17
jrmu
060
2021-12-17
jrmu
'Some of the monks', 'the Perl monastery', and 'a vow of silence' are noun
061
2021-12-17
jrmu
phrases.
062
2021-12-17
jrmu
063
2021-12-17
jrmu
Next, we declare the variable $logs. Notice that we declare $logs outside
064
2021-12-17
jrmu
of any subroutine. This is necessary because we want $logs to accumulate
065
2021-12-17
jrmu
all user chat from the moment the bot connects.
066
2021-12-17
jrmu
067
2021-12-17
jrmu
In perl, a variable declared with my is a *lexical* variable. If a variable
068
2021-12-17
jrmu
is declared inside a subroutine, it exists only from the opening brace {
069
2021-12-17
jrmu
to the closing brace }. Once the subroutine ends, lexical variables are
070
2021-12-17
jrmu
recycled and their data is lost forever. For example, suppose we have:
071
2021-12-17
jrmu
072
2021-12-17
jrmu
sub said {
073
2021-12-17
jrmu
my $logs = "12:00 < nickname> Welcome, user!\n"
074
2021-12-17
jrmu
}
075
2021-12-17
jrmu
076
2021-12-17
jrmu
print $logs;
077
2021-12-17
jrmu
078
2021-12-17
jrmu
Nothing will get printed, because $logs would cease to exist by the time
079
2021-12-17
jrmu
the program leaves the end brace }.
080
2021-12-17
jrmu
081
2021-12-17
jrmu
We need $logs to survive after leaving a subroutine, so we define it
082
2021-12-17
jrmu
outside of the subroutine.
083
2021-12-17
jrmu
084
2021-12-17
jrmu
We're going to modify our chanjoin subroutine to add some new greetings:
085
2021-12-17
jrmu
086
2021-12-17
jrmu
sub chanjoin {
087
2021-12-17
jrmu
my $self = shift;
088
2021-12-17
jrmu
my $arguments = shift;
089
2021-12-17
jrmu
@@ -12,18 +15,34 @@
090
2021-12-17
jrmu
if ($nick eq $self->pocoirc->nick_name()) {
091
2021-12-17
jrmu
return;
092
2021-12-17
jrmu
}
093
2021-12-17
jrmu
+ my @greetings = ("Hey there, $nick!",
094
2021-12-17
jrmu
+ "$nick, welcome!",
095
2021-12-17
jrmu
+ "sup $nick!",
096
2021-12-17
jrmu
+ "$nick, it's good to see you.",
097
2021-12-17
jrmu
+ "How can I help you, $nick?",
098
2021-12-17
jrmu
+ "Hey $nick, do you hang out here too?",
099
2021-12-17
jrmu
+ "Hiya $nick.");
100
2021-12-17
jrmu
+
101
2021-12-17
jrmu
$self->say(
102
2021-12-17
jrmu
channel => $arguments->{channel},
103
2021-12-17
jrmu
- body => "Welcome, $nick!",
104
2021-12-17
jrmu
+ body => $greetings[int(rand(scalar(@greetings)))],
105
2021-12-17
jrmu
);
106
2021-12-17
jrmu
}
107
2021-12-17
jrmu
108
2021-12-17
jrmu
We again create an array of greetings. In $self->say(), we pick a
109
2021-12-17
jrmu
random greeting:
110
2021-12-17
jrmu
111
2021-12-17
jrmu
body => $greetings[int(rand(scalar(@greetings)))],
112
2021-12-17
jrmu
113
2021-12-17
jrmu
First, we find the length of the array @greetings using scalar(@greetings).
114
2021-12-17
jrmu
Then, we select a random number between 0 and the length of the array
115
2021-12-17
jrmu
with rand(scalar(@greetings)).
116
2021-12-17
jrmu
117
2021-12-17
jrmu
In this case, the array has a length of 7, but we don't want to write
118
2021-12-17
jrmu
rand(7). This is because we might later want to add or remove greetings,
119
2021-12-17
jrmu
so the length of the array may change. Besides, we might forget to update
120
2021-12-17
jrmu
the number 7.
121
2021-12-17
jrmu
122
2021-12-17
jrmu
We then *truncate* the number (drop the decimal part) with int(). We now
123
2021-12-17
jrmu
have a random number between zero to less than the length of the array.
124
2021-12-17
jrmu
125
2021-12-17
jrmu
We use this number as an index into the array @greetings.
126
2021-12-17
jrmu
This gives us $greetings[int(rand(scalar(@greetings)))].
127
2021-12-17
jrmu
Notice that we change from an array sigil @ to a scalar sigil $ because we
128
2021-12-17
jrmu
want one greeting, a string, instead of an array of strings.
129
2021-12-17
jrmu
130
2021-12-17
jrmu
We do the same with chanpart:
131
2021-12-17
jrmu
132
2021-12-17
jrmu
sub chanpart {
133
2021-12-17
jrmu
my $self = shift;
134
2021-12-17
jrmu
my $arguments = shift;
135
2021-12-17
jrmu
+ my $nick = $arguments->{who};
136
2021-12-17
jrmu
+ my @farewells = ("I'm sad to see $nick go",
137
2021-12-17
jrmu
+ "Oh, $nick left, I was just about to send a message.",
138
2021-12-17
jrmu
+ "I always seem to return just as $nick leaves.",
139
2021-12-17
jrmu
+ "I hope $nick will rejoin later.",
140
2021-12-17
jrmu
+ "I'm going to take a break too, brb.",
141
2021-12-17
jrmu
+ "See you later $nick. Oops, I was too late.");
142
2021-12-17
jrmu
+
143
2021-12-17
jrmu
$self->say(
144
2021-12-17
jrmu
channel => $arguments->{channel},
145
2021-12-17
jrmu
- body => "I'm sad to see $arguments->{who} go.",
146
2021-12-17
jrmu
+ body => $farewells[int(rand(scalar(@farewells)))],
147
2021-12-17
jrmu
);
148
2021-12-17
jrmu
}
149
2021-12-17
jrmu
150
2021-12-17
jrmu
In our old noticed subroutine, we hard-coded the number 4 to represent
151
2021-12-17
jrmu
the length of the array. As mentioned above, this is not ideal. So
152
2021-12-17
jrmu
we use scalar(@notices) to determine the length of the array:
153
2021-12-17
jrmu
154
2021-12-17
jrmu
@@ -53,39 +72,50 @@
155
2021-12-17
jrmu
$self->notice(
156
2021-12-17
jrmu
who => $nick,
157
2021-12-17
jrmu
channel => $arguments->{channel},
158
2021-12-17
jrmu
- body => $notices[int(rand(4))],
159
2021-12-17
jrmu
+ body => $notices[int(rand(scalar(@notices)))],
160
2021-12-17
jrmu
);
161
2021-12-17
jrmu
}
162
2021-12-17
jrmu
163
2021-12-17
jrmu
We modify the topic subroutine to send different replies:
164
2021-12-17
jrmu
165
2021-12-17
jrmu
sub topic {
166
2021-12-17
jrmu
my $self = shift;
167
2021-12-17
jrmu
my $arguments = shift;
168
2021-12-17
jrmu
+ my @replies = ("Nice",
169
2021-12-17
jrmu
+ "Hm, I liked the old topic better.",
170
2021-12-17
jrmu
+ "Please don't change the topic.",
171
2021-12-17
jrmu
+ "Good thinking.",
172
2021-12-17
jrmu
+ "That makes more sense.");
173
2021-12-17
jrmu
174
2021-12-17
jrmu
- if ($arguments->{who} eq $self->pocoirc->nick_name()) {
175
2021-12-17
jrmu
- return;
176
2021-12-17
jrmu
- }
177
2021-12-17
jrmu
- $self->pocoirc->yield('topic' => $arguments->{channel} => "$arguments->{topic} || Don't change the topic!");
178
2021-12-17
jrmu
+ $self->say(
179
2021-12-17
jrmu
+ channel => $arguments->{channel},
180
2021-12-17
jrmu
+ body => $replies[int(rand(scalar(@replies)))],
181
2021-12-17
jrmu
+ );
182
2021-12-17
jrmu
}
183
2021-12-17
jrmu
184
2021-12-17
jrmu
We'll delete the nick_change subroutine and add a said subroutine:
185
2021-12-17
jrmu
186
2021-12-17
jrmu
-sub nick_change {
187
2021-12-17
jrmu
- my $self = shift;
188
2021-12-17
jrmu
- my $oldnick = shift;
189
2021-12-17
jrmu
- my $newnick = shift;
190
2021-12-17
jrmu
-
191
2021-12-17
jrmu
- if ($newnick eq $self->pocoirc->nick_name()) {
192
2021-12-17
jrmu
- return;
193
2021-12-17
jrmu
- }
194
2021-12-17
jrmu
-
195
2021-12-17
jrmu
- $self->pocoirc->yield('nick' => "$oldnick");
196
2021-12-17
jrmu
- $self->say(
197
2021-12-17
jrmu
- who => "$newnick",
198
2021-12-17
jrmu
- body => "If you don't mind, I'd like to use your old nick.",
199
2021-12-17
jrmu
- );
200
2021-12-17
jrmu
-}
201
2021-12-17
jrmu
202
2021-12-17
jrmu
+sub said {
203
2021-12-17
jrmu
+ my $self = shift;
204
2021-12-17
jrmu
+ my $arguments = shift;
205
2021-12-17
jrmu
+
206
2021-12-17
jrmu
+ $logs .= "$arguments->{body}\n";
207
2021-12-17
jrmu
+ my $p = new Lingua::EN::Tagger;
208
2021-12-17
jrmu
+ my %word_freqs = $p->get_words($logs);
209
2021-12-17
jrmu
+ my $keyword;
210
2021-12-17
jrmu
+ my $total = 0;
211
2021-12-17
jrmu
+ foreach my $freq (keys %word_freqs) {
212
2021-12-17
jrmu
+ $total += $word_freqs{$freq};
213
2021-12-17
jrmu
+ $keyword = $freq if rand($total) < $word_freqs{$freq};
214
2021-12-17
jrmu
+ }
215
2021-12-17
jrmu
+ my @replies = ("I think you have a valid point about $keyword.",
216
2021-12-17
jrmu
+ "Hm, what do others think about $keyword?",
217
2021-12-17
jrmu
+ ucfirst $keyword." is not something I'm familiar with",
218
2021-12-17
jrmu
+ "Are you sure about $keyword?",
219
2021-12-17
jrmu
+ "Tell me more about $keyword.",
220
2021-12-17
jrmu
+ "What about $keyword?",
221
2021-12-17
jrmu
+ "Let's talk about something else besides $keyword.");
222
2021-12-17
jrmu
+ return $replies[int(rand(scalar(@replies)))];
223
2021-12-17
jrmu
+}
224
2021-12-17
jrmu
225
2021-12-17
jrmu
At the bottom of the file, we replace GreetBot->new( with ChatBot->new(:
226
2021-12-17
jrmu
227
2021-12-17
jrmu
package main;
228
2021-12-17
jrmu
229
2021-12-17
jrmu
-my $bot = GreetBot->new(
230
2021-12-17
jrmu
+my $bot = ChatBot->new(
231
2021-12-17
jrmu
server => 'irc.example.com',
232
2021-12-17
jrmu
port => '6667',
233
2021-12-17
jrmu
channels => ['#perl102'],
234
2021-12-17
jrmu
235
2021-12-17
jrmu
(Hint: the answer is in /home/perl103/chatbot.pl)
236
2021-12-17
jrmu
237
2021-12-17
jrmu
This is a very simple bot, but perhaps in the future, you could use more
238
2021-12-17
jrmu
advanced techniques to write a more realistic chat bot.
239
2021-12-17
jrmu
240
2021-12-17
jrmu
================================================================================
241
2021-12-17
jrmu
242
2021-12-17
jrmu
Username: perl103
243
2021-12-17
jrmu
Password: t3Qa8CRfArL
244
2021-12-17
jrmu
Server: freeirc.org
245
2021-12-17
jrmu
Port: 22
246
2021-12-17
jrmu
247
2021-12-17
jrmu
================================================================================
IRCNow