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