[10853] in Perl-Users-Digest
Perl-Users Digest, Issue: 4454 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Dec 18 16:07:30 1998
Date: Fri, 18 Dec 98 13:00:18 -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 Fri, 18 Dec 1998 Volume: 8 Number: 4454
Today's topics:
Re: $&, $', and $` and parens.... (Larry Rosler)
Re: $&, $', and $` and parens.... (Bart Lateur)
Re: ? (question mark) not recognised. (Greg Ward)
Re: An example of good file locking please <tchrist@mox.perl.com>
Re: An example of good file locking please (Bill Moseley)
Re: array initialisation (Joergen W. Lang)
Generating Random Hexadecimal Numbers <tlynch@cisco.com>
Re: Generating Random Hexadecimal Numbers (brian d foy)
Re: Happy Birthday! (Tad McClellan)
Re: Happy Birthday! (I R A Aggie)
Help: Moving Perl to different platform <paul.kwan@aud.alcatel.com>
Re: Help: Moving Perl to different platform (Erik)
Re: numbers in base 36 (brian d foy)
Oracle 8.0.4 and Perl pdcarter@my-dejanews.com
Perl scripts not terminating: SIGCLD (5.004_1, SunOS 5. <michel.prevost@cactuscom.ca_REMOVE_TO_MAIL>
proper use of eval? <jipes@ispchannel.com>
Re: Search Not Working <tim.hicks@iname.com>
Re: Searching through a 10MB file (Christian M. Aranda)
Re: Security in Distributing Scripts. (I R A Aggie)
Re: Unix / Nt Perl Modules ?? (Randy Kobes)
Using Expect to set passwd (Brett Goldstock)
What's the Right Way to detect an Array Ref? dg50@chrysler.com
Special: Digest Administrivia (Last modified: 12 Dec 98 (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Fri, 18 Dec 1998 10:42:59 -0800
From: lr@hpl.hp.com (Larry Rosler)
Subject: Re: $&, $', and $` and parens....
Message-Id: <MPG.10e4420867b7b8539898d9@nntp.hpl.hp.com>
[Posted to comp.lang.perl.misc and a copy mailed.]
In article <367d2f8b.4701580@news.skynet.be> on Fri, 18 Dec 1998
10:36:34 GMT, Bart Lateur <bart.lateur@skynet.be> says...
> Larry Rosler wrote:
>
> >You *never* need to use $`, $&, $'.
> >
> >my ($pre_match, $match, $post_match) = /(.*)(...whatever...)(.*)/s;
>
> At first sight, I would *seriously* doubt that
>
> /(.*?)(... whatever...)(.*)/
>
> would be faster than the much simpler regex
>
> /...whatever.../
>
> plus $`, $&, $'.
>
> Of course, I didn't benchmark. ;-) If it is, there must be something
> wrong.
So I just did benchmark it. (Surprise! ;-) And you are right. There
must be something wrong -- not with the perl interpreter, but with the
conventional wisdom. Here are my code and results:
#!/usr/local/bin/perl -w
use Benchmark;
$a = 'x' x 50 . '1' . 'y' x 50;
timethese(1 << (shift || 0), {
Anchor => sub { my ($pre, $match, $post) = $a =~ /^(.*?)(\d)(.*)/ },
Unanch => sub { my ($pre, $match, $post) = $a =~ /(.*?)(\d)(.*)/ },
#Special => sub { $a =~ /\d/; my ($pre, $match, $post) = ($`, $&, $') },
});
__END__
This is perl, version 5.005_02 built for MSWin32-x86-object
Binary build 506 provided by ActiveState Tool Corp.
http://www.ActiveState.com
Built 15:40:37 Oct 27 1998
Benchmark: timing 65536 iterations of Anchor, Unanch...
Anchor: 6 wallclock secs ( 5.39 usr + 0.00 sys = 5.39 CPU)
Unanch: 5 wallclock secs ( 5.39 usr + 0.00 sys = 5.39 CPU)
Benchmark: timing 65536 iterations of Anchor, Special, Unanch...
Anchor: 6 wallclock secs ( 5.36 usr + 0.00 sys = 5.36 CPU)
Special: 3 wallclock secs ( 2.33 usr + 0.00 sys = 2.33 CPU)
Unanch: 6 wallclock secs ( 5.83 usr + 0.00 sys = 5.83 CPU)
The results are similar on an older perl (on a different processor):
This is perl, version 5.004_03
Benchmark: timing 65536 iterations of Anchor, Unanch...
Anchor: 15 secs (11.57 usr 0.05 sys = 11.62 cpu)
Unanch: 17 secs (11.66 usr 0.08 sys = 11.74 cpu)
Benchmark: timing 65536 iterations of Anchor, Special, Unanch...
Anchor: 22 secs (12.02 usr 0.11 sys = 12.13 cpu)
Special: 5 secs ( 4.78 usr 0.03 sys = 4.81 cpu)
Unanch: 16 secs (11.77 usr 0.08 sys = 11.85 cpu)
-------------
My conclusions (based on these limited tests):
1. Anchoring or not anchoring doesn't seem to matter much.
2. Using the special variables has a *small* negative impact on
performance when they are not used.
3. Using the special variables has a *big* positive impact on
performace when they are used.
HELP!!! Is the Surgeon General's warning about the special variables
wrong??? From perlre:
Once perl sees that you need one of $&, $` or $' anywhere in the
program, it has to provide them on each and every pattern match. This
can slow your program down. The same mechanism that handles these
provides for the use of $1, $2, etc., so you pay the same price for each
pattern that contains capturing parentheses. But if you never use $&,
etc., in your script, then patterns without capturing parentheses won't
be penalized. So avoid $&, $', and $` if you can, but if you can't (and
some algorithms really appreciate them), once you've used them once, use
them at will, because you've already paid the price. As of 5.005, $& is
not so costly as the other two.
--
(Just Another Larry) Rosler
Hewlett-Packard Company
http://www.hpl.hp.com/personal/Larry_Rosler/
lr@hpl.hp.com
------------------------------
Date: Fri, 18 Dec 1998 20:05:42 GMT
From: bart.lateur@skynet.be (Bart Lateur)
Subject: Re: $&, $', and $` and parens....
Message-Id: <367ab3ce.258641@news.skynet.be>
Larry Rosler wrote:
>So I just did benchmark it. (Surprise! ;-) And you are right. There
>must be something wrong -- not with the perl interpreter, but with the
>conventional wisdom.
Depends on whose common sense.
So the simple regex + use of ($`,$&,$') is 2 to 3 times faster than the
far more complicated (from the point of view of the regex engine!) one.
And the penaly for using those special variables does exist, but the
speed drop appears to be around 1% or less. Oh dear. What were we
loosing sleep over.
BTW it's the numbers between the parens that are important, right? But I
don't get why there's such a sometimes extreme difference between CPU
time and total time.
Bart.
------------------------------
Date: 18 Dec 1998 19:03:40 GMT
From: gward@thrak.cnri.reston.va.us (Greg Ward)
Subject: Re: ? (question mark) not recognised.
Message-Id: <75e8uc$alv$6@news0-alterdial.uu.net>
Jason Q. <pigs_can_fly@mindless.com> wrote:
> I can't figure what's wrong with my code.
>
> Basically it searches for $RSTRING1, then splice it with $RSTRING2.
>
> It works fine except when $Value[$question1] and/or $Value[$answer1]
> has a "?" (question mark) in it, whereby
> 1. it isn't able to match $array[$found] with $RSTRING
> 2. $halt then equals 0
> 3. splice dumps $RSTRING2 to the first line of the $datafile.
You forgot to mention that you're using $RSTRING1 as a regex. Good
thing I read the code! When you use a random string like this in a
regex, you have to quote regex metacharacters:
$RSTRING1 = quotemeta ("$Value[$question1] $Value[$answer1]");
> ----------------------------------------------------------------
>
> $RSTRING1 = "$Value[$question1] $Value[$answer1]";
> $RSTRING2 = "$Value[$question2] $Value[$answer2]";
>
> open(HANDLE, "$datafile");
> @array = <HANDLE>;
> close(HANDLE);
>
> $found = 0;
>
> foreach $i (@array)
> {
> if ($array[$found] =~ $RSTRING1)
> {
> $halt = $found;
> }
> $found++;
> }
>
> splice (@array, $halt, 1, "$RSTRING2\n");
>
> open(HANDLE, ">$datafile");
> print HANDLE @array;
> close(HANDLE);
> ----------------------------------------------------------------
Of course, on reading the code, it's not clear to me why you're using
the regex engine at all: you could just as well use index, or maybe
string comparison (if you're looking for lines that exactly match
$RSTRING1 rather than lines that contain $RSTRING1). Also, what is $i
used for -- why are you even using a foreach loop, if you increment a
counter each time through?
In fact your whole algorithm seems awfully clunky to me. I'll assume
you're looking for lines that *match* $RSTRING1 rather than *contain*
it; I would rewrite everything in between the read-file and write-file
steps as follows:
foreach (@array)
{
$_ = $RSTRING2 if $_ eq $RSTRING1;
}
You could make this even smaller with map and/or grep, but I think this
is clear and simple.
If what you really need is to replace lines that *contain* $RSTRING1,
use 'index': left as an exercise to the reader. RTFM.
Greg
--
Greg Ward - software developer gward@cnri.reston.va.us
Corporation for National Research Initiatives
1895 Preston White Drive voice: +1-703-620-8990 x287
Reston, Virginia, USA 20191-5434 fax: +1-703-620-0913
------------------------------
Date: 18 Dec 1998 17:35:36 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: An example of good file locking please
Message-Id: <75e3p8$nh2$1@csnews.cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc, shaleh@livenet.net writes:
:Could someone post a good example of file locking or point me towards one on
:the Net somewhere? Preferably using flock but if there is a better way, will
:take that instead.
:
:Questions I have include:
:how do I detect and exclusive lock?
:do flocks go away if the app dies?
:
:Essentially I am in a multi-app or thread situation where the same program
:could be writing to the file at once and I am trying to avoid a race while at
:the same time another app may be reading from that file (not writing).
I just posted a FMTEYEWTK on open. Please grab that.
And check the FAQ.
You might also want to ftp the PCB code and consult that.
--tom
--
Nothing is created by a team or an organization. Every new idea comes out
of a single human mind. -- Admiral Rickover
------------------------------
Date: 18 Dec 1998 20:51:55 GMT
From: moseley@best.com (Bill Moseley)
Subject: Re: An example of good file locking please
Message-Id: <367ac06b$0$214@nntp1.ba.best.com>
In article <75e1ns$6c9$1@nnrp1.dejanews.com>, shaleh@livenet.net says...
>
>Could someone post a good example of file locking or point me towards one on
>the Net somewhere? Preferably using flock but if there is a better way, will
>take that instead.
Ok, I'll throw mine out there. I love a chance to get eaten alive! (And
get some nice pointers.)
It's code from L. Stein, and the perl FAQ.
I call this as:
$my $file_handle = fl_lock('filename',$rw);
Where:
$rw is true when writing.
use Fcntl ':flock';
sub fl_lock {
my $path = shift;
my $for_writing = shift;
local(*FH);
my ($lock_type,$path_name,$description);
if ($for_writing) {
$lock_type = LOCK_EX;
$path_name = ">>$path";
$description = 'writing';
} else {
$lock_type = LOCK_SH;
$path_name = $path;
$description = 'reading';
}
open (FH,$path_name) or do {
print "<P>failed to open $path_name: $!";
warn("Couldn't open $path for $description: $!"), return undef;
};
# Note, this $SIG assignment generates a warning message:
# ...You need to quote "sub" at workshopevalb.cgi line ...
# This is due to the version of CGI.pm that exports "sub". Lincoln changed to upper case in version 2.44
# but Larry Wall recommended changing the source to only warn on barward followed by ";"
# All per dejenews.
eval {
local $SIG{ALRM} = sub { die "timed out waiting for flock" };
alarm 10;
flock(FH, $lock_type); # either blocking write, or share
alarm 0;
};
# if defined something didn't work (most likely timed out, but failed anyway)
# should print out message here, but I deal with it at the call
if ($@) { return undef; }
return *FH; # return typeglob to make strict 'subs' happy.
}
--------------
Bill Moseley
moseley@best.com
------------------------------
Date: Fri, 18 Dec 1998 21:09:12 +0100
From: jwl@worldmusic.de (Joergen W. Lang)
Subject: Re: array initialisation
Message-Id: <1dk8zwi.wwnpb0x6hqjwN@host026-210.seicom.net>
Daniel Grisinger <dgris@moiraine.dimensional.com> wrote:
> jwl@worldmusic.de (Joergen W. Lang) writes:
>
> > Yep - but they do it on purpose. I still have an unfinished japh on my
> > machine that - when it's finished - is supposed to do an acoustic
> > version via Morse Code. I thought of using \a but I can't get it
> > changing the length of the sound to produce the .--..-'s
> > Any ideas ;-)
>
> Don't make sounds based on .s or -s, make silences.
>
> Beep
> short pause (dot)
> Beep
> long pause (dash)
> Beep
>
> etc.
>
> :-)
> dgris
> - I actually read once that this is how it was done by telegraphers,
> but I have no idea if that is accurate, and am too lazy to go
> find out :-)
On the "Canadian Railway Telegraph History" webpages I found a code that
is called the "Smitty Harris Tap Code" from around 1965. It has the
advantage of using equally long signals seperated by "silences". This
makes it possible to use \a as the sound "source".
Each "letter" consists of a pair of taps seperated by a pause. The
misspelling of the "c" in "hacker" stems from the same combination of
taps used for c and k.
Here's my first go at it:
#!/usr/bin/perl -w
$| = 1;
for (split / /, <DATA>)
{
for (/../g)
{
m/(.)(.)/;
print "\a" x $1;
sleep 1;
print "\a" x $2;
sleep 2;
}
sleep 4;
}
__DATA__
23454344 11333444231542 35154231 231113131545
j u s t a n o t h e r p e r l h a k k e r
which I managed to destil down to:
#!/usr/bin/perl -w
$"="\a";$|=1;map{map{/(.)(.)/;print$"x$1;
sleep 1;print$"x$2;sleep 2;}/../g;sleep 4;}split/0/,
"234543440113334442315420351542310231113131545";
There must be better ways to do this. Any omments welcome :-)
Joergen
--
-------------------------------------------------------------------
"Everything is possible - even sometimes the impossible"
HOELDERLIN EXPRESS - "Touch the void"
-------------------------------------------------------------------
------------------------------
Date: Fri, 18 Dec 1998 14:08:38 -0500
From: Tom Lynch <tlynch@cisco.com>
Subject: Generating Random Hexadecimal Numbers
Message-Id: <367AA836.367E44BB@cisco.com>
Greetings:
I have been trying to generate random hex
numbers so I can do some testing on a
system. I have a hexadecimal counter which
increments by 4 every time so I can stay
on a boundry. The problem is generating
hex numbers from 0 to 1FFFFFFF even incrementing
by 4 takes a loooong time. Then the file is
huge.
From the "Perl Cookbook" I'm using
"Picking a Random Line from a File" which
then will give me a random Hex number. Again
this is very slow. Any ideas as to how to
improve performance and maybe getting rid
of that very large hex number file while
staying on the boundry?
Thanks for any help in advanced!
Tom
--
#-----------------------+--------------------------+
# Tom Lynch | Email: tlynch@cisco.com |
# Cisco Systems | Phone: 978-244-8765 |
# 250 Apollo Drive | FAX: 978-244-8039 |
# Chelmsford MA 01824 | MS: CH1-2LF |
#-----------------------+--------------------------+
------------------------------
Date: Fri, 18 Dec 1998 14:54:08 -0500
From: comdog@computerdog.com (brian d foy)
Subject: Re: Generating Random Hexadecimal Numbers
Message-Id: <comdog-ya02408000R1812981454080001@news.panix.com>
In article <367AA836.367E44BB@cisco.com>, Tom Lynch <tlynch@cisco.com> posted:
> I have been trying to generate random hex
> numbers so I can do some testing on a
> system. I have a hexadecimal counter which
> increments by 4 every time so I can stay
> on a boundry. The problem is generating
> hex numbers from 0 to 1FFFFFFF even incrementing
> by 4 takes a loooong time. Then the file is
> huge.
what are you doing?
why not generate a random number as usual, round off to the
nearest boundry, then convert to hex with sprintf or the like?
--
brian d foy <brianNOSPAM@NOSPAM.smithrenaud.com>
CGI Meta FAQ <URL:http://computerdog.com/CGI_MetaFAQ.html>
remove NOSPAM or don't. it doesn't matter either way.
------------------------------
Date: Fri, 18 Dec 1998 13:24:38 -0600
From: tadmc@metronet.com (Tad McClellan)
Subject: Re: Happy Birthday!
Message-Id: <m5ae57.b7u.ln@magna.metronet.com>
I R A Aggie (fl_aggie@thepentagon.com) wrote:
: In article <75co4t$1gk$1@picasso.op.net>, mjd@plover.com (Mark-Jason
: Dominus) wrote:
: + Perl is 11 years old today.
: At least I'm using a language younger than I am...
At least I'm using a language whose age is smaller than my shoe size...
--
Tad McClellan SGML Consulting
tadmc@metronet.com Perl programming
Fort Worth, Texas
------------------------------
Date: Fri, 18 Dec 1998 14:47:43 -0500
From: fl_aggie@thepentagon.com (I R A Aggie)
Subject: Re: Happy Birthday!
Message-Id: <fl_aggie-1812981447430001@aggie.coaps.fsu.edu>
In article <367A892C.1B552F@email.sps.mot.com>, Tk Soh
<r28629@email.sps.mot.com> wrote:
+ I R A Aggie wrote:
+ > + Perl is 11 years old today.
+ > At least I'm using a language younger than I am...
+ I believe you are younger than English language, aren't you? ;-)
Only ever-so-barely. I urged them to use French, but would those stiff-
necked English listen to me? Nooooooo...
James
------------------------------
Date: Fri, 18 Dec 1998 13:46:05 -0600
From: "Paul A. Kwan" <paul.kwan@aud.alcatel.com>
Subject: Help: Moving Perl to different platform
Message-Id: <367AB0FD.AE1784DA@aud.alcatel.com>
Hi,
I have compiled perl on my workstation and I would like to
port perl to another platoform without re-compilation.
Is there a set of files that I can just simply ftp to the other
platform ?
Any help is greatly appreciated.
Regards,
Paul
------------------------------
Date: 18 Dec 1998 20:03:31 GMT
From: eln@cyberhighway.net (Erik)
Subject: Re: Help: Moving Perl to different platform
Message-Id: <75ecej$kcd$1@news.cyberhighway.net>
In article <367AB0FD.AE1784DA@aud.alcatel.com>,
"Paul A. Kwan" <paul.kwan@aud.alcatel.com> writes:
> I have compiled perl on my workstation and I would like to
> port perl to another platoform without re-compilation.
> Is there a set of files that I can just simply ftp to the other
> platform ?
>From what platform to what other platform? Generally, you cannot move
binaries from one platform to another and still expect them to work
properly. If the platforms are similar enough, on the same hardware, you
may be able to execute the binaries, but they will probably behave
in weird ways and die randomly because of differing libraries and whatnot.
When moving to another platform, a recompile is almost always necessary, and
often times you have to tweak the code itself to allow for some difference.
Of course, with Perl being supported on nearly every platform in the
universe, porting is no longer something you have to do yourself with it.
If you just compiled the stock distribution without modifications, check
out CPAN...it might very well have some precompiled binaries for the
platform you want to port to.
If not, take off and recompile the source...it's the only way to be sure.
--
Erik Nielsen, Cyberhighway Internet Services NOC
kill -9 them all, let reboot -rf now sort them out
-- Peter Gutmann in a.s.r.
------------------------------
Date: Fri, 18 Dec 1998 14:50:02 -0500
From: comdog@computerdog.com (brian d foy)
Subject: Re: numbers in base 36
Message-Id: <comdog-ya02408000R1812981450020001@news.panix.com>
In article <Pine.GSO.3.96.981218092552.25649B-100000@pdxue150.cadence.com>, Colin Kuskie <ckuskie@cadence.com> posted:
> > There is a function in Java to format an integer in any base, I would
> > like to create a base 36 number in java and pass it to a perl script.
> > Can perl convert it back to decimal?
>
> my $c = 0;
> my %lh = map { $_ => $c++ } 0..9,'a'..'z';
>
> sub b36todec1 {
there were a few errors in your routine...
> }
but i was interested enough to write my own (with different error
probably :) this should work up to base 36 when i ran out of
symbols...
#!/usr/bin/perl
use strict;
use subs qw(base2base);
while( <DATA> )
{
next if /^#/ or /^\s*$/;
my($num, $in_base, $out_base) = split;
print "$num base $in_base is ",
base2base($num, $in_base, $out_base), " base $out_base\n";
}
# sub base2base
# input: < cardinal number>
# < base of input number, in decimal >
# < base of output number, in decimal >
#
# output: number in output base
#
# LIMIT! works up to base 36 (we rely on 36 symbols to represent digits)
sub base2base
{
my $num = lc shift;
my $in_base = shift;
my $out_base = shift;
my @digits = (0..9,'A'..'Z');
$in_base = 10 unless $in_base =~ /^\d+$/;
$out_base = 10 unless $out_base =~ /^\d+$/;
return $num if $in_base == $out_base;
#convert to a machine format
my $temp_num = 0;
my $count = 0;
foreach my $digit ( reverse(split //, $num) )
{
$temp_num += $digit =~ m/^[0-9]$/ ?
$digit * ($in_base ** $count++) :
ord($digit) - 55;
}
#find the highest power of the output base
my $higher_power = int(log($temp_num)/log($out_base)); #God == Math
my $output = '';
foreach my $power ( reverse 0 .. $higher_power )
{
my $order = int( $temp_num / ($out_base**$power));
$temp_num = $temp_num - $order * ($out_base**$power);
$output .= $digits[$order];
}
return $output;
}
__DATA__
128 10 2
128 10 16
32 10 16
32 10 32
32 10 8
1000 2 10
1010 2 8
36 10 36
72 10 36
20 36 10
10 32 16
37 10 13
90 11 9
--
brian d foy <brianNOSPAM@NOSPAM.smithrenaud.com>
CGI Meta FAQ <URL:http://computerdog.com/CGI_MetaFAQ.html>
remove NOSPAM or don't. it doesn't matter either way.
------------------------------
Date: Fri, 18 Dec 1998 19:18:55 GMT
From: pdcarter@my-dejanews.com
Subject: Oracle 8.0.4 and Perl
Message-Id: <75e9qs$d7a$1@nnrp1.dejanews.com>
Hi,
I was wondering if anyone has had any success with using ORAPERL
with Oracle 8.0.4. The CERN has info about Version 7, but no
references to 8 yet. Any info would be greatly appreciated.
Thanks in advance & Happy Holidays,
Paul
------------------------------------------------------------------------
pdcarter@my-dejanews.com
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: Fri, 18 Dec 1998 14:36:47 -0500
From: Michel Prevost <michel.prevost@cactuscom.ca_REMOVE_TO_MAIL>
Subject: Perl scripts not terminating: SIGCLD (5.004_1, SunOS 5.5.1)
Message-Id: <367AAECF.2651002B@cactuscom.ca_REMOVE_TO_MAIL>
Hi all
This one is very weird. I have a Perl script that exit()s after its last
statement. The problem is that sometimes the program, instead of
exiting, starts eating up CPU time, which brings the machine to a
crawl..
The program makes a connection to an Oracle database, and that
connection is performed via Oraperl. I used the "truss" command to
figure out what was happening and found out that the process was
receiving SIGCLD repeatedly over and over, until we kill it.
I don't think that Oraperl is faulty here, because another guy here has
about 15 scripts and only one of them has the same behavior, and it
happens that that script is the only one forking a child.
We think here that it may be a Perl bug.
In the meantime, until we figure out what is going on, I replaced the
exi() call by "kill('KILL',$$)", but this is really really bad.
Any idea?
Michel
------------------------------
Date: Fri, 18 Dec 1998 14:00:02 -0600
From: "BenJamin Prater" <jipes@ispchannel.com>
Subject: proper use of eval?
Message-Id: <367ab3dc.0@news.mediacity.com>
Yesterday, I posted a message about recursion, and as yet, haven't found a
suitable solution.
However, I do know that the code I'm using now does work. But it's ugly.
Have three parsing routines (parse, reparse and rereparse) are ugly.
The only solution I see is to begin using eval to create subs on the fly.
And Tom C. says that's ugly.
What is the lesser of all evils?
Ben
THE MAIN SAMPLE SCRIPT
#! perl
use strict;
use lib qw/c:\\jipes\\scripts\\modules\\/;
use CGI qw/:standard/;
use CGI qw/fatalsToBrowser/;
use SmartFile;
use RandomFile;
use TemplateAgent;
my @sample;
my $handler = {
main => {
cur_file => sub { '' },
itemloop => \&itemloop,
html_code => sub { '' },
cur_no => sub { '' },
value => sub { '' },
},
shows => {
itemno => sub { 'he' },
itemdata => \&poke,
},
poke => {
line1 => sub { 'line1' },
line2 => sub { 'line2' },
line3 => sub { 'line3' }
}
};
$sample[0] = <<END;
<table border=2>
<tr><td>
<center><B>
<line1><line1>
</B></center><p>
<line2>
<br>
<I><line3></I>
</table>
END
$sample[1] = <<END;
<table border=2>
<tr><td>
<i><line1></i><P>
<b><line2></b><br>
<font face="verdana"><line3></font>
</td></tr>
</table>
END
$sample[2] = <<END;
<table border=2>
<tr><td>
<i><line1></i><P>
<b><line2></b><br>
<font face="verdana"><line3></font>
</td></tr>
</table>
END
my @def = qw/Blank Blank Blank/;
my $save_path = 'c:\\jipes\\scripts\\htmlsig\\';
main();
sub poke {
my ($tag, $pairs, $text, $data) = @_;
return rereparse( $_[3], $handler->{poke} );
}
sub itemloop {
my ($tag, $pairs, $text, $data) = @_;
my (@buf);
for(@sample) {
push @buf, reparse($text, $handler->{shows}, $_ );
}
return join '', @buf;
}
sub start
if ( param('file') )
open FILE, '>'. $save_path . param('file') or die $!;
for (qw/line1 line2 line3/) {
print FILE param($_), "\n";
}
close FILE or die $!;
my $cookie = cookie('file', param('file'));
print header(-cookie => [ $cookie ]);
}
else { print header }
# we don't care if the next set of lines is successful or not
open FILE, $save_path . param('file') || cookie('file');
my @liners = <FILE>;
close FILE;
}
sub main {
start();
print parse_file( "${save_path}mod.thtml", $handler->{main}, '' );
}
THE MODULE
package TemplateAgent;
use strict;
use Exporter;
use vars qw($VERSION @ISA @EXPORT);
@ISA = qw/Exporter/;
@EXPORT = qw/parse_file rereparse reparse parse/;
$VERSION = '1.00';
sub parse_file {
my ($file, $tagset, $extra_data) = @_;
open FILE, $file or die $!;
my $buf = parse( (join '', <FILE>), $tagset, $extra_data );
close FILE or die $!;
return $buf;
}
sub parse {
my ($in_data, $tagset, $extra_data) = @_;
my $cur_tag;
for $cur_tag (keys %$tagset) {
while( $in_data =~ s/
<($cur_tag)\s*([^>]+)?>(?:(.*?)<\/\1>)?/
ref($tagset->{$cur_tag}) eq 'SCALAR' ?
${ $tagset->{$cur_tag} } :
$tagset->{$cur_tag}->
($1, $2 ? _pairs($2) : undef, $3, $extra_data)
/gisex ) { } ;
}
return $in_data;
}
sub rereparse {
my ($in_data, $tagset, $extra_data) = @_;
my $cur_tag;
for $cur_tag (keys %$tagset) {
while( $in_data =~ s/
<($cur_tag)\s*([^>]+)?>(?:(.*?)<\/\1>)?/
ref($tagset->{$cur_tag}) eq 'SCALAR' ?
${ $tagset->{$cur_tag} } :
$tagset->{$cur_tag}->
($1, $2 ? _pairs($2) : undef, $3, $extra_data)
/gisex ) { } ;
}
return $in_data;
}
sub reparse {
my ($in_data, $tagset, $extra_data) = @_;
my $cur_tag;
for $cur_tag (keys %$tagset) {
while( $in_data =~ s/
<($cur_tag)\s*([^>]+)?>(?:(.*?)<\/\1>)?/
ref($tagset->{$cur_tag}) eq 'SCALAR' ?
${ $tagset->{$cur_tag} } :
$tagset->{$cur_tag}->
($1, $2 ? _pairs($2) : undef, $3, $extra_data)
/gisex ) { } ;
}
return $in_data;
}
sub _pairs {
my ($in_data) = @_;
my %key;
$key{lc $1} = $2 while $in_data =~
m/(\w+)\s*=\s*['"]?(.*?)(?:['"])?(?=(\s+\w+\s*=|\s*$))/gs;
return \%key;
}
1;
__END__
------------------------------
Date: Fri, 18 Dec 1998 19:06:20 -0000
From: "Tim Hicks" <tim.hicks@iname.com>
Subject: Re: Search Not Working
Message-Id: <XUxe2.1417$5j2.328@news-reader.bt.net>
Thanks guys, it was starting to drive me a little bit loopy!! Your help is
appreciated.
Tim
------------------------------
Date: Fri, 18 Dec 1998 19:46:25 GMT
From: christian.aranda@iiginc.com (Christian M. Aranda)
Subject: Re: Searching through a 10MB file
Message-Id: <75ebkn$jqp$1@news-2.news.gte.net>
On 17 Dec 1998 16:08:52 -0500, Uri Guttman <uri@ibnets.com> wrote:
>but if it is the start line, it can't also be the end line! so if you
>found a start line, skip the other tests and go get the next line with
>next.
>
>anyway, as i said, using a single loop with flags is old
>fashioned. learn to use multiple loops. the logic is simpler and it is
>faster to boot. my earlier post has most of the code you need for that
>design.
>
>uri
Thanks for the explaination! The new version of my code is as follows
(it smokes!) -
sub get_ddts_record
{
open(DDTS_DATA, "$ddts_file") ||
&err_msg("fatal", "Unable to open data file", "open",
undef ) ;
$start = "Start: $ddts_value{identifier}";
$end_record = "End: $ddts_value{identifier}";
undef($attached_record);
while (<DDTS_DATA>) {
if (index($_, $start) == 0) {
while (<DDTS_DATA>) {
last if (index($_, "History") == 0);
}
while (<DDTS_DATA>) {
chop($_);
$attached_record .= "$_\n";
last if (index($_, $end_record) == 0);
}
}
}
@comments = split("Related-file:",$attached_record);
close(DDTS_DATA);
}
------------------------------
Date: Fri, 18 Dec 1998 14:45:25 -0500
From: fl_aggie@thepentagon.com (I R A Aggie)
Subject: Re: Security in Distributing Scripts.
Message-Id: <fl_aggie-1812981445250001@aggie.coaps.fsu.edu>
In article <75e709$b2m$1@nnrp1.dejanews.com>, mjswart@my-dejanews.com wrote:
+ Are there methods to preserve the scripts?
Yeah, its called a license agreement. Go talk with a contract lawyer.
James
------------------------------
Date: 18 Dec 1998 20:31:11 GMT
From: randy@theory.uwinnipeg.ca (Randy Kobes)
Subject: Re: Unix / Nt Perl Modules ??
Message-Id: <slrn77lfe0.91k.randy@theory.uwinnipeg.ca>
On Fri, 18 Dec 1998 16:23:01 -0800,
Kim Squires <kim@metanoia.demon.co.uk> wrote:
>I am running a pl script that uses the Date::Manip routines ... from an NT
>server. I get an error message posted back :
>
>ERROR: Date::Manip unable to determine TimeZone. Date::Manip::Date_TimeZone
>called at C:\perl\lib\site/Date/Manip.pm line 2332
>
>What concerns me here is the change in the slashes from ' \ ' to ' / ' in
>the middle of the path statement.
Hi,
This looks OK - perl on Windows understands the Unix-style / directory
separator, and the fact that it found the Manip.pm file suggests
this isn't the problem. What if you try setting the TZ environment
variable in the format described in the Dat::Manip docs?
--
Best regards,
Randy Kobes
Physics Department Phone: (204) 786-9399
University of Winnipeg Fax: (204) 774-4134
Winnipeg, Manitoba R3B 2E9 e-mail: randy@theory.uwinnipeg.ca
Canada http://theory.uwinnipeg.ca/
------------------------------
Date: Fri, 18 Dec 1998 14:04:46 -0500
From: brett@tvdata.com.nospam.please (Brett Goldstock)
Subject: Using Expect to set passwd
Message-Id: <brett-ya02408000R1812981404460001@news.tvdata.com>
I'm trying to use the Expect module to set a passwd under Perl 5 on a
Solaris 2.5.1 machine. It doesn't want to work. It looks like it works - it
runs passwd ok and looks like it sends text ok, but the password doesn't
get changed. I've installed IO-Tty-0.02 and IO-Stty-.02 as required.
Here's my program:
#!/usr/local/bin/perl
use Expect;
$Expect::Log_Stdout=1;
$Expect::Debug=3;
$Expect::Exp_Internal=1;
($pwd = Expect->spawn("passwd xyz")) || die "Couldn't run passwd, $!";
unless ($pwd->expect(5,"New password:")) {
die "Never got New Password: prompt, ".$pwd->exp_error()."\n";
}
print $pwd "test123\r";
unless ($pwd->expect(5,"Re-enter new password:")) {
die "Never got Re-enter new password: prompt, ".$pwd->exp_error()."\n";
}
print $pwd "test123\r";
Anything wrong with this?
-Brett
--
|Brett M. Goldstock brett@tvdata.com|
|Senior Technical Analyst/Sys Admin http://www.tvdata.com|
|TVData 800/833-9581|
| "We tell the world what's on TV." |
------------------------------
Date: Fri, 18 Dec 1998 19:54:11 GMT
From: dg50@chrysler.com
Subject: What's the Right Way to detect an Array Ref?
Message-Id: <75ebt2$f2j$1@nnrp1.dejanews.com>
I have a function (from the CGI_Lite module, ectually) that parses a CGI form,
and puts the name=value pairs into a hash - which is Good.
Multi-valued forms return a reference to an array - which is Good too.
However, I now find myself with a program where I have values that may be
multivalued (or not), so that I may-or-may not get an array ref back from the
function for a given key in the hash.
What I want is for - in this one instance - to ALWAYS return an array ref,
even if there is only one element in the name=value hash.
To do this, my tortured and overworked little brain came up with:
$promotees_raw = $FORM{'promote'};
# Ohhhh, this is ugly!
$promotees_raw = [ ("$promotees_raw") ] if ($promotees_raw !~ /^ARRAY/);
foreach $string (@{$promotees_raw}) {
...etc.
What's the Right Way to do this?
I didn't find anything immedately obvious in perldoc or perlfaq, but I
suppose I may have missed something....
DG
-----------== 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 4454
**************************************
