[11412] in Perl-Users-Digest
Perl-Users Digest, Issue: 5012 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Mar 1 11:07:30 1999
Date: Mon, 1 Mar 99 08:02:00 -0800
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Mon, 1 Mar 1999 Volume: 8 Number: 5012
Today's topics:
Help!! <clm@biteme.com>
HELP: Am 100% lost on these error msgs (David Combs)
Is there a more efficient routine? <jaybyrd@macs.net>
libwww-perl vs. telnet to port 80 (Carl Brock Sides)
Re: localtime -> time <rra@stanford.edu>
Re: localtime -> time <Philip.Newton@datenrevision.de>
Re: localtime -> time (M.J.T. Guy)
Re: make an index of links to html files in a directory (Randal L. Schwartz)
mod_perl + Net::PH => persistant DB connection? otis@my-dejanews.com
Special: Digest Administrivia (Last modified: 12 Dec 98 (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sun, 28 Feb 1999 02:45:04 -0500
From: "Clawed Le Mew" <clm@biteme.com>
Subject: Help!!
Message-Id: <ORE4J6uY#GA.119@nih2naad.prod2.compuserve.com>
I am writing my first Perl script, which is a simple looping translation
program, or so I thought until I actually wrote it.
The problem I encountered is that I want to replace a number of expressions
that literally begin with plus signs that are present in the data I am
translating. Unfortunately for me, the plus signs are interpreted as regexp
characters. How do I get around this?
Here is the script so you can see what I am attempting to do.
------------
#!/usr/local/bin/perl
# This program is meant to read lines of text which contain many special
character codes
# as well as formatting codes which are nonstandard and which I want to
universally replace
# with a different set of codes. The way I have presented it here works. The
problem
# occurs when I try to use the values that begin with plus signs, shown
below.
@map =
(
"&", "&",
"<", "<",
">", ">",
0,0);
while (<>)
{
for( $a = 0; $map[$a]; $a+=2 )
{
s/$map[$a]/$map[$a+1]/g;
}
print "$_";
}
print "\n";
#---------------------------------------------------------------------------
------------
# end of program. What follows is the rest of the "@map" array I wanted to
use,
# commented out, of course.
#
# Note: These are actual "plus signs" that I want to search for and replace.
# They are not intended to be regexp characters.
#
#"+100", "⁁",
#"+200", "á",
#"+201", "Á",
#"+202", "à",
#"+203", "À",
#"+204", "â",
#"+205", "Â",
#"+206", "ä",
#"+207", "Ä",
#"+208", "å",
#"+209", "Å",
#"+210", "ā",
#"+211", "Ā",
#"+212", "&adot;",
#"+213", "&Adot;",
#"+214", "ă",
#"+215", "Ă",
#"+216", "ą",
#"+217", "Ą",
#"+218", "&acaron;",
#"+219", "&Acaron;",
#"+220", "ã",
#"+221", "Ã",
#"+222", "&acedil;",
#"+223", "&Acedil;",
#"+224", "&araisd;",
#"+230", "ç",
#"+231", "Ç",
#"+232", "č",
#"+233", "Č",
#"+234", "ć",
#"+235", "Ć",
#"+236", "&cbreve;",
#"+237", "&Cbreve;",
#"+242", "&dcedil;",
#"+243", "&Dcedil;",
#"+244", "&ddot;",
#"+245", "&Ddot;",
#"+248", "é",
#"+249", "É",
#"+250", "è",
#"+251", "È",
#"+252", "ê",
#"+253", "Ê",
#"+254", "ë",
#"+255", "Ë",
#"+256", "ē",
#"+257", "Ē",
#"+258", "ě",
#"+259", "Ě",
#"+260", "ę",
#"+261", "Ę",
#"+262", "ė",
#"+263", "Ė",
#"+264", "&ebreve;",
#"+265", "&Ebreve;",
#"+274", "ğ",
#"+275", "Ğ",
#"+276", "&gcaron;",
#"+277", "&Gcaron;",
#"+282", "&hcedil;",
#"+283", "&Hcedil;",
#"+284", "&hdot;",
#"+285", "&Hdot;",
#"+290", "í",
#"+291", "Í",
#"+292", "ì",
#"+293", "Ì",
#"+294", "î",
#"+295", "Î",
#"+296", "ï",
#"+297", "Ï",
#"+298", "ī",
#"+299", "Ī",
#"+300", "&icaron;",
#"+301", "&Icaron;",
#"+302", "&ibreve;",
#"+303", "&Ibreve;",
#"+318", "ñ",
#"+319", "Ñ",
#"+320", "ń",
#"+321", "Ń",
#"+322", "ň",
#"+323", "Ň",
#"+324", "&ndot;",
#"+325", "&Ndot;",
#"+326", "ņ",
#"+327", "Ņ",
#"+330", "á",
#"+331", "&udot;",
#"+332", "ó",
#"+333", "Ó",
#"+334", "ò",
#"+335", "Ò",
#"+336", "ô",
#"+337", "Ô",
#"+338", "ö",
#"+339", "Ö",
#"+340", "ō",
#"+341", "Ō",
#"+342", "&obreve;",
#"+343", "&Obreve;",
#"+344", "õ",
#"+345", "Õ",
#"+346", "⊙",
#"+347", "&Odot;",
#"+348", "&ocedil;",
#"+349", "&Ocedil;",
#"+350", "ø",
#"+351", "Ø",
#"+360", "ř",
#"+361", "Ř",
#"+362", "&rdot;",
#"+363", "&Rdot;",
#"+364", "&rdotun;",
#"+365", "&Rdotun;",
#"+368", "š",
#"+369", "Š",
#"+370", "ş",
#"+371", "Ş",
#"+372", "ś",
#"+373", "Ś",
#"+374", "&sdotun;",
#"+375", "&Sdotun;",
#"+378", "ţ",
#"+379", "Ţ",
#"+380", "&tdotun;",
#"+381", "&Tdotun;",
#"+388", "ú",
#"+389", "Ú",
#"+390", "ù",
#"+391", "Ù",
#"+392", "û",
#"+393", "Û",
#"+394", "ü",
#"+395", "Ü",
#"+396", "ū",
#"+397", "Ū",
#"+398", "&udot;",
#"+399", "&Udot;",
#"+400", "ŭ",
#"+401", "Ŭ",
#"+402", "&ucaron;",
#"+403", "&Ucaron;",
#"+404", "ũ",
#"+405", "Ũ",
#"+406", "ů",
#"+407", "Ů",
#"+408", "&ucedil;",
#"+409", "&Ucedil;",
#"+414", "&wdot;",
#"+415", "&Wdot;",
#"+416", "&wuml;",
#"+417", "&Wuml;",
#"+426", "ý",
#"+427", "Ý",
#"+428", "ÿ",
#"+429", "Ÿ",
#"+430", "&ymacr;",
#"+431", "&Ymacr;",
#"+438", "ž",
#"+439", "Ž",
#"+440", "ź",
#"+441", "Ź",
#"+442", "ż",
#"+443", "Ż",
#"+444", "&zcedil;",
#"+445", "&Zcedil;",
#"+0", " ",
#"+1", "‘",
#"+2", "’",
#"+5", "¶",
#"+8", "[",
#"+9", "]",
#"+10", " ",
#"+13", "—",
#"+17", "§",
#"+20", "°",
#"+21", "<",
#"+22", ">",
#"+23", "¢",
#"+24", "&smbull;",
#"+25", "•",
#"+30", "+",
#"+31", "¿",
#"+32", "=",
#"+37", "“",
#"+38", "”",
#"+39", "&under;",
#"+46", "|",
#"+47", "\",
#"+48", "{",
#"+49", "}",
#"+60", "˜",
#"+73", "℞",
#"+86", "Æ",
#"+87", "æ",
#"+96", "ß",
#"+99", "☆",
#"+cp", "<?lcaps?>",
#"+nt", "<?notran?>",
#"+sc", "<?scaps?>",
#"+c", "<?clight6?>",
#"+cm", "<?clight7?>",
#"+cb", "<?cbold7?>",
#"+cx", "<?cmed8?>",
#"+p", "<?p?>",
#"+p +10", "<?p?> ",
#"+ql", "<?ql?>",
#"+qr", "<?qr?>",
#"+fl", "<?fl?>",
#"+dc", "<?dcol?>",
#"+d2", "<?dcolbk?>",
#"+nl", "<?newln?>",
#"+s", "<?sp?>",
#"+bk", "<?bk?>",
#"+bb ", "<?bb?>",
#"+d", "‡",
#"+l", "<?light6?>",
#"+m", "<?light7?>",
#"+x", "<?med8?>",
#"+b", "<?b?>",
#"+I", "<?it?>",
#"+r", "<?rm?>",
#"+ns", "<?newlnsm?>",
------------------------------
Date: Mon, 1 Mar 1999 03:58:20 GMT
From: dkcombs@netcom.com (David Combs)
Subject: HELP: Am 100% lost on these error msgs
Message-Id: <dkcombsF7wDp8.Bx9@netcom.com>
Am at my wits end.
I learned at least to use STDERR, which seems to automatically
"flush" the line before the err msgs come out.
Does anything stand out as being a problem?
First, the version typeout, then the run and its error
messages from perl, with some comments from me,
and finally the source -- with wide lines (20-in screen);
will maybe someday make into 80-cols wide, once the
prog works.
Everything works ok, UNTIL setting that parameter
$doOpenAndWrite... to ONE, which tells it to try
to write out each (maybe changed) line.
Works ok (or at least it did) when set to 0;
the entire problem seems to me to be the output I/O.
(WRONG: even that doesn't work. Well, am at a total
loss. these error msgs leave me TOTALLY CLUELESS;
I've tried to initialize everything, declare everything,
use my for everything, use -w when I run it...)
HELP!
Thanks SO much! (this is NOT my first perl program!)
David Combs
=====================================================================
======================= First, what version I am using:
=====================================================================
428 ==/home/dkc/manual==> perl -V
Summary of my perl5 (5.0 patchlevel 5 subversion 2) configuration:
Platform:
osname=solaris, osvers=2.5.1, archname=sun4-solaris
uname='sunos 5.5.1 generic sun4m sparc sunw,sparcstation-10 '
hint=recommended, useposix=true, d_sigaction=define
usethreads=undef useperlio=undef d_sfio=undef
Compiler:
cc='gcc', optimize='-O', gccversion=2.8.1
cppflags='-I/usr/local/include'
ccflags ='-I/usr/local/include'
stdchar='unsigned char', d_stdstdio=define, usevfork=false
intsize=4, longsize=4, ptrsize=4, doublesize=8
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
alignbytes=8, usemymalloc=y, prototype=define
Linker and Libraries:
ld='gcc', ldflags =' -L/usr/local/lib'
libpth=/usr/local/lib /lib /usr/lib /usr/ccs/lib
libs=-lsocket -lnsl -ldl -lm -lc -lcrypt
libc=/lib/libc.so, so=so, useshrplib=false, libperl=libperl.a
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
cccdlflags='-fPIC', lddlflags='-G -L/usr/local/lib'
Characteristics of this binary (from libperl):
Built under solaris
Compiled at Jan 23 1999 01:43:05
@INC:
/usr/local/lib/perl5/5.00502/sun4-solaris
/usr/local/lib/perl5/5.00502
/usr/local/lib/perl5/site_perl/5.005/sun4-solaris
/usr/local/lib/perl5/site_perl/5.005
.
=====================================================================
======================= Now, the run (program has "use diagnostics"):
=====================================================================
430 ==/home/dkc/manual==> perl -w test-flipflop9.pl bonds.mss > ! t.loc
Will now run perl5.00502 "straight"
===================== ENTERING test-flipflop9.pl: ARGV is @ARGV::
======= $outfilePrefix is "foodir/foo".
======= $doOpenAndWriteToFileToLaterReplaceMeWith is "1".
======= $rangeINCLUDEStheBeginAndEnd is 1.
Result of trim: now
------------------------------- ARG:: argvNum is 1, fileNum is 1; curFileName is "bonds.mss":
ENTERING SUBROUTINE processOneFile: curFileName is "bonds.mss":
----------------------------------------------------------------------
--------------- NOW STARTING ON FILE num #1: "bonds.mss".
DEBUG: NOW OPENING INPUT FILE "bonds.mss":
DEBUG: OPENING OUTPUT fileName4LaterReplaceMeWith as "foodir/foobonds.mss".
Use of uninitialized value at test-flipflop9.pl line 386, <FIN> chunk 1 (#1)
(W) An undefined value was used as if it were already defined. It was
interpreted as a "" or a 0, but maybe it was a mistake. To suppress this
warning assign an initial value to your variables.
DEBUG: NEW LINE, at L1, is: ""
Use of uninitialized value at test-flipflop9.pl line 387, <FIN> chunk 1 (#1)
Undefined subroutine &main::processThisline called at test-flipflop9.pl line
390, <FIN> chunk 1 (#2)
(F) The subroutine indicated hasn't been defined, or if it was, it
has since been undefined.
Uncaught exception from user code:
Undefined subroutine &main::processThisline called at test-flipflop9.pl line 390, <FIN> chunk 1.
main::processOneFile('bonds.mss') called at test-flipflop9.pl line 453
2.0 sys= 0.0 49% || mem=0 in=0
431 ==/home/dkc/manual==>
=====================================================================
======================= Note this about the above:
=====================================================================
(1) Sorry, but I haven't a clue about these error messages.
Either I don't know both what uninitialized values are
and what never-defined subroutines are (when I can see
it right in front of my eyes), or something elsewhere in
this program is causing "bogus" error messages.
(2) The input file (bonds.mss, above) can be ANY ascii file.
(3) Please don't sweat the wide lines; I hope you have a wide screen!
(if you really complain, I'll have to shorten them all, and probably
break the program even more by doing that!)
(4) Why the "$myvar = FIN*"? Because, at my wits end, I saw in the
COOKBOOK that you could do this. (Thought it might help somehow.
It didn't.)
---- Doing it shouldn't hurt, as this little program, fooio.pl, DOES work ok:
#!/usr/bin/perl -w
use strict;
print "\n===================== ENTERING $0: ARGV is \@ARGV::\n";
open(FIN, "<" . "fooio.pl") or die "Cannot open!";
my ($myFIN) = *FIN; my ($line) = "";
while (defined($line = <$myFIN>)) {
print $line; }
print "\nDONE!\n\n";
(5) FOR EXTRA CREDIT: For everything AFTER the subs, why, why, WHY, dear god,
does cperl-mode's "indent-region" indent all THOSE lines over
about 20 chars? (I use emacs 19.34, AND
;; $Id: cperl-mode.el,v 4.18 1998/12/08 19:37:54 ilya Exp ilya $
).
(I cannot find any unbalanced parens or curlies -- and I have looked!)
Please, can ANYONE give me ANY help with the above problems? THANKS!
=====================================================================
======================= Here is that super-wide source:
=====================================================================
#!/usr/bin/perl -w
use strict;
use diagnostics;
$^W = 1;
# How to RUN this program:
# USAGE: perl -w test-flipflop8.pl `cat t.nam` >! t.loc
# How to PRINT-OUT this program:
# prlno test-flipflop8.pl | sed 's/@/@@/g' > ! t.lno
# scribe t
# ghostview t.ps
# lp t.ps
# FLUSH: perlfaq5.pod-42- select((select(OUTPUT_HANDLE), $| = 1)[0]);
print STDERR "\n===================== ENTERING $0: ARGV is \@ARGV::\n";
# ========== SET THESE TWO PARAMETERS::
my ($doOpenAndWriteToFileToLaterReplaceMeWith) = 1; # <== SET THIS PARAMETER!!
my ($outfilePrefix) = "foodir/foo";
my ($rangeINCLUDEStheBeginAndEnd) = 1; # Else (ie 0) are JUST-OUTSIDE the range.
# Defines "within"; WHETHER the @begin & @end boundary-lines THEMSELVES are
# considered "WITHIN" the begin-end.
#
print STDERR " ======= \$outfilePrefix is \"$outfilePrefix\".\n";
print STDERR " ======= \$doOpenAndWriteToFileToLaterReplaceMeWith is \"$doOpenAndWriteToFileToLaterReplaceMeWith\".\n";
print STDERR " ======= \$rangeINCLUDEStheBeginAndEnd is $rangeINCLUDEStheBeginAndEnd.\n";
print STDERR "\n\n";
# -rw-r--r-- 1 dkc staff 11872 Dec 11 18:13 test-flipflop7.pl
# ------------------------------------------------
# NOTE THESE LINES BELOW:
## $fileName4LaterReplaceMeWith = "foodir/" . $curFileName; #DOCME!
## my ($doOpenAndWriteToFileToLaterReplaceMeWith) = 0;# <== SET THIS PARAMETER!!
# ------------------------------------------------
my ($numTotalFilesSeenSoFar) = 0; # FIXME: Do a "if not VAR then VAR = 0".
my $myVarHoldingFIN;
my ($offOn) = 0;
#
my ($curFileName) = "";
my ($prevCurFileName) = "";
#
my ($curLine) = ""; #debug only: dkc added 26feb99.
my ($prevCurLine) = ""; #debug only: dkc added 26feb99.
#
my ($theAtBeginLineNum) = 0;
my ($theAtBeginLine) = "";
#
my ($maxNumAllowableFiles) = 300; # because we once had a same-file LOOP!
#
my ($numFilesSeenSoFar) = 0;
my ($numTotalLinesSeenSoFar) = 0;
#
my ($numBeginsInThisFile) = 0;
my ($numEndsInThisFile) = 0;
my ($numErrors) = 0;
#
my ($fileName4LaterReplaceMeWith) = "";
my $myFOUT;
my ($myDiscoveredFunnyThing) = "";
my ($myPriorDiscoveredFunnyThing) = "";
# ------------------------------------------------
my ($numSubsofBOLtoTwoAmperSemisSoFar) = 0;
my ($sawAnAtBeginOnTHISline, $sawAnAtEndOnTHISline); # For REMEMBERING,
# and WITH $rangeINCLUDEStheBeginAndEnd, tells whether THIS begin or
# end-line is considered part of the region, or not.
# ------------------------------------------------------------------------
# ------------------------------------------------------------------------
# ------------------------------------------------------------------------
# ------------------------------------------------------------------------
sub trim {
my ($variable) = @_;
# from perlop.pod: trim whitespace:
for ($variable) { # trim white space in $variable, cheap
s/^\s+//;
s/\s+$//;
}
$variable; # return this.
}
sub processThisLine { # STARTOF: sub processThisLine:::
$numTotalLinesSeenSoFar += 1;
# ------------ Does THIS line EITHER start OR end a @begin-@end RANGE?::
$sawAnAtBeginOnTHISline = $sawAnAtEndOnTHISline = 0;
# PROGRAMEXAMPLE|@sle|trueverbatim <--- FIXME!
# longprogramexample centeredProgramExample useCenterUseProgramExample
if (/^\@begin\([a-zA-Z0-9]*PROGRAMEXAMPLE.*/i) {
$sawAnAtBeginOnTHISline = 1;
# print STDERR "\@BEGIN, at L$.: $curLine\n"; #DEBUG ONLY!!
}
if (/^\@end\([a-zA-Z0-9]*PROGRAMEXAMPLE.*/i) {
$sawAnAtEndOnTHISline = 1;
# print STDERR "\@END, at L$.: $curLine\n"; #DEBUG ONLY!!
}
if ($sawAnAtBeginOnTHISline and $sawAnAtEndOnTHISline) {
$numErrors += 1;
print(STDERR "\n\nERROR: FOUND ON SAME LINE BOTH a \@begin AND an \@end, ",
"at an \@BEGIN:\n $curFileName L", "$.: $_\n\n"); }
# -------------------------------------- @BEGIN:
# -------------------------------------- @BEGIN:
if ($sawAnAtBeginOnTHISline) { # @BEGIN:
$theAtBeginLine = $_;
$theAtBeginLineNum = $.;
$numBeginsInThisFile += 1;
# print STDERR "----- debug: we ENTER a begin-end group: $curFileName L", "$.: $_\n";
if ($offOn) {
$numErrors += 1;
print STDERR "\n\nNESTING-ERROR: offOn gets set ON, but was ALREADY on!!!:\n $curFileName L", "$.: $_\n\n";
}
# OK, we've tested for nesting-err on $offON, so NOW MAYBE set it ON --
# ACTUALLY, we do THAT kind of stuff for BOTH @begin AND @end together,
# JUST AS WE FINISH the "@end"-block, below.
if ($sawAnAtEndOnTHISline) { # REDUNDANT, so is really more of an ASSERT:
$numErrors += 1;
print STDERR "\n\nNESTING-ERROR: (same one?) via \$sawAnAtEndOnTHISline still on, at an \@BEGIN:\n $curFileName L", "$.: $_\n\n";
}
$sawAnAtEndOnTHISline = 0; # And must ensure is off SOMETIME, huh?
## if (! /\@isVwc/) {
## $numErrors += 1;
## print STDERR "\n\n: ERROR: (at $curFileName L", "$.): on \@BEGIN-line, NO \@isVwc...!!\n";
## print STDERR " $_\n\n";
## }
} # @BEGIN.
# -------------------------------------- @END:
# -------------------------------------- @END:
if ($sawAnAtEndOnTHISline) { # @END:
$numEndsInThisFile += 1;
# print STDERR "----- DEBUG: we EXIT a begin-end group: $curFileName L", "$.: $_\n";
if (! $offOn) {
$numErrors += 1;
print STDERR "\n\nNESTING-ERROR: offOn gets set OFF, but was ALREADY off!!! (at $curFileName L", "$.):\n$_\n\n";
}
#
# OK, we've tested for nesting-err on $offON, so NOW MAYBE set it off --
# ACTUALLY, we do THAT kind of stuff for BOTH @begin and @end together,
# just after FINISHING this "@end"-block.
$theAtBeginLine = "";
$theAtBeginLineNum = 0;
} # @END.
# Are we "WITHIN" the begin-end range? TWO schools-of-thought on it:
# (1) if the begin & end THEMSELVES are "within" the begin-end range, VS
# (2) if the begin & end THEMSELVES are NOT "within" the begin-end range.
#
# NOTE: we MAYBE DELAY, via $sawAnAtEndOnTHISline, setting $offOn to zero:
# NOTE: we MAYBE DELAY, via $sawAnAtEndOnTHISline, setting $offOn to zero:
# Yes, would run faster to split these two, factor-out the "sawAn...",
# and move one each up into the each of the above two blocks --
# BUT this way it LOOKS SYMMETRIC to the SIMILAR two stmts
# down at where the DELAYED setting of $offOn is done.
#
# (if range DOES include them, rush the begin (now), and delay the end):
# (if range DOESN'T include them, delay the begin, and rush the end (now)):
#
if ($rangeINCLUDEStheBeginAndEnd and $sawAnAtBeginOnTHISline) {
$offOn = 1;
}
if (! $rangeINCLUDEStheBeginAndEnd and $sawAnAtEndOnTHISline) {
$offOn = 0;
}
#
# It is due to THIS logic that must be illegal to have BOTH @begin & @end
# on the SAME line.
# ----------------------------- So, are we now "WITHIN" a @begin/end?:
if ($offOn) { #START-If WITHIN the @begin/@end:
my ($myBegin) = "";
my ($myEnd) = "";
my ($mySingleton) = 0;
# Now, check for funny things that maybe should NOT be WITHIN a @begin/end:
if (/ViaWALLCHARTverbatim/i) { #START-if-/ViaWALLCHARTverbatim/i:
#
my ($myPreMatch) = $`; # For gblvar-safety, placed HERE.
# ROTATE "prior":
$myPriorDiscoveredFunnyThing = $myDiscoveredFunnyThing;
$myDiscoveredFunnyThing = $&;
if ($myPreMatch =~ /\@begin/i) {
$myBegin = $&;
} elsif ($myPreMatch =~ /\@end/i) {
$myEnd = $&;
} else {
$mySingleton = 1;
}
if ($myBegin and $myEnd) {
$numErrors += 1;
print STDERR "ERROR: (at $curFileName L", "$.): \"funny\" \@begin and \@end on SAME LINE!!!\n";
}
if ($myBegin or $mySingleton) {
print STDERR "\n";
}
; #To space singleton OR begin-end-PAIR within the ERR-mgs.
print STDERR "WARNING: /$myDiscoveredFunnyThing/ \"inside\" a: L", "$theAtBeginLineNum: $theAtBeginLine: \n";
# print STDERR "DEBUG: myPreMatch is $myPreMatch, myBegin is $myBegin, myEnd is $myEnd, mySingleton is $mySingleton.\n";
print STDERR " $curFileName L", "$.: $_\n";
# print STDERR " (WITHIN THE \@BEGIN-END that STARTS at: $curFileName L", "$theAtBeginLineNum: $theAtBeginLine). \n";
if ($myEnd and ($myPriorDiscoveredFunnyThing ne $myDiscoveredFunnyThing)) {
$numErrors += 1;
print STDERR "ERROR: HAS \@begin-\@end MISMATCH!!!\n";
}
if ($myEnd or $mySingleton) {
print STDERR "\n";
}
; # ditto above's spacing.
} #END-if-/ViaWALLCHARTverbatim/i.
if ( m/^@;@;@;/ ) { # Seeing THREE, "@;@;@;" ==> an ERROR.
$numErrors += 1;
print STDERR "\n\n: ERROR: in file $curFileName, line $., saw an EXISTING THREE \"@;@;@;\"!!!:\n";
print STDERR " $_\n\n";
} elsif ( m/^@;@;/ ) { # Seeing TWO "@;@;" ==> an ERROR.
$numErrors += 1;
print STDERR "\n\n: ERROR: in file $curFileName, line $., saw an EXISTING TWO \"@;@;\"!!!:\n";
print STDERR " $_\n\n";
} elsif ( m/^@;/ ) {
$numSubsofBOLtoTwoAmperSemisSoFar += s/^/@;/; # prepend ONE MORE, makes TWO.
} else {
$numSubsofBOLtoTwoAmperSemisSoFar += s/^/@;@;/;
} #prepend normal TWO.
} #END-If WITHIN the @begin/@end.
else { # the NOT--within-these-FUNNY-@begin/@ends:
# FIXME: move this elsewhere? Do in EARLIER PASS? (via egrep?:
if ( m/^@;@;/ ) { # convert EXISTING (viaWallCh...verbatim) to THREE:
s/^/@;/; # prepend ONE MORE, makes THREE
}
}
# ----------------------------------- Finally, some tests on EVERY line:
if (/\(verbatim/i) {
print STDERR "\n\n: ERROR: in file $curFileName, line $., saw a \"naked\"-VERBATIM:\n";
print STDERR " $_\n\n";
}
# ----------------------------------- AND FINALLY, WRITE OUT THE LINE:
if ($doOpenAndWriteToFileToLaterReplaceMeWith) {
print $myFOUT $_, "\n";
}
#------------------ Finally, we're TOTALLY DONE with the CURRENT line:
#------------------ Finally, we're TOTALLY DONE with the CURRENT line:
# THIS CODE MUST(!!) be BEYOND the VERY-FINAL "LOOK" at the CURRENT LINE!
# THIS CODE MUST(!!) be BEYOND the VERY-FINAL "LOOK" at the CURRENT LINE!
# NOTE: we MAYBE DELAY, via $sawAnAtEndOnTHISline, setting $offOn to zero:
# NOTE: we MAYBE DELAY, via $sawAnAtEndOnTHISline, setting $offOn to zero:
# (if range DOES include them, already rushed the begin, and delay the end (to now)):
# (if range DOESN'T include them, delay the begin (to now), and already rushed the end):
if (! $rangeINCLUDEStheBeginAndEnd and $sawAnAtBeginOnTHISline) {
$offOn = 1;
}
if ($rangeINCLUDEStheBeginAndEnd and $sawAnAtEndOnTHISline) {
$offOn = 0;
}
} # ENDOF: sub processThisLine.
# ----------------------------------------------------------------------
# ----------------------------------------------------------------------
# ----------------------------------------------------------------------
# ----------------------------------------------------------------------
sub processOneFile($) { # Start processOneFile():::
## $curFileName = @_; # is a "package" variable (ie, for this FILE).
if (length($outfilePrefix) >= 1 and $curFileName =~ /^\//) {
print STDERR "ERROR: WHEN there is an \$outfilePrefix, a filename\n (\"$curFileName\") MAY NOT START with a slash! Try again.\n";
die "yes, must die!";
exit }
print(STDERR "\nENTERING SUBROUTINE processOneFile: curFileName is \"$curFileName\":\n");
# print(STDERR " NOTE: dollar-zero is \"$0\"\n"); #docme
if ( ($numFilesSeenSoFar += 1) >= $maxNumAllowableFiles) {
$numErrors += 1;
die "========>>>> ERROR: STOPPING: \$numFilesSeenSoFar ($numFilesSeenSoFar) hits \$maxNumAllowableFiles ($maxNumAllowableFiles).\n";
}
print STDERR '-' x 70, "\n";
print STDERR "--------------- NOW STARTING ON FILE num #$numFilesSeenSoFar: \"$curFileName\".\n";
print(STDERR "DEBUG: NOW OPENING INPUT FILE \"$curFileName\":\n");
open(FIN, "<" . $curFileName) or die "can't open file \"$curFileName\"!";
$myVarHoldingFIN = *FIN; # Why? Exasperation, try anything!
$numTotalFilesSeenSoFar += 1;
$offOn = 0;
$curLine = "";
$prevCurLine = "";
$theAtBeginLine = "";
$theAtBeginLineNum = 0;
$myPriorDiscoveredFunnyThing = "";
$numBeginsInThisFile = 0;
$numEndsInThisFile = 0;
# ---- INIT STUFF FOR THIS NEW, FRESH "LATERREPLACEMEWITH" FILE:
if ($doOpenAndWriteToFileToLaterReplaceMeWith) { #WILL write new file:
$fileName4LaterReplaceMeWith = $outfilePrefix . $curFileName; #DOCME!
print STDERR "DEBUG: OPENING OUTPUT fileName4LaterReplaceMeWith as \"$fileName4LaterReplaceMeWith\".\n";
open(LATERREPLACEMEWITH, ">" . $fileName4LaterReplaceMeWith) or die("can't open $fileName4LaterReplaceMeWith: at L$!");
$myFOUT = *LATERREPLACEMEWITH; # Why? Exasperation, try anything!
print $myFOUT "DEBUG TEST!!!!\n"; # <-- THIS IS THE ONLY OUTPUT WE GET!
} #END: WILL write new file.
$curLine = "";
while (defined($curLine = <$myVarHoldingFIN>)) { # START-WHILE:
print STDERR "DEBUG: NEW LINE, at L", "$., is: \"$_\"\n"; #27feb99
chomp;
$prevCurLine = $curLine; #debug only: dkc added 26feb99.
processThisline(); # ----------- CALL TO "PROCESS THIS LINE()".
} # END-WHILE.
if ($offOn) {
$numErrors += 1;
print STDERR "\n\nNESTING-ERROR: at EOF of $curFileName, offOn was STILL ON!!!:\n\n";
}
# A suplerflous test (already caught via $offOn?):
if ($numBeginsInThisFile != $numEndsInThisFile) {
print STDERR "ERROR: \@begin-\@end MISMATCH!!: at eof \"$curFileName\": numBeginsInThisFile ($numBeginsInThisFile) != numEndsInThisFile ($numEndsInThisFile)\n";
}
close($myVarHoldingFIN);
if ($doOpenAndWriteToFileToLaterReplaceMeWith) {
close(LATERREPLACEMEWITH);
}
;
return 1; # ==================>>> RETURN RETURN =====>>>
} #end processOneFile().
# ------------------------------------------------------------------------
# ------------------------------------------------------------------------
# ------------------------------------------------------------------------
# ------------------------------------------------------------------------
# ---------------------------------------------------------------------------------------------
# ---------------------------------------------------------------------------------------------
# ---------------------------------------------------------------------------------------------
# ---------------------------------------------------------------------------------------------
# ---------------------------------------------------------------------------------------------
# ---------------------------------------------------------------------------------------------
print STDERR "Result of trim: ", trim(" now "), "\n\n";
my $fileNum = 0;
my $argvNum = 0;
while ($ARGV = shift) {
$argvNum += 1;
-e $ARGV or die "$ARGV does not EXIST (as file)!";
-f $ARGV or die "$ARGV is NOT a REGULAR FILE!";
-r $ARGV or die "$ARGV is NOT a READABLE file!";
-T $ARGV or die "$ARGV is NOT a TEXT file!";
$fileNum += 1;
$curFileName = $ARGV;
print(STDERR "\n------------------------------- ARG:: argvNum is $argvNum, fileNum is $fileNum; curFileName is \"$curFileName\":\n");
# Note: PP says I cannot use "&" if I want "prototype" CHECKED:
processOneFile($curFileName); # <<==== NOW, CALL IT <<<====.
} # end "while ($ARGV = shift)".
print(STDERR "\n\n");
system("date");
print(STDERR "ALL DONE: EXITING PROGRAM $0: ARGV was @ARGV.\n");
if ($doOpenAndWriteToFileToLaterReplaceMeWith) {
print(STDERR "\n====>>> TO GET ACTUAL OUTPUT-FILES, LOOK IN foodir/\n\n");
}
# ------------------------------------------------------------------------
# ------------------------------------------------------------------------
print STDERR "\nALL DONE:: numErrors is $numErrors;\n AND:: numFilesSeenSoFar is $numFilesSeenSoFar.\n";
print STDERR " AND:: \$numSubsofBOLtoTwoAmperSemisSoFar is $numSubsofBOLtoTwoAmperSemisSoFar.\n";
print STDERR " AND:: \$numTotalLinesSeenSoFar is $numTotalLinesSeenSoFar.\n";
print STDERR "\n\n";
------------------------------
Date: Mon, 01 Mar 1999 07:23:33 -0500
From: "Bill Chase" <jaybyrd@macs.net>
Subject: Is there a more efficient routine?
Message-Id: <7be0sa$s0i$1@news0-alterdial.uu.net>
All of the following works but is there a way of making it more efficient?
I also need to make sure that all items are unique and sorted after being read
back out of tempdb.txt.
Thanks in advance,
-Bill
$pg = $formdata{'pg_id'};
#tempdb.txt is only for temporary holding
#til all selections have been made
#each tempdb.txt file must be unique for each customer
open(DB, ">>tempdb.txt");
print DB $pg;
open(DB, "tempdb.txt");
@tempdb = <DB>;
close (DB);
#this works but theres got to a more efficient way
foreach $page (@ tempdb) {
foreach $page (@page = split(/\|/, $page)){
foreach $item (@item = split(/\:/,$page)){
}
$title = $item[0];
$url = $item[1];
# remove commas and whitespce
$text = $title;
$text =~ s/\, / /g ;
$text =~ s/ / /g ;
$doc_title = $text;
print "$title\n";
print "$url\n";
}
}
------------------------------
Date: Sat, 27 Feb 1999 16:00:04 GMT
From: opus@magibox.net (Carl Brock Sides)
Subject: libwww-perl vs. telnet to port 80
Message-Id: <opus-2702991002140001@harmless.magibox.net>
In the midst of trying to track down a weird web-server problem, I ran across a
phenomena I hope someone here can explain. To save myself the trouble of
telnetting to port 80 over and over again, I wrote a little libwww script, like
so:
#!/usr/bin/perl
use HTTP::Response;
use LWP::UserAgent;
use URI::URL;
my $ua = new LWP::UserAgent;
$ua->agent('Foozilla');
my $request = new HTTP::Request(GET, shift);
my $response = $ua->request($request);
my $headers = $response->headers_as_string;
print $headers;
When I invoke it, I get this:
[brock@harmless brock]$ perl get.pl http://grunt.yellowsnow.org
Connection: close
Date: Sat, 27 Feb 1999 04:05:00 GMT
Server: Apache/1.3.3 (Unix) (Red Hat/Linux)
Content-Type: text/html
Client-Date: Sat, 27 Feb 1999 04:08:29 GMT
Client-Peer: 192.168.0.4:80
Title: Index of /
So far so good. But when I telnet to port 80, emulating my mini-client, I get
this:
[brock@harmless brock]$ telnet grunt.yellowsnow.org 80
Trying 192.168.0.4...
Connected to grunt.
Escape character is '^]'.
GET / HTTP/1.0
User-Agent: Foozilla
HTTP/1.1 200 OK
Date: Sat, 27 Feb 1999 04:08:24 GMT
Server: Apache/1.3.3 (Unix) (Red Hat/Linux)
Connection: close
Content-Type: text/html
[body content omitted]
I don't get the Client-Date, Client-Peer, or Title headers. Why not? How can the
server "know", apart from what headers are passed to it, whether it's a human
typing into a terminal or a libwww-perl script? Is there some magic information
being passed by the script that I don't know about?
Thanks for any help.
Brock Sides
opus@magibox.net
------------------------------
Date: 01 Mar 1999 07:04:08 -0800
From: Russ Allbery <rra@stanford.edu>
Subject: Re: localtime -> time
Message-Id: <yl3e3pjlp3.fsf@windlord.stanford.edu>
Philip Newton <Philip.Newton@datenrevision.de> writes:
> Where do you get perlwhich from?
Well, there's a version that does the same thing in Tom Christiansen's set
of module tools, but I wrote that one myself a while back.
#!/usr/bin/perl
$version = q$Id: perlwhich,v 0.1 1998/01/12 23:33:29 eagle Exp $;
#
# perlwhich -- Print the full path from which a Perl module was loaded.
# Copyright 1997 by Russ Allbery <rra@stanford.edu>
#
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
$0 =~ s%.*/%%;
my $module = shift or die "Usage: $0 <module>";
my $filename = $module;
$filename =~ s%::%/%;
$filename .= '.pm' unless ($filename =~ m%\.[^/]*$%);
eval { require $filename };
if ($@) {
warn "$module not found\n";
} else {
print $INC{$filename}, "\n";
}
which, upon looking at it, isn't as platform-independent as it could be.
So here's a better version:
#!/usr/bin/perl
die "Usage: $0 <module>" unless @ARGV;
for (@ARGV) {
eval "require $_";
if ($@) {
warn "$_ not found or could not be loaded\n";
} else {
print $INC{$_}, "\n";
}
}
or you can just use Tom's.
--
#!/usr/bin/perl -- Russ Allbery, Just Another Perl Hacker
$^=q;@!>~|{>krw>yn{u<$$<[~||<Juukn{=,<S~|}<Jwx}qn{<Yn{u<Qjltn{ > 0gFzD gD,
00Fz, 0,,( 0hF 0g)F/=, 0> "L$/GEIFewe{,$/ 0C$~> "@=,m,|,(e 0.), 01,pnn,y{
rw} >;,$0=q,$,,($_=$^)=~y,$/ C-~><@=\n\r,-~$:-u/ #y,d,s,(\$.),$1,gee,print
------------------------------
Date: Mon, 01 Mar 1999 14:30:53 +0100
From: Philip Newton <Philip.Newton@datenrevision.de>
Subject: Re: localtime -> time
Message-Id: <36DA968D.FF8149CF@datenrevision.de>
Russ Allbery wrote:
>
> windlord:~> wc `perlwhich Date::Parse`
> 308 887 6130 /usr/local/lib/perl5/site_perl/5.005/Date/Parse.pm
Where do you get perlwhich from?
Cheers,
Philip
------------------------------
Date: 28 Feb 1999 23:43:58 GMT
From: mjtg@cus.cam.ac.uk (M.J.T. Guy)
Subject: Re: localtime -> time
Message-Id: <7bckbu$opj$1@pegasus.csx.cam.ac.uk>
Jonathan Stowe <gellyfish@btinternet.com> wrote:
>On Sun, 28 Feb 1999 15:46:46 GMT johan.levin@mbox300.swipnet.se wrote:
>> There are two functions to convert from seconds-since-1970 to human-readable,
>> but I haven't found an easy way to convert in the other direction.
>>
>> Is there a similar builtin for this (that I can't find) or do I have to do
>> it manually?
>
>There is no builtin that will do that however there is Date::Parse that
>does - it is part of the TimeDate package available from CPAN.
Umm... that's somewhat misleading. Time::Local is part of every
recent Perl distribution and probably does what Johan wants.
Mike Guy
------------------------------
Date: 01 Mar 1999 07:10:01 -0800
From: merlyn@stonehenge.com (Randal L. Schwartz)
Subject: Re: make an index of links to html files in a directory
Message-Id: <m1lnhhqm9i.fsf@halfdome.holdit.com>
>>>>> "Sheila" == Sheila Eugenio <seugenio@man.amis.com> writes:
Sheila> I want to create a table of links as an index to html files in
Sheila> my directory. I have the ff codes but it prints out a link to
Sheila> 0.htm only when I have 01845.htm in the directory as my first
Sheila> html file. All of the other filenames are 5-digit. The last
Sheila> filenme in that directory is 15513.htm Thanks for your
Sheila> assistance.
Sheila> @files="$html_dir/[0-9]*.htm";
If you're trying to get a list of existing filenames here, you're
missing a "glob":
@files = glob "$html_dir/[0-9]*.htm";
Sheila> open(INDEX,">$html_dir/index.htm");
You didn't check the return value of open. This might have failed.
Sheila> #write out a title
Sheila> $date = localtime(time);
Sheila> print INDEX '
You can do this with a "here" doc... stuff like <<END
Sheila> <HTML>
Sheila> <HEAD>
Sheila> <TITLE> Status Index Page</TITLE>
Sheila> </HEAD>
Sheila> <BODY bgcolor="ffffff">
Heh. never set bgcolor without setting fgcolor. (What if I have my
characters set to white by default?) But this isn't the HTML
newsgroup... so ignore me.
Sheila> <center>
Sheila> <H2>Last updated: Manila ' . $date . '</H2>
Sheila> <p>
Sheila> <table border=0 width=100%>
Sheila> <tr>
Sheila> ';
Sheila> foreach $p (sort @files) {
Sheila> if(($part)=$p=~/(\d+)/){
Sheila> $counter++;
Sheila> print INDEX "<td><a HREF=\"$part.htm\" >$part</a><br>\n";
Sheila> if ($counter %10 == 0){
Sheila> print INDEX "</tr>\n<tr>\n";
Sheila> }
Sheila> }
Sheila> }
Sheila> print INDEX "
Sheila> </table>
Sheila> </p>
Sheila> </center>
Sheila> <hr>
Sheila> </html>
Sheila> ";
Sheila> sub by_num {
Sheila> get_num($a) <=> get_num($b);
Sheila> }
Sheila> sub get_num {
Sheila> ($part)=$_[0]=~/(\d+)/;
Sheila> $part;
Sheila> }
Hmm. Looks like that subroutine could have been used earlier. :)
The rest of the code looks great. Make those changes, and you'll
probably be home free.
print "Just another Perl hacker,"
--
Name: Randal L. Schwartz / Stonehenge Consulting Services (503)777-0095
Keywords: Perl training, UNIX[tm] consulting, video production, skiing, flying
Email: <merlyn@stonehenge.com> Snail: (Call) PGP-Key: (finger merlyn@teleport.com)
Web: <A HREF="http://www.stonehenge.com/merlyn/">My Home Page!</A>
Quote: "I'm telling you, if I could have five lines in my .sig, I would!" -- me
------------------------------
Date: Mon, 01 Mar 1999 15:20:16 GMT
From: otis@my-dejanews.com
Subject: mod_perl + Net::PH => persistant DB connection?
Message-Id: <7beb74$j34$1@nnrp1.dejanews.com>
Hello,
I am about to try setting up some web-based Qi/Ph clients using Net::PH Perl
module (part of libnet) and mod_perl Apache module.
One of the things that I would like to accomplish is creating persistant
connections to the Qi/Ph database so that I don't have to establish a new
connection each time a CGI is invoked and goes against the Qi/Ph Db.
My question is - has anyone done this? Is it possible? All mod_perl examples
for creating persistant Db connections are for relational databases via DBI,
but I'd like to try the same for Ph db.
Any help, hints, suggestions or even just a simple 'yes, it is doable' or
'no, not possible, sorry' would be welcome.
Thanks,
Otis
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: 12 Dec 98 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Special: Digest Administrivia (Last modified: 12 Dec 98)
Message-Id: <null>
Administrivia:
Well, after 6 months, here's the answer to the quiz: what do we do about
comp.lang.perl.moderated. Answer: nothing.
]From: Russ Allbery <rra@stanford.edu>
]Date: 21 Sep 1998 19:53:43 -0700
]Subject: comp.lang.perl.moderated available via e-mail
]
]It is possible to subscribe to comp.lang.perl.moderated as a mailing list.
]To do so, send mail to majordomo@eyrie.org with "subscribe clpm" in the
]body. Majordomo will then send you instructions on how to confirm your
]subscription. This is provided as a general service for those people who
]cannot receive the newsgroup for whatever reason or who just prefer to
]receive messages via e-mail.
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.misc (and this Digest), send your
article to perl-users@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.
The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V8 Issue 5012
**************************************
