Warning: this is an htmlized version!
The original is across this link,
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.
#
# 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")








#####
#
# 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")





# (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




#  Local Variables:
#  coding:               no-conversion
#  ee-delimiter-hash:    "\n#*\n"
#  ee-delimiter-percent: "\n%*\n"
#  ee-anchor-format:     "«%s»"
#  End: