1 8f7f2f4a 2021-12-17 jrmu ================================================================================
5 8f7f2f4a 2021-12-17 jrmu Let's take our original Auto Greet bot and turn it into a simple Chat bot.
6 8f7f2f4a 2021-12-17 jrmu The goal is to make the chat seem realistic in order to trick a user into
7 8f7f2f4a 2021-12-17 jrmu thinking that a real human is talking with him.
9 8f7f2f4a 2021-12-17 jrmu As part of this task, we will add new replies for when a user joins a
10 8f7f2f4a 2021-12-17 jrmu channel, parts a channel, changes the topic, and says something. Just like
11 8f7f2f4a 2021-12-17 jrmu the way we handled notices, we should use one reply at random.
13 8f7f2f4a 2021-12-17 jrmu We will remove the nick_change subroutine because stealing someone's old
14 8f7f2f4a 2021-12-17 jrmu nick is annoying.
16 8f7f2f4a 2021-12-17 jrmu When a user says something, we will search for the keywords in the chat
17 8f7f2f4a 2021-12-17 jrmu and repeat it back to the user, to pretend like the bot is listening.
19 8f7f2f4a 2021-12-17 jrmu ================================================================================
21 8f7f2f4a 2021-12-17 jrmu Modifying greetbot.pl
23 8f7f2f4a 2021-12-17 jrmu Once again, we're going to change the name of GreetBot to ChatBot. Here
24 8f7f2f4a 2021-12-17 jrmu is the diff:
26 8f7f2f4a 2021-12-17 jrmu --- /home/perl102/autogreet.pl Sun Aug 29 06:53:39 2021
27 8f7f2f4a 2021-12-17 jrmu +++ /home/perl103/chatbot.pl Sun Aug 29 07:11:13 2021
28 8f7f2f4a 2021-12-17 jrmu @@ -2,9 +2,12 @@
30 8f7f2f4a 2021-12-17 jrmu use warnings;
32 8f7f2f4a 2021-12-17 jrmu -package GreetBot;
33 8f7f2f4a 2021-12-17 jrmu +package ChatBot;
34 8f7f2f4a 2021-12-17 jrmu use base qw(Bot::BasicBot);
35 8f7f2f4a 2021-12-17 jrmu +use Lingua::EN::Tagger;
39 8f7f2f4a 2021-12-17 jrmu A diff is a short way of showing what changed in a file. The + plus
40 8f7f2f4a 2021-12-17 jrmu symbol at the left of the screen means a line was added, and
41 8f7f2f4a 2021-12-17 jrmu the - minus symbol at the left of the screen means that a line was deleted.
43 8f7f2f4a 2021-12-17 jrmu First, we delete the line with GreetBot and replace it with ChatBot.
45 8f7f2f4a 2021-12-17 jrmu Next, we add a new line: use Lingua::EN::Tagger. This loads a new module,
46 8f7f2f4a 2021-12-17 jrmu Lingua::EN::Tagger, to help us recognize the parts of speech in a sentence.
47 8f7f2f4a 2021-12-17 jrmu See: https://metacpan.org/pod/Lingua::EN::Tagger
49 8f7f2f4a 2021-12-17 jrmu This module comes from CPAN, the Comprehensive Perl Archive Network.
50 8f7f2f4a 2021-12-17 jrmu CPAN is similar to other package managers like npm from Node.js or
51 8f7f2f4a 2021-12-17 jrmu pip from python. It contains an enormous collection of perl modules
52 8f7f2f4a 2021-12-17 jrmu that you can use. See: http://www.cpan.org
54 8f7f2f4a 2021-12-17 jrmu Lingua::EN::Tagger helps us easily find the noun phrases of a sentence.
55 8f7f2f4a 2021-12-17 jrmu These noun phrases are the keywords that our bot will repeat back to
56 8f7f2f4a 2021-12-17 jrmu pretend like it is listening. For example, in the sentence:
58 8f7f2f4a 2021-12-17 jrmu Some of the monks at the Perl monastery observe a vow of silence.
60 8f7f2f4a 2021-12-17 jrmu 'Some of the monks', 'the Perl monastery', and 'a vow of silence' are noun
63 8f7f2f4a 2021-12-17 jrmu Next, we declare the variable $logs. Notice that we declare $logs outside
64 8f7f2f4a 2021-12-17 jrmu of any subroutine. This is necessary because we want $logs to accumulate
65 8f7f2f4a 2021-12-17 jrmu all user chat from the moment the bot connects.
67 8f7f2f4a 2021-12-17 jrmu In perl, a variable declared with my is a *lexical* variable. If a variable
68 8f7f2f4a 2021-12-17 jrmu is declared inside a subroutine, it exists only from the opening brace {
69 8f7f2f4a 2021-12-17 jrmu to the closing brace }. Once the subroutine ends, lexical variables are
70 8f7f2f4a 2021-12-17 jrmu recycled and their data is lost forever. For example, suppose we have:
73 8f7f2f4a 2021-12-17 jrmu my $logs = "12:00 < nickname> Welcome, user!\n"
76 8f7f2f4a 2021-12-17 jrmu print $logs;
78 8f7f2f4a 2021-12-17 jrmu Nothing will get printed, because $logs would cease to exist by the time
79 8f7f2f4a 2021-12-17 jrmu the program leaves the end brace }.
81 8f7f2f4a 2021-12-17 jrmu We need $logs to survive after leaving a subroutine, so we define it
82 8f7f2f4a 2021-12-17 jrmu outside of the subroutine.
84 8f7f2f4a 2021-12-17 jrmu We're going to modify our chanjoin subroutine to add some new greetings:
86 8f7f2f4a 2021-12-17 jrmu sub chanjoin {
87 8f7f2f4a 2021-12-17 jrmu my $self = shift;
88 8f7f2f4a 2021-12-17 jrmu my $arguments = shift;
89 8f7f2f4a 2021-12-17 jrmu @@ -12,18 +15,34 @@
90 8f7f2f4a 2021-12-17 jrmu if ($nick eq $self->pocoirc->nick_name()) {
93 8f7f2f4a 2021-12-17 jrmu + my @greetings = ("Hey there, $nick!",
94 8f7f2f4a 2021-12-17 jrmu + "$nick, welcome!",
95 8f7f2f4a 2021-12-17 jrmu + "sup $nick!",
96 8f7f2f4a 2021-12-17 jrmu + "$nick, it's good to see you.",
97 8f7f2f4a 2021-12-17 jrmu + "How can I help you, $nick?",
98 8f7f2f4a 2021-12-17 jrmu + "Hey $nick, do you hang out here too?",
99 8f7f2f4a 2021-12-17 jrmu + "Hiya $nick.");
101 8f7f2f4a 2021-12-17 jrmu $self->say(
102 8f7f2f4a 2021-12-17 jrmu channel => $arguments->{channel},
103 8f7f2f4a 2021-12-17 jrmu - body => "Welcome, $nick!",
104 8f7f2f4a 2021-12-17 jrmu + body => $greetings[int(rand(scalar(@greetings)))],
108 8f7f2f4a 2021-12-17 jrmu We again create an array of greetings. In $self->say(), we pick a
109 8f7f2f4a 2021-12-17 jrmu random greeting:
111 8f7f2f4a 2021-12-17 jrmu body => $greetings[int(rand(scalar(@greetings)))],
113 8f7f2f4a 2021-12-17 jrmu First, we find the length of the array @greetings using scalar(@greetings).
114 8f7f2f4a 2021-12-17 jrmu Then, we select a random number between 0 and the length of the array
115 8f7f2f4a 2021-12-17 jrmu with rand(scalar(@greetings)).
117 8f7f2f4a 2021-12-17 jrmu In this case, the array has a length of 7, but we don't want to write
118 8f7f2f4a 2021-12-17 jrmu rand(7). This is because we might later want to add or remove greetings,
119 8f7f2f4a 2021-12-17 jrmu so the length of the array may change. Besides, we might forget to update
120 8f7f2f4a 2021-12-17 jrmu the number 7.
122 8f7f2f4a 2021-12-17 jrmu We then *truncate* the number (drop the decimal part) with int(). We now
123 8f7f2f4a 2021-12-17 jrmu have a random number between zero to less than the length of the array.
125 8f7f2f4a 2021-12-17 jrmu We use this number as an index into the array @greetings.
126 8f7f2f4a 2021-12-17 jrmu This gives us $greetings[int(rand(scalar(@greetings)))].
127 8f7f2f4a 2021-12-17 jrmu Notice that we change from an array sigil @ to a scalar sigil $ because we
128 8f7f2f4a 2021-12-17 jrmu want one greeting, a string, instead of an array of strings.
130 8f7f2f4a 2021-12-17 jrmu We do the same with chanpart:
132 8f7f2f4a 2021-12-17 jrmu sub chanpart {
133 8f7f2f4a 2021-12-17 jrmu my $self = shift;
134 8f7f2f4a 2021-12-17 jrmu my $arguments = shift;
135 8f7f2f4a 2021-12-17 jrmu + my $nick = $arguments->{who};
136 8f7f2f4a 2021-12-17 jrmu + my @farewells = ("I'm sad to see $nick go",
137 8f7f2f4a 2021-12-17 jrmu + "Oh, $nick left, I was just about to send a message.",
138 8f7f2f4a 2021-12-17 jrmu + "I always seem to return just as $nick leaves.",
139 8f7f2f4a 2021-12-17 jrmu + "I hope $nick will rejoin later.",
140 8f7f2f4a 2021-12-17 jrmu + "I'm going to take a break too, brb.",
141 8f7f2f4a 2021-12-17 jrmu + "See you later $nick. Oops, I was too late.");
143 8f7f2f4a 2021-12-17 jrmu $self->say(
144 8f7f2f4a 2021-12-17 jrmu channel => $arguments->{channel},
145 8f7f2f4a 2021-12-17 jrmu - body => "I'm sad to see $arguments->{who} go.",
146 8f7f2f4a 2021-12-17 jrmu + body => $farewells[int(rand(scalar(@farewells)))],
150 8f7f2f4a 2021-12-17 jrmu In our old noticed subroutine, we hard-coded the number 4 to represent
151 8f7f2f4a 2021-12-17 jrmu the length of the array. As mentioned above, this is not ideal. So
152 8f7f2f4a 2021-12-17 jrmu we use scalar(@notices) to determine the length of the array:
154 8f7f2f4a 2021-12-17 jrmu @@ -53,39 +72,50 @@
155 8f7f2f4a 2021-12-17 jrmu $self->notice(
156 8f7f2f4a 2021-12-17 jrmu who => $nick,
157 8f7f2f4a 2021-12-17 jrmu channel => $arguments->{channel},
158 8f7f2f4a 2021-12-17 jrmu - body => $notices[int(rand(4))],
159 8f7f2f4a 2021-12-17 jrmu + body => $notices[int(rand(scalar(@notices)))],
163 8f7f2f4a 2021-12-17 jrmu We modify the topic subroutine to send different replies:
165 8f7f2f4a 2021-12-17 jrmu sub topic {
166 8f7f2f4a 2021-12-17 jrmu my $self = shift;
167 8f7f2f4a 2021-12-17 jrmu my $arguments = shift;
168 8f7f2f4a 2021-12-17 jrmu + my @replies = ("Nice",
169 8f7f2f4a 2021-12-17 jrmu + "Hm, I liked the old topic better.",
170 8f7f2f4a 2021-12-17 jrmu + "Please don't change the topic.",
171 8f7f2f4a 2021-12-17 jrmu + "Good thinking.",
172 8f7f2f4a 2021-12-17 jrmu + "That makes more sense.");
174 8f7f2f4a 2021-12-17 jrmu - if ($arguments->{who} eq $self->pocoirc->nick_name()) {
177 8f7f2f4a 2021-12-17 jrmu - $self->pocoirc->yield('topic' => $arguments->{channel} => "$arguments->{topic} || Don't change the topic!");
178 8f7f2f4a 2021-12-17 jrmu + $self->say(
179 8f7f2f4a 2021-12-17 jrmu + channel => $arguments->{channel},
180 8f7f2f4a 2021-12-17 jrmu + body => $replies[int(rand(scalar(@replies)))],
184 8f7f2f4a 2021-12-17 jrmu We'll delete the nick_change subroutine and add a said subroutine:
186 8f7f2f4a 2021-12-17 jrmu -sub nick_change {
187 8f7f2f4a 2021-12-17 jrmu - my $self = shift;
188 8f7f2f4a 2021-12-17 jrmu - my $oldnick = shift;
189 8f7f2f4a 2021-12-17 jrmu - my $newnick = shift;
191 8f7f2f4a 2021-12-17 jrmu - if ($newnick eq $self->pocoirc->nick_name()) {
195 8f7f2f4a 2021-12-17 jrmu - $self->pocoirc->yield('nick' => "$oldnick");
196 8f7f2f4a 2021-12-17 jrmu - $self->say(
197 8f7f2f4a 2021-12-17 jrmu - who => "$newnick",
198 8f7f2f4a 2021-12-17 jrmu - body => "If you don't mind, I'd like to use your old nick.",
202 8f7f2f4a 2021-12-17 jrmu +sub said {
203 8f7f2f4a 2021-12-17 jrmu + my $self = shift;
204 8f7f2f4a 2021-12-17 jrmu + my $arguments = shift;
206 8f7f2f4a 2021-12-17 jrmu + $logs .= "$arguments->{body}\n";
207 8f7f2f4a 2021-12-17 jrmu + my $p = new Lingua::EN::Tagger;
208 8f7f2f4a 2021-12-17 jrmu + my %word_freqs = $p->get_words($logs);
209 8f7f2f4a 2021-12-17 jrmu + my $keyword;
210 8f7f2f4a 2021-12-17 jrmu + my $total = 0;
211 8f7f2f4a 2021-12-17 jrmu + foreach my $freq (keys %word_freqs) {
212 8f7f2f4a 2021-12-17 jrmu + $total += $word_freqs{$freq};
213 8f7f2f4a 2021-12-17 jrmu + $keyword = $freq if rand($total) < $word_freqs{$freq};
215 8f7f2f4a 2021-12-17 jrmu + my @replies = ("I think you have a valid point about $keyword.",
216 8f7f2f4a 2021-12-17 jrmu + "Hm, what do others think about $keyword?",
217 8f7f2f4a 2021-12-17 jrmu + ucfirst $keyword." is not something I'm familiar with",
218 8f7f2f4a 2021-12-17 jrmu + "Are you sure about $keyword?",
219 8f7f2f4a 2021-12-17 jrmu + "Tell me more about $keyword.",
220 8f7f2f4a 2021-12-17 jrmu + "What about $keyword?",
221 8f7f2f4a 2021-12-17 jrmu + "Let's talk about something else besides $keyword.");
222 8f7f2f4a 2021-12-17 jrmu + return $replies[int(rand(scalar(@replies)))];
225 8f7f2f4a 2021-12-17 jrmu At the bottom of the file, we replace GreetBot->new( with ChatBot->new(:
227 8f7f2f4a 2021-12-17 jrmu package main;
229 8f7f2f4a 2021-12-17 jrmu -my $bot = GreetBot->new(
230 8f7f2f4a 2021-12-17 jrmu +my $bot = ChatBot->new(
231 8f7f2f4a 2021-12-17 jrmu server => 'irc.example.com',
232 8f7f2f4a 2021-12-17 jrmu port => '6667',
233 8f7f2f4a 2021-12-17 jrmu channels => ['#perl102'],
235 8f7f2f4a 2021-12-17 jrmu (Hint: the answer is in /home/perl103/chatbot.pl)
237 8f7f2f4a 2021-12-17 jrmu This is a very simple bot, but perhaps in the future, you could use more
238 8f7f2f4a 2021-12-17 jrmu advanced techniques to write a more realistic chat bot.
240 8f7f2f4a 2021-12-17 jrmu ================================================================================
242 8f7f2f4a 2021-12-17 jrmu Username: perl103
243 8f7f2f4a 2021-12-17 jrmu Password: t3Qa8CRfArL
244 8f7f2f4a 2021-12-17 jrmu Server: freeirc.org
247 8f7f2f4a 2021-12-17 jrmu ================================================================================
