|
Warning: this is an htmlized version!
The original is here, and the conversion rules are here. |
#######
#
# E-scripts on Perl, Apache and cgis.
#
# Note 1: use the eev command (defined in eev.el) and the
# ee alias (in my .zshrc) to execute parts of this file.
# Executing this file as a whole makes no sense.
# An introduction to eev can be found here:
#
# (find-eev-quick-intro)
# http://angg.twu.net/eev-intros/find-eev-quick-intro.html
#
# Note 2: be VERY careful and make sure you understand what
# you're doing.
#
# Note 3: If you use a shell other than zsh things like |&
# and the for loops may not work.
#
# Note 4: I always run as root.
#
# Note 5: some parts are too old and don't work anymore. Some
# never worked.
#
# Note 6: the definitions for the find-xxxfile commands are on my
# .emacs.
#
# Note 7: if you see a strange command check my .zshrc -- it may
# be defined there as a function or an alias.
#
# Note 8: the sections without dates are always older than the
# sections with dates.
#
# This file is at <http://angg.twu.net/e/perl.e>
# or at <http://angg.twu.net/e/perl.e.html>.
# See also <http://angg.twu.net/emacs.html>,
# <http://angg.twu.net/.emacs[.html]>,
# <http://angg.twu.net/.zshrc[.html]>,
# <http://angg.twu.net/escripts.html>,
# and <http://angg.twu.net/>.
#
#######
# «.perl-doc» (to "perl-doc")
# «.hex2c» (to "hex2c")
# «.perl-nle» (to "perl-nle")
# «.perldb» (to "perldb")
# «.mimelite_zsh1» (to "mimelite_zsh1")
# «.mimelite_zsh2» (to "mimelite_zsh2")
# «.Getopt::Std» (to "Getopt::Std")
# «.argv» (to "argv")
# «.argc» (to "argc")
# «.Data::Dumper» (to "Data::Dumper")
# «.Net::NNTP» (to "Net::NNTP")
# «.reading_a_file_at_once» (to "reading_a_file_at_once")
# «.eval_in_regsub» (to "eval_in_regsub")
# «.filter» (to "filter")
# «.db_files» (to "db_files")
# «.eepitch-perl» (to "eepitch-perl")
# «.sepia» (to "sepia")
# «.cpan-2020» (to "cpan-2020")
#####
#
# perl-doc
# 2007may18
#
#####
# «perl-doc» (to ".perl-doc")
# (find-status "perl-doc")
# (find-vldifile "perl-doc.list")
# (find-udfile "perl-doc/")
# (find-man "1 perl")
# (find-man "1 perltoc")
# (find-man "1 perlsyn")
# (find-man "1 perldata")
# (find-man "1 perlop")
# (find-man "1 perlfunc")
# (find-man "1 perlfunc" "print LIST")
# (find-man "1 perlfaq")
# (find-man "1 perlfaq1")
# (find-man "1 perlfaq2")
# (find-man "1 perlfaq4")
# (find-man "1 perlfaq5")
# (find-man "1 perlfaq6")
# (find-man "1 perlfaq7")
# (find-man "1 perlfaq8")
# (find-man "1 perlrun")
# (find-man "1 perldebug")
#####
#
# hex2c
# 2007may18
#
#####
# «hex2c» (to ".hex2c")
# (find-man "1 perlfunc" "hex EXPR")
# (find-man "1 perlfunc" "chr NUMBER")
# (find-man "1 perlfunc" "write EXPR")
# (find-man "1 perlop")
# (find-man "1 perlop" "m//")
# (find-man "1 perlfunc" "print")
# (find-man "1 perlfunc" "printf FORMAT, LIST")
# "write" doesn't work as I expected... ask for help
#*
echo '40 20.33 _ 0a' \
| tr ' .' \\n \
| perl -nle 'if (/^[0-9A-Za-z][0-9A-Za-z]$/) { print hex($_) }'
#*
* (eepitch-shell)
* (eepitch-kill)
* (eepitch-shell)
perl -d -e 42
write("foo\n")
write "foo\n"
;
flush;
hex("40");
print hex(40);
print hex("40");
print chr(hex("40"));
#####
#
# perl -nle
# 2000dec26
#
#####
# «perl-nle» (to ".perl-nle")
# (eeman "1p perlrun" "^ *-n")
# (eeman "1p perlrun" "-nle")
# (eeman "1p perlrun" "^ *-l")
# (eeman "1p perlrun" "^ *-e")
#*
ls /tmp | perl -nle '$n++; print "$n: \"$_\""'
ls /tmp | perl -nle 'print'
ls /tmp | perl -nle 'printf "\"%s\"\n", $_'
ls /tmp | perl -le 'while (<>) { printf "($_)" }'
ls /tmp | perl -e 'while (<>) { print "($_)" }'
#*
# (eeman "1p perlop" "The null filehandle <>")
# Use <STDIN> when you don't want the ARGV trick.
#####
#
# perldb
# 2000nov17
#
#####
# «perldb» (to ".perldb")
# (find-pl5podfile "")
# (find-pl5podfile "perlfaq3.pod" "How can I use Perl interactively?")
# (find-pl5podfile "perldebug.pod")
# (eeman "perlfaq3" "interactively")
# (eeman "perldebug")
# (find-pl5file "5.004/perl5db.pl")
# (find-pl5file "5.005/perl5db.pl")
#*
cat > $EEG <<'---'
h
h h
|h h
---
eeg perl -de 42
#*
# (perldb "perl /usr/sbin/update-alternatives --display wish")
# (find-angg ".emacs" "gdbk-mode")
#*
# (gdbk-perldb t "/usr/sbin/update-alternatives --display wish" "" t)
#*
# (gdbk-perldb nil "/usr/sbin/update-alternatives --display wish")
#####
#
# string escape codes
# 2000jul24
#
#####
# «escape_codes»
perl -e 'print "\100\n";'
#####
#
# opcodes
#
#####
apti perl-5.004-debug
aptrm perl-5.004-debug
# (find-status "perl-5.004-debug")
# (find-vldifile "perl-5.004-debug.list")
# (find-fline "/usr/doc/perl-5.004-debug/")
cd /usr/lib/perl5/5.004/pod/
agrep -i opcode * | l -S
# (eeman "perlguts" "Examining the tree")
pdsc /debian/main/source/interpreters/perl_5.004.04-6.dsc
cd /usr/src/perl-5.004.04
#
# (find-fline "/usr/src/perl-5.004.04/debian/rules" "-D optimize='-O2' ")
debian/rules binary |& tee odrb
#####
#
# Indexing
#
#####
cd /usr/lib/perl5/
find * -type f | grep -v '\.so$\|\.a$' > .files
#####
#
# ?
#
#####
# (find-fline "~/PERL/promit")
# (setq w3-reuse-buffers 'yes)
# (w3-open-local "/snarf/http/agora.leeds.ac.uk/Perl/start.html")
http://agora.leeds.ac.uk/Perl/start.html
Operações importantes: limpa os espaços,
cd /usr/lib/perl5/
pod2man CGI.pm | groff -Tascii -man | l
echo foobarplic | sed s/o/O/g
echo foobarplic | sed 's/[oa]//g'
# (find-fline "~/PERL/mysed")
#####
#
# CGI.pm
#
#####
# (find-fline "/usr/doc/perl/examples/cgi/")
# (find-pl5file "")
# (find-pl5file "CGI/")
# (find-pl5file "CGI.pm")
# (find-pl5file "CGI.pm" "=head1 DEBUGGING")
# (find-pl5file "CGI.pm" "strong")
# (find-pl5file "CGI.pm" "as_string")
# (find-fline "/etc/apache/")
# (find-fline "/etc/apache/httpd.conf")
# (find-fline "/etc/apache/srm.conf" "/var/www")
# (find-fline "/etc/apache/srm.conf" "AddHandler cgi-script .cgi")
# (find-fline "/usr/doc/perl/examples/cgi/")
# (find-fline "/var/www/perlex/")
rm -Rv /var/www/perlex/
mkdir /var/www/perlex/
cd /var/www/perlex/
cp -iv /usr/doc/perl/examples/cgi/* .
gzip -dv *
perl RunMeFirst
chmod 755 *.cgi
chown edrx:edrx -Rc /var/www/perlex
# (w3-fetch "http://0/perlex/")
lynx http://0.0.0.0/perlex/
# (find-fline "/var/www/perlex/tryit.cgi")
cd /var/www/perlex/
tryit.cgi ''
tryit.cgi name=Edrx%20Foo color=Blue
# (find-pl5podfile "perlfaq4.pod")
# (find-pl5podfile "perlfaq5.pod")
# (find-pl5podfile "perlfaq6.pod")
# (find-pl5podfile "perlfaq7.pod")
# (find-pl5podfile "perlfaq8.pod")
# (find-pl5podfile "perlfaq9.pod" "send/read mail")
dpkg -i ~/HASH/mailtools
# (find-pl5file "Mail/")
# (find-pl5file "Mail/Send.pm")
# (find-pl5file "auto/Mail/")
# (find-fline "~/PERL/m")
use Mail::Internet;
use Mail::Header;
# say which mail host to use
$ENV{SMTPHOSTS} = 'mail.frii.com';
# create headers
$header = new Mail::Header;
$header->add('From', 'gnat@frii.com');
$header->add('Subject', 'Testing');
$header->add('To', 'gnat@frii.com');
# create body
$body = 'This is a test, ignore';
# create mail object
$mail = new Mail::Internet(undef, Header => $header, Body => \[$body]);
# send it
$mail->smtpsend or die;
cd /var/www/perlex/
a2ps -o ~/o.ps -M A4dj -6 -A --highlight-level=none $(
cat index.html |
perl -e 'foreach $li (<STDIN>) {$li =~ s/.*"(.*.cgi)".*/$1/ && print $li;}')
cd
rm o.p[0-9][0-9]
gs -sDEVICE=djet500 -r300 -sOutputFile=o.p%02d -dNOPAUSE -dBATCH o.ps
rm o.zip; zip o.zip o.p0?
laf o.zip
cat index.html |
perl -e 'foreach $li (<STDIN>) { print $li;}'
# (find-pl5file "CGI.pm")
# (find-pl5file "CGI.pm")
# (find-pl5file "pod/perlmod.pod")
qualified
# (w3-open-local "/usr/doc/HOWTO/html/Java-CGI-HOWTO.html")
#####
#
# dwww
#
#####
# (find-hamm "dwww")
######
#
# Embedding Perl in text
#
######
#!/usr/bin/perl
print "a$BO\n";
print 'b$BO\n';
print 'c', 'foo';
print "\n\n\n";
(defun p ()
(interactive)
(write-region (get-register ?b) (get-register ?e) "~/PERL/p")
(set-file-modes "~/PERL/p" 511))
#!/usr/bin/perl
$_ = "foo_bar";
print "Ok\n" if /.*foo.*/;
print /.*o\(.*a\).*/;
print "hello", "\n";
print ($a = [1, 2, 3]), "\n";
# (find-fline "~/PERL/tut0")
#!/usr/bin/perl
# (set-file-modes (buffer-file-name) 511)
######
#
# Docs
#
######
/snarf/ftp/agora.leeds.ac.uk/scs/doc/whole-perl-tutorial.readme
/snarf/http/www.eecs.nwu.edu/perl/perl.html
(find-fline "~/ZHTML/texps.ht")
(find-fline "/snarf/ftp/agora.leeds.ac.uk/scs/doc/whole-perl-tutorial.txt.gz")
(find-fline "/usr/doc/perl/examples")
(find-fline "/usr/doc/perl/examples/cgi/")
#######
#
# a2ps on some docs
#
#######
l ~/TCL/spawn-send-expect-interact
a2ps -8 -M A4dj -o ~/o.ps /usr/lib/perl5/CGI.pm
rm ~/o.p[0-9][0-9]
cd
gs -sDEVICE=djet500 -r300 -sOutputFile=o.p%02d -dNOPAUSE -dBATCH o.ps
rm o.zip; zip o.zip o.p0{1,2,3,4,5,6,7}
rm o.zip; zip o.zip o.p{0{8,9},1{0,1}}
# (find-node "(a2ps)Top")
# (find-node "(a2ps)Sheets Options")
# (find-fline "/usr/share/a2ps/sheets/")
# (find-fline "/usr/share/a2ps/sheets/perl.ssh")
#####
#
#
#
#####
cd /usr/lib/perl5/
etags $(find * -name '*.p[ml]')
# (code-c-d "pl5" "/usr/lib/perl5/")
# (find-pl5file "CGI.pm")
# (find-enode "Programs")
# (find-enode "Font Lock")
# (global-font-lock-mode t)
# (list-faces-display)
# (find-pl5file "i386-linux/5.004/DynaLoader.pm")
# (find-pl5file "i386-linux/5.004/auto/DynaLoader/")
# (find-pl5file "pod/perlxs.pod")
# (find-pl5file "pod/perlxstut.pod")
######
#
# perl-tk
#
######
# (find-fline "/usr/doc/perl-tk/")
# (find-fline "/usr/lib/perl5/Tk/")
# (code-c-d "ptk" "/usr/src/perl-tk-400.202/")
# (find-ptkfile "Manifest")
# (find-ptkfile "")
debsource /debian/main/source/interpreters perl-tk 400.202 -9
cd /usr/src/perl-tk-400.202/
cd /usr/src/perl-tk-400.202/demos/
widget
#####
#
# Sending MIME'd mail with MIME::Lite (and zsh)
#
#####
# «mimelite_zsh1» (to ".mimelite_zsh1")
# Old version:
function mailfile () {
TO=$1 FILE=$2 perl -e '
use lib "$ENV{HOME}/PERL/";
use MIME::Lite;
$msg = new MIME::Lite
# From => $ENV{"FROM"},
To => $ENV{"TO"},
Subject => $ENV{"FILE"},
Data => "";
attach $msg
Encoding => "base64",
Type => "BINARY",
Path => $ENV{"FILE"},
Filename => $ENV{"FILE"};
if (open SENDMAIL, "|/usr/sbin/sendmail -t -oi -oem") {
$msg->print(\*SENDMAIL);
close SENDMAIL;
} else {
print "Erro interno no sendmail: !=$!, ?=$?.\n";
}'
}
# Demo:
cd ~/GIMP/; mailfile edrx tmp.jpg
# «mimelite_zsh2» (to ".mimelite_zsh2")
# New version:
# Note that I'm using "su -s /usr/sbin/sendmail edrx --" instead of
# simply "/usr/sbin/sendmail".
function email_mimelite () {
perl -e 'use lib "$ENV{HOME}/PERL/"; use MIME::Lite;
'$1'
if (open SENDMAIL, "|su -s /usr/sbin/sendmail edrx -- -t -oi -oem") {
$msg->print(\*SENDMAIL); close SENDMAIL;
} else { print "Erro interno no sendmail: !=$!, ?=$?.\n";
}'
}
function email850 () {
850toiso | TO=$1 SUBJ=$2 email_mimelite '
undef $/;
$msg = new MIME::Lite
To => $ENV{"TO"},
Subject => $ENV{"SUBJ"},
Encoding => "quoted-printable",
Data => <>;'
}
function emailfile () {
TO=$1 FILE=$2 email_mimelite '
$msg = new MIME::Lite
To => $ENV{"TO"},
Subject => $ENV{"FILE"},
Data => "";
attach $msg
Encoding => "base64",
Type => "BINARY",
Path => $ENV{"FILE"},
Filename => $ENV{"FILE"};'
}
# Demos:
email850 edrx 'no subject' < ~/PERSONAL/99jun24
cd ~/GIMP/; emailfile edrx tmp.jpg
#####
#
# CPAN
# 99nov27
#
#####
# (find-fline "~/ICON/lslR2find.icn")
# (find-fline "$SDEBIAN/ls-lR")
# (find-fline "$SDEBIAN/ls-lR.i")
# (find-fline "$SCPAN/ls-lR")
# (find-fline "$SCPAN/ls-lR.i")
psne $FCPAN/ls-lR.gz
cd $SCPAN
gzip -dv ls-lR.gz
cd $SCPAN
~/ICON/lslR2find2 25 33 47 < ls-lR > ls-lR.i
psne $FCPAN/authors/id/LDS/CGI.pm-2.56.tar.gz
cd $SCPAN
~/ICON/lslR2find 2 -10 < ls-lR |& l -S
~/ICON/lslR2find 1 -10 < ls-lR |& l -S
~/ICON/lslR2find 0 -10 < ls-lR |& l -S
~/ICON/lslR2find 0 -8 < ls-lR |& l -S
cd $SCPAN
~/ICON/lslR2find2 25 33 46 < ls-lR |& l -S
~/ICON/lslR2find2 26 33 47 < ls-lR |& l -S
~/ICON/lslR2find2 27 34 48 < ls-lR |& l -S
#####
#
# Getopt::Std
# 2000may08
#
#####
# «Getopt::Std» (to ".Getopt::Std")
# (eeman "Getopt::Std")
#*
cat > /tmp/p <<'---'
use Getopt::Std;
use Net::SMTP;
getopt('s');
print ":$opt_s:$ARGV[0]:\n"
---
perl /tmp/p -s 'Foo' Bar
perl /tmp/p -s 'Foo'
perl /tmp/p Bar
perl /tmp/p
#*
# Options after the straight args don't work:
perl /tmp/p Bar -s 'Foo'
# Were is it said that GNU's getopt accepts options after the other
# args? Not in the obvious place:
# (find-node "(libc)Getopt")
#####
#
# argv and argc
#
#####
# «argv» (to ".argv")
# (find-man "1 perlvar" "@ARGV")
# (find-man "1 perldata" "$#days")
#*
# «argc» (to ".argc")
# About argc:
perl -e 'print ":", @ARGV+0, ":\n";'
perl -e 'print ":", @ARGV+0, ":\n";' an_arg
#*
perl -e 'print ":$#ARGV:\n";'
perl -e 'print ":$#ARGV:\n";' foo
perl -e 'print ":$#ARGV:\n";' foo bar
perl -e 'print ":$#ARGV:\n";' foo bar plic
#*
#####
#
# sendEmail
# 2000may08
#
#####
# «sendEmail»
# (find-fline "$S/http/marvin.criadvantage.com/caspian/Software/SendEmail/sendEmail-v1.20.tar.gz")
rm -Rv /usr/src/sendEmail/
cd /usr/src/
tar -xvzf $S/http/marvin.criadvantage.com/caspian/Software/SendEmail/sendEmail-v1.20.tar.gz
cd /usr/src/sendEmail/
# (find-fline "/usr/src/sendEmail/sendEmail")
# (find-fline "/usr/src/sendEmail/sendEmail" "sub help")
cd /usr/src/sendEmail/
./sendEmail -f hahaha -t edrx -u Teste -m Hello -vv
# But instead of learning enough of this to use it to send email from
# my machine bypassing the broken exim, I decided to perfect my code
# that called Net::SMTP... and solved the problem.
# (find-es "mail" "Net::SMTP2")
# (find-fline "~/bin/sendemail")
#####
#
# Data::Dumper
# 2000may09
#
#####
# «Data::Dumper» (to ".Data::Dumper")
# (eeman "CGI")
# (eeman "CGI" "CGI.INPUTFILE.")
# (find-pl5file "5.005/Data/Dumper.pm" "=head1")
# pod2t /usr/lib/perl5/5.005/Data/Dumper.pm |& l
#*
echo foo=bar > /tmp/oc
cat > /tmp/p <<'---'
use CGI;
open(QF, "/tmp/oc");
$query = new CGI(QF);
#
use Data::Dumper;
print Dumper('$query', $query);
sub pdump { print "\n $_[0] =\n", Dumper($_[1]); }
pdump('$query', $query);
---
perl /tmp/p
#*
# And this one shows some things about references.
# (eeman "perlref")
cat > /tmp/p <<'---'
use Data::Dumper;
sub pdump { print "\n $_[0] =\n", Dumper($_[1]); }
@a = ['aa', 'bb'];
$b = \@a;
$c = ['aa', 'bb'];
pdump('@a', @a);
pdump('$b', $b);
pdump('$c', $c);
pdump('join', join('', @$c));
---
perl /tmp/p
#*
#####
#
# Net::NNTP
# 2000may09
#
#####
# «Net::NNTP» (to ".Net::NNTP")
# (eeman "Net::NNTP")
# (find-pl5file "Net/NNTP.pm")
# (find-pl5file "Net/NNTP.pm" "=item next")
# (find-pl5file "Net/NNTP.pm" "=item newnews")
# (find-fline "~/bin/sendemail")
# (find-pl5file "5.005/Data/Dumper.pm")
# First test: get the last (?) article.
cat > /tmp/p <<'---'
use Data::Dumper;
sub pdump { print "\n $_[0] =\n", Dumper($_[1]); }
use Net::NNTP;
$nntp = Net::NNTP->new("news.inx.com.br",
Debug => 1);
$nntp->group("comp.lang.tcl");
pdump('$nntp', $nntp);
$msgid =
$nntp->next();
$art =
$nntp->article($msgid);
print join('', @$art);
# Also works; this msgnum was extracted from an "Xref:" line by hand.
#$art2 =
# $nntp->article(138818);
#print join('', @$art2);
$nntp->quit;
---
perl /tmp/p \
|& tee ~/o
# Try to get all the articles posted in the last 24hs in a group.
# First the list... (put it in ~/o2)
# (find-es "mail" "RFCs")
# (find-fline "~/tmp/rfc977.txt" "3.8.1. NEWNEWS")
# (find-fline "~/tmp/rfc977.txt" "The date is sent as")
# (find-pl5file "Net/NNTP.pm" "sub _timestr")
# (find-pl5file "Net/NNTP.pm" "=item newnews")
# (find-pl5file "Net/NNTP.pm" "=item date")
cat > /tmp/p <<'---'
use Data::Dumper;sub pdump{print"\n $_[0] =\n",Dumper($_[1]);}
use Net::NNTP;$nntp=Net::NNTP->new("news.inx.com.br",Debug=>1);
$date =
$nntp->date();
pdump('$date', $date);
$newnews =
$nntp->newnews( $date - 24*3600, "comp.lang.tcl");
pdump('$newnews', $newnews);
#
open(O, "> $ENV{'HOME'}/o2") || die "Can't open o2";
print O join("\n", @$newnews);
close(O);
---
perl /tmp/p \
|& tee ~/o
# (find-fline "~/o")
# (find-fline "~/o2")
cat > /tmp/p <<'---'
$newnews = ["foo\n", "bar\n"];
open(O, "> $ENV{'HOME'}/o2") || die "Can't open";
print O join("\n", @$newnews);
close(O);
---
perl /tmp/p
cat ~/o2
# ...and now the articles themselves, using the listing in ~/o2.
# (eeman "perlsyn" "foreach my")
rm -Rv /tmp/n/
mkdir /tmp/n/
cd /tmp/n/
cat > /tmp/p <<'---'
use Data::Dumper;sub pdump{print"\n $_[0] =\n",Dumper($_[1]);}
use Net::NNTP;$nntp=Net::NNTP->new("news.inx.com.br",Debug=>1);
@articles = split("\n", `cat ~/o2`);
$n = 0;
foreach $msgid (@articles) {
$art =
$nntp->article($msgid);
$fname = "> _" . sprintf("%03d", $n);
open(O, $fname) || die "Can't open $fname";
print O join('', @$art);
close(O);
$n++;
}
---
perl /tmp/p
mkdir ~/tmp/tclnews
mv * ~/tmp/tclnews/ -v
cd ~/tmp/tclnews/
# (find-fline "~/tmp/tclnews/")
#####
#
# reading an entire file at once
# 2000oct02
#
#####
# «reading_a_file_at_once» (to ".reading_a_file_at_once")
# (eeman "perlvar" "input_record_separator HANDLE EXPR")
# (eeman "perlop" "null filehandle")
#*
ls /tmp \
| perl -e 'undef $/; print "AAAA:", <>, ":ZZZZ\n";'
#*
#####
#
# "/e" in regsub
# 2001jan15
#
#####
# «eval_in_regsub» (to ".eval_in_regsub")
# (find-angg ".zshrc" "save-input")
# (eeman "perlop" "abc246xyz")
# (find-pl5podfile "perlop.pod" "abc246xyz")
# (find-pl5podfile "perlfunc.pod" "=item chr\n")
# (find-node "(zsh)Shell Builtin Commands" "echo")
#*
echo -ne '\r\a\n\f\t' \
| perl -nle '
s/[\000-\037]/"^".chr(ord($&)+64)/eg; print
'
#*
#####
#
# filter
# 2001jul11
#
#####
# «filter» (to ".filter")
# (eeman "1p perlfunc" "split /")
# (eeman "1p perlop" " Quote and Quote-like Operators")
#*
# (find-angg ".zshrc" "filter")
function filter () {
WHICH=$1 \
perl -nle '
if (m/;;-> (.*)/) {
$doprint = 0;
for $p (split(/ /, $1)) {
for $w (split(/,/, $ENV{"WHICH"})) {
if ($p eq $w) { $doprint = 1 }
}
}
} else {
if ($doprint) { print; }
}
'
}
cat > /tmp/file <<'---'
one
;;-> foo
two
;;-> bar baz
three
;;-> foo baz
four
;;-> fiv
five
---
cat /tmp/file | filter foo
cat /tmp/file | filter bar
cat /tmp/file | filter baz
cat /tmp/file | filter foo,fiv
#*
#####
#
# DB files
# 2005oct27
#
#####
# «db_files» (to ".db_files")
# (find-man "3perl DB_File" "print the contents of the file")
# (find-man "1 perlfunc" "tie VARIABLE,CLASSNAME,LIST")
# (find-sh "file /var/cache/man/index.db")
#*
rm -Rv /tmp/mydb/
mkdir /tmp/mydb/
cd /tmp/mydb/
cat > foo.pl <<'%%%'
use warnings ;
use strict ;
use DB_File ;
our (%h, $k, $v) ;
unlink "fruit" ;
tie %h, "DB_File", "fruit", O_RDWR|O_CREAT, 0666, $DB_HASH
or die "Cannot open file 'fruit': $!\n";
# Add a few key/value pairs to the file
$h{"apple"} = "red" ;
$h{"orange"} = "orange" ;
$h{"banana"} = "yellow" ;
$h{"tomato"} = "red" ;
# Check for existence of a key
print "Banana Exists\n\n" if $h{"banana"} ;
# Delete a key/value pair.
delete $h{"apple"} ;
# print the contents of the file
while (($k, $v) = each %h)
{ print "$k -> $v\n" }
untie %h ;
%%%
perl foo.pl
#*
cd /tmp/mydb/
cat > bar.pl <<'%%%'
use warnings ;
use strict ;
use DB_File ;
our (%h, $k, $v) ;
tie %h, "DB_File", "fruit", O_RDONLY, 0666, $DB_HASH
or die "Cannot open file 'fruit': $!\n";
# print the contents of the file
while (($k, $v) = each %h)
{ print "$k -> $v\n" }
untie %h ;
%%%
perl bar.pl
#*
#####
#
# eepitch-perl
# 2009jul26
#
#####
# «eepitch-perl» (to ".eepitch-perl")
# (find-angg ".emacs" "perl")
* (eepitch-perl)
* (eepitch-kill)
* (eepitch-perl)
write("foo\n")
write "foo\n"
;
flush;
hex("40");
print hex(40);
print hex("40");
print chr(hex("40"));
h h
perl-doc perl-doc-html
# (find-status "perl-doc")
# (find-vldifile "perl-doc.list")
# (find-udfile "perl-doc/")
# (find-status "perl-doc-html")
# (find-vldifile "perl-doc-html.list")
# (find-udfile "perl-doc-html/")
# (find-man "perldebug")
#####
#
# Sepia (Simple Emacs-Perl InterAction)
# 2013jan02
#
#####
# «sepia» (to ".sepia")
# (find-available "sepia")
#####
#
# cpan-2020
# 2020jun28
#
#####
# «cpan-2020» (to ".cpan-2020")
# (find-asrootfile "/root/.cpan/")
# (find-asrootfile "/root/.cpan/CPAN/")
Autoconfiguration complete.
commit: wrote '/root/.cpan/CPAN/MyConfig.pm'
You can re-run configuration any time with 'o conf init' in the CPAN shell
# https://lists.gnu.org/archive/html/bug-gnu-emacs/2023-02/msg00263.html
git log -p --since="2021-10-01" --author luangruo -- | perl -ne 'chomp; $line =
$_;
if ($line =~ /^[ -]((DEFUN\s\()|[a-z]\S+\s\()/) {
$prim = 1 if $2;
$new = "";
substr($line,0,1) = "-";
$old = "$line\n";
} elsif ($old && $line =~ /^[-]/) {
$old .= "$line\n" if $line =~ /[(),]/;
} elsif ($old && $line =~ /^\+/) {
$new .= "$line\n" if $line =~ /[(),]/;
if (!$prim && $new =~ /\)\s*$/ ||
$prim && $new =~ /\d,\s*\d,\s*\d/) {
print $old;
print $new;
$prim = $old = $new = "";
}
} else {
$prim = $old = $new = "";
}'
# (find-sh "egrep '^[qwertyuiop]+$' /usr/share/dict/words | perl -lne '/(.*)/ and print length($1), \"\\t\", $1' | sort -nr | head -n 100")
# (find-sh "egrep '^[aoeuidhtns]+$' /usr/share/dict/words | perl -lne '/(.*)/ and print length($1), \"\\t\", $1' | sort -nr | head -n 100")
/x for whitespace and comments
use re "debug"
will cause the perl regex engine to spit out lots of comments about
what it's doing
use re 'debugcolor'
perl -Mre=debugcolor -e '"hi" =~ /h([a-z]*)/'
http://search.cpan.org/dist/Perl-Tidy/bin/perltidy
http://www.csse.monash.edu.au/~damian/papers/HTML/Perligata.html
https://news.ycombinator.com/item?id=28919910 The reports of Perl's death have been greatly exaggerated (phoenixtrap.com)
https://news.ycombinator.com/item?id=33404658 The Perl Foundation will now be known as The Perl and Raku Foundation (perlfoundation.org)
https://news.ycombinator.com/item?id=36569727 Perl 5.38 (perl.org)
https://news.ycombinator.com/item?id=36650120 Perl first commit: a “replacement” for Awk and sed (github.com/perl)
https://metacpan.org/pod/criticism
https://metacpan.org/pod/Carton
# Local Variables:
# coding: utf-8-unix
# End: