commit 8f7f2f4a721b4811928323ee791cf2f8e95eef17 from: jrmu date: Fri Dec 17 14:15:53 2021 UTC Import sources commit - /dev/null commit + 8f7f2f4a721b4811928323ee791cf2f8e95eef17 blob - /dev/null blob + 2f7b5bcbad101e944a39a3e314741ab3dc0d02b6 (mode 644) --- /dev/null +++ perl100/.Xdefaults @@ -0,0 +1,2 @@ +! $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 @@ -0,0 +1,32 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,20 @@ +# $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 @@ -0,0 +1,4 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,2 @@ +! $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 @@ -0,0 +1,32 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,20 @@ +# $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 @@ -0,0 +1,4 @@ +# $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 @@ -0,0 +1,7 @@ +# $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 @@ -0,0 +1,102 @@ +================================================================================ + + 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 @@ -0,0 +1,110 @@ +================================================================================ + + 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 @@ -0,0 +1,26 @@ +#!/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 @@ -0,0 +1,45 @@ +================================================================================ + + 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 @@ -0,0 +1,18 @@ + + _______\\__ + (_. _ ._ _/ + '-' \__. / + / / 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 @@ -0,0 +1,2 @@ +! $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 @@ -0,0 +1,32 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,20 @@ +# $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 @@ -0,0 +1,4 @@ +# $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 @@ -0,0 +1,7 @@ +# $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 @@ -0,0 +1,95 @@ +#!/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 @@ -0,0 +1,247 @@ +================================================================================ + + 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 @@ -0,0 +1,237 @@ +================================================================================ + + 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 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 @@ -0,0 +1,27 @@ +#!/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 @@ -0,0 +1,21 @@ + + '\|/' * + -- * ----- + /|\ ____ + ' | ' {_ 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 @@ -0,0 +1,133 @@ +================================================================================ + + 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 @@ -0,0 +1,46 @@ +================================================================================ + + 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 @@ -0,0 +1,2 @@ +! $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 @@ -0,0 +1,32 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,20 @@ +# $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 @@ -0,0 +1,4 @@ +# $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 @@ -0,0 +1,7 @@ +# $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 @@ -0,0 +1,144 @@ +================================================================================ + + 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 ; + + 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 @@ -0,0 +1,180 @@ +================================================================================ + + 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 . 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 + ++ 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 @@ -0,0 +1,125 @@ +#!/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 @@ -0,0 +1,99 @@ +================================================================================ + + 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: + +Ircnow / Servers +https://wiki.ircnow.org/index.php?n=Ircnow.Servers +mkf +2021-08-29T15:27:58Z +Sun, 29 Aug 2021 15:27:58 GMT + + + + 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 @@ -0,0 +1,200 @@ +================================================================================ + + 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 @@ -0,0 +1,22 @@ + + 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 @@ -0,0 +1,799 @@ + 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 @@ -0,0 +1,38 @@ +#!/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 @@ -0,0 +1,42 @@ +================================================================================ + + 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 @@ -0,0 +1,2 @@ +! $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 @@ -0,0 +1,32 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,20 @@ +# $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 @@ -0,0 +1,4 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,175 @@ +================================================================================ + + 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 @@ -0,0 +1,282 @@ +================================================================================ + + 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 @@ -0,0 +1,41 @@ +================================================================================ + + 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 @@ -0,0 +1,109 @@ +#!/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 @@ -0,0 +1,83 @@ +#!/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 @@ -0,0 +1,18 @@ + ,. + . :%%%. .%%%. + __%%%(\ `%%%%% .%%%%% + /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 @@ -0,0 +1,2 @@ +! $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 @@ -0,0 +1,32 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,20 @@ +# $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 @@ -0,0 +1,4 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,157 @@ +#!/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 @@ -0,0 +1,69 @@ +#!/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 @@ -0,0 +1,2 @@ +! $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 @@ -0,0 +1,32 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,20 @@ +# $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 @@ -0,0 +1,4 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1 @@ +$irc->yield(mode => $channel => '+o' => $dude); blob - /dev/null blob + 2f7b5bcbad101e944a39a3e314741ab3dc0d02b6 (mode 644) --- /dev/null +++ perl107/.Xdefaults @@ -0,0 +1,2 @@ +! $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 @@ -0,0 +1,32 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,20 @@ +# $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 @@ -0,0 +1,4 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,2 @@ +! $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 @@ -0,0 +1,32 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,20 @@ +# $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 @@ -0,0 +1,4 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,2 @@ +! $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 @@ -0,0 +1,32 @@ +# $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 @@ -0,0 +1,6 @@ +# $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 @@ -0,0 +1,20 @@ +# $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 @@ -0,0 +1,4 @@ +# $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 @@ -0,0 +1,6 @@ +# $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)