commit - /dev/null
commit + 8f7f2f4a721b4811928323ee791cf2f8e95eef17
blob - /dev/null
blob + 2f7b5bcbad101e944a39a3e314741ab3dc0d02b6 (mode 644)
--- /dev/null
+++ perl100/.Xdefaults
+! $OpenBSD: dot.Xdefaults,v 1.3 2014/07/10 10:22:59 jasper Exp $
+XTerm*loginShell:true
blob - /dev/null
blob + 5a4d9aef3ea0d37c8873ef1a9acea1705f1c61e5 (mode 644)
--- /dev/null
+++ perl100/.cshrc
+# $OpenBSD: dot.cshrc,v 1.10 2020/01/24 02:09:51 okan Exp $
+#
+# csh initialization
+
+alias df df -k
+alias du du -k
+alias f finger
+alias h 'history -r | more'
+alias j jobs -l
+alias la ls -a
+alias lf ls -FA
+alias ll ls -lsA
+alias tset 'set noglob histchars=""; eval `\tset -s \!*`; unset noglob histchars'
+alias z suspend
+
+set path = (~/bin /bin /sbin /usr/{bin,sbin,X11R6/bin,local/bin,local/sbin,games})
+
+if ($?prompt) then
+ # An interactive shell -- set some stuff up
+ set filec
+ set history = 1000
+ set ignoreeof
+ set mail = (/var/mail/$USER)
+ set mch = `hostname -s`
+ alias prompt 'set prompt = "$mch:q"":$cwd:t {\!} "'
+ alias cd 'cd \!*; prompt'
+ alias chdir 'cd \!*; prompt'
+ alias popd 'popd \!*; prompt'
+ alias pushd 'pushd \!*; prompt'
+ cd .
+ umask 22
+endif
blob - /dev/null
blob + 2266a4a05265e9993ed8503d80d0544c0c07fe6a (mode 644)
--- /dev/null
+++ perl100/.cvsrc
+# $OpenBSD: dot.cvsrc,v 1.3 2016/10/31 20:50:11 tb Exp $
+#
+diff -uNp
+update -Pd
+checkout -P
+rdiff -u
blob - /dev/null
blob + 1087d67d3f660d5ba8b9e03f23ea048ffcbe56a2 (mode 644)
--- /dev/null
+++ perl100/.login
+# $OpenBSD: dot.login,v 1.6 2015/12/15 16:37:58 deraadt Exp $
+#
+# csh login file
+
+if ( ! $?TERMCAP ) then
+ if ( $?XTERM_VERSION ) then
+ tset -IQ '-munknown:?vt220' $TERM
+ else
+ tset -Q '-munknown:?vt220' $TERM
+ endif
+endif
+
+stty newcrt crterase
+
+set savehist=100
+set ignoreeof
+
+setenv EXINIT 'set ai sm noeb'
+
+if (-x /usr/games/fortune) /usr/games/fortune
blob - /dev/null
blob + d052b599855ffef8527c486df620a73b604914b8 (mode 644)
--- /dev/null
+++ perl100/.mailrc
+# $OpenBSD: dot.mailrc,v 1.3 2014/07/10 11:18:23 jasper Exp $
+set ask
+set crt
+ignore message-id received date fcc status resent-date resent-message-id resent-from in-reply-to
blob - /dev/null
blob + 54b76518023d70efad37a53081563ed222b0da73 (mode 644)
--- /dev/null
+++ perl100/.profile
+# $OpenBSD: dot.profile,v 1.7 2020/01/24 02:09:51 okan Exp $
+#
+# sh/ksh initialization
+
+PATH=$HOME/bin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/X11R6/bin:/usr/local/bin:/usr/local/sbin:/usr/games
+export PATH HOME TERM
blob - /dev/null
blob + e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 (mode 644)
blob - /dev/null
blob + 2f7b5bcbad101e944a39a3e314741ab3dc0d02b6 (mode 644)
--- /dev/null
+++ perl101/.Xdefaults
+! $OpenBSD: dot.Xdefaults,v 1.3 2014/07/10 10:22:59 jasper Exp $
+XTerm*loginShell:true
blob - /dev/null
blob + 5a4d9aef3ea0d37c8873ef1a9acea1705f1c61e5 (mode 644)
--- /dev/null
+++ perl101/.cshrc
+# $OpenBSD: dot.cshrc,v 1.10 2020/01/24 02:09:51 okan Exp $
+#
+# csh initialization
+
+alias df df -k
+alias du du -k
+alias f finger
+alias h 'history -r | more'
+alias j jobs -l
+alias la ls -a
+alias lf ls -FA
+alias ll ls -lsA
+alias tset 'set noglob histchars=""; eval `\tset -s \!*`; unset noglob histchars'
+alias z suspend
+
+set path = (~/bin /bin /sbin /usr/{bin,sbin,X11R6/bin,local/bin,local/sbin,games})
+
+if ($?prompt) then
+ # An interactive shell -- set some stuff up
+ set filec
+ set history = 1000
+ set ignoreeof
+ set mail = (/var/mail/$USER)
+ set mch = `hostname -s`
+ alias prompt 'set prompt = "$mch:q"":$cwd:t {\!} "'
+ alias cd 'cd \!*; prompt'
+ alias chdir 'cd \!*; prompt'
+ alias popd 'popd \!*; prompt'
+ alias pushd 'pushd \!*; prompt'
+ cd .
+ umask 22
+endif
blob - /dev/null
blob + 2266a4a05265e9993ed8503d80d0544c0c07fe6a (mode 644)
--- /dev/null
+++ perl101/.cvsrc
+# $OpenBSD: dot.cvsrc,v 1.3 2016/10/31 20:50:11 tb Exp $
+#
+diff -uNp
+update -Pd
+checkout -P
+rdiff -u
blob - /dev/null
blob + 1087d67d3f660d5ba8b9e03f23ea048ffcbe56a2 (mode 644)
--- /dev/null
+++ perl101/.login
+# $OpenBSD: dot.login,v 1.6 2015/12/15 16:37:58 deraadt Exp $
+#
+# csh login file
+
+if ( ! $?TERMCAP ) then
+ if ( $?XTERM_VERSION ) then
+ tset -IQ '-munknown:?vt220' $TERM
+ else
+ tset -Q '-munknown:?vt220' $TERM
+ endif
+endif
+
+stty newcrt crterase
+
+set savehist=100
+set ignoreeof
+
+setenv EXINIT 'set ai sm noeb'
+
+if (-x /usr/games/fortune) /usr/games/fortune
blob - /dev/null
blob + d052b599855ffef8527c486df620a73b604914b8 (mode 644)
--- /dev/null
+++ perl101/.mailrc
+# $OpenBSD: dot.mailrc,v 1.3 2014/07/10 11:18:23 jasper Exp $
+set ask
+set crt
+ignore message-id received date fcc status resent-date resent-message-id resent-from in-reply-to
blob - /dev/null
blob + de9ddc506c824d8f810823505fe78e6063b5d2bd (mode 644)
--- /dev/null
+++ perl101/.profile
+# $OpenBSD: dot.profile,v 1.7 2020/01/24 02:09:51 okan Exp $
+#
+# sh/ksh initialization
+
+PATH=$HOME/bin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/X11R6/bin:/usr/local/bin:/usr/local/sbin:/usr/games
+export PATH HOME TERM
+cat perl101
blob - /dev/null
blob + e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 (mode 644)
blob - /dev/null
blob + a67f58c004252495d4218ef731dabb4c707d83ad (mode 644)
--- /dev/null
+++ perl101/challenge
+================================================================================
+
+ Challenge
+
+ In this challenge, we will modify our original dicebot.pl to convert it
+ into a bot that checks the person who messages it.
+
+ Every time the owner messages the channel, it will say, "You're the boss!"
+ Every time another user messages it, it will say, "I don't recognize you!"
+
+================================================================================
+
+ Modifying dicebot.pl
+
+ Let's start with our original dicebot.pl. With just a few modifications, we
+ can make the bot chat in new and interactive ways.
+
+ Let's edit the subroutine said:
+
+sub said {
+ my $self = shift;
+ my $arguments = shift;
+ if ($arguments->{body} =~ /^!roll/) {
+ my $dice = int(rand(12))+1;
+ return "You rolled $dice!";
+ }
+}
+
+ Let's change the if test. Instead of testing if the body of the message
+ starts with !roll, let's test if the sender has the right nick:
+
+ We replace:
+
+ if ($arguments->{body} =~ /^!roll/) {
+
+ with:
+
+ if ($arguments->{who} =~ /^yournick$/) {
+
+ Replace yournick with your nick on IRC.
+
+ The if (...) conditional tests whether the expression inside is true.
+ Here, we check the sender of the message with $arguments->{who}.
+ We use =~ to test if it matches the string yournick. The carat
+ symbol ^ marks the beginning of the string and the dollar symbol $
+ marks the end of the string.
+
+ Now that we're no longer rolling dice, we can delete this line:
+
+ my $dice = int(rand(12))+1;
+
+ Next, we should change the message. We replace:
+
+ return "You rolled $dice!";
+
+ with:
+
+ return "You're the boss!";
+
+ We now have this snippet of code:
+
+ if ($arguments->{who} =~ /^yournick$/) {
+ return "You're the boss!";
+ }
+
+ This means: If the message comes from yournick, say "You're the boss!"
+ in the same channel that the message came from.
+
+ Let's use an else statement to send a message for users
+ that do not match yournick:
+
+ else {
+ return "I don't recognize you!";
+ }
+
+ Finally, we will replace DiceBot on lines 5 and 20 with IDBot (because
+ this bot checks our ID):
+
+package DiceBot;
+
+ becomes:
+
+package IDBot;
+
+ and:
+
+my $bot = DiceBot->new(
+
+ becomes:
+
+my $bot = IDBot->new(
+
+ (Hint: the answer is in /home/perl102/idbot.pl)
+
+================================================================================
+
+ Username: perl102
+ Password: UoBnjdJd5P1
+ Server: freeirc.org
+ Port: 22
+
+================================================================================
blob - /dev/null
blob + 75bfdc2fcb243223d07dd16d47b802cf98462e2a (mode 644)
--- /dev/null
+++ perl101/comments
+================================================================================
+
+ DiceBot Explained
+
+ We name the file dicebot.pl because the pl extension is commonly used for
+ perl scripts.
+
+ We start off our perl script with this first line:
+
+#!/usr/bin/perl
+
+ The #! on the first line is called the "shebang", short for sharp (#) and
+ bang (!). It comes at the beginning of a script to tell the operating system
+ which program to load to interpret our script. In this case, we want to load
+ /usr/bin/perl.
+
+use strict;
+use warnings;
+
+ use strict causes perl to force you to write better code. This is helpful
+ when you're writing a new program, and especially when learning perl: the
+ program will immediately quit with an error message if you don't follow best
+ practices when programming.
+
+ use warnings warns you whenever it sees a potential mistake in your
+ program. Otherwise, perl will attempt to guess what you mean, which can
+ result in surprising errors that are hard to debug (fix).
+
+ Always use these two in all of your scripts.
+
+use base qw(Bot::BasicBot);
+
+ In this line, we use the Bot::BasicBot IRC module. This makes it easy
+ to create a new IRC bot.
+
+sub said {
+ ...
+}
+
+ (The ... represents code that has been left out)
+
+ This creates a subroutine called said. A subroutine in perl is the same as
+ a function in other programming languages. It is a piece of code that you
+ can reuse over and over.
+
+ Here's what's inside the subroutine said:
+
+sub said {
+ my $self = shift;
+ my $arguments = shift;
+ ...
+}
+
+ A subroutine can have arguments passed to it. In this case, there are
+ two arguments: $self and $arguments.
+
+ Notice that in perl, variables begin with a dollar sign $.
+ my $var will declare a variable named var so you can use it.
+
+ Inside the subroutine said:
+
+ if ($arguments->{body} =~ /^!roll/) {
+
+ If the body of the message of $arguments begins with !roll,
+ then we roll the dice.
+
+ my $dice = int(rand(12))+1;
+
+ We define a new variable $dice to be an integer (a whole number)
+ chosen randomly from 0 to 12.
+
+ return "You rolled $dice!",
+
+ We then tell the bot to return the message, "You rolled $dice!" . perl
+ will replace $dice with the random value generated earlier.
+
+my $bot = DiceBot->new(
+ server => 'irc.example.com',
+ port => '6667',
+ channels => ['#perl101'],
+ nick => 'nickname',
+ name => 'username',
+);
+
+ We create a new bot using DiceBot->new(...).
+
+ We then define the key-value pairs like server => 'irc.example.com'. These
+ will provide the settings for the IRC bot.
+
+ Finally, we tell the bot to run:
+
+$bot->run();
+
+================================================================================
+
+ This lesson provides only a fast tour of how to create an IRC bot. It does
+ not fully explain all the details of the perl language -- we will explain
+ those soon.
+
+ If you're new to programming, check out Beginning Perl:
+
+ https://www.perl.org/books/beginning-perl
+
+ If you're an experienced programmer, check out Impatient Perl:
+
+ http://www.greglondon.com/iperl/index.htm
+
+ View the file ~/challenge to finish the lesson.
+
+================================================================================
blob - /dev/null
blob + ba28495eb8efa26cbd96ed8e8476e80d1259d614 (mode 644)
--- /dev/null
+++ perl101/dicebot.pl
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+package DiceBot;
+use base qw(Bot::BasicBot);
+
+sub said {
+ my $self = shift;
+ my $arguments = shift;
+ if ($arguments->{body} =~ /^!roll/) {
+ my $dice = int(rand(12))+1;
+ return "You rolled $dice!",
+ }
+}
+
+package main;
+
+my $bot = DiceBot->new(
+ server => 'irc.example.com',
+ port => '6667',
+ channels => ['#perl101'],
+ nick => 'nickname',
+ name => 'username',
+);
+$bot->run();
blob - /dev/null
blob + b0095f3f5ef147a733c28c41f2758e0300ad45f9 (mode 644)
--- /dev/null
+++ perl101/firstbot
+================================================================================
+
+ Creating a DiceBot
+
+ In our first lesson, we'll create an IRC bot that rolls the
+ dice for you.
+
+ Copy the code for dicebot.pl to your home folder:
+
+ $ cp dicebot.pl ~/dicebot.pl
+
+ Next, open up dicebot.pl using a text editor and make a few changes.
+ (We recommend vim because it provides syntax highlighting)
+
+ 1. Edit the server in line 20. Replace irc.example.com with the server's
+ real address. NOTE: Only IPv4 is supported.
+ 2. Edit line 23 to replace nickname with the nickname you want for the bot.
+ WARNING: The nickname must not already be taken, or else the bot will
+ fail to connect.
+ 3. Edit line 24 to replace username with the username you want for the bot.
+ The username is what appears in a /whois on IRC; it can be different
+ from the nickname.
+
+ Next, you'll want to make the perl script executable:
+
+ $ chmod u+x ~/dicebot.pl
+
+ Then run the script:
+
+ $ perl ~/dicebot.pl
+
+ On IRC, /join #perl101
+
+ Type !roll and you'll see the bot rolls a pair of virtual dice.
+
+ In less than 5 minutes, you've created your first IRC bot with perl.
+
+================================================================================
+
+ Understanding DiceBot
+
+ Next, take a look at the file called ~/comments to see an explanation of
+ key lines in the program.
+
+================================================================================
blob - /dev/null
blob + beaa70c5605b9e759bb05fda8f67ba5fb1c74566 (mode 644)
--- /dev/null
+++ perl101/perl101
+
+ _______\\__
+ (_. _ ._ _/
+ '-' \__. /
+ / / Perl101
+ / / .--. .--.
+ ( ( / '' \/ '' \ " Creating an IRC Dice Bot
+ \ \_.' \ )
+ || _ './ Open ~/firstbot to begin
+ |\ \ ___.'\ /
+ '-./ .' \ |/ (artwork: https://ascii.co.uk/art/camel)
+ \| / )|\
+ |/ // \\
+ |\ __// \\__
+ //\\ /__/ mrf\__|
+ .--_/ \_--.
+ /__/ \__\
+
blob - /dev/null
blob + 2f7b5bcbad101e944a39a3e314741ab3dc0d02b6 (mode 644)
--- /dev/null
+++ perl102/.Xdefaults
+! $OpenBSD: dot.Xdefaults,v 1.3 2014/07/10 10:22:59 jasper Exp $
+XTerm*loginShell:true
blob - /dev/null
blob + 5a4d9aef3ea0d37c8873ef1a9acea1705f1c61e5 (mode 644)
--- /dev/null
+++ perl102/.cshrc
+# $OpenBSD: dot.cshrc,v 1.10 2020/01/24 02:09:51 okan Exp $
+#
+# csh initialization
+
+alias df df -k
+alias du du -k
+alias f finger
+alias h 'history -r | more'
+alias j jobs -l
+alias la ls -a
+alias lf ls -FA
+alias ll ls -lsA
+alias tset 'set noglob histchars=""; eval `\tset -s \!*`; unset noglob histchars'
+alias z suspend
+
+set path = (~/bin /bin /sbin /usr/{bin,sbin,X11R6/bin,local/bin,local/sbin,games})
+
+if ($?prompt) then
+ # An interactive shell -- set some stuff up
+ set filec
+ set history = 1000
+ set ignoreeof
+ set mail = (/var/mail/$USER)
+ set mch = `hostname -s`
+ alias prompt 'set prompt = "$mch:q"":$cwd:t {\!} "'
+ alias cd 'cd \!*; prompt'
+ alias chdir 'cd \!*; prompt'
+ alias popd 'popd \!*; prompt'
+ alias pushd 'pushd \!*; prompt'
+ cd .
+ umask 22
+endif
blob - /dev/null
blob + 2266a4a05265e9993ed8503d80d0544c0c07fe6a (mode 644)
--- /dev/null
+++ perl102/.cvsrc
+# $OpenBSD: dot.cvsrc,v 1.3 2016/10/31 20:50:11 tb Exp $
+#
+diff -uNp
+update -Pd
+checkout -P
+rdiff -u
blob - /dev/null
blob + 1087d67d3f660d5ba8b9e03f23ea048ffcbe56a2 (mode 644)
--- /dev/null
+++ perl102/.login
+# $OpenBSD: dot.login,v 1.6 2015/12/15 16:37:58 deraadt Exp $
+#
+# csh login file
+
+if ( ! $?TERMCAP ) then
+ if ( $?XTERM_VERSION ) then
+ tset -IQ '-munknown:?vt220' $TERM
+ else
+ tset -Q '-munknown:?vt220' $TERM
+ endif
+endif
+
+stty newcrt crterase
+
+set savehist=100
+set ignoreeof
+
+setenv EXINIT 'set ai sm noeb'
+
+if (-x /usr/games/fortune) /usr/games/fortune
blob - /dev/null
blob + d052b599855ffef8527c486df620a73b604914b8 (mode 644)
--- /dev/null
+++ perl102/.mailrc
+# $OpenBSD: dot.mailrc,v 1.3 2014/07/10 11:18:23 jasper Exp $
+set ask
+set crt
+ignore message-id received date fcc status resent-date resent-message-id resent-from in-reply-to
blob - /dev/null
blob + 48ee3ad078b78484c38796d9a179d1a2c2570f1c (mode 644)
--- /dev/null
+++ perl102/.profile
+# $OpenBSD: dot.profile,v 1.7 2020/01/24 02:09:51 okan Exp $
+#
+# sh/ksh initialization
+
+PATH=$HOME/bin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/X11R6/bin:/usr/local/bin:/usr/local/sbin:/usr/games
+export PATH HOME TERM
+cat perl102
blob - /dev/null
blob + e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 (mode 644)
blob - /dev/null
blob + 69fce51450eefea7a8de6998cce1e1f0cbcf567f (mode 644)
--- /dev/null
+++ perl102/autogreet.pl
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+package GreetBot;
+use base qw(Bot::BasicBot);
+
+sub chanjoin {
+ my $self = shift;
+ my $arguments = shift;
+ my $nick = $arguments->{who};
+ if ($nick eq $self->pocoirc->nick_name()) {
+ return;
+ }
+ $self->say(
+ channel => $arguments->{channel},
+ body => "Welcome, $nick!",
+ );
+}
+
+sub chanpart {
+ my $self = shift;
+ my $arguments = shift;
+ $self->say(
+ channel => $arguments->{channel},
+ body => "I'm sad to see $arguments->{who} go.",
+ );
+}
+
+sub emoted {
+ my $self = shift;
+ my $arguments = shift;
+
+ $self->emote(
+ channel => $arguments->{channel},
+ body => "$arguments->{body} too",
+ );
+}
+
+sub noticed {
+ my $self = shift;
+ my $arguments = shift;
+
+ my $nick = $arguments->{who};
+
+ my @notices = (
+ "$nick, please resend this in a normal message",
+ "I'm having a hard time reading your notice.",
+ "Good point, $nick.",
+ "Can you message on the public channel instead?",
+ );
+
+ $self->notice(
+ who => $nick,
+ channel => $arguments->{channel},
+ body => $notices[int(rand(4))],
+ );
+}
+
+sub topic {
+ my $self = shift;
+ my $arguments = shift;
+
+ if ($arguments->{who} eq $self->pocoirc->nick_name()) {
+ return;
+ }
+ $self->pocoirc->yield('topic' => $arguments->{channel} => "$arguments->{topic} || Don't change the topic!");
+}
+
+sub nick_change {
+ my $self = shift;
+ my $oldnick = shift;
+ my $newnick = shift;
+
+ if ($newnick eq $self->pocoirc->nick_name()) {
+ return;
+ }
+
+ $self->pocoirc->yield('nick' => "$oldnick");
+ $self->say(
+ who => "$newnick",
+ body => "If you don't mind, I'd like to use your old nick.",
+ );
+}
+
+package main;
+
+my $bot = GreetBot->new(
+ server => 'irc.example.com',
+ port => '6667',
+ channels => ['#perl102'],
+ nick => 'nickname',
+ name => 'username',
+);
+$bot->run();
blob - /dev/null
blob + 399730bacd9dd034c61ffab695b325714282b992 (mode 644)
--- /dev/null
+++ perl102/challenge
+================================================================================
+
+ Challenge
+
+ Let's take our original Auto Greet bot and turn it into a simple Chat bot.
+ The goal is to make the chat seem realistic in order to trick a user into
+ thinking that a real human is talking with him.
+
+ As part of this task, we will add new replies for when a user joins a
+ channel, parts a channel, changes the topic, and says something. Just like
+ the way we handled notices, we should use one reply at random.
+
+ We will remove the nick_change subroutine because stealing someone's old
+ nick is annoying.
+
+ When a user says something, we will search for the keywords in the chat
+ and repeat it back to the user, to pretend like the bot is listening.
+
+================================================================================
+
+ Modifying greetbot.pl
+
+ Once again, we're going to change the name of GreetBot to ChatBot. Here
+ is the diff:
+
+--- /home/perl102/autogreet.pl Sun Aug 29 06:53:39 2021
++++ /home/perl103/chatbot.pl Sun Aug 29 07:11:13 2021
+@@ -2,9 +2,12 @@
+ use strict;
+ use warnings;
+
+-package GreetBot;
++package ChatBot;
+ use base qw(Bot::BasicBot);
++use Lingua::EN::Tagger;
+
++my $logs;
+
+ A diff is a short way of showing what changed in a file. The + plus
+ symbol at the left of the screen means a line was added, and
+ the - minus symbol at the left of the screen means that a line was deleted.
+
+ First, we delete the line with GreetBot and replace it with ChatBot.
+
+ Next, we add a new line: use Lingua::EN::Tagger. This loads a new module,
+ Lingua::EN::Tagger, to help us recognize the parts of speech in a sentence.
+ See: https://metacpan.org/pod/Lingua::EN::Tagger
+
+ This module comes from CPAN, the Comprehensive Perl Archive Network.
+ CPAN is similar to other package managers like npm from Node.js or
+ pip from python. It contains an enormous collection of perl modules
+ that you can use. See: http://www.cpan.org
+
+ Lingua::EN::Tagger helps us easily find the noun phrases of a sentence.
+ These noun phrases are the keywords that our bot will repeat back to
+ pretend like it is listening. For example, in the sentence:
+
+ Some of the monks at the Perl monastery observe a vow of silence.
+
+ 'Some of the monks', 'the Perl monastery', and 'a vow of silence' are noun
+ phrases.
+
+ Next, we declare the variable $logs. Notice that we declare $logs outside
+ of any subroutine. This is necessary because we want $logs to accumulate
+ all user chat from the moment the bot connects.
+
+ In perl, a variable declared with my is a *lexical* variable. If a variable
+ is declared inside a subroutine, it exists only from the opening brace {
+ to the closing brace }. Once the subroutine ends, lexical variables are
+ recycled and their data is lost forever. For example, suppose we have:
+
+sub said {
+ my $logs = "12:00 < nickname> Welcome, user!\n"
+}
+
+print $logs;
+
+ Nothing will get printed, because $logs would cease to exist by the time
+ the program leaves the end brace }.
+
+ We need $logs to survive after leaving a subroutine, so we define it
+ outside of the subroutine.
+
+ We're going to modify our chanjoin subroutine to add some new greetings:
+
+ sub chanjoin {
+ my $self = shift;
+ my $arguments = shift;
+@@ -12,18 +15,34 @@
+ if ($nick eq $self->pocoirc->nick_name()) {
+ return;
+ }
++ my @greetings = ("Hey there, $nick!",
++ "$nick, welcome!",
++ "sup $nick!",
++ "$nick, it's good to see you.",
++ "How can I help you, $nick?",
++ "Hey $nick, do you hang out here too?",
++ "Hiya $nick.");
++
+ $self->say(
+ channel => $arguments->{channel},
+- body => "Welcome, $nick!",
++ body => $greetings[int(rand(scalar(@greetings)))],
+ );
+ }
+
+ We again create an array of greetings. In $self->say(), we pick a
+ random greeting:
+
+ body => $greetings[int(rand(scalar(@greetings)))],
+
+ First, we find the length of the array @greetings using scalar(@greetings).
+ Then, we select a random number between 0 and the length of the array
+ with rand(scalar(@greetings)).
+
+ In this case, the array has a length of 7, but we don't want to write
+ rand(7). This is because we might later want to add or remove greetings,
+ so the length of the array may change. Besides, we might forget to update
+ the number 7.
+
+ We then *truncate* the number (drop the decimal part) with int(). We now
+ have a random number between zero to less than the length of the array.
+
+ We use this number as an index into the array @greetings.
+ This gives us $greetings[int(rand(scalar(@greetings)))].
+ Notice that we change from an array sigil @ to a scalar sigil $ because we
+ want one greeting, a string, instead of an array of strings.
+
+ We do the same with chanpart:
+
+ sub chanpart {
+ my $self = shift;
+ my $arguments = shift;
++ my $nick = $arguments->{who};
++ my @farewells = ("I'm sad to see $nick go",
++ "Oh, $nick left, I was just about to send a message.",
++ "I always seem to return just as $nick leaves.",
++ "I hope $nick will rejoin later.",
++ "I'm going to take a break too, brb.",
++ "See you later $nick. Oops, I was too late.");
++
+ $self->say(
+ channel => $arguments->{channel},
+- body => "I'm sad to see $arguments->{who} go.",
++ body => $farewells[int(rand(scalar(@farewells)))],
+ );
+ }
+
+ In our old noticed subroutine, we hard-coded the number 4 to represent
+ the length of the array. As mentioned above, this is not ideal. So
+ we use scalar(@notices) to determine the length of the array:
+
+@@ -53,39 +72,50 @@
+ $self->notice(
+ who => $nick,
+ channel => $arguments->{channel},
+- body => $notices[int(rand(4))],
++ body => $notices[int(rand(scalar(@notices)))],
+ );
+ }
+
+ We modify the topic subroutine to send different replies:
+
+ sub topic {
+ my $self = shift;
+ my $arguments = shift;
++ my @replies = ("Nice",
++ "Hm, I liked the old topic better.",
++ "Please don't change the topic.",
++ "Good thinking.",
++ "That makes more sense.");
+
+- if ($arguments->{who} eq $self->pocoirc->nick_name()) {
+- return;
+- }
+- $self->pocoirc->yield('topic' => $arguments->{channel} => "$arguments->{topic} || Don't change the topic!");
++ $self->say(
++ channel => $arguments->{channel},
++ body => $replies[int(rand(scalar(@replies)))],
++ );
+ }
+
+ We'll delete the nick_change subroutine and add a said subroutine:
+
+-sub nick_change {
+- my $self = shift;
+- my $oldnick = shift;
+- my $newnick = shift;
+-
+- if ($newnick eq $self->pocoirc->nick_name()) {
+- return;
+- }
+-
+- $self->pocoirc->yield('nick' => "$oldnick");
+- $self->say(
+- who => "$newnick",
+- body => "If you don't mind, I'd like to use your old nick.",
+- );
+-}
+
++sub said {
++ my $self = shift;
++ my $arguments = shift;
++
++ $logs .= "$arguments->{body}\n";
++ my $p = new Lingua::EN::Tagger;
++ my %word_freqs = $p->get_words($logs);
++ my $keyword;
++ my $total = 0;
++ foreach my $freq (keys %word_freqs) {
++ $total += $word_freqs{$freq};
++ $keyword = $freq if rand($total) < $word_freqs{$freq};
++ }
++ my @replies = ("I think you have a valid point about $keyword.",
++ "Hm, what do others think about $keyword?",
++ ucfirst $keyword." is not something I'm familiar with",
++ "Are you sure about $keyword?",
++ "Tell me more about $keyword.",
++ "What about $keyword?",
++ "Let's talk about something else besides $keyword.");
++ return $replies[int(rand(scalar(@replies)))];
++}
+
+ At the bottom of the file, we replace GreetBot->new( with ChatBot->new(:
+
+ package main;
+
+-my $bot = GreetBot->new(
++my $bot = ChatBot->new(
+ server => 'irc.example.com',
+ port => '6667',
+ channels => ['#perl102'],
+
+ (Hint: the answer is in /home/perl103/chatbot.pl)
+
+ This is a very simple bot, but perhaps in the future, you could use more
+ advanced techniques to write a more realistic chat bot.
+
+================================================================================
+
+ Username: perl103
+ Password: t3Qa8CRfArL
+ Server: freeirc.org
+ Port: 22
+
+================================================================================
blob - /dev/null
blob + cb48258cee844706a9c6a11b729e2b4cd457d395 (mode 644)
--- /dev/null
+++ perl102/comments
+================================================================================
+
+ AutoGreet Explained
+
+ The first 6 lines of autogreet.pl are similar to dicebot.pl from the
+ previous lesson:
+
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+package GreetBot;
+use base qw(Bot::BasicBot);
+
+ The only difference is we changed the package to GreetBot instead of
+ DiceBot.
+
+ Next, we have our first subroutine chanjoin, which greets new users
+ whenever one joins a channel.
+
+sub chanjoin {
+ my $self = shift;
+ my $arguments = shift;
+ my $nick = $arguments->{who};
+ if ($nick eq $self->pocoirc->nick_name()) {
+ return;
+ }
+ $self->say(
+ channel => $arguments->{channel},
+ body => "Welcome, $nick!",
+ );
+}
+
+ We store the user's nick in $nick:
+
+ my $nick = $arguments->{who};
+
+ Afterwards, we check if the new user's nick, $nick, is the same as our
+ bot's nick, $self->pocoirc->nick_name(). When the bot itself first joins
+ a channel, chanjoin is called. We don't want the bot to greet itself, so
+ we skip it with return.
+
+ if ($nick eq $self->pocoirc->nick_name()) {
+ return;
+ }
+
+ The return statement exits a subroutine without executing any
+ of the code that comes after it:
+
+ Next, we tell the bot to send a message to the channel to greet the new
+ user:
+
+ $self->say(
+ channel => $arguments->{channel},
+ body => "Welcome, $nick!",
+ );
+
+ Up next is the subroutine chanpart. It is called whenever a user parts from
+ a channel. It tells the bot to send a message whenever a user leaves:
+
+sub chanpart {
+ my $self = shift;
+ my $arguments = shift;
+ $self->say(
+ channel => $arguments->{channel},
+ body => "I'm sad to see $arguments->{who} go.",
+ );
+}
+
+ Take a closer look at the value of body:
+
+ body => "I'm sad to see $arguments->{who} go.",
+
+ Notice that $arguments->{who} is put right inside the quotation marks, but
+ the message does not literally have the string "$arguments->{who}". Instead,
+ perl evalutes $arguments->{who} to get the user's nick, then puts that value
+ into the string.
+
+ We do something different for the subroutine emoted. Instead of merely
+ sending a message, we will emote it (send an action message):
+
+sub emoted {
+ my $self = shift;
+ my $arguments = shift;
+
+ $self->emote(
+ channel => $arguments->{channel},
+ body => "$arguments->{body} too",
+ );
+}
+
+ On many irc clients, you can type /me <your-text-here> to emote.
+ Watch the bot emote back!
+
+ In the subroutine noticed, we use an array for @notices:
+
+sub noticed {
+ my $self = shift;
+ my $arguments = shift;
+
+ my $nick = $arguments->{who};
+
+ my @notices = (
+ "$nick, please resend this in a normal message",
+ "I'm having a hard time reading your notice.",
+ "Good point, $nick.",
+ "Can you message on the public channel instead?",
+ );
+
+ $self->notice(
+ who => $nick,
+ channel => $arguments->{channel},
+ body => $notices[int(rand(4))],
+ );
+}
+
+ When you send a notice to the bot or to a channel the bot is in, it will
+ reply with one of four different notices:
+
+ my @notices = (
+ "$nick, please resend this in a normal message",
+ "I'm having a hard time reading your notice.",
+ "Good point, $nick.",
+ "Can you message on the public channel instead?",
+ );
+
+ The sigil (the symbol before a variable) for an array is @. An array
+ can begin with an open and close parenthesis ( ) and the items inside are
+ separated with commas ,.
+
+ @notices has four strings. Those strings use double quotes so
+ that the variables inside will get interpolated.
+
+ An array stores many items, each one with a unique index. The first
+ element of the array @notices is $notices[0]. The second element is
+ $notices[1], and the third is $notices[2].
+
+ Arrays in Perl (like in most programming languages) begin with 0 as
+ the first index.
+
+ body => $notices[int(rand(4))],
+
+ rand(n) will return a random float between 0 and n. int() *truncates*
+ the float, meaning it drops everything after the decimal point. For
+ example, int(3.1415) gets *truncated* to 3: everything after the
+ decimal point gets ignored.
+
+ int(rand(4)) gives a random integer from 0 to 3, which we use as the
+ index for $notices. In other words, the body is a random notice chosen
+ from an array of four notices.
+
+ In the subroutine topic, anytime the topic is changed, the bot will
+ add a short warning to the end of it:
+
+sub topic {
+ my $self = shift;
+ my $arguments = shift;
+
+ if ($arguments->{who} eq $self->pocoirc->nick_name()) {
+ return;
+ }
+ $self->pocoirc->yield('topic' => $arguments->{channel} => "$arguments->{topic} || Don't change the topic!");
+}
+
+ If the new nick $arguments->{who} is the same as the bot's current nick
+ $self->pocoirc->nick_name(), then we return and do nothing. This line
+ is necessary to prevent an infinite loop. Without this line, if the bot
+ changes the topic, the subroutine topic will get called again, causing
+ the bot to again change the topic.
+
+ if ($arguments->{who} eq $self->pocoirc->nick_name()) {
+ return;
+ }
+
+ The bot will change the topic in the current channel to a new topic.
+ This topic contains the original topic plus "|| Don't change the topic!":
+
+ $self->pocoirc->yield('topic' => $arguments->{channel} => "$arguments->{topic} || Don't change the topic!");
+
+ The last subroutine is nick_change:
+
+sub nick_change {
+ my $self = shift;
+ my $oldnick = shift;
+ my $newnick = shift;
+
+ if ($newnick eq $self->pocoirc->nick_name()) {
+ return;
+ }
+
+ $self->pocoirc->yield('nick' => "$oldnick");
+ $self->say(
+ who => "$newnick",
+ body => "If you don't mind, I'd like to use your old nick.",
+ );
+}
+
+ Again, if the new nick is the same as the bot's current nick, we return
+ to prevent an infinite loop:
+
+ if ($newnick eq $self->pocoirc->nick_name()) {
+ return;
+ }
+
+ We change the bot's nick to $oldnick:
+
+ $self->pocoirc->yield('nick' => "$oldnick");
+
+ Then have the bot send a message to the user who changed his nick:
+
+ $self->say(
+ who => "$newnick",
+ body => "If you don't mind, I'd like to use your old nick.",
+ );
+
+ The last bit of code is similar to DiceBot. We create a GreetBot then run it:
+
+package main;
+
+my $bot = GreetBot->new(
+ server => 'irc.example.com',
+ port => '6667',
+ channels => ['#perl102'],
+ nick => 'nickname',
+ name => 'username',
+);
+$bot->run();
+
+================================================================================
+
+ To learn more about the Bot::BasicBot framework, visit:
+
+ https://metacpan.org/pod/Bot::BasicBot
+
+ View the file ~/challenge to finish the lesson.
+
+================================================================================
blob - /dev/null
blob + 0c0b4253881a898e7aa1f24f8ff5b88a97736950 (mode 644)
--- /dev/null
+++ perl102/idbot.pl
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+package IDBot;
+use base qw(Bot::BasicBot);
+
+sub said {
+ my $self = shift;
+ my $arguments = shift;
+ if ($arguments->{who} =~ /^yournick$/) {
+ return "You're the boss!";
+ } else {
+ return "I don't recognize you!";
+ }
+}
+
+package main;
+
+my $bot = IDBot->new(
+ server => 'irc.example.com',
+ port => '6667',
+ channels => ['#perl101'],
+ nick => 'nickname',
+ name => 'username',
+);
+$bot->run();
blob - /dev/null
blob + 9dc4feadb7614aa43378ddbe690c803eb81efd49 (mode 644)
--- /dev/null
+++ perl102/perl102
+
+ '\|/' *
+ -- * -----
+ /|\ ____
+ ' | ' {_ o^> * (https://www.asciiart.eu/animals/camels)
+ : -_ /)
+ : ( ( .-''`'. Perl102
+ . \ \ / \
+ . \ \ / \ Auto-Greet
+ \ `-' `'.
+ \ . ' / `. Open ~/scalars
+ \ ( \ ) ( .') to begin
+ ,, t '. | / | (
+ '|``_/^\___ '| |`'-..-'| ( ()
+ _~~|~/_|_|__/|~~~~~~~ | / ~~~~~ | | ~~~~~~~~
+ -_ |L[|]L|/ | |\ MJP ) )
+ ( |( / /|
+ ~~ ~ ~ ~~~~ | /\\ / /| |
+ || \\ _/ / | |
+ ~ ~ ~~~ _|| (_/ (___)_| |Nov291999
+ (__) (____)
blob - /dev/null
blob + e8270aa9eb9102538194cff3cab91abdf1639bb3 (mode 644)
--- /dev/null
+++ perl102/scalars
+================================================================================
+
+ Scalars
+
+ A scalar can store a string, number, reference (which points to another
+ variable), or a file handle (which lets you read and write to a file).
+
+ my $server = "irc.example.com";
+ my $port = 6667;
+
+ The first scalar $server contains the string "irc.example.com". A string
+ is made up of letters. The second scalar $port contains the number 6667.
+
+================================================================================
+
+ Strings
+
+ If you want to use a literal string, make sure to put it around 'single
+ quotes' or "double quotes" -- if you do not, perl will report an error:
+
+ print Welcome to my IRC channel;
+
+ syntax error at - line 1, near "my IRC channel"
+ Execution of - aborted due to compilation errors.
+
+ When you use "double quotes", perl will evaluate any variables inside the
+ string and replace them with their values.
+
+ my $nick = "perlmonk";
+ my $msg = "Welcome to the channel, $nick!";
+
+ The perl interpreter replaces $nick with the string "perlmonk", so that
+ $msg will contain the string "Welcome to the channel, perlmonk!" This
+ is called *string interpolation*.
+
+ When you use 'single quotes', no string interpolation takes place. The
+ string is identical to what you type.
+
+ my $msg = 'Welcome to the channel, $nick!';
+
+ The scalar $msg will literally contain 'Welcome to the channel, $nick!'
+ and not 'Welcome to the channel, perlmonk!' This can be useful to
+ avoid accidental string interpolation:
+
+ my $msg = 'Just call $mrmoney and send an email to @cash.com!';
+
+ If we had used double quotes above, perl would try to replace $mrmoney
+ and @cash with the value of those variables. We use single quotes
+ to keep them literal.
+
+ If you need to start a new line in your string, you can use "\n":
+
+ print "To start, press any key.\nWhere's the 'Any' key?"
+
+ This will print:
+
+ To start, press any key.
+ Where's the 'Any' key?
+
+================================================================================
+
+ Numbers
+
+ There are two number types: integers and floats. An integer is a number
+ with no decimals or fractions. A float is stored as a decimal or fraction.
+
+ my $port = 6697;
+ my $delay = 3.5;
+
+ $port is the integer 6697 but $delay might last for three and a half
+ seconds.
+
+================================================================================
+
+ References
+
+ A reference points to another variable, like a pointer in C. The reference
+ does not store the data itself, but stores the address for the data you want.
+
+ my $channel = "#perl102";
+ my $channel_ref = \$channel;
+
+ $channel_ref now points to $channel, but does not contain the string
+ "#perl102" itself.
+
+ To get the value of this reference, put an extra $ in front of the
+ reference:
+
+ print "Welcome to $$channel_ref, new user!\n";
+
+ References may not seem very useful now, but we will use them frequently
+ when programming in Perl.
+
+================================================================================
+
+ Filehandles
+
+ We can call open and pass it a scalar and a filename to open a file:
+
+ open(my $filehandle, '>log.txt');
+
+ The greater than > sign means we want to redirect output to log.txt.
+ Perl will store the handle to the file in the scalar. We can then print
+ to $filehandle to write to the text file:
+
+ print $filehandle "12:56 -!- nickname [nick@10.0.0.1] has joined #channel";
+ print $filehandle "21:28 -!- mode/#channel [+o nickname] by you";
+ close($filehandle);
+
+ Once you are done with a filehandle, make sure to close it. We now have IRC
+ logs written to log.txt which we can read later.
+
+================================================================================
+
+ Learn more about Perl
+
+ At any time, you can get more information by using perldoc:
+
+ $ perldoc perldoc
+
+ Websites to learn more about Perl:
+
+ http://learn.perl.org
+
+ http://www.perldoc.com
+
+================================================================================
+
+ Auto Greet Bot
+
+ Open up ~/secondbot and follow the instructions to set up your second bot.
+
+================================================================================
blob - /dev/null
blob + 03b1f587d1a7f632bf8c6be9be362c4f1e64ac51 (mode 644)
--- /dev/null
+++ perl102/secondbot
+================================================================================
+
+ Creating a Greeting Bot
+
+ In our second lesson, we'll create an IRC bot that greets and interacts
+ with users.
+
+ Copy the code for autogreet.pl to your home folder:
+
+ $ cp autogreet.pl ~/autogreet.pl
+
+ Next, open up autogreet.pl using a text editor and make a few changes.
+ (We recommend vim because it provides syntax highlighting)
+
+ 1. Edit the server in line 89. Replace irc.example.com with the server's
+ real address. NOTE: Only IPv4 is supported.
+ 2. Edit line 92 to replace nickname with the nickname you want for the bot.
+ WARNING: The nickname must not already be taken, or else the bot will
+ fail to connect.
+ 3. Edit line 93 to replace username with the username you want for the bot.
+ The username is what appears in a /whois on IRC; it can be different
+ from the nickname.
+
+ Next, you'll want to make the perl script executable:
+
+ $ chmod u+x ~/autogreet.pl
+
+ Then run the script:
+
+ $ ~/autogreet.pl
+
+ On IRC, /join #perl102
+
+ Whenever a user joins or parts the channel, the bot will send a message.
+ Try sending a /me action and a notice in the channel tos ee the bot respond.
+ Lastly, try changing your nick or changing the topic in the channel.
+ What happens?
+
+================================================================================
+
+ Understanding AutoGreet
+
+ Next, take a look at the file called ~/comments to see an explanation of
+ key lines in the program.
+
+================================================================================
blob - /dev/null
blob + 2f7b5bcbad101e944a39a3e314741ab3dc0d02b6 (mode 644)
--- /dev/null
+++ perl103/.Xdefaults
+! $OpenBSD: dot.Xdefaults,v 1.3 2014/07/10 10:22:59 jasper Exp $
+XTerm*loginShell:true
blob - /dev/null
blob + 5a4d9aef3ea0d37c8873ef1a9acea1705f1c61e5 (mode 644)
--- /dev/null
+++ perl103/.cshrc
+# $OpenBSD: dot.cshrc,v 1.10 2020/01/24 02:09:51 okan Exp $
+#
+# csh initialization
+
+alias df df -k
+alias du du -k
+alias f finger
+alias h 'history -r | more'
+alias j jobs -l
+alias la ls -a
+alias lf ls -FA
+alias ll ls -lsA
+alias tset 'set noglob histchars=""; eval `\tset -s \!*`; unset noglob histchars'
+alias z suspend
+
+set path = (~/bin /bin /sbin /usr/{bin,sbin,X11R6/bin,local/bin,local/sbin,games})
+
+if ($?prompt) then
+ # An interactive shell -- set some stuff up
+ set filec
+ set history = 1000
+ set ignoreeof
+ set mail = (/var/mail/$USER)
+ set mch = `hostname -s`
+ alias prompt 'set prompt = "$mch:q"":$cwd:t {\!} "'
+ alias cd 'cd \!*; prompt'
+ alias chdir 'cd \!*; prompt'
+ alias popd 'popd \!*; prompt'
+ alias pushd 'pushd \!*; prompt'
+ cd .
+ umask 22
+endif
blob - /dev/null
blob + 2266a4a05265e9993ed8503d80d0544c0c07fe6a (mode 644)
--- /dev/null
+++ perl103/.cvsrc
+# $OpenBSD: dot.cvsrc,v 1.3 2016/10/31 20:50:11 tb Exp $
+#
+diff -uNp
+update -Pd
+checkout -P
+rdiff -u
blob - /dev/null
blob + 1087d67d3f660d5ba8b9e03f23ea048ffcbe56a2 (mode 644)
--- /dev/null
+++ perl103/.login
+# $OpenBSD: dot.login,v 1.6 2015/12/15 16:37:58 deraadt Exp $
+#
+# csh login file
+
+if ( ! $?TERMCAP ) then
+ if ( $?XTERM_VERSION ) then
+ tset -IQ '-munknown:?vt220' $TERM
+ else
+ tset -Q '-munknown:?vt220' $TERM
+ endif
+endif
+
+stty newcrt crterase
+
+set savehist=100
+set ignoreeof
+
+setenv EXINIT 'set ai sm noeb'
+
+if (-x /usr/games/fortune) /usr/games/fortune
blob - /dev/null
blob + d052b599855ffef8527c486df620a73b604914b8 (mode 644)
--- /dev/null
+++ perl103/.mailrc
+# $OpenBSD: dot.mailrc,v 1.3 2014/07/10 11:18:23 jasper Exp $
+set ask
+set crt
+ignore message-id received date fcc status resent-date resent-message-id resent-from in-reply-to
blob - /dev/null
blob + 4c01ab6ccb23df1fcf0479ee649eaa2ac2359b88 (mode 644)
--- /dev/null
+++ perl103/.profile
+# $OpenBSD: dot.profile,v 1.7 2020/01/24 02:09:51 okan Exp $
+#
+# sh/ksh initialization
+
+PATH=$HOME/bin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/X11R6/bin:/usr/local/bin:/usr/local/sbin:/usr/games
+export PATH HOME TERM
+cat perl103
blob - /dev/null
blob + e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 (mode 644)
blob - /dev/null
blob + 2faa38e09554a9b3f760c39a43cccea5565d85c3 (mode 644)
--- /dev/null
+++ perl103/arrayhash
+================================================================================
+
+ Arrays
+
+ An array is a list of scalars. The list can include numbers, strings,
+ references, and file handles. Arrays start with the sigil @. For example:
+
+my @langs = ("perl", "C", "ksh");
+
+ Here's the array @langs in table format:
+
+ Index | Value
+ ------+-------
+ 0 | "perl"
+ 1 | "C"
+ 2 | "ksh"
+
+ The first element in the array, "perl", has index 0. The second element
+ "C" has index 1, and the third element "ksh" has index 2. Notice that
+ the first element starts at index 0, not 1.
+
+ To get the first element "perl" in @langs, we write: $langs[0].
+ To get the second element "C" in @langs, we write: $langs[1].
+ To get the third element "ksh" in @langs, we write: $langs[2].
+
+ Notice that when we retrieve a scalar from an array, the sigil changes to $.
+ If we want to get the entire array, we use the sigil @: @langs.
+
+ To find the length of an array, use scalar(). scalar(@langs) is equal to 3.
+
+================================================================================
+
+ Push and Pop
+
+ push(@array, LIST) lets you add LIST to the end of @array.
+
+ my @feedURLs;
+ push(@feedURLs, "http://example.com/rss.xml");
+
+ We add the URL to the end of @feedURLs and increase its length by 1.
+
+ pop(@array, LIST) gives you the last element and removes it from @array.
+
+ my $url = pop(@feedURLs);
+ process($url);
+
+ We grab the last URL from @feedURLs, remove it from the array, and
+ then assign it to $url. Then, we process ($url).
+
+================================================================================
+
+ foreach Loops
+
+foreach my $lang (@langs) {
+ print "Learn $lang, ";
+}
+
+ The foreach loop will *iterate* through each element in the array.
+ In this loop, it will get each string in the array @langs, replace
+ $lang with the string, then print "Learn $lang, "
+
+ The above code will output: Learn perl, Learn C, Learn ksh,
+
+================================================================================
+
+ Hashes
+
+ A hash is like an array, except the index is called a key, and this key
+ is a string instead of a number.
+
+my %feedURLs = (
+ "undeadly" => "http://undeadly.org/cgi?action=rss",
+ "eff" => "https://www.eff.org/rss/updates.xml",
+ "hackernews" => "https://news.ycombinator.com/rss",
+);
+
+ Key | Value
+ -------------+-------------------------------------
+ "undeadly" | "http://undeadly.org/cgi?action=rss"
+ "eff" | "https://www.eff.org/rss/updates.xml"
+ "hackernews" | "https://news.ycombinator.com/rss"
+
+ A hash contains *key-value pairs* because each key stores a value.
+ A hash is sometimes called a dictionary in other languages, because
+ the key-value pairs are similar to how a dictionary contains
+ terms and their definitions.
+
+ Unlike an array, the keys of a hash are not numbers, so there is no real
+ order to the key-value pairs.
+
+ To refer to a hash itself, we use the sigil %. But if we lookup the
+ value of a key, we use a $ because we're referring to a scalar.
+ $feedURLs{undeadly} will give us the value of the key "undeadly"
+
+================================================================================
+
+ Dumping Data
+
+ When working with arrays and hashes, you may want to view the data stored
+ inside to help with debugging. We recommend using the module Data::Dumper
+ to dump the contents of arrays and hashes in a structured format:
+
+use Data::Dumper <data::Dumper>;
+
+ Any time you want to dump an array or hash, pass a reference to a
+ hash or array:
+
+warn Dumper \@array;
+warn Dumper \%feedURLs;
+
+ For example:
+
+warn Dumper \%feedURLs;
+
+$VAR1 = {
+ 'undeadly' => 'http://undeadly.org/cgi?action=rss',
+ 'eff' => 'https://www.eff.org/rss/updates.xml',
+ 'hackernews' => 'https://news.ycombinator.com/rss',
+}
+
+================================================================================
+
+ Hashes: Keys and Values
+
+ We use keys() to get a list of all the keys in a hash.
+ keys(%feedURLs) will give us an array with 3 elements:
+ ('undeadly', 'eff', 'hackernews')
+
+ Note: keys in the hash have no predictable order to them.
+
+ We use values() to get a list of all the values in a hash.
+ The values will match the same order as the keys. So
+ values(%feedURLs) will give us an array with 3 elements:
+ ('http://undeadly.org/cgi?action=rss',
+ 'https://www.eff.org/rss/updates.xml',
+ 'https://news.ycombinator.com/rss')
+
+================================================================================
+
+ News Bot
+
+ Open up ~/thirdbot and follow the instructions to set up your third bot.
+
+================================================================================
blob - /dev/null
blob + f764a4491f78799c9ac2cc232c90ecad33a93618 (mode 644)
--- /dev/null
+++ perl103/challenge
+================================================================================
+
+ Challenge
+
+ In this challenge, we will modify our original rssbot.pl to include 7
+ preloaded RSS feeds. For example, to get the headlines from the IRCNow
+ Almanack, the user would type: !ircnow
+
+ We also need to add the ability for the user to add and delete RSS feeds.
+ To add an RSS feed, a user can type !add name URL
+ To delete an RSS feed, a user can type !delete name URL
+
+ Finally, the old RSS bot displayed every single article in the RSS feed.
+ Some feeds can be very long with hundreds of articles in them. Let's
+ update the bot so it only displays 5 items at a time.
+
+================================================================================
+
+ Modifying rssbot.pl
+
+ We're going to change the name of RSSBot to NewsBot, so the filenames
+ will change from rssbot.pl to newsbot.pl.
+
+ Next, we're going to replace the scalar $url with the hash %feedURLs
+ so we can download from multiple RSS feeds:
+
+--- /home/perl103/rssbot.pl Tue Aug 31 04:59:42 2021
++++ /home/perl104/newsbot.pl Wed Sep 1 10:38:42 2021
+@@ -6,21 +6,66 @@
+ use base qw(Bot::BasicBot);
+ use XML::RSS::Parser;
+
+-my $url = 'https://wiki.ircnow.org/index.php?n=Site.AllRecentChanges?action=rss';
++my %feedURLs = (
++ "undeadly" => "http://undeadly.org/cgi?action=rss",
++ "eff" => "https://www.eff.org/rss/updates.xml",
++ "hackernews" => "https://news.ycombinator.com/rss",
++ "krebs" => "https://krebsonsecurity.com/feed",
++ "ircnow" => "https://wiki.ircnow.org/index.php?n=Site.AllRecentChanges?action=rss",
++ "schneier" => "https://www.schneier.com/blog/atom.xml",
++ "slashdot" => "http://rss.slashdot.org/Slashdot/slashdotMain",
++ "theregister" => "https://www.theregister.com/headlines.rss",
++);
+
+ The keys for %feedURLs are the names of the news sites, and the values
+ are the URLs of the RSS feeds.
+
+ Inside the subroutine said, we need to check for two new commands,
+ !add and !delete, plus the rss feed itself.
+
+ sub said {
+ my $self = shift;
+ my $arguments = shift;
+- if ($arguments->{body} =~ /^!rss/) {
++ if ($arguments->{body} =~ m{^!add\s+(\w+)\s+(https?://[[:print:]]+)$}) {
++ my ($name, $url) = ($1, $2);
++ $feedURLs{$name} = $url;
++ $self->say(
++ channel => $arguments->{channel},
++ body => "$name added.",
++ );
++ }
+
+ We first check to see if the user typed !add <name> <url>. Here, we use
+ perl regular expressions (regex for short) to see if the user typed in
+ a valid feed name and URL.
+
+ NOTE: It is very important to check that data is valid. If you don't,
+ it can become a source of security holes which attackers can use to
+ steal control of your program.
+
+ Let's take a closer look at the if condition:
+
++ if ($arguments->{body} =~ m{^!add\s+(\w+)\s+(https?://[[:print:]]+)$}) {
+
+ We check if the message $arguments->{body} fits the right format. It must
+ begin with the string !add, followed by one or more whitespace characters,
+ then http:// or https://, then one or more printing characters up to the
+ end of the string. The feed name is captured in $1 and the URL is captured
+ in $2.
+
+ If the IRC message matches our regex, we then store the name and URL as
+ a key-value pair in our hash %feedURLs, with the name as key and the URL
+ as value. We then send a message to the channel saying that $name has
+ been added.
+
+ In the next block, we check to see if the user typed
+ !delete <username> <email>
+
++ if ($arguments->{body} =~ m{^!delete\s+(\w+)$}) {
++ my $name = $1;
++ delete($feedURLs{$name});
++ $self->say(
++ channel => $arguments->{channel},
++ body => "$name deleted.",
++ );
++ }
+
+ If it matches our regular expression, we delete the key-value pair
+ from %feedURLs and then send a message to the channel.
+
+ Now, if a user sends any other command, we check to see if a key-value
+ pair is defined for the feed:
+
++ if ($arguments->{body} =~ /^!(\w+)$/) {
++ my $name = $1;
++ if (!exists($feedURLs{$name})) {
++ $self->say(
++ channel => $arguments->{channel},
++ body => "Error: $name has not been added",
++ );
++ return;
++ }
+
+ If none is defined, we send a message to the channel showing an
+ error.
+
+ If a URL is defined for the feed, then we create a new XML::RSS::Parser
+ object. We're going to replace the old foreach loop because the old
+ loop printed out every single item in an RSS feed. Some of the new feeds
+ we add have hundreds of articles; a for loop allows us to limit the
+ articles to 5 per feed.
+
+ my $p = XML::RSS::Parser->new;
++ my $url = $feedURLs{$name};
+ my $feed = $p->parse_uri($url);
+- foreach my $i ( $feed->query('//item') ) {
+- my $title = $i->query('title');
+- my $contributor = $i->query('dc:contributor');
+- my $link = $i->query('link');
+
+ In the code below, we first find the feed's title, then loop through
+ each item in the feed using a for loop. We start with index $i = 0 and
+ stop when we have printed all items or after we have finished 5, whichever
+ comes first. Each time through the loop, we increment (add one) to $i.
+
++ my $qtitle = $feed->query('/channel/title');
++ my $feed_title = $qtitle->text_content;
++ my @qitems = $feed->query('//item');
++ for (my $i = 0; $i < scalar(@qitems) && $i < 5; $i++) {
+
+ Inside the loop, we store the query for each into $qitem. We create
+ a hash called %item for each item, and we store the feed's title
+ and tags inside. If the tag is undefined, we store an empty string.
+
++ my $qitem = $qitems[$i];
++ my %item;
++ $item{feed_title} = $feed_title;
++ foreach my $tag (qw(title dc:contributor link comments)) {
++ my $qtag = $qitem->query($tag);
++ if(defined($qtag)) {
++ $item{$tag} = $qtag->text_content;
++ } else {
++ $item{$tag} = "";
++ }
++ }
+
+ We then send a message to the channel, properly formatted, with the feed's
+ title and the value of the tags for each item.
+
+ $self->say(
+ channel => $arguments->{channel},
+- body => $title->text_content.' - '.$contributor->text_content.': '.$link->text_content,
++ body => "[\002$item{feed_title}\002] $item{title} ($item{'dc:contributor'}) $item{link}: $item{comments}",
+ );
+ }
+ }
+
+ Many IRC clients will interpret \002 as a bold character.
+
+ (Hint: sample code is in /home/perl104/newsbot.pl)
+
+================================================================================
+
+ Username: perl104
+ Password: Hp9XsPhANc6
+ Server: freeirc.org
+ Port: 22
+
+================================================================================
blob - /dev/null
blob + fe4bf4e28ec03d1fcf10d9fa6ce0dcf8bf2bd2a7 (mode 644)
--- /dev/null
+++ perl103/chatbot.pl
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+package ChatBot;
+use base qw(Bot::BasicBot);
+use Lingua::EN::Tagger;
+
+my $logs;
+
+sub chanjoin {
+ my $self = shift;
+ my $arguments = shift;
+ my $nick = $arguments->{who};
+ if ($nick eq $self->pocoirc->nick_name()) {
+ return;
+ }
+ my @greetings = ("Hey there, $nick!",
+ "$nick, welcome!",
+ "sup $nick!",
+ "$nick, it's good to see you.",
+ "How can I help you, $nick?",
+ "Hey $nick, do you hang out here too?",
+ "Hiya $nick.");
+
+ $self->say(
+ channel => $arguments->{channel},
+ body => $greetings[int(rand(scalar(@greetings)))],
+ );
+}
+
+sub chanpart {
+ my $self = shift;
+ my $arguments = shift;
+ my $nick = $arguments->{who};
+ my @farewells = ("I'm sad to see $nick go",
+ "Oh, $nick left, I was just about to send a message.",
+ "I always seem to return just as $nick leaves.",
+ "I hope $nick will rejoin later.",
+ "I'm going to take a break too, brb.",
+ "See you later $nick. Oops, I was too late.");
+
+ $self->say(
+ channel => $arguments->{channel},
+ body => $farewells[int(rand(scalar(@farewells)))],
+ );
+}
+
+sub emoted {
+ my $self = shift;
+ my $arguments = shift;
+
+ $self->emote(
+ channel => $arguments->{channel},
+ body => "$arguments->{body} too",
+ );
+}
+
+sub noticed {
+ my $self = shift;
+ my $arguments = shift;
+
+ my $nick = $arguments->{who};
+
+ my @notices = (
+ "$nick, please resend this in a normal message",
+ "I'm having a hard time reading your notice.",
+ "Good point, $nick.",
+ "Can you message on the public channel instead?",
+ );
+
+ $self->notice(
+ who => $nick,
+ channel => $arguments->{channel},
+ body => $notices[int(rand(scalar(@notices)))],
+ );
+}
+
+sub topic {
+ my $self = shift;
+ my $arguments = shift;
+ my @replies = ("Nice",
+ "Hm, I liked the old topic better.",
+ "Please don't change the topic.",
+ "Good thinking.",
+ "That makes more sense.");
+
+ $self->say(
+ channel => $arguments->{channel},
+ body => $replies[int(rand(scalar(@replies)))],
+ );
+}
+
+sub said {
+ my $self = shift;
+ my $arguments = shift;
+
+ $logs .= "$arguments->{body}\n";
+ my $p = new Lingua::EN::Tagger;
+ my %word_freqs = $p->get_words($logs);
+ my $keyword;
+ my $total = 0;
+ foreach my $freq (keys %word_freqs) {
+ $total += $word_freqs{$freq};
+ $keyword = $freq if rand($total) < $word_freqs{$freq};
+ }
+ my @replies = ("I think you have a valid point about $keyword.",
+ "Hm, what do others think about $keyword?",
+ ucfirst $keyword." is not something I'm familiar with",
+ "Are you sure about $keyword?",
+ "Tell me more about $keyword.",
+ "What about $keyword?",
+ "Let's talk about something else besides $keyword.");
+ return $replies[int(rand(scalar(@replies)))];
+}
+package main;
+
+my $bot = ChatBot->new(
+ server => 'irc.example.com',
+ port => '6667',
+ channels => ['#perl102'],
+ nick => 'nickname',
+ name => 'username',
+);
+$bot->run();
blob - /dev/null
blob + ada71f109708c4c0b67cc697ae9d9a9ce75cf2a1 (mode 644)
--- /dev/null
+++ perl103/comments
+================================================================================
+
+ RSSBot Explained
+
+ News feeds are generally handled using RSS feeds. RSS is an open format that
+ allows websites to quickly show which articles have been updated recently.
+
+ To learn more about RSS, visit: https://rss.softwaregarden.com/aboutrss.html
+
+ In RSSBot, we use the XML::RSS::Parser module from CPAN:
+
+use XML::RSS::Parser;
+
+ Many of your favorite websites have RSS feeds. Use a search engine to find
+ them. In this example, we will use IRCNow's Almanack:
+
+my $url = 'https://wiki.ircnow.org/index.php?n=Site.AllRecentChanges?action=rss';
+
+ You can replace this URL with the RSS feed from your favorite website to
+ change the news that your bot displays.
+
+ We recommend you download an RSS feed and open it with a text editor to
+ see what the RSS format looks like. Here is one sample:
+
+<title>Ircnow / Servers</title>
+<link>https://wiki.ircnow.org/index.php?n=Ircnow.Servers</link>
+<dc:contributor>mkf</dc:contributor>
+<dc:date>2021-08-29T15:27:58Z</dc:date>
+<pubDate>Sun, 29 Aug 2021 15:27:58 GMT</pubDate>
+</item>
+<item>
+
+ Let's take a look at inside the subroutine said:
+
+sub said {
+ my $self = shift;
+ my $arguments = shift;
+ if ($arguments->{body} =~ /^!rss/) {
+ my $p = XML::RSS::Parser->new;
+ my $feed = $p->parse_uri($url);
+ foreach my $i ( $feed->query('//item') ) {
+ my $title = $i->query('title');
+ my $contributor = $i->query('dc:contributor');
+ my $link = $i->query('link');
+ $self->say(
+ channel => $arguments->{channel},
+ body => $title->text_content.' - '.$contributor->text_content.': '.$link->text_content,
+ );
+ }
+ }
+}
+
+ First, we check if a user types a message that begins with !rss
+
+ if ($arguments->{body} =~ /^!rss/) {
+
+ If the user does, then we create a new Parser object and assign this to $p:
+
+ my $p = XML::RSS::Parser->new;
+
+ Next, we parse (analyze) the feed using $p, and assign this to $feed:
+
+ my $feed = $p->parse_uri($url);
+
+ RSS feeds contain a list of news items, and we need to process each item
+ one at a time. For this task, we will use a foreach loop. We are going
+ to query (ask) $feed for all items, then use the foreach loop to iterate
+ through each item. We assign each item to $i.
+
+ foreach my $i ( $feed->query('//item') ) {
+
+ Next, we query $i to find the title, contributor, and link of each item.
+ We assign these values to $title, $contributor, and $link.
+
+ my $title = $i->query('title');
+ my $contributor = $i->query('dc:contributor');
+ my $link = $i->query('link');
+
+ For each item, we send a message to the channel with the title, contributor,
+ and link.
+
+ $self->say(
+ channel => $arguments->{channel},
+ body => $title->text_content.' - '.$contributor->text_content.': '.$link->text_content,
+ );
+
+================================================================================
+
+ Further Reading
+
+ XML::RSS::Parser module: https://metacpan.org/pod/XML::RSS::Parser
+
+================================================================================
+
+ Learn about Loops
+
+ View the file ~/control to learn about control structures for perl.
+
+================================================================================
blob - /dev/null
blob + b56dca87fcb3e7595832e305c6a0b1e58594687d (mode 644)
--- /dev/null
+++ perl103/control
+================================================================================
+
+ If, Else, Elsif
+
+ In perl, we can control how a program executes by using if, elsif, and else:
+
+if (CONDITION) {
+ STATEMENT;
+} elsif (CONDITION) {
+ STATEMENT;
+} else {
+ STATEMENT;
+}
+
+ If the first CONDITION is true, we execute the statements in the first block;
+ else (otherwise) if the second CONDITION is true, we execute the statements
+ in the second block; else we execute the statements in the last block.
+
+ NOTE: In many languages, the keyword is else if. In perl, however, it's elsif
+ (there is only one letter 'e').
+
+my @feeds;
+...
+if (scalar(@feeds) == 0) {
+ print "You have no feeds\n";
+} elsif (scalar(@feeds) < 10) {
+ print "You have ".scalar(@feeds)." feeds\n";
+} else {
+ print "You have too many feeds!\n";
+}
+
+ The code above first checks if scalar(@feeds) (the length of the array
+ @feeds) is equal to zero. If so, it says you have no feeds. Otherwise, it
+ checks if the length of the feeds is less than 10. If so, it reports the
+ number of feeds. Otherwise, it says you have too many feeds.
+
+================================================================================
+
+ Booleans
+
+ Perl is flexible about what it considers to be true or false. The empty
+ string "" and "0" are considered false. All other strings are true. The
+ number 0 is considered false; all other numbers are true. All references
+ are true; undef (for when a variable is undefined) is false.
+
+ This can help save some typing. For example:
+
+if (scalar(@feeds) == 0) {
+ print "You have no feeds\n";
+}
+
+ can now be rewritten as:
+
+if (scalar(@feeds)) {
+ print "You have no feeds\n";
+}
+
+================================================================================
+
+ Comparisons
+
+ Perl has different operators for comparing strings and numbers:
+
+ Comparison | String | Numeric
+ --------------+---------------+------------------
+ equal | eq | ==
+ --------------+---------------+------------------
+ not equal | ne | !=
+ --------------+---------------+------------------
+ less than | lt | <
+ --------------+---------------+------------------
+ greater than | gt | >
+ --------------+---------------+------------------
+ less than or | le | <=
+ equal to | |
+ --------------+---------------+------------------
+ greater than | ge | >=
+ or equal to | |
+ --------------+---------------+------------------
+ comparison | cmp | <=>
+
+ For example, if you want to compare if two strings are equal:
+
+if ($arguments->{who} eq "nickname") {
+ ...
+}
+
+ This checks if the sender's nick is the same as "nickname". If you want
+ to compare if two numbers are equal:
+
+if ($arguments->{who} eq "nickname") {
+ ...
+}
+
+ The spaceship operator <=> and cmp compares the first scalar to the second.
+ -1 is returned if the first is less than the second, 0 if they are equal,
+ and +1 is the first is greater than the second:
+
+ print $x <=> $y;
+
+ This prints -1 if $x < $y, 0 if $x == $y, and 1 if $x > $y.
+
+ WARNING: Make sure to use the correct operator for strings and numbers.
+ "6" < "1337" is true because the number 6 is less than the number 1337,
+ but "6" lt "1337" is false because the string "1337" comes before "6"
+ when sorted alphabetically. (It's the same reason why the word "bot" comes
+ before the word "computer" in the dictionary.)
+
+================================================================================
+
+ Logical Operators
+
+ Operator | Operator | Meaning
+ --------------+--------------+-------------------------------------------
+ && | and | True if both operands are true,
+ | | false otherwise
+ --------------+--------------+-------------------------------------------
+ || | or | True if either operand is true,
+ | | false otherwise
+ --------------+--------------+-------------------------------------------
+ ! | not | False if operand is true,
+ | | true if operand is false
+ --------------+--------------+-------------------------------------------
+ | xor | True if the first or second operand is
+ | | true, false otherwise
+
+ We can use the || or operator for providing default values:
+
+ $var ||= 1;
+
+ This means the same as:
+
+ $var = $var || 1;
+
+ If $var is not defined, then $var is false, and undef || 1 will
+ return the second value, 1. So $var gets the default value of 1
+ if it is undefined.
+
+================================================================================
+
+ While, Do
+
+ In a while loop, perl checks if CONDITION is true; if so, it executes
+ STATEMENT, then repeats the loop again. If CONDITION is false, it leaves
+ the loop.
+
+while (CONDITION) {
+ STATEMENT;
+}
+
+ Here's a sample while loop:
+
+while (scalar(@feedURLs)) {
+ my $url = pop(@feedURLs);
+ process($url);
+}
+
+ While there are still urls remaining, we pop the last url from
+ @feedURLs, remove it from the array, and process it.
+
+================================================================================
+
+ For Loop
+
+for (INITIALIZE; CONDITION; STEP) {
+ STATEMENT;
+}
+
+ INITIALIZE is executed only once at the beginning.
+
+ Next, CONDITION is checked. If CONDITION is false, the loop is finished.
+ If CONDITION is true, then STATEMENT is executed, and then STEP.
+ Then the loop repeats itself.
+
+for (my $i = 0; $i < scalar(@nicks); $i++) {
+ $self->say(
+ channel => "#perl103"
+ body => "Hi, $nick[$i]";
+ );
+}
+
+ In this code, we first run INITIALIZE: set $i to zero. Then, we check
+ CONDITION: is $i less than the length of the array @nicks? If true,
+ we execute STATEMENT. If not, the loop is finished.
+
+ For STATEMENT, we send a message to the channel #perl103 and say hi to
+ $nick[$i], the nick at index $i in the array. If $i = 0, then we say hi
+ to $nick[0], the first nick. If $i = 1, then we say hi to $nick[1],
+ the second nick.
+
+ In other words, this loop sends a hello message to channel #perl103 to
+ every nick in the array @nicks.
+
+================================================================================
+
+ Challenge
+
+ View the file ~/challenge to finish the lesson.
+
+================================================================================
blob - /dev/null
blob + aff468222066f60de6ccae36e42b8cb204163443 (mode 644)
--- /dev/null
+++ perl103/perl103
+
+ Perl 103: RSS Reader
+
+ Open ~/arrayhash to begin
+ =--_
+ .-""""""-. |* _)
+ / \ / /
+ / \_/ /
+ _ /| /
+ _-'"/\ / | ____ _.-" _
+ _-' ( '-_ _ ( \ |\ /\ || .-'".".
+_.-' '. `'-._ .-'"/'. " | |/ / | |/ _-" ( '-_
+ '. _-" ( '-_ \ | / \ | _.-' ) "-._
+ _.' _.-' ) "-._ ||\\ |\\ '"' .-'
+ ' .-' `' || \\ ||))
+jjs__ _ ___ _ ____________ _____ ___ _|\ _|\_|\\/ _______________ ___ _
+ c c " c C ""C " "" "" ""
+ c C
+ C C
+ C
+ C c
+ https://asciiart.website/index.php?art=animals/camels
blob - /dev/null
blob + 3ccece1f5122ba34458aea729e41446fc249f589 (mode 644)
--- /dev/null
+++ perl103/regex
+ 20 Regular Expressions
+
+Regular expressions are the text processing workhorse of perl. With
+regular expressions, you can search strings for patterns, find out what
+matched the patterns, and substitute the matched patterns with new strings.
+
+
+There are three different regular expression operators in perl:
+
+1.match m{PATTERN}
+
+2.substitute s{OLDPATTERN}{NEWPATTERN}
+
+3.transliterate tr{OLD_CHAR_SET}{NEW_CHAR_SET}
+
+
+Perl allows any delimiter in these operators, such as {} or () or // or
+## or just about any character you wish to use. The most common
+delimiter used is probably the m// and s/// delimiters, but I prefer to
+use m{} and s{}{} because they are clearer for me. There are two ways to
+"bind" these operators to a string expression:
+
+
+1.=~ pattern does match string expression
+
+2.!~ pattern does NOT match string expression
+
+
+Binding can be thought of as "Object Oriented Programming" for regular
+expressions. Generic OOP structure can be represented as
+
+
+$subject -> verb ( adjectives, adverbs, etc );
+
+
+Binding in Regular Expressions can be looked at in a similar fashion:
+
+
+$string =~ verb ( pattern );
+
+
+where "verb" is limited to 'm' for match, 's' for substitution, and 'tr'
+for translate. You may see perl code that simply looks like this:
+
+
+/patt/;
+
+
+This is functionally equivalent to this:
+
+
+$_ =~ m/patt/;
+
+
+
+Here are some examples:
+
+
+# spam filter
+
+my $email = "This is a great Free Offer\n";
+
+if($email =~ m{Free Offer})
+
+{$email="*deleted spam*\n"; }
+
+print "$email\n";
+
+
+# upgrade my car
+
+my $car = "my car is a toyota\n";
+
+
+$car =~ s{toyota}{jaguar};
+
+print "$car\n";
+
+
+# simple encryption, Caesar cypher
+
+my $love_letter = "How I love thee.\n";
+
+$love_letter =~ tr{A-Za-z}{N-ZA-Mn-za-m};
+
+print "encrypted: $love_letter";
+
+
+$love_letter =~ tr{A-Za-z}{N-ZA-Mn-za-m};
+
+print "decrypted: $love_letter\n";
+
+
+> *deleted spam*
+
+> my car is a jaguar
+
+> encrypted: Ubj V ybir gurr.
+
+
+> decrypted: How I love thee.
+
+
+The above examples all look for fixed patterns within the string.
+Regular expressions also allow you to look for patterns with different
+types of "wildcards".
+
+
+ 20.1 Variable Interpolation
+
+The braces that surround the pattern act as double-quote marks,
+subjecting the pattern to one pass of variable interpolation as if the
+pattern were contained in double-quotes. This allows the pattern to be
+contained within variables and interpolated during the regular expression.
+
+
+my $actual = "Toyota";
+
+my $wanted = "Jaguar";
+
+my $car = "My car is a Toyota\n";
+
+$car =~ s{$actual}{$wanted};
+
+print $car;
+
+
+> My car is a Jaguar
+
+
+ 20.2 Wildcard Example
+
+In the example below, we process an array of lines, each containing the
+pattern {filename: } followed by one or more non-whitespace characters
+forming the actual filename. Each line also contains the pattern {size:
+} followed by one or more digits that indicate the actual size of that
+file.
+
+
+my @lines = split "\n", <<"MARKER"
+
+filename: output.txt size: 1024
+
+filename: input.dat size: 512
+
+filename: address.db size: 1048576
+
+MARKER
+
+;
+
+foreach my $line (@lines) {
+
+####################################
+
+# \S is a wildcard meaning
+
+# "anything that is not white-space".
+
+# the "+" means "one or more"
+
+####################################
+
+if($line =~ m{filename: (\S+)}) {
+
+my $name = $1;
+
+###########################
+
+# \d is a wildcard meaning
+
+# "any digit, 0-9".
+
+###########################
+
+
+$line =~ m{size: (\d+)};
+
+my $size = $1;
+
+print "$name,$size\n";
+
+}
+
+}
+
+> output.txt,1024
+
+> input.dat,512
+
+> address.db,1048576
+
+
+ 20.3 Defining a Pattern
+
+A pattern can be a literal pattern such as {Free Offer}. It can contain
+wildcards such as {\d}. It can also contain metacharacters such as the
+parenthesis. Notice in the above example, the parenthesis were in the
+pattern but did not occur in the string, yet the pattern matched.
+
+
+
+ 20.4 Metacharacters
+
+Metacharacters do not get interpreted as literal characters. Instead
+they tell perl to interpret the metacharacter (and sometimes the
+characters around metacharacter) in a different way. The following are
+metacharacters in perl regular expression patterns:
+
+
+\ | ( ) [ ] { } ^ $ * + ? .
+
+
+\
+
+
+
+(backslash) if next character combined with this backslash forms a
+character class shortcut, then match that character class. If not a
+shortcut, then simply treat next character as a non-metacharacter.
+
+|
+
+
+
+alternation: (patt1 | patt2) means (patt1 OR patt2)
+
+
+( )
+
+
+
+grouping (clustering) and capturing
+
+(?: )
+
+
+
+grouping (clustering) only. no capturing. (somewhat faster)
+
+.
+
+
+
+match any single character (usually not "\n")
+
+[ ]
+
+
+
+define a character class, match any single character in class
+
+
+*
+
+
+
+(quantifier): match previous item zero or more times
+
++
+
+
+
+(quantifier): match previous item one or more times
+
+?
+
+
+
+(quantifier): match previous item zero or one time
+
+{ }
+
+
+
+(quantifier): match previous item a number of times in given range
+
+^
+
+
+
+
+(position marker): beginning of string (or possibly after "\n")
+
+$
+
+
+
+(position marker): end of string (or possibly before "\n")
+
+
+
+
+Examples below. Change the value assigned to $str and re-run the script.
+Experiment with what matches and what does not match the different
+regular expression patterns.
+
+
+my $str = "Dear sir, hello and goodday! "
+
+." dogs and cats and sssnakes put me to sleep."
+
+." zzzz. Hummingbirds are ffffast. "
+
+
+." Sincerely, John";
+
+
+# | alternation
+
+# match "hello" or "goodbye"
+
+if($str =~ m{hello|goodbye}){warn "alt";}
+
+
+# () grouping and capturing
+
+# match 'goodday' or 'goodbye'
+
+if($str =~ m{(good(day|bye))})
+
+{warn "group matched, captured '$1'";}
+
+
+# . any single character
+
+# match 'cat' 'cbt' 'cct' 'c%t' 'c+t' 'c?t' ...
+
+if($str =~ m{c.t}){warn "period";}
+
+
+
+# [] define a character class: 'a' or 'o' or 'u'
+
+# match 'cat' 'cot' 'cut'
+
+if($str =~ m{c[aou]t}){warn "class";}
+
+
+# * quantifier, match previous item zero or more
+
+# match '' or 'z' or 'zz' or 'zzz' or 'zzzzzzzz'
+
+if($str =~ m{z*}){warn "asterisk";}
+
+
+# + quantifier, match previous item one or more
+
+# match 'snake' 'ssnake' 'sssssssnake'
+
+if($str =~ m{s+nake}){warn "plus sign";}
+
+
+# ? quantifier, previous item is optional
+
+# match only 'dog' and 'dogs'
+
+
+if($str =~ m{dogs?}){warn "question";}
+
+
+# {} quantifier, match previous, 3 <= qty <= 5
+
+# match only 'fffast', 'ffffast', and 'fffffast'
+
+if($str =~ m{f{3,5}ast}){warn "curly brace";}
+
+
+# ^ position marker, matches beginning of string
+
+# match 'Dear' only if it occurs at start of string
+
+if($str =~ m{^Dear}){warn "caret";}
+
+
+# $ position marker, matches end of string
+
+# match 'John' only if it occurs at end of string
+
+if($str =~ m{John$}){warn "dollar";}
+
+
+> alt at ...
+
+> group matched, captured 'goodday' at ...
+
+> period at ...
+
+> class at ...
+
+> asterisk at ...
+
+> plus sign at ...
+
+> question at ...
+
+> curly brace at ...
+
+> caret at ...
+
+> dollar at ...
+
+
+ 20.5 Capturing and Clustering Parenthesis
+
+Normal parentheses will both cluster and capture the pattern they
+contain. Clustering affects the order of evaluation similar to the way
+parentheses affect the order of evaluation within a mathematical
+expression. Normally, multiplication has a higher precedence than
+addition. The expression "2 + 3 * 4" does the multiplication first and
+then the addition, yielding the result of "14". The expression "(2 + 3)
+* 4" forces the addition to occur first, yielding the result of "20".
+
+
+Clustering parentheses work in the same fashion. The pattern {cats?}
+will apply the "?" quantifier to the letter "s", matching either "cat"
+or "cats". The pattern {(cats)?} will apply the "?" quantifier to the
+entire pattern within the parentheses, matching "cats" or null string.
+
+
+ 20.5.1 $1, $2, $3, etc Capturing parentheses
+
+Clustering parentheses will also Capture the part of the string that
+matched the pattern within parentheses. The captured values are
+accessible through some "magical" variables called $1, $2, $3, ... Each
+left parenthesis increments the number used to access the captured
+string. The left parenthesis are counted from left to right as they
+occur within the pattern, starting at 1.
+
+
+
+my $test="Firstname: John Lastname: Smith";
+
+############################################
+
+# $1 $2
+
+$test=~m{Firstname: (\w+) Lastname: (\w+)};
+
+my $first = $1;
+
+my $last = $2;
+
+print "Hello, $first $last\n";
+
+
+> Hello, John Smith
+
+
+
+
+Because capturing takes a little extra time to store the captured result
+into the $1, $2, <85> variables, sometimes you just want to cluster without
+the overhead of capturing. In the below example, we want to cluster
+"day|bye" so that the alternation symbol "|" will go with "day" or
+"bye". Without the clustering parenthesis, the pattern would match
+"goodday" or "bye", rather than "goodday" or "goodbye". The pattern
+contains capturing parens around the entire pattern, so we do not need
+to capture the "day|bye" part of the pattern, therefore we use
+cluster-only parentheses.
+
+
+if($str =~ m{(good(?:day|bye))})
+
+{warn "group matched, captured '$1'";}
+
+
+
+Cluster-only parenthesis don't capture the enclosed pattern, and they
+don't count when determining which magic variable, $1, $2, $3 ..., will
+contain the values from the
+
+capturing parentheses.
+
+
+my $test = 'goodday John';
+
+##########################################
+
+# $1 $2
+
+if($test =~ m{(good(?:day|bye)) (\w+)})
+
+{ print "You said $1 to $2\n"; }
+
+
+> You said goodday to John
+
+
+ 20.5.2 Capturing parentheses not capturing
+
+If a regular expression containing capturing parentheses does not match
+the string, the magic variables $1, $2, $3, etc will retain whatever
+PREVIOUS value they had from any PREVIOUS regular expression. This means
+that you MUST check to make sure the regular expression matches BEFORE
+you use the $1, $2, $3, etc variables.
+
+
+
+In the example below, the second regular expression does not match,
+therefore $1 retains its old value of 'be'. Instead of printing out
+something like "Name is Horatio" or "Name is" and failing on an
+undefined value, perl instead keeps the old value for $1 and prints
+"Name is 'be'", instead.
+
+
+my $string1 = 'To be, or not to be';
+
+$string1 =~ m{not to (\w+)}; # matches, $1='be'
+
+warn "The question is to $1";
+
+
+my $string2 = 'that is the question';
+
+$string2 =~ m{I knew him once, (\w+)}; # no match
+
+warn "Name is '$1'";
+
+# no match, so $1 retains its old value 'be'
+
+
+> The question is to be at ./script.pl line 7.
+
+
+> Name is 'be' at ./script.pl line 11.
+
+
+ 20.6 Character Classes
+
+The "." metacharacter will match any single character. This is
+equivalent to a character class that includes every possible character.
+You can easily define smaller character classes of your own using the
+square brackets []. Whatever characters are listed within the square
+brackets are part of that character class. Perl will then match any one
+character within that class.
+
+
+[aeiouAEIOU] any vowel
+
+[0123456789] any digit
+
+
+ 20.6.1 Metacharacters Within Character Classes
+
+Within the square brackets used to define a character class, all
+previously defined metacharacters cease to act as metacharacters and are
+interpreted as simple literal characters. Characters classes have their
+own special metacharacters.
+
+ \
+
+
+
+ (backslash) demeta the next character
+
+ -
+
+
+
+ (hyphen) Indicates a consecutive character range, inclusively.
+
+ [a-f] indicates the letters a,b,c,d,e,f.
+
+ Character ranges are based off of ASCII numeric values.
+
+ ^
+
+
+
+ If it is the first character of the class, then this indicates the class
+
+ is any character EXCEPT the ones in the square brackets.
+
+ Warning: [^aeiou] means anything but a lower case vowel. This
+
+
+ is not the same as "any consonant". The class [^aeiou] will
+
+ match punctuation, numbers, and unicode characters.
+
+
+ 20.7 Shortcut Character Classes
+
+Perl has shortcut character classes for some more common classes.
+
+
+ /*shortcut*/
+
+
+
+ /*class*/
+
+
+
+ /*description*/
+
+ \d
+
+
+
+ [0-9]
+
+
+
+ any *d*igit
+
+ \D
+
+
+
+ [^0-9]
+
+
+
+ any NON-digit
+
+ \s
+
+
+
+ [ \t\n\r\f]
+
+
+
+ any white*s*pace
+
+
+ \S
+
+
+
+ [^ \t\n\r\f]
+
+
+
+ any NON-whitespace
+
+ \w
+
+
+
+ [a-zA-Z0-9_]
+
+
+
+ any *w*ord character (valid perl identifier)
+
+ \W
+
+
+ [^a-zA-Z0-9_]
+
+
+
+ any NON-word character
+
+
+ 20.8 Greedy (Maximal) Quantifiers
+
+Quantifiers are used within regular expressions to indicate how many
+times the previous item occurs within the pattern. By default,
+quantifiers are "greedy" or "maximal", meaning that they will match as
+many characters as possible and still be true.
+
+
+ *
+
+
+
+ match zero or more times (match as much as possible)
+
+ +
+
+
+
+
+ match one or more times (match as much as possible)
+
+ ?
+
+
+
+ match zero or one times (match as much as possible)
+
+ {count}
+
+
+
+ match exactly "count" times
+
+ {min, }
+
+
+
+ match at least "min" times (match as much as possible)
+
+ {min,max}
+
+
+
+ match at least "min" and at most "max" times
+
+ *(match as much as possible)*
+
+
+
+ 20.10 Position Assertions / Position Anchors
+
+Inside a regular expression pattern, some symbols do not translate into
+a character or character class. Instead, they translate into a
+"position" within the string. If a position anchor occurs within a
+pattern, the pattern before and after that anchor must occur within a
+certain position within the string.
+
+
+ ^
+
+
+
+ Matches the beginning of the string.
+
+ If the /m (multiline) modifier is present, matches "\n" also.
+
+ $
+
+
+
+ Matches the end of the string.
+
+ If the /m (multiline) modifier is present, matches "\n" also.
+
+ \A
+
+
+
+ Match the beginning of string only. Not affected by /m modifier.
+
+ \z
+
+
+
+ Match the end of string only. Not affected by /m modifier.
+
+ \Z
+
+
+
+ Matches the end of the string only, but will chomp() a "\n" if that
+
+ was the last character in string.
+
+ \b
+
+ word "b"oundary
+
+ A word boundary occurs in four places.
+
+ 1) at a transition from a \w character to a \W character
+
+ 2) at a transition from a \W character to a \w character
+
+ 3) at the beginning of the string
+
+ 4) at the end of the string
+
+ \B
+
+
+
+ NOT \b
+
+ \G
+
+
+ usually used with /g modifier (probably want /c modifier too).
+
+ Indicates the position after the character of the last pattern match
+ performed on the string. If this is the first regular expression begin
+
+ performed on the string then \G will match the beginning of the
+
+ string. Use the pos() function to get and set the current \G position
+
+ within the string.
+
+
+ 20.10.1 The \b Anchor
+
+Use the \b anchor when you want to match a whole word pattern but not
+part of a word. This example matches "jump" but not "jumprope":
+
+
+my $test1='He can jump very high.';
+
+if($test1=~m{\bjump\b})
+
+{ print "test1 matches\n"; }
+
blob - /dev/null
blob + f1108d714553a58612e97e9d497b4fb683ed6bcd (mode 644)
--- /dev/null
+++ perl103/rssbot.pl
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+package RSSBot;
+use base qw(Bot::BasicBot);
+use XML::RSS::Parser;
+
+my $url = 'https://wiki.ircnow.org/index.php?n=Site.AllRecentChanges?action=rss';
+
+sub said {
+ my $self = shift;
+ my $arguments = shift;
+ if ($arguments->{body} =~ /^!rss/) {
+ my $p = XML::RSS::Parser->new;
+ my $feed = $p->parse_uri($url);
+ foreach my $i ( $feed->query('//item') ) {
+ my $title = $i->query('title');
+ my $contributor = $i->query('dc:contributor');
+ my $link = $i->query('link');
+ $self->say(
+ channel => $arguments->{channel},
+ body => $title->text_content.' - '.$contributor->text_content.': '.$link->text_content,
+ );
+ }
+ }
+}
+
+package main;
+
+my $bot = RSSBot->new(
+ server => 'irc.example.com',
+ port => '6667',
+ channels => ['#perl103'],
+ nick => 'nickname',
+ name => 'username',
+);
+$bot->run();
blob - /dev/null
blob + 4f0f257e4825072efe37d6d15c04e2ef64f58b88 (mode 644)
--- /dev/null
+++ perl103/thirdbot
+================================================================================
+
+ Creating a News Bot
+
+ In our third lesson, we'll create an IRC bot that reads the news.
+
+ Copy the code for rssbot.pl to your home folder:
+
+ $ cp rssbot.pl ~/rssbot.pl
+
+ Next, open up rssbot.pl using a text editor and make a few changes.
+
+ 1. Edit the server in line 32. Replace irc.example.com with the server's
+ real address. NOTE: Only IPv4 is supported.
+ 2. Edit line 35 to replace nickname with the nickname you want for the bot.
+ WARNING: The nickname must not already be taken, or else the bot will
+ fail to connect.
+ 3. Edit line 36 to replace username with the username you want for the bot.
+ The username is what appears in a /whois on IRC; it can be different
+ from the nickname.
+
+ Next, you'll want to make the perl script executable:
+
+ $ chmod u+x ~/rssbot.pl
+
+ Then run the script:
+
+ $ perl ~/rssbot.pl
+
+ On IRC, /join #perl103
+
+ Type !rss and the bot will show you the latest updates to the
+ IRCNow Almanack.
+
+================================================================================
+
+ Understanding RSSBot
+
+ Next, take a look at the file called ~/comments to see an explanation of
+ key lines in the program RSSBot.
+
+================================================================================
blob - /dev/null
blob + 2f7b5bcbad101e944a39a3e314741ab3dc0d02b6 (mode 644)
--- /dev/null
+++ perl104/.Xdefaults
+! $OpenBSD: dot.Xdefaults,v 1.3 2014/07/10 10:22:59 jasper Exp $
+XTerm*loginShell:true
blob - /dev/null
blob + 5a4d9aef3ea0d37c8873ef1a9acea1705f1c61e5 (mode 644)
--- /dev/null
+++ perl104/.cshrc
+# $OpenBSD: dot.cshrc,v 1.10 2020/01/24 02:09:51 okan Exp $
+#
+# csh initialization
+
+alias df df -k
+alias du du -k
+alias f finger
+alias h 'history -r | more'
+alias j jobs -l
+alias la ls -a
+alias lf ls -FA
+alias ll ls -lsA
+alias tset 'set noglob histchars=""; eval `\tset -s \!*`; unset noglob histchars'
+alias z suspend
+
+set path = (~/bin /bin /sbin /usr/{bin,sbin,X11R6/bin,local/bin,local/sbin,games})
+
+if ($?prompt) then
+ # An interactive shell -- set some stuff up
+ set filec
+ set history = 1000
+ set ignoreeof
+ set mail = (/var/mail/$USER)
+ set mch = `hostname -s`
+ alias prompt 'set prompt = "$mch:q"":$cwd:t {\!} "'
+ alias cd 'cd \!*; prompt'
+ alias chdir 'cd \!*; prompt'
+ alias popd 'popd \!*; prompt'
+ alias pushd 'pushd \!*; prompt'
+ cd .
+ umask 22
+endif
blob - /dev/null
blob + 2266a4a05265e9993ed8503d80d0544c0c07fe6a (mode 644)
--- /dev/null
+++ perl104/.cvsrc
+# $OpenBSD: dot.cvsrc,v 1.3 2016/10/31 20:50:11 tb Exp $
+#
+diff -uNp
+update -Pd
+checkout -P
+rdiff -u
blob - /dev/null
blob + 1087d67d3f660d5ba8b9e03f23ea048ffcbe56a2 (mode 644)
--- /dev/null
+++ perl104/.login
+# $OpenBSD: dot.login,v 1.6 2015/12/15 16:37:58 deraadt Exp $
+#
+# csh login file
+
+if ( ! $?TERMCAP ) then
+ if ( $?XTERM_VERSION ) then
+ tset -IQ '-munknown:?vt220' $TERM
+ else
+ tset -Q '-munknown:?vt220' $TERM
+ endif
+endif
+
+stty newcrt crterase
+
+set savehist=100
+set ignoreeof
+
+setenv EXINIT 'set ai sm noeb'
+
+if (-x /usr/games/fortune) /usr/games/fortune
blob - /dev/null
blob + d052b599855ffef8527c486df620a73b604914b8 (mode 644)
--- /dev/null
+++ perl104/.mailrc
+# $OpenBSD: dot.mailrc,v 1.3 2014/07/10 11:18:23 jasper Exp $
+set ask
+set crt
+ignore message-id received date fcc status resent-date resent-message-id resent-from in-reply-to
blob - /dev/null
blob + 54b76518023d70efad37a53081563ed222b0da73 (mode 644)
--- /dev/null
+++ perl104/.profile
+# $OpenBSD: dot.profile,v 1.7 2020/01/24 02:09:51 okan Exp $
+#
+# sh/ksh initialization
+
+PATH=$HOME/bin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/X11R6/bin:/usr/local/bin:/usr/local/sbin:/usr/games
+export PATH HOME TERM
blob - /dev/null
blob + e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 (mode 644)
blob - /dev/null
blob + fc2d8825eb2d1e85e2ed30163d58719cc19965ab (mode 644)
--- /dev/null
+++ perl104/comments
+================================================================================
+
+ Log Bot Explained
+
+ logbot.pl joins a channel and then logs activity to logbot.log:
+
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+open(my $fh, ">>logbot.log") or die "Unable to write to logbot.log";
+select((select($fh), $|=1)[0]);
+
+ open() attempts to append to logbot.log (>> for append, > for write).
+ We append because we want to add new logs to the end of the file, not
+ overwrite an existing file.
+
+ If open succeeds, the filehandle will be assigned to $fh.
+ If open() fails, it returns false, which means that perl to immediately
+ quit with the message "Unable to write to logbot.log".
+
+package LogBot;
+use base qw(Bot::BasicBot);
+
+sub date {
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
+ my $localtime = sprintf("%04d%02d%02d %02d:%02d", $year+1900, $mon+1, $mday, $hour, $min);
+ return $localtime;
+}
+
+ We define the subroutine date(). WHen it is called, it returns the date and time
+ as a string in YYYYMMDD HH:MM format, where YYYY is the year, MM is the month,
+ DD is the day, HH is the hour, and MM is the minute.
+
+ If someone sends a message, we append this to the end of the log:
+
+sub said {
+ my $self = shift;
+ my $arguments = shift;
+ print $fh date()." <$arguments->{who}> $arguments->{body}\n";
+ return;
+}
+
+ To append, we simply print a string to $fh. The string starts with
+ the date and time, followed by the nickname of the sender of the message,
+ then the message itself.
+
+ Emotes and notices are also appended with the date and time, nickname, and
+ message.
+
+sub emoted {
+ my $self = shift;
+ my $arguments = shift;
+ print $fh date()." *$arguments->{who} $arguments->{body}\n";
+ return;
+}
+
+sub noticed {
+ my $self = shift;
+ my $arguments = shift;
+ print $fh date()." [$arguments->{who} notice]: $arguments->{body}\n";
+ return;
+}
+
+ If a user joins or parts a channel, we record their full hostmask (rather
+ than just the nickname) using $arguments->{raw_nick}:
+
+sub chanjoin {
+ my $self = shift;
+ my $arguments = shift;
+ print $fh date()." -!- $arguments->{raw_nick} has joined $arguments->{channel}\n";
+ return;
+}
+
+sub chanpart {
+ my $self = shift;
+ my $arguments = shift;
+ print $fh date()." -!- $arguments->{raw_nick} has left $arguments->{channel} $arguments->{body}\n";
+ return;
+}
+
+ If the topic is changed, we first check if the sender's nickname is defined.
+ If so, we log the nickname, channel, and topic:
+
+sub topic {
+ my $self = shift;
+ my $arguments = shift;
+ my $who = $arguments->{who};
+ if (defined($who)) {
+ print $fh date()." -!- $who changed the topic of $arguments->{channel} to: $arguments->{topic}\n";
+ }
+ return;
+}
+
+ If the user changes nicks, we log both the old and new nick:
+
+sub nickchange {
+ my $self = shift;
+ my $oldnick = shift;
+ my $newnick = shift;
+ print $fh "$oldnick is now known as $newnick\n";
+ return;
+}
+
+ Mode changes are a bit more complex to log because each mode change can
+ have multiple operands. For example, a channel op can op two users with one
+ command.
+
+ First, we check if the mode change came from a channel ($chan ne "msg"). Then,
+ we check to make sure there is at least one operand. If so, we append the date,
+ the changer's nick, the changes, and the operands. We use join(", ", @$operands)
+ to join all the operands together.
+
+sub mode_change {
+ my $self = shift;
+ my $arguments = shift;
+ my $chan = $arguments->{channel};
+ my $operands = $arguments->{mode_operands};
+ if (defined($chan) && $chan ne "msg" && scalar(@$operands)) {
+ print $fh date()." -!- mode/$chan $arguments->{who} [$arguments->{mode_changes}] ".join(", ", @$operands)."\n";
+ }
+ return;
+}
+
+ Finally, we log when a user is kicked or quits:
+
+sub kicked {
+ my $self = shift;
+ my $arguments = shift;
+ print $fh date()." -!- $arguments->{who} kicks $arguments->{kicked} [$arguments->{reason}]\n";
+}
+
+sub userquit {
+ my $self = shift;
+ my $arguments = shift;
+ print $fh " -!- $arguments->{raw_nick} quits [$arguments->{body}]\n";
+}
+
+package main;
+
+my $bot = LogBot->new(
+ server => 'irc.example.com',
+ port => '6667',
+ channels => ['#perl104'],
+ nick => 'nickname',
+ name => 'username',
+);
+
+ Because we opened a file descriptor, we also need to close it once we're
+ done with the program. To do this, we assign a subroutine to $SIG{INT}.
+ This subroutine will get called whenever the bot receives an INTerrupt
+ signal (ctrl+c). Inside the subroutine, we close the filehandle $fh
+ and then shut down the bot.
+
+local $SIG{INT} = sub {
+ close($fh);
+ print "Quitting program...\n";
+ $bot->shutdown("Quitting...");
+};
+
+$bot->run();
+
+================================================================================
+
+ Further Reading
+
+ XML::RSS::Parser module: https://metacpan.org/pod/XML::RSS::Parser
+
+================================================================================
+
+ Learn about Loops
+
+ View the file ~/control to learn about control structures for perl.
+
+================================================================================
blob - /dev/null
blob + ebb57c6f17e78418a6b9a7ec9ea18acc1cef920a (mode 644)
--- /dev/null
+++ perl104/each
+================================================================================
+
+ Each
+
+ each() lets you iterate through each key-value pair in a hash:
+
+my % = (
+
+);
+my %pets = (
+
+fish=>3,
+
+cats=>2,
+
+dogs=>1,
+
+);
+
+while(my($pet,$qty)=each(%pets)) {
+
+print "pet='$pet', qty='$qty'\n";
+
+}
+
+
+> pet='cats', qty='2'
+
+> pet='dogs', qty='1'
+
+> pet='fish', qty='3'
+
+
+Every call to each() returns the next key/value pair in the hash. After
+the last key/value pair is returned, the next call to each() will return
+an empty list, which is boolean false. This is how the while loop is
+able to loop through each key/value and then exit when done.
+
+
+Every hash has one "each iterator" attached to it. This iterator is used
+by perl to remember where it is in the hash for the next call to each().
+
+Calling keys() on the hash will reset the iterator. The list returned by
+keys() can be discarded.
+
+
+keys(%hash);
+
+
+Do not add keys while iterating a hash with each().
+
+
+You can delete keys while iterating a hash with each().
+
+
+The each() function does not have to be used inside a while loop. This
+example uses a subroutine to call each() once and print out the result.
+The subroutine is called multiple times without using a while() loop.
+
+Calling keys() on the hash will reset the iterator. The list returned by
+keys() can be discarded.
+
+
+keys(%hash);
+
+
+Do not add keys while iterating a hash with each().
+
+
+You can delete keys while iterating a hash with each().
+
+
+The each() function does not have to be used inside a while loop. This
+example uses a subroutine to call each() once and print out the result.
+The subroutine is called multiple times without using a while() loop.
+
+my %pets = (
+
+fish=>3,
+
+cats=>2,
+
+dogs=>1,
+
+);
+
+
+sub one_time {
+
+my($pet,$qty)=each(%pets);
+
+# if key is not defined,
+
+# then each() must have hit end of hash
+
+if(defined($pet)) {
+
+print "pet='$pet', qty='$qty'\n";
+
+} else {
+
+print "end of hash\n";
+
+}
+
+}
+
+
+one_time; # cats
+
+one_time; # dogs
+
+keys(%pets); # reset the hash iterator
+
+one_time; # cats
+
+one_time; # dogs
+
+one_time; # fish
+
+one_time; # end of hash
+
+one_time; # cats
+
+one_time; # dogs
+
+
+> pet='cats', qty='2'
+
+> pet='dogs', qty='1'
+
+> pet='cats', qty='2'
+
+> pet='dogs', qty='1'
+
+> pet='fish', qty='3'
+
+> end of hash
+
+> pet='cats', qty='2'
+
+> pet='dogs', qty='1'
+
+
+There is only one iterator variable connected with each hash, which
+means calling each() on a hash in a loop that then calls each() on the
+same hash another loop will cause problems. The example below goes
+through the %pets hash and attempts to compare the quantity of different
+pets and print out their comparison.
+
+
+my %pets = (
+
+fish=>3,
+
+cats=>2,
+
+dogs=>1,
+
+);
+
+while(my($orig_pet,$orig_qty)=each(%pets)) {
+
+while(my($cmp_pet,$cmp_qty)=each(%pets)) {
+
+if($orig_qty>$cmp_qty) {
+
+print "there are more $orig_pet "
+
+."than $cmp_pet\n";
+
+} else {
+
+print "there are less $orig_pet "
+
+."than $cmp_pet\n";
+
+
+}
+
+}
+
+}
+
+
+> there are more cats than dogs
+
+> there are less cats than fish
+
+> there are more cats than dogs
+
+> there are less cats than fish
+
+> there are more cats than dogs
+
+> there are less cats than fish
+
+> there are more cats than dogs
+
+> there are less cats than fish
+
+> ...
+
+The outside loop calls each() and gets "cats". The inside loop calls
+each() and gets "dogs". The inside loop continues, calls each() again,
+and gets "fish". The inside loop calls each() one more time and gets an
+empty list. The inside loop exits. The outside loop calls each() which
+continues where the inside loop left off, namely at the end of the list,
+and returns "cats". The code then enters the inside loop, and the
+process repeats itself indefinitely.
+
+
+One solution for this each() limitation is shown below. The inner loop
+continues to call each() until it gets the key that matches the outer
+loop key. The inner loop must skip the end of the hash (an undefined
+key) and continue the inner loop. This also fixes a problem in the above
+example in that we probably do not want to compare a key to itself.
+
+
+my %pets = (
+
+fish=>3,
+
+cats=>2,
+
+dogs=>1,
+
+);
+
+
+while(my($orig_pet,$orig_qty)=each(%pets)) {
+
+while(1) {
+
+my($cmp_pet,$cmp_qty)=each(%pets);
+
+next unless(defined($cmp_pet));
+
+last if($cmp_pet eq $orig_pet);
+
+if($orig_qty>$cmp_qty) {
+
+print "there are more $orig_pet "
+
+."than $cmp_pet\n";
+
+} else {
+
+print "there are less $orig_pet "
+
+."than $cmp_pet\n";
+
+}
+
+
+}
+
+}
+
+
+> there are more cats than dogs
+
+> there are less cats than fish
+
+> there are less dogs than fish
+
+> there are less dogs than cats
+
+> there are more fish than cats
+
+> there are more fish than dogs
+
+
+If you do not know the outer loop key, either because its in someone
+else's code and they do not pass it to you, or some similar problem,
+then the only other solution is to call keys on the hash for all inner
+loops, store the keys in an array, and loop through the array of keys
+using foreach. The inner loop will then not rely on the internal hash
+iterator value.
+
+
+
blob - /dev/null
blob + fee5eed935476cc4102da6c8af5e8e2986eb72d7 (mode 644)
--- /dev/null
+++ perl104/fourthbot
+================================================================================
+
+ Creating a Logging Bot
+
+ In our fourth lesson, we'll create an IRC bot that logs a channel.
+
+ Copy the code for logbot.pl to your home folder:
+
+ $ cp logbot.pl ~/logbot.pl
+
+ Next, open up logbot.pl using a text editor and make a few changes.
+
+ 1. Edit the server in line 32. Replace irc.example.com with the server's
+ real address. NOTE: Only IPv4 is supported.
+ 2. Edit line 35 to replace nickname with the nickname you want for the bot.
+ WARNING: The nickname must not already be taken, or else the bot will
+ fail to connect.
+ 3. Edit line 36 to replace username with the username you want for the bot.
+ The username is what appears in a /whois on IRC; it can be different
+ from the nickname.
+
+ Next, you'll want to make the perl script executable:
+
+ $ chmod u+x ~/logbot.pl
+
+ Then run the script:
+
+ $ perl ~/logbot.pl
+
+ On IRC, /join #perl104
+
+ Chat
+
+================================================================================
+
+ Understanding LogBot
+
+ Next, take a look at the file called ~/comments to see an explanation of
+ key lines in the program.
+
+================================================================================
blob - /dev/null
blob + 720e999a0bc9b591d2163da524a0f021343a206e (mode 644)
--- /dev/null
+++ perl104/logbot.pl
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+open(my $fh, ">>logbot.log") or die "Unable to write to logbot.log";
+select((select($fh), $|=1)[0]);
+
+package LogBot;
+use base qw(Bot::BasicBot);
+
+sub date {
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
+ my $localtime = sprintf("%04d%02d%02d %02d:%02d", $year+1900, $mon+1, $mday, $hour, $min);
+ return $localtime;
+}
+
+sub said {
+ my $self = shift;
+ my $arguments = shift;
+ print $fh date()." <$arguments->{who}> $arguments->{body}\n";
+ return;
+}
+
+sub emoted {
+ my $self = shift;
+ my $arguments = shift;
+ print $fh date()." *$arguments->{who} $arguments->{body}\n";
+ return;
+}
+
+sub noticed {
+ my $self = shift;
+ my $arguments = shift;
+ print $fh date()." [$arguments->{who} notice]: $arguments->{body}\n";
+ return;
+}
+
+sub chanjoin {
+ my $self = shift;
+ my $arguments = shift;
+ print $fh date()." -!- $arguments->{raw_nick} has joined $arguments->{channel}\n";
+ return;
+}
+
+sub chanpart {
+ my $self = shift;
+ my $arguments = shift;
+ print $fh date()." -!- $arguments->{raw_nick} has left $arguments->{channel} $arguments->{body}\n";
+ return;
+}
+
+sub topic {
+ my $self = shift;
+ my $arguments = shift;
+ my $who = $arguments->{who};
+ if (defined($who)) {
+ print $fh date()." -!- $who changed the topic of $arguments->{channel} to: $arguments->{topic}\n";
+ }
+ return;
+}
+
+sub nickchange {
+ my $self = shift;
+ my $oldnick = shift;
+ my $newnick = shift;
+ print $fh "$oldnick is now known as $newnick\n";
+ return;
+}
+
+sub mode_change {
+ my $self = shift;
+ my $arguments = shift;
+ my $chan = $arguments->{channel};
+ my $operands = $arguments->{mode_operands};
+ if (defined($chan) && $chan ne "msg" && scalar(@$operands)) {
+ print $fh date()." -!- mode/$chan $arguments->{who} [$arguments->{mode_changes}] ".join(", ", @$operands)."\n";
+ }
+ return;
+}
+
+sub kicked {
+ my $self = shift;
+ my $arguments = shift;
+ print $fh date()." -!- $arguments->{who} kicks $arguments->{kicked} [$arguments->{reason}]\n";
+}
+
+sub userquit {
+ my $self = shift;
+ my $arguments = shift;
+ print $fh " -!- $arguments->{raw_nick} quits [$arguments->{body}]\n";
+}
+
+package main;
+
+my $bot = LogBot->new(
+ server => 'irc.example.com',
+ port => '6667',
+ channels => ['#perl104'],
+ nick => 'nickname',
+ name => 'username',
+);
+
+local $SIG{INT} = sub {
+ close($fh);
+ print "Quitting program...\n";
+ $bot->shutdown("Quitting...");
+};
+
+$bot->run();
blob - /dev/null
blob + cbd6ff16f9cea72efbb64736e0ad141d63d4e107 (mode 644)
--- /dev/null
+++ perl104/newsbot.pl
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+package RSSBot;
+use base qw(Bot::BasicBot);
+use XML::RSS::Parser;
+
+my %feedURLs = (
+ "undeadly" => "http://undeadly.org/cgi?action=rss",
+ "eff" => "https://www.eff.org/rss/updates.xml",
+ "hackernews" => "https://news.ycombinator.com/rss",
+ "krebs" => "https://krebsonsecurity.com/feed",
+ "ircnow" => "https://wiki.ircnow.org/index.php?n=Site.AllRecentChanges?action=rss",
+ "schneier" => "https://www.schneier.com/blog/atom.xml",
+ "slashdot" => "http://rss.slashdot.org/Slashdot/slashdotMain",
+ "theregister" => "https://www.theregister.com/headlines.rss",
+);
+
+sub said {
+ my $self = shift;
+ my $arguments = shift;
+ if ($arguments->{body} =~ m{^!add\s+(\w+)\s+(https?://[[:print:]]+)$}) {
+ my ($name, $url) = ($1, $2);
+ $feedURLs{$name} = $url;
+ $self->say(
+ channel => $arguments->{channel},
+ body => "$name added.",
+ );
+ }
+ if ($arguments->{body} =~ m{^!delete\s+(\w+)$}) {
+ my $name = $1;
+ delete($feedURLs{$name});
+ $self->say(
+ channel => $arguments->{channel},
+ body => "$name deleted.",
+ );
+ }
+ if ($arguments->{body} =~ /^!(\w+)$/) {
+ my $name = $1;
+ if (!exists($feedURLs{$name})) {
+ $self->say(
+ channel => $arguments->{channel},
+ body => "Error: $name has not been added",
+ );
+ return;
+ }
+ my $p = XML::RSS::Parser->new;
+ my $url = $feedURLs{$name};
+ my $feed = $p->parse_uri($url);
+ my $qtitle = $feed->query('/channel/title');
+ my $feed_title = $qtitle->text_content;
+ my @qitems = $feed->query('//item');
+ for (my $i = 0; $i < scalar(@qitems) && $i < 5; $i++) {
+ my $qitem = $qitems[$i];
+ my %item;
+ $item{feed_title} = $feed_title;
+ foreach my $tag (qw(title dc:contributor link comments)) {
+ my $qtag = $qitem->query($tag);
+ if(defined($qtag)) {
+ $item{$tag} = $qtag->text_content;
+ } else {
+ $item{$tag} = "";
+ }
+ }
+ $self->say(
+ channel => $arguments->{channel},
+ body => "[\002$item{feed_title}\002] $item{title} ($item{'dc:contributor'}) $item{link}: $item{comments}",
+ );
+ }
+ }
+}
+
+package main;
+
+my $bot = RSSBot->new(
+ server => 'irc.example.com',
+ port => '6667',
+ channels => ['#perl103'],
+ nick => 'nickname',
+ name => 'username',
+);
+$bot->run();
blob - /dev/null
blob + c7d53b8c2054738fd2fce6a515c44d2b78bef168 (mode 644)
--- /dev/null
+++ perl104/perl104
+ ,.
+ . :%%%. .%%%.
+ __%%%(\ `%%%%% .%%%%%
+ /a ^ '% %%%% %: ,% %%"`
+ '__.. ,'% .-%: %-' %
+ ~~""%:. ` % ' . `.
+ %% % ` %% .%: . \. Perl 104
+ %%:. `-' ` .%% . %: :\
+ %(%,%..." `%, %%' %% ) ) Channel Logging Bot
+ %)%%)%%' )%%%.....- ' "/ (
+ %a:f%%\ % / \`% "%%% ` / \)) Open ~/fourthbot to begin
+ %(%' % /-. \ ' \ |-. '.
+ `' |% `() \| `()
+ || / () /
+a:f () 0 | o
+ \ /\ o /
+ o ` /-|
+ ,-/ ` ,-/ (https://www.asciiart.eu/animals/camels)
blob - /dev/null
blob + 2f7b5bcbad101e944a39a3e314741ab3dc0d02b6 (mode 644)
--- /dev/null
+++ perl105/.Xdefaults
+! $OpenBSD: dot.Xdefaults,v 1.3 2014/07/10 10:22:59 jasper Exp $
+XTerm*loginShell:true
blob - /dev/null
blob + 5a4d9aef3ea0d37c8873ef1a9acea1705f1c61e5 (mode 644)
--- /dev/null
+++ perl105/.cshrc
+# $OpenBSD: dot.cshrc,v 1.10 2020/01/24 02:09:51 okan Exp $
+#
+# csh initialization
+
+alias df df -k
+alias du du -k
+alias f finger
+alias h 'history -r | more'
+alias j jobs -l
+alias la ls -a
+alias lf ls -FA
+alias ll ls -lsA
+alias tset 'set noglob histchars=""; eval `\tset -s \!*`; unset noglob histchars'
+alias z suspend
+
+set path = (~/bin /bin /sbin /usr/{bin,sbin,X11R6/bin,local/bin,local/sbin,games})
+
+if ($?prompt) then
+ # An interactive shell -- set some stuff up
+ set filec
+ set history = 1000
+ set ignoreeof
+ set mail = (/var/mail/$USER)
+ set mch = `hostname -s`
+ alias prompt 'set prompt = "$mch:q"":$cwd:t {\!} "'
+ alias cd 'cd \!*; prompt'
+ alias chdir 'cd \!*; prompt'
+ alias popd 'popd \!*; prompt'
+ alias pushd 'pushd \!*; prompt'
+ cd .
+ umask 22
+endif
blob - /dev/null
blob + 2266a4a05265e9993ed8503d80d0544c0c07fe6a (mode 644)
--- /dev/null
+++ perl105/.cvsrc
+# $OpenBSD: dot.cvsrc,v 1.3 2016/10/31 20:50:11 tb Exp $
+#
+diff -uNp
+update -Pd
+checkout -P
+rdiff -u
blob - /dev/null
blob + 1087d67d3f660d5ba8b9e03f23ea048ffcbe56a2 (mode 644)
--- /dev/null
+++ perl105/.login
+# $OpenBSD: dot.login,v 1.6 2015/12/15 16:37:58 deraadt Exp $
+#
+# csh login file
+
+if ( ! $?TERMCAP ) then
+ if ( $?XTERM_VERSION ) then
+ tset -IQ '-munknown:?vt220' $TERM
+ else
+ tset -Q '-munknown:?vt220' $TERM
+ endif
+endif
+
+stty newcrt crterase
+
+set savehist=100
+set ignoreeof
+
+setenv EXINIT 'set ai sm noeb'
+
+if (-x /usr/games/fortune) /usr/games/fortune
blob - /dev/null
blob + d052b599855ffef8527c486df620a73b604914b8 (mode 644)
--- /dev/null
+++ perl105/.mailrc
+# $OpenBSD: dot.mailrc,v 1.3 2014/07/10 11:18:23 jasper Exp $
+set ask
+set crt
+ignore message-id received date fcc status resent-date resent-message-id resent-from in-reply-to
blob - /dev/null
blob + 54b76518023d70efad37a53081563ed222b0da73 (mode 644)
--- /dev/null
+++ perl105/.profile
+# $OpenBSD: dot.profile,v 1.7 2020/01/24 02:09:51 okan Exp $
+#
+# sh/ksh initialization
+
+PATH=$HOME/bin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/X11R6/bin:/usr/local/bin:/usr/local/sbin:/usr/games
+export PATH HOME TERM
blob - /dev/null
blob + e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 (mode 644)
blob - /dev/null
blob + 9984cb76f2e8fdbf9d2e3b5c4ee87341423b0a49 (mode 644)
--- /dev/null
+++ perl105/logbot.pl
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+my $chans = ['#perl101', '#perl102', '#perl103', '#perl104'];
+
+my %fhs;
+foreach my $chan (@$chans) {
+ open(my $fh, ">>$chan.log") or die "Unable to write to $chan.log";
+ $fhs{$chan} = $fh;
+ select((select($fh), $|=1)[0]);
+}
+
+package LogBot;
+use base qw(Bot::BasicBot);
+
+sub date {
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
+ my $localtime = sprintf("%04d%02d%02d %02d:%02d", $year+1900, $mon+1, $mday, $hour, $min);
+ return $localtime;
+}
+sub said {
+ my $self = shift;
+ my $arguments = shift;
+ my $chan = $arguments->{channel};
+ if (defined($chan) && $chan ne "msg") {
+ my $fh = $fhs{$chan};
+ print $fh date()." <$arguments->{who}> $arguments->{body}\n";
+ }
+ return;
+}
+
+sub emoted {
+ my $self = shift;
+ my $arguments = shift;
+ my $chan = $arguments->{channel};
+ if (defined($chan) && $chan ne "msg") {
+ my $fh = $fhs{$chan};
+ print $fh date()." *$arguments->{who} $arguments->{body}\n";
+ }
+ return;
+}
+
+sub noticed {
+ my $self = shift;
+ my $arguments = shift;
+ my $chan = $arguments->{channel};
+ if (defined($chan) && $chan ne "msg") {
+ my $fh = $fhs{$chan};
+ print $fh date()." [$arguments->{who} notice]: $arguments->{body}\n";
+ }
+ return;
+}
+
+sub chanjoin {
+ my $self = shift;
+ my $arguments = shift;
+ my $chan = $arguments->{channel};
+ if (defined($chan) && $chan ne "msg") {
+ my $fh = $fhs{$chan};
+ print $fh date()." -!- $arguments->{raw_nick} has joined $chan\n";
+ }
+ return;
+}
+
+sub chanpart {
+ my $self = shift;
+ my $arguments = shift;
+ my $chan = $arguments->{channel};
+ if (defined($chan) && $chan ne "msg") {
+ my $fh = $fhs{$chan};
+ print $fh date()." -!- $arguments->{raw_nick} has left $chan: $arguments->{body}\n";
+ }
+ return;
+}
+
+sub topic {
+ my $self = shift;
+ my $arguments = shift;
+ my $chan = $arguments->{channel};
+ my $who = $arguments->{who};
+ my $topic = $arguments->{topic};
+ if (defined($chan) && defined($who) && defined($topic)) {
+ my $fh = $fhs{$chan};
+ print $fh date()." -!- $who changed the topic of $chan to: $topic\n";
+ }
+ return;
+}
+
+sub nick_change {
+ my $self = shift;
+ my $oldnick = shift;
+ my $newnick = shift;
+ #print $fh "$oldnick changed nick to $newnick\n";
+ return;
+}
+
+sub mode_change {
+ my $self = shift;
+ my $arguments = shift;
+ my $chan = $arguments->{channel};
+ my $operands = $arguments->{mode_operands};
+ if (defined($chan) && $chan ne "msg" && scalar(@$operands)) {
+ my $fh = $fhs{$chan};
+ print $fh date()." -!- mode/$chan $arguments->{who} [$arguments->{mode_changes}] ".join(", ", @$operands)."\n";
+ }
+ return;
+}
+
+sub kicked {
+ my $self = shift;
+ my $arguments = shift;
+ my $chan = $arguments->{channel};
+ if (defined($chan) && $chan ne "msg") {
+ my $fh = $fhs{$chan};
+ print $fh date()." -!- $arguments->{who} kicks $arguments->{kicked} [$arguments->{reason}]\n";
+ }
+ return;
+}
+
+sub userquit {
+ my $self = shift;
+ my $arguments = shift;
+ my $chan = $arguments->{channel};
+ if (defined($chan) && $chan ne "msg") {
+ my $fh = $fhs{$chan};
+ print $fh " -!- $arguments->{raw_nick} quits [$arguments->{body}]\n";
+ }
+ return;
+}
+
+sub raw_in {
+ my $self = shift;
+ my $line = shift;
+}
+
+package main;
+
+my $bot = LogBot->new(
+ server => 'irc.example.com',
+ port => '6667',
+ channels => $chans,
+ nick => 'nickname',
+ name => 'username',
+);
+
+local $SIG{INT} = sub {
+ my $fh;
+ foreach my $chan (keys(%fhs)) {
+ $fh = $fhs{$chan};
+ close($fh);
+ }
+ print "Quitting program...\n";
+ $bot->shutdown("Quitting...");
+};
+
+$bot->run();
blob - /dev/null
blob + 2cf421b817032ab38e001f36b2b136dd993d6725 (mode 644)
--- /dev/null
+++ perl105/monopbot.pl
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+package MonopBot;
+use base qw(Bot::BasicBot);
+use Expect;
+$Expect::Log_Stdout = 0;
+$Expect::Multiline_Matching = 0;
+my $command = 'monop';
+my $timeout = 300;
+my $exp = new Expect;
+$exp->raw_pty(1);
+$exp->spawn($command, ()) or die "Cannot spawn $command: $!\n";
+
+my $output;
+my @nicks;
+
+# returns output from command
+sub readcmd {
+ my @results = $exp->expect($timeout, -re => '^[\n\s[:print:]]+$');
+ my ($pos, $error, $match, $before, $after) = @results;
+ return $before.$match.$after;
+}
+
+sub got_names {
+ my $self = shift;
+ my $arguments = shift;
+ @nicks = keys(%{$arguments->{names}});
+}
+
+sub chanjoin {
+ my $self = shift;
+ my $arguments = shift;
+ my $nick = $arguments->{who};
+ if ($nick eq $self->pocoirc->nick_name()) { # bot itself joins
+ $output = readcmd();
+ return $output;
+ }
+ return;
+}
+
+sub said {
+ my $self = shift;
+ my $arguments = shift;
+ if (scalar(@nicks) && grep /^$arguments->{who}$/, @nicks) {
+ print $exp "$arguments->{body}\n";
+ $output = readcmd();
+ return $output;
+ }
+ return;
+}
+
+package main;
+
+my $bot = MonopBot->new(
+ server => 'irc.example.com',
+ port => '6667',
+ channels => ['#perl105'],
+ nick => 'nickname',
+ name => 'username',
+);
+
+local $SIG{INT} = sub {
+ $exp->hard_close();
+ print "Quitting program...\n";
+ $bot->shutdown("Quitting...");
+};
+$bot->run();
blob - /dev/null
blob + 2f7b5bcbad101e944a39a3e314741ab3dc0d02b6 (mode 644)
--- /dev/null
+++ perl106/.Xdefaults
+! $OpenBSD: dot.Xdefaults,v 1.3 2014/07/10 10:22:59 jasper Exp $
+XTerm*loginShell:true
blob - /dev/null
blob + 5a4d9aef3ea0d37c8873ef1a9acea1705f1c61e5 (mode 644)
--- /dev/null
+++ perl106/.cshrc
+# $OpenBSD: dot.cshrc,v 1.10 2020/01/24 02:09:51 okan Exp $
+#
+# csh initialization
+
+alias df df -k
+alias du du -k
+alias f finger
+alias h 'history -r | more'
+alias j jobs -l
+alias la ls -a
+alias lf ls -FA
+alias ll ls -lsA
+alias tset 'set noglob histchars=""; eval `\tset -s \!*`; unset noglob histchars'
+alias z suspend
+
+set path = (~/bin /bin /sbin /usr/{bin,sbin,X11R6/bin,local/bin,local/sbin,games})
+
+if ($?prompt) then
+ # An interactive shell -- set some stuff up
+ set filec
+ set history = 1000
+ set ignoreeof
+ set mail = (/var/mail/$USER)
+ set mch = `hostname -s`
+ alias prompt 'set prompt = "$mch:q"":$cwd:t {\!} "'
+ alias cd 'cd \!*; prompt'
+ alias chdir 'cd \!*; prompt'
+ alias popd 'popd \!*; prompt'
+ alias pushd 'pushd \!*; prompt'
+ cd .
+ umask 22
+endif
blob - /dev/null
blob + 2266a4a05265e9993ed8503d80d0544c0c07fe6a (mode 644)
--- /dev/null
+++ perl106/.cvsrc
+# $OpenBSD: dot.cvsrc,v 1.3 2016/10/31 20:50:11 tb Exp $
+#
+diff -uNp
+update -Pd
+checkout -P
+rdiff -u
blob - /dev/null
blob + 1087d67d3f660d5ba8b9e03f23ea048ffcbe56a2 (mode 644)
--- /dev/null
+++ perl106/.login
+# $OpenBSD: dot.login,v 1.6 2015/12/15 16:37:58 deraadt Exp $
+#
+# csh login file
+
+if ( ! $?TERMCAP ) then
+ if ( $?XTERM_VERSION ) then
+ tset -IQ '-munknown:?vt220' $TERM
+ else
+ tset -Q '-munknown:?vt220' $TERM
+ endif
+endif
+
+stty newcrt crterase
+
+set savehist=100
+set ignoreeof
+
+setenv EXINIT 'set ai sm noeb'
+
+if (-x /usr/games/fortune) /usr/games/fortune
blob - /dev/null
blob + d052b599855ffef8527c486df620a73b604914b8 (mode 644)
--- /dev/null
+++ perl106/.mailrc
+# $OpenBSD: dot.mailrc,v 1.3 2014/07/10 11:18:23 jasper Exp $
+set ask
+set crt
+ignore message-id received date fcc status resent-date resent-message-id resent-from in-reply-to
blob - /dev/null
blob + 54b76518023d70efad37a53081563ed222b0da73 (mode 644)
--- /dev/null
+++ perl106/.profile
+# $OpenBSD: dot.profile,v 1.7 2020/01/24 02:09:51 okan Exp $
+#
+# sh/ksh initialization
+
+PATH=$HOME/bin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/X11R6/bin:/usr/local/bin:/usr/local/sbin:/usr/games
+export PATH HOME TERM
blob - /dev/null
blob + e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 (mode 644)
blob - /dev/null
blob + 0d4873471bf979c484150da3ede9004e3b0460ac (mode 644)
--- /dev/null
+++ perl106/channel.pl
+$irc->yield(mode => $channel => '+o' => $dude);
blob - /dev/null
blob + 2f7b5bcbad101e944a39a3e314741ab3dc0d02b6 (mode 644)
--- /dev/null
+++ perl107/.Xdefaults
+! $OpenBSD: dot.Xdefaults,v 1.3 2014/07/10 10:22:59 jasper Exp $
+XTerm*loginShell:true
blob - /dev/null
blob + 5a4d9aef3ea0d37c8873ef1a9acea1705f1c61e5 (mode 644)
--- /dev/null
+++ perl107/.cshrc
+# $OpenBSD: dot.cshrc,v 1.10 2020/01/24 02:09:51 okan Exp $
+#
+# csh initialization
+
+alias df df -k
+alias du du -k
+alias f finger
+alias h 'history -r | more'
+alias j jobs -l
+alias la ls -a
+alias lf ls -FA
+alias ll ls -lsA
+alias tset 'set noglob histchars=""; eval `\tset -s \!*`; unset noglob histchars'
+alias z suspend
+
+set path = (~/bin /bin /sbin /usr/{bin,sbin,X11R6/bin,local/bin,local/sbin,games})
+
+if ($?prompt) then
+ # An interactive shell -- set some stuff up
+ set filec
+ set history = 1000
+ set ignoreeof
+ set mail = (/var/mail/$USER)
+ set mch = `hostname -s`
+ alias prompt 'set prompt = "$mch:q"":$cwd:t {\!} "'
+ alias cd 'cd \!*; prompt'
+ alias chdir 'cd \!*; prompt'
+ alias popd 'popd \!*; prompt'
+ alias pushd 'pushd \!*; prompt'
+ cd .
+ umask 22
+endif
blob - /dev/null
blob + 2266a4a05265e9993ed8503d80d0544c0c07fe6a (mode 644)
--- /dev/null
+++ perl107/.cvsrc
+# $OpenBSD: dot.cvsrc,v 1.3 2016/10/31 20:50:11 tb Exp $
+#
+diff -uNp
+update -Pd
+checkout -P
+rdiff -u
blob - /dev/null
blob + 1087d67d3f660d5ba8b9e03f23ea048ffcbe56a2 (mode 644)
--- /dev/null
+++ perl107/.login
+# $OpenBSD: dot.login,v 1.6 2015/12/15 16:37:58 deraadt Exp $
+#
+# csh login file
+
+if ( ! $?TERMCAP ) then
+ if ( $?XTERM_VERSION ) then
+ tset -IQ '-munknown:?vt220' $TERM
+ else
+ tset -Q '-munknown:?vt220' $TERM
+ endif
+endif
+
+stty newcrt crterase
+
+set savehist=100
+set ignoreeof
+
+setenv EXINIT 'set ai sm noeb'
+
+if (-x /usr/games/fortune) /usr/games/fortune
blob - /dev/null
blob + d052b599855ffef8527c486df620a73b604914b8 (mode 644)
--- /dev/null
+++ perl107/.mailrc
+# $OpenBSD: dot.mailrc,v 1.3 2014/07/10 11:18:23 jasper Exp $
+set ask
+set crt
+ignore message-id received date fcc status resent-date resent-message-id resent-from in-reply-to
blob - /dev/null
blob + 54b76518023d70efad37a53081563ed222b0da73 (mode 644)
--- /dev/null
+++ perl107/.profile
+# $OpenBSD: dot.profile,v 1.7 2020/01/24 02:09:51 okan Exp $
+#
+# sh/ksh initialization
+
+PATH=$HOME/bin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/X11R6/bin:/usr/local/bin:/usr/local/sbin:/usr/games
+export PATH HOME TERM
blob - /dev/null
blob + e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 (mode 644)
blob - /dev/null
blob + 2f7b5bcbad101e944a39a3e314741ab3dc0d02b6 (mode 644)
--- /dev/null
+++ perl108/.Xdefaults
+! $OpenBSD: dot.Xdefaults,v 1.3 2014/07/10 10:22:59 jasper Exp $
+XTerm*loginShell:true
blob - /dev/null
blob + 5a4d9aef3ea0d37c8873ef1a9acea1705f1c61e5 (mode 644)
--- /dev/null
+++ perl108/.cshrc
+# $OpenBSD: dot.cshrc,v 1.10 2020/01/24 02:09:51 okan Exp $
+#
+# csh initialization
+
+alias df df -k
+alias du du -k
+alias f finger
+alias h 'history -r | more'
+alias j jobs -l
+alias la ls -a
+alias lf ls -FA
+alias ll ls -lsA
+alias tset 'set noglob histchars=""; eval `\tset -s \!*`; unset noglob histchars'
+alias z suspend
+
+set path = (~/bin /bin /sbin /usr/{bin,sbin,X11R6/bin,local/bin,local/sbin,games})
+
+if ($?prompt) then
+ # An interactive shell -- set some stuff up
+ set filec
+ set history = 1000
+ set ignoreeof
+ set mail = (/var/mail/$USER)
+ set mch = `hostname -s`
+ alias prompt 'set prompt = "$mch:q"":$cwd:t {\!} "'
+ alias cd 'cd \!*; prompt'
+ alias chdir 'cd \!*; prompt'
+ alias popd 'popd \!*; prompt'
+ alias pushd 'pushd \!*; prompt'
+ cd .
+ umask 22
+endif
blob - /dev/null
blob + 2266a4a05265e9993ed8503d80d0544c0c07fe6a (mode 644)
--- /dev/null
+++ perl108/.cvsrc
+# $OpenBSD: dot.cvsrc,v 1.3 2016/10/31 20:50:11 tb Exp $
+#
+diff -uNp
+update -Pd
+checkout -P
+rdiff -u
blob - /dev/null
blob + 1087d67d3f660d5ba8b9e03f23ea048ffcbe56a2 (mode 644)
--- /dev/null
+++ perl108/.login
+# $OpenBSD: dot.login,v 1.6 2015/12/15 16:37:58 deraadt Exp $
+#
+# csh login file
+
+if ( ! $?TERMCAP ) then
+ if ( $?XTERM_VERSION ) then
+ tset -IQ '-munknown:?vt220' $TERM
+ else
+ tset -Q '-munknown:?vt220' $TERM
+ endif
+endif
+
+stty newcrt crterase
+
+set savehist=100
+set ignoreeof
+
+setenv EXINIT 'set ai sm noeb'
+
+if (-x /usr/games/fortune) /usr/games/fortune
blob - /dev/null
blob + d052b599855ffef8527c486df620a73b604914b8 (mode 644)
--- /dev/null
+++ perl108/.mailrc
+# $OpenBSD: dot.mailrc,v 1.3 2014/07/10 11:18:23 jasper Exp $
+set ask
+set crt
+ignore message-id received date fcc status resent-date resent-message-id resent-from in-reply-to
blob - /dev/null
blob + 54b76518023d70efad37a53081563ed222b0da73 (mode 644)
--- /dev/null
+++ perl108/.profile
+# $OpenBSD: dot.profile,v 1.7 2020/01/24 02:09:51 okan Exp $
+#
+# sh/ksh initialization
+
+PATH=$HOME/bin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/X11R6/bin:/usr/local/bin:/usr/local/sbin:/usr/games
+export PATH HOME TERM
blob - /dev/null
blob + e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 (mode 644)
blob - /dev/null
blob + 2f7b5bcbad101e944a39a3e314741ab3dc0d02b6 (mode 644)
--- /dev/null
+++ perl109/.Xdefaults
+! $OpenBSD: dot.Xdefaults,v 1.3 2014/07/10 10:22:59 jasper Exp $
+XTerm*loginShell:true
blob - /dev/null
blob + 5a4d9aef3ea0d37c8873ef1a9acea1705f1c61e5 (mode 644)
--- /dev/null
+++ perl109/.cshrc
+# $OpenBSD: dot.cshrc,v 1.10 2020/01/24 02:09:51 okan Exp $
+#
+# csh initialization
+
+alias df df -k
+alias du du -k
+alias f finger
+alias h 'history -r | more'
+alias j jobs -l
+alias la ls -a
+alias lf ls -FA
+alias ll ls -lsA
+alias tset 'set noglob histchars=""; eval `\tset -s \!*`; unset noglob histchars'
+alias z suspend
+
+set path = (~/bin /bin /sbin /usr/{bin,sbin,X11R6/bin,local/bin,local/sbin,games})
+
+if ($?prompt) then
+ # An interactive shell -- set some stuff up
+ set filec
+ set history = 1000
+ set ignoreeof
+ set mail = (/var/mail/$USER)
+ set mch = `hostname -s`
+ alias prompt 'set prompt = "$mch:q"":$cwd:t {\!} "'
+ alias cd 'cd \!*; prompt'
+ alias chdir 'cd \!*; prompt'
+ alias popd 'popd \!*; prompt'
+ alias pushd 'pushd \!*; prompt'
+ cd .
+ umask 22
+endif
blob - /dev/null
blob + 2266a4a05265e9993ed8503d80d0544c0c07fe6a (mode 644)
--- /dev/null
+++ perl109/.cvsrc
+# $OpenBSD: dot.cvsrc,v 1.3 2016/10/31 20:50:11 tb Exp $
+#
+diff -uNp
+update -Pd
+checkout -P
+rdiff -u
blob - /dev/null
blob + 1087d67d3f660d5ba8b9e03f23ea048ffcbe56a2 (mode 644)
--- /dev/null
+++ perl109/.login
+# $OpenBSD: dot.login,v 1.6 2015/12/15 16:37:58 deraadt Exp $
+#
+# csh login file
+
+if ( ! $?TERMCAP ) then
+ if ( $?XTERM_VERSION ) then
+ tset -IQ '-munknown:?vt220' $TERM
+ else
+ tset -Q '-munknown:?vt220' $TERM
+ endif
+endif
+
+stty newcrt crterase
+
+set savehist=100
+set ignoreeof
+
+setenv EXINIT 'set ai sm noeb'
+
+if (-x /usr/games/fortune) /usr/games/fortune
blob - /dev/null
blob + d052b599855ffef8527c486df620a73b604914b8 (mode 644)
--- /dev/null
+++ perl109/.mailrc
+# $OpenBSD: dot.mailrc,v 1.3 2014/07/10 11:18:23 jasper Exp $
+set ask
+set crt
+ignore message-id received date fcc status resent-date resent-message-id resent-from in-reply-to
blob - /dev/null
blob + 54b76518023d70efad37a53081563ed222b0da73 (mode 644)
--- /dev/null
+++ perl109/.profile
+# $OpenBSD: dot.profile,v 1.7 2020/01/24 02:09:51 okan Exp $
+#
+# sh/ksh initialization
+
+PATH=$HOME/bin:/bin:/sbin:/usr/bin:/usr/sbin:/usr/X11R6/bin:/usr/local/bin:/usr/local/sbin:/usr/games
+export PATH HOME TERM
blob - /dev/null
blob + e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 (mode 644)
