1 ================================================================================
2 
3                                AutoGreet Explained
4 
5   The first 6 lines of autogreet.pl are similar to dicebot.pl from the
6   previous lesson:
7 
8 #!/usr/bin/perl
9 use strict;
10 use warnings;
11 
12 package GreetBot;
13 use base qw(Bot::BasicBot);
14 
15   The only difference is we changed the package to GreetBot instead of
16   DiceBot.
17 
18   Next, we have our first subroutine chanjoin, which greets new users
19   whenever one joins a channel.
20 
21 sub chanjoin {
22 	my $self      = shift;
23 	my $arguments = shift;
24 	my $nick = $arguments->{who};
25 	if ($nick eq $self->pocoirc->nick_name()) { 
26 		return;
27 	}
28 	$self->say(
29 		channel => $arguments->{channel},
30 		body    => "Welcome, $nick!",
31 	);
32 }
33 
34   We store the user's nick in $nick:
35 
36 	my $nick = $arguments->{who};
37 
38   Afterwards, we check if the new user's nick, $nick, is the same as our
39   bot's nick, $self->pocoirc->nick_name(). When the bot itself first joins
40   a channel, chanjoin is called. We don't want the bot to greet itself, so
41   we skip it with return.
42 
43 	if ($nick eq $self->pocoirc->nick_name()) { 
44 		return;
45 	}
46 
47   The return statement exits a subroutine without executing any
48   of the code that comes after it:
49 
50   Next, we tell the bot to send a message to the channel to greet the new
51   user:
52 
53 	$self->say(
54 		channel => $arguments->{channel},
55 		body    => "Welcome, $nick!",
56 	);
57 
58   Up next is the subroutine chanpart. It is called whenever a user parts from
59   a channel. It tells the bot to send a message whenever a user leaves:
60 
61 sub chanpart {
62 	my $self      = shift;
63 	my $arguments = shift;
64 	$self->say(
65 		channel => $arguments->{channel},
66 		body    => "I'm sad to see $arguments->{who} go.",
67 	);
68 }
69 
70   Take a closer look at the value of body:
71 
72 		body    => "I'm sad to see $arguments->{who} go.",
73 
74   Notice that $arguments->{who} is put right inside the quotation marks, but
75   the message does not literally have the string "$arguments->{who}". Instead,
76   perl evalutes $arguments->{who} to get the user's nick, then puts that value
77   into the string.
78 
79   We do something different for the subroutine emoted. Instead of merely
80   sending a message, we will emote it (send an action message):
81 
82 sub emoted {
83 	my $self      = shift;
84 	my $arguments = shift;
85 
86 	$self->emote(
87 		channel => $arguments->{channel},
88 		body    => "$arguments->{body} too",
89 	);
90 }
91 
92   On many irc clients, you can type /me <your-text-here> to emote.
93   Watch the bot emote back!
94 
95   In the subroutine noticed, we use an array for @notices:
96 
97 sub noticed {
98 	my $self      = shift;
99 	my $arguments = shift;
100 
101 	my $nick = $arguments->{who};
102 
103 	my @notices = (
104 			 "$nick, please resend this in a normal message",
105 			 "I'm having a hard time reading your notice.",
106 			 "Good point, $nick.",
107 			 "Can you message on the public channel instead?",
108 			);
109 
110 	$self->notice(
111 		who => $nick,
112 		channel => $arguments->{channel},
113 		body    => $notices[int(rand(4))],
114 	);
115 }
116 
117   When you send a notice to the bot or to a channel the bot is in, it will
118   reply with one of four different notices:
119 
120 	my @notices = (
121 			 "$nick, please resend this in a normal message",
122 			 "I'm having a hard time reading your notice.",
123 			 "Good point, $nick.",
124 			 "Can you message on the public channel instead?",
125 			);
126 
127   The sigil (the symbol before a variable) for an array is @. An array
128   can begin with an open and close parenthesis ( ) and the items inside are
129   separated with commas ,.
130 
131   @notices has four strings. Those strings use double quotes so
132   that the variables inside will get interpolated.
133 
134   An array stores many items, each one with a unique index. The first
135   element of the array @notices is $notices[0]. The second element is
136   $notices[1], and the third is $notices[2].
137 
138   Arrays in Perl (like in most programming languages) begin with 0 as
139   the first index.
140 
141 		body    => $notices[int(rand(4))],
142 
143   rand(n) will return a random float between 0 and n. int() *truncates*
144   the float, meaning it drops everything after the decimal point. For
145   example, int(3.1415) gets *truncated* to 3: everything after the
146   decimal point gets ignored.
147 
148   int(rand(4)) gives a random integer from 0 to 3, which we use as the
149   index for $notices. In other words, the body is a random notice chosen
150   from an array of four notices.
151 
152   In the subroutine topic, anytime the topic is changed, the bot will
153   add a short warning to the end of it:
154 
155 sub topic {
156 	my $self      = shift;
157 	my $arguments = shift;
158 
159 	if ($arguments->{who} eq $self->pocoirc->nick_name()) { 
160 		return;
161 	}
162 	$self->pocoirc->yield('topic' => $arguments->{channel} => "$arguments->{topic} || Don't change the topic!");
163 }
164 
165   If the new nick $arguments->{who} is the same as the bot's current nick
166   $self->pocoirc->nick_name(), then we return and do nothing. This line
167   is necessary to prevent an infinite loop. Without this line, if the bot
168   changes the topic, the subroutine topic will get called again, causing
169   the bot to again change the topic.
170 
171 	if ($arguments->{who} eq $self->pocoirc->nick_name()) { 
172 		return;
173 	}
174 
175   The bot will change the topic in the current channel to a new topic.
176   This topic contains the original topic plus "|| Don't change the topic!":
177 
178 	$self->pocoirc->yield('topic' => $arguments->{channel} => "$arguments->{topic} || Don't change the topic!");
179 
180   The last subroutine is nick_change:
181 
182 sub nick_change {
183 	my $self      = shift;
184 	my $oldnick = shift;
185 	my $newnick = shift;
186 
187 	if ($newnick eq $self->pocoirc->nick_name()) { 
188 		return;
189 	}
190 
191 	$self->pocoirc->yield('nick' => "$oldnick");
192 	$self->say(
193 		who => "$newnick",
194 		body    => "If you don't mind, I'd like to use your old nick.",
195 	);
196 }
197 
198   Again, if the new nick is the same as the bot's current nick, we return
199   to prevent an infinite loop:
200 
201 	if ($newnick eq $self->pocoirc->nick_name()) { 
202 		return;
203 	}
204 
205   We change the bot's nick to $oldnick:
206 
207 	$self->pocoirc->yield('nick' => "$oldnick");
208 
209   Then have the bot send a message to the user who changed his nick:
210  
211 	$self->say(
212 		who => "$newnick",
213 		body    => "If you don't mind, I'd like to use your old nick.",
214 	);
215 
216   The last bit of code is similar to DiceBot. We create a GreetBot then run it:
217 
218 package main;
219 
220 my $bot = GreetBot->new(
221 	server      => 'irc.example.com',
222 	port        => '6667',
223 	channels    => ['#perl102'],
224 	nick        => 'nickname',
225 	name        => 'username',
226 );
227 $bot->run();
228 
229 ================================================================================
230 
231   To learn more about the Bot::BasicBot framework, visit:
232 
233   https://metacpan.org/pod/Bot::BasicBot
234 
235   View the file ~/challenge to finish the lesson.
236 
237 ================================================================================