[6539] in Perl-Users-Digest
Perl-Users Digest, Issue: 164 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Mar 23 13:07:34 1997
Date: Sun, 23 Mar 97 10:00:20 -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 Sun, 23 Mar 1997 Volume: 8 Number: 164
Today's topics:
Re: "guaranteed" exit routine? <tchrist@mox.perl.com>
Re: "guaranteed" exit routine? <rootbeer@teleport.com>
Re: Another dereferencing bug in 5.003 ? <merlyn@stonehenge.com>
Re: case sensativity (Andrew M. Langmead)
Re: Fork and flush <rootbeer@teleport.com>
Has anybody made Perl's DB_File + the Berkeley DB under <gtk@walsh2.med.harvard.edu>
Re: Help! Making a perl script write to a log sheet <rootbeer@teleport.com>
How can I find the current working directory? <webmaster@surewould.com>
Re: Parsing html tag attributes & values in Perl (Svein Hevard Djupvik)
Re: Parsing html tag attributes & values in Perl (Svein Hevard Djupvik)
Re: Parsing html tag attributes & values in Perl (Svein Hevard Djupvik)
Re: Parsing html tag attributes & values in Perl (Svein Hevard Djupvik)
Re: printf... (Simon Hyde (aka Jeckyll))
Re: Taking parameters from scrollboxes and then display <rootbeer@teleport.com>
Re: TEST for empty DIR <rootbeer@teleport.com>
Re: Text::ParseWords Error <rootbeer@teleport.com>
Re: Wildcards in a system (mv, fn, fn) call won't work <tchrist@mox.perl.com>
Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 23 Mar 1997 16:36:43 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: "guaranteed" exit routine?
Message-Id: <5h3m6r$e1$1@csnews.cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc,
"Rich Schramm" <schramm@one.net> writes:
:Hi,
:
:I was told by someone that perl has a facility that will allow me to run a
:an exit routine, even if perl were to abort abnormally. I am doing some
:oracle connection stuff, and want to ensure that a logout occurs, even if
:something untoward were to happen during execution.
:
:I read about garbage collection in the camel book, but that does not seem
:to be what I am looking for.
:
:Does something like this exist?
Look up the use of the END{} function. And you should probably
trap signals, too.
sub END { print "I SHALL BE CALLED\n" }
$SIG{INT} = sub { exit };
--tom
--
Tom Christiansen tchrist@jhereg.perl.com
"And I don't like doing silly things (except on purpose)."
--Larry Wall in <1992Jul3.191825.14435@netlabs.com>
------------------------------
Date: Sun, 23 Mar 1997 09:07:00 -0800
From: Tom Phoenix <rootbeer@teleport.com>
To: Rich Schramm <schramm@one.net>
Subject: Re: "guaranteed" exit routine?
Message-Id: <Pine.GSO.3.96.970323085553.739K-100000@kelly.teleport.com>
On 22 Mar 1997, Rich Schramm wrote:
> I was told by someone that perl has a facility that will allow me to run
> a an exit routine, even if perl were to abort abnormally.
They lied. :-) If Perl dumps core, if your process is the target of 'kill
-9', if smoke comes out of the rear vents, all bets are off.
But if you define code in an END block, Perl promises to _try_ to run that
block at the bitter end, even if it die()s unexpectedly. See perlmod(1)
for details.
END {
&logout if $still_logged_in;
}
Hope this helps!
-- Tom Phoenix http://www.teleport.com/~rootbeer/
rootbeer@teleport.com PGP Skribu al mi per Esperanto!
Randal Schwartz Case: http://www.lightlink.com/fors/
------------------------------
Date: 23 Mar 1997 08:37:29 -0700
From: Randal Schwartz <merlyn@stonehenge.com>
To: jhg@acm.org, perlbug@perl.com
Subject: Re: Another dereferencing bug in 5.003 ?
Message-Id: <8cend6zkjq.fsf@gadget.cscaper.com>
>>>>> "Jim" == Jim Garrison <jhg@io.com> writes:
Jim> Randal Schwartz wrote:
>> The problem is that @$foo->[...] is *illegal* syntax that wasn't
>> caught correctly by 5.003,
Jim> I know this might be considered an RTFM question, but could
Jim> you please point out where in Camel-2 this is defined to be
Jim> illegal?
It's illegal by its absence. Here are the legal dereferencing forms,
using SREF for scalar ref, HREF for hash ref, and AREF for array ref,
and $x and @y for just a couple of ordinary expressions:
${SREF}
@{AREF}
${AREF}[$x] or AREF->[$x]
@{AREF}[@y]
%{HREF}
${HREF}{$x} or HREF->{$x}
@{HREF}[@y]
That's it. @{AREF} is no longer an AREF (it's a list), so it can't
fit anywhere above. You can't derefence a list... only a reference.
In fact, I'd argue that @$foo->[$x] should take the construct @$foo in
a scalar context (yielding the length of @$foo), then use that as a
soft reference to give me some element of something like @15
($15[$x]), if interpreted strictly.
So maybe it shouldn't be illegal after all, but it's certainly not
going to do what you think it should do.
print "Just another Perl hacker," # but not what the media calls "hacker!" :-)
## legal fund: $20,495.69 collected, $182,159.85 spent; just 527 more days
## before I go to *prison* for 90 days; email fund@stonehenge.com for details
--
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@ora.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: Sun, 23 Mar 1997 16:12:54 GMT
From: aml@world.std.com (Andrew M. Langmead)
Subject: Re: case sensativity
Message-Id: <E7I7pI.EHB@world.std.com>
mirage@tsil.net writes:
>Is there anyway to keep Perl, Java, JavaScript, etc from being
>case sensitive?
[stuff deleleted]
>I don't know about others but I find mixed case greatly improves
>script readability. Why do people keep developing new languages that
>omit this freedom?
I think that I'm missing something, first you compain about perl
et. al. being case sensitive. (That the identifers, $VAR, $Var, and
$var are different.) and then complain that you can't use mixed case
(To me implying that you must use $var, and the identifiers $VAR or
$Var are illegal.) Or are you saying that because the identifiers are
case sensitive you force yourself to use all lowercase letters to
prevent using the wrong case?
You can use the case you want to name your variables, you just have to
be consistant on a per variable basis. This used to be tougher in perl
than it was in C. The only checking you had for consistant variable
naming was the "Possible Typo" warning from the "-w" switch. (And if
you used different capitalizations, and used each one more than once,
perl would never complain.) With the "use strict" pragmatic module, I
never get any bugs due to mistakes in variable names anymore.
I'm not going to try to rationalize that case sensitive identifiers
are important to the language, but I've never found it a reason to
complain either.
--
Andrew Langmead
------------------------------
Date: Sun, 23 Mar 1997 08:54:08 -0800
From: Tom Phoenix <rootbeer@teleport.com>
To: "Paul D. Smith" <psmith@baynetworks.com>
Subject: Re: Fork and flush
Message-Id: <Pine.GSO.3.96.970323085023.739J-100000@kelly.teleport.com>
On 22 Mar 1997, Paul D. Smith wrote:
> 'Kay, so I'm writing a module that forks/execs a process.
>
> People are complaining that if they redirect the output to a file, they
> get duplicate lines.
>
> I've realized that I'm not flushing STDOUT/STDERR before I invoke the
> subprocess. If I add this to my test program, the problem goes away:
>
> select(STDERR); $| = 1;
> select(STDOUT); $| = 1;
>
> So, I'm pretty sure that's the problem.
>
> However, I can't just _do_ that in my module, since it is just a module.
> What I want to do is just flush the buffers right before I fork, but not
> change the buffering of the file descriptors forever.
What about any other filehandles which the module user has open? You can't
take too much responsibility for them. Make it the caller's obligation,
and tell them that they'll end up with a mess if they forget to flush.
-- Tom Phoenix http://www.teleport.com/~rootbeer/
rootbeer@teleport.com PGP Skribu al mi per Esperanto!
Randal Schwartz Case: http://www.lightlink.com/fors/
------------------------------
Date: 23 Mar 1997 11:41:43 -0500
From: Gregory Tucker-Kellogg <gtk@walsh2.med.harvard.edu>
Subject: Has anybody made Perl's DB_File + the Berkeley DB under IRIX 5.3?
Message-Id: <w2ohcay308.fsf@walsh2.med.harvard.edu>
I'm having a terrible time getting the Berkeley DB working with perl
5.003 under IRIX 5.3 (and IRIX 6.2, incidentally). Has anybody on
this list been able to do it? I'm sure the problem is making a proper
port to IRIX 5.3 for db-1.85.
The db1.85 distribution doesn't come with a port for irix 5.3,
but I can get a library compiled using the defaults for IRIX 4.0.5F.
If I use that library for making DB_File.so, I get this far:
> Making DB_File (dynamic)
> cc -c -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -Olimit 3000 \
> -I/usr/local/include -DLANGUAGE_C -O -DVERSION=\"1.01\" \
> -DXS_VERSION=\"1.01\" -I../.. DB_File.c
>
> cfe: Error: /usr/include/db.h, line 54: Syntax Error
> typedef __signed char int8_t;
> ------- ------------- ---------^
> .
> .
> .
> cfe: Error: DB_File.c, line 102: Empty declaration specifiers (3.5)
> data1 = key1->data ;
> ----^
> cfe: Fatal: Too many errors... goodbye.
> *** Error code 1 (bu21)
> *** Error code 1 (bu21)
Not surprising because the libdb.a and libdb.so were built with
different flags (-cckr -D_BSD_COMPAT -c -D__DBINTERFACE_PRIVATE).
If I make some changes so that libdb.a can be built using the flags
used during the perl build, I get this far:
> Making DB_File (dynamic)
> cc -c -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -Olimit 3000 \
> -I/usr/local/include -DLANGUAGE_C -O -DVERSION=\"1.01\" \
> -DXS_VERSION=\"1.01\" -I../.. DB_File.c
> cfe: Error: DB_File.c, line 322: \
> Incompatible pointer type assignment (3.3.16.1, 3.5.4.1(21))
> info.hash.hash = hash_cb ;
> -------------------------------^
> cfe: Error: DB_File.c, line 322: \
> Type int (* )(const void * , size_t ) of rhs of assignment expression\
> is incompatible with type u_int32_t (* )(const void * , size_t ) of lhs (3.3.16.1)
> info.hash.hash = hash_cb ;
> -------------------------------^
> cfe: Error: DB_File.c, line 362: \
> Incompatible pointer type assignment (3.3.16.1, 3.5.4.1(21))
> info.btree.prefix = btree_prefix ;
> ----------------------------------^
> cfe: Error: DB_File.c, line 362: \
> Type int (* )(const DBT * , const DBT * ) of rhs of assignment expression\
> is incompatible with type size_t (* )(const DBT * , const DBT * ) of lhs (3.3.16.1)
> info.btree.prefix = btree_prefix ;
> ----------------------------------^
> *** Error code 1 (bu21)
> *** Error code 1 (bu21)
Any help is appreciated.
TIA,
Greg
--
Gregory Tucker-Kellogg
Department of Biological Chemistry and Molecular Pharmacology
Harvard Medical School, Boston MA 02115
"Mojo Dobro" Finger for PGP info
------------------------------
Date: Sun, 23 Mar 1997 08:32:18 -0800
From: Tom Phoenix <rootbeer@teleport.com>
To: Brian Cohen <audible@fox.nstn.ca>
Subject: Re: Help! Making a perl script write to a log sheet
Message-Id: <Pine.GSO.3.96.970323083124.739E-100000@kelly.teleport.com>
On 22 Mar 1997, Brian Cohen wrote:
> Can someone please tell me how to make a perl script write to a log
> sheet so I can see who was on my web site and at what time. I would
> appreciate the advice.
If your server is any good, it already can (and probably does) make log
files. Hope this helps!
-- Tom Phoenix http://www.teleport.com/~rootbeer/
rootbeer@teleport.com PGP Skribu al mi per Esperanto!
Randal Schwartz Case: http://www.lightlink.com/fors/
------------------------------
Date: Sun, 23 Mar 1997 11:19:50 -0500
From: Chris <webmaster@surewould.com>
Subject: How can I find the current working directory?
Message-Id: <33355826.FA6@surewould.com>
How in Perl can I determine the name of the current working directory?
I've tried getting sneaky (but not too sneaky) with telldir() and
system("cd .") but none of this is quite right. Is there something
straightforward I'm missing?
- Chris
------------------------------
Date: Sun, 23 Mar 1997 16:41:44 GMT
From: svdjupvi@sn.no (Svein Hevard Djupvik)
Subject: Re: Parsing html tag attributes & values in Perl
Message-Id: <33355467.8737252@news.sn.no>
On Wed, 19 Mar 1997 22:47:30 GMT, dan@gulch.demon.co.uk (Dan Sumption)
wrote:
>Thanks to everyone on the Web Programming mailing list and
>comp.lang.perl.misc newsgroup for the various suggestions on how to
>do this, and in particular to Rodos who wrote what was almost the
>right program (only problem was, once I received his solution I had
>already thought out another way to do it).
>
>Below, I present my final (for now) version. I added a couple of
>configuration variables, so you can either use it the obvious way or
>the way I wanted it originally. Due to the haphazard way in which I
>learned perl, the code is probably fairly sloppy - if anyone spots any
>obvious flaws in the way I'm doing things, please please let me know
>(I intend running this on a site where it may be used a lot
>concurrently, and I'd like to keep processing requirements down).
>Obviously, I'd also like to hear of any useful additions people can
>make.
>
>Finally, a question - is there any kind of equivalent of chop which
>returns the _first_ character of a string - you may notice the rather
>sloppy way in which I had to resort to using substr's (I could also
>have used a regexp like $tempchar = s/^.//, but I imagine this would
>have been equally demanding).
>
>OK, so here, for anyone interested, is the code to return an
>associative array of attributes and their values, given an html tag:
>
>sub parseTag {
>
> use Strict;
>
> # Call using &parseTag(tag)
>
> local ($line) = shift;
> my ($attribute, $value, $separator, $tempchar, $hasvalue, $tag, $count, %pairs) = '';
> local ($includequotes, $inside, $order);
>
> # Configuration variables
> $includequotes = 0; # Set to 1 if you want to retain quotes around
> # values (e.g. if you want to put them back in
> # to some html, and ensure that they don't clash
> # with embedded quotes).
>
> $inside = 0; # Set to 1 if the initial < has already been
> # stripped from the tag
>
> $order = 0; # Set to 1 to add a 2 digit number before each
> # attribute so that they can be re-arranged in
> # their original order by sorting the keys of
> # the array (again this may beuseful if you are
> # outputting the results as html).
>
> unless ($inside) {
> # Remove upto (not including) the < and store it in the pairs array,
> # referenced by _before
> $line =~ s/^([^<]*?)<//;
> $pairs{'_before'} = $1;
> }
>
> # Take the first word, its the tag
> $line =~ s/^\s*((\w|-)+)\s*//;
> $tag = $1;
>
> # Whilst we still have attribute pairs read them
> $tempchar = substr($line,0,1);
> substr($line,0,1) = '';
> while ($line) {
>
> # Get the next character and skip if it's whitespace
> if ($tempchar =~ /\s/) {
> $tempchar = substr($line,0,1);
> substr($line,0,1) = '';
> next;
> }
>
> # End the loop if we reach the closing >, storing the remainder
> # in the array, referenced by _after
> if ($tempchar eq '>') {
> $pairs{'_after'} = $line;
> $line = '';
> last;
> }
>
> # Loop for getting next attribute name
> while ($tempchar !~ /\s|=/) {
> $attribute .= $tempchar;
> $tempchar = substr($line,0,1);
> substr($line,0,1) = '';
> }
>
> # Warn if the attribute name contains anything other than a-z, 0-9 or -
> if ($attribute =~ /([^\w|-])/) {
> warn "Unexpected character: $1 appears in attribute: $attribute, remainder of line: $line\n";
> }
>
> # Skip whitespace between attribute and value/next attribute, and
> # look out for = sign, which shows that there's a value to follow.
> while ($tempchar =~ /\s|=/) {
> $hasvalue = 1 if $tempchar eq '=';
> $tempchar = substr($line,0,1);
> substr($line,0,1) = '';
> }
>
> # If this attribute has a value, then get it.
> # Set $separator to characters which indicate we've reached the
> # end of the value (ie. a quote which matches the one we begin
> # with, or a space or > if there's no quotes).
> if ($hasvalue) {
> if ($tempchar =~ /("|')/) {
> $separator = $1;
> $value .= $tempchar if $includequotes;
> $tempchar = substr($line,0,1);
> substr($line,0,1) = '';
> }
> else {
> $separator = '\s|>';
> }
> while ($tempchar !~ /$separator/) {
> $value .= $tempchar;
> $tempchar = substr($line,0,1);
> substr($line,0,1) = '';
> }
>
> $value .= $tempchar if ($includequotes && ($tempchar =~ /'|"/));
> $tempchar = substr($line,0,1);
> substr($line,0,1) = '';
> }
>
> # Store the current attribute and its value in the array, before
> # resetting all temp values to null and going round again...
> if ($order) {
> substr($attribute,0,0) = sprintf "%2.2d", $count;
> $count++;
> }
> $pairs{$attribute} = $value;
> $attribute = $value = $separator = $hasvalue = '';
> }
> return ($tag, %pairs);
>}
>
>-------------------------------------------------------------------
>Dan Sumption : dan@gulch.demon.co.uk
>Hard Media, London SE1 dan@hardnet.co.uk
>
>http://www.hardnet.co.uk/dan/
------------------------------
Date: Sun, 23 Mar 1997 16:41:46 GMT
From: svdjupvi@sn.no (Svein Hevard Djupvik)
Subject: Re: Parsing html tag attributes & values in Perl
Message-Id: <333554fa.8884708@news.sn.no>
On Thu, 20 Mar 1997 11:25:09 +1000, Rodos <rodos@haywood.org> wrote:
>Dan Sumption wrote:
>> Below, I present my final (for now) version. I added a couple of
>> configuration variables, so you can either use it the obvious way or
>> the way I wanted it originally. Due to the haphazard way in which I
>> learned perl, the code is probably fairly sloppy - if anyone spots any
>> obvious flaws in the way I'm doing things, please please let me know
>
>> OK, so here, for anyone interested, is the code to return an
>> associative array of attributes and their values, given an html tag:
>
>On the performance side you test for the trailing > character and
>terminate from within the while loop. Would it be better to do this up
>front (like the previous version) and save one test for each interation.
>Whats the main reason for changing the previous attribute=value parsing
>to the new one? Was it to support the new options, it seams more
>complicate (or maybe it is just my lack of sleep :-).
>
>Now that we have a tag parse routine how about one to take a file and
>break it into tag and text, parseTag can then be used to parse each tag.
>I have the following object that does it but I now know that it will
>screw up on tags that contain > or < inside quotes. I would also like to
>make it as fast as possible! It should not modify the file in any way,
>so dumping the parsed output to a file should match the original file
>(newlines and all).
>
>Any alternative solutions or improvements on this one?
>
>#############################################################################
># Object : HTMLParser
>#
># Methods : HTMLParser(<text>) Constructor. Pass text to parse
># NextChunk Returns the next chunk from the
>text
># GetPage Returns whatever is left of the
>page
>
>package HTMLParser;
>
>sub new { # Constructor
> my $self = {};
> bless $self;
>
> $self->{'thePage'} = $_[1];
>
> return $self;
>}
>
>sub NextChunk {
>
> my $self = shift;
> my ($level, $bit, $chunk);
>
> # Break the bage down into matching < and >'s and return each chunk
>as required.
> # A chunk may be a tag or clear text
>
> #Is there anything left to process?
> if ($self->{'thePage'} eq "") {return undef;}
>
> $level = 0;
> $chunk = '';
>
> # Make sure we are starting with the <
> $left = index($self->{'thePage'},'<');
> if ($left > 0) {
> $chunk = substr($self->{'thePage'},0,$left); # Get the big
>chunk
> substr($self->{'thePage'}, 0, $left) = ''; # Remove it
> #$main::chunkSaves += $left;
> return $chunk;
> }
>
> while ($self->{'thePage'} ne '' ) {
>
> # Lets find and jump to the next < or >
> $right = index($self->{'thePage'},'>');
> $left = index($self->{'thePage'},'<');
> $left = ($left < $right) ? $left : $right;
> if ($left > 0) {
> $chunk .= substr($self->{'thePage'},0,$left); # Get the
>big chunk
> substr($self->{'thePage'}, 0, $left) = ''; # Remove it
> #$main::chunkSaves += $left;
> }
>
> $bit = substr($self->{'thePage'},0,1); # Get next character
>out of file.
> substr($self->{'thePage'}, 0, 1) = ''; # Replace the first
>character
> # with nothing, a reverse chop
>
> # If we find a start increment the level
> if ($bit eq '<') { # Start of tag
> if ($level == 0) {
> # If there is clear text in chunk return it otherwise
>just keep processing
> # so that this tag is extracted and then returned at the
>>
> if ($chunk ne '') {
> $self->{'thePage'} = $bit . $self->{'thePage'}; #
>Put the < back
> return $chunk;
> }
> }
> $level += 1;
> }
> if ($bit eq '>') { # End of tag
> $level -= 1;
> if ($level == 0) {
> $chunk .= $bit; # The > is part of this chunk
>not the next one
> return $chunk;
> }
> }
> # We are in the middle of either a tag so keep adding it on
> $chunk .= $bit;
> }
>
> # Hit the end of the page, return whatever was left.
> return $chunk;
>}
>
>sub GetPage { # Return whatever is left of the page
>
> my $self = shift;
>
> return $self->{'thePage'};
>}
>
>sub AddChunk {
># Add a chunk onto the start of the page so it can be processed.
># Used for putting back a comments content and parsing it
>
> my $self = shift;
>
> $self->{'thePage'} = $_[0] . $self->{'thePage'};
>}
>
>###### End of code
------------------------------
Date: Sun, 23 Mar 1997 16:41:42 GMT
From: svdjupvi@sn.no (Svein Hevard Djupvik)
Subject: Re: Parsing html tag attributes & values in Perl
Message-Id: <333552aa.8292398@news.sn.no>
On Thu, 20 Mar 1997 01:02:56 +1000, Rodos <rodos@haywood.org> wrote:
>Dan Sumption wrote:
>> My problem is that that the program separates out the tag by
>> looking for the < and > characters. This can lead to errors (and
>> a potentially never-ending loop) when one of these characters
>> appears as part of a value. For example:
>> <img src="arrow.gif" alt="Look Here >">
>> Should be reduced to:
>> src="arrow.gif" alt="Look Here >"
>> before parsing, but my code instead reduces it to:
>> src="arrow.gif" alt="Look Here ">
>>
>> I can write various 'fixes' to avoid some of these potential
>> problems, but they all seem very long-winded and ugly looking.
>> Surely there must be 'more than one way to do it'?
>
>> Enough already! Here's the code:
>> (call using, for e.g., %pairs=&tag_attribs('<META NAME="Author"
>> CONTENT="Dan Sumption">');
>>
>> sub tag_attribs
>> {
>> local ($_, *pairs) = shift;
>> s/^\s*<\s*\w+\s*([^>]*)>.*/$1/;
>
>Dan I have worked out whats going wrong.
>
>In the first regex (above) the ([^>]*) will stop at the FIRST > and not
>gobble up characters until the last >. Thats why you end up with
>src="arrow.gif" alt="Look Here ">
>rather than
>src="arrow.gif" alt="Look Here>"
>as you want.
>
>Now I played with this trying to use a $ at the end to get the regex to
>gobble as much as I could but it got awfully complicated and I could not
>get it to work. Then I replaced it with two regex's.
>
>s/^[^<]<(.*)/$1/;
>s/(.*)>\s*$/$1/;
>
>Which drops everything before the first < and then everything after the
>last >. After this the value left is
>src="arrow.gif" alt="Look Here>"
>and it works no matter how may < or > are in quoted text.
>
>Here is my test program.
>
>Rodos
>
>P.S. You did a great job on the parsing of the attribute value pairs!
>P.P.S. I added comments (as I can never remember what my code does a
>week later) so its a little longer.
>
># parsetag.pl
>
>$check = ' < img src=blue.gif alt="<blue dot>"> '; &dump;
>$check = ' < img src=blue.gif alt="blue dot>"> '; &dump;
>$check = q| < img src='blue.gif' alt="blue dot"> |; &dump;
>$check = q| <table border cellpadding=5> |; &dump;
>$check = q| <table border cellpadding=5 > |; &dump;
>$check = q| <td width=50% valign="center"> |; &dump;
>
>exit;
>
>sub dump {
> ($tag, %pairs) = &parseTag($check);
> print "\n\n$check\n$tag : ";
> foreach $key (keys %pairs) {
> print "'$key = $pairs{$key}'\t";
> }
>}
>
>sub parseTag {
>
> use Strict;
> local ($_) = shift;
> my ($attribute, $value, $separator, $tag, %pairs) = '';
>
> # Remove upto and including the <
> s/^[^<]<(.*)/$1/;
>
> # Remove everything after and including the outer >
> s/(.*)>\s*$/$1/;
>
> # Take the first word, its the tag
> s/^\s*((\w|-)+)\s*//;
> $tag = $1;
>
> # Whilst we still have attribute pairs read them
> while ($_) {
>
> # Get the next word delimited by a space
> s/^\s*((\w|-)+)\s*//;
> $attribute = $1;
>
> # Is there is a value for the attribute? Remove the =
> if (s/^\s*=\s*//) {
>
> # Is the attribute surounded by a delimiter?
> if (s/^\s*("|')//) {
>
> # There was a seperate, grab everything until
> #the end of the seperator
> $separator = $1;
> s/^([^$1]*)$1\s*//;
> $value = $1;
> }
> else {
>
> # No delimiter on the value so grab everything up the
>gap
> s/^(\S*)\s*//;
> $value = $1;
> }
> }
> else {
> # There was no = so it was a bare attribute, such as
>"border"
> $value = '';
> }
> $pairs{$attribute} = $value;
> }
> return ($tag, %pairs);
>}
------------------------------
Date: Sun, 23 Mar 1997 16:41:44 GMT
From: svdjupvi@sn.no (Svein Hevard Djupvik)
Subject: Re: Parsing html tag attributes & values in Perl
Message-Id: <3335532e.8424308@news.sn.no>
On Wed, 19 Mar 1997 23:49:33 GMT, dan@gulch.demon.co.uk (Dan Sumption)
wrote:
>OK, one more slight correction -
>The script I wrote will not find the closing > if the last character
>in the tag is not a closing quote or a space (oops) - to fix this,
>after the line:
>$value .= $tempchar if ($includequotes && ($tempchar =~ /'|"/));
>
>you should modify the next two lines to read:
>unless ($tempchar eq '>') {
> $tempchar = substr($line,0,1);
> substr($line,0,1) = '';
>}
>
>Hope that sorts it (coz I'm off to bed!)
>
>
>-------------------------------------------------------------------
>Dan Sumption : dan@gulch.demon.co.uk
>Hard Media, London SE1 dan@hardnet.co.uk
>
>http://www.hardnet.co.uk/dan/
------------------------------
Date: Sun, 23 Mar 1997 15:24:11 GMT
From: shyde@poboxes.com (Simon Hyde (aka Jeckyll))
Subject: Re: printf...
Message-Id: <3337395a.4563433@news.uni-stuttgart.de>
On 22 Mar 1997 00:04:17 GMT, "Casey Lee" <cplee@thegrid.net> wrote:
>Hello,
>
>I am writting a script that will print statements
>for our clients. The thing is that I need to
>print on two halfs of the statement:
>
>-------------------------------------------------------------------------
>| | |
>| Some stuff here | Some more stuff here |
>| | |
>| More stuff here | |
>| | And more here |
>| | |
>-------------------------------------------------------------------------
>
>The thing is that all field need to be variable between
>0 and (size of page)/2. Is there a way I can use
>printf and write a subroutine so I could say like
>
>&printLeft("Some Stuff here");
>&printRight("Some more stuff here");
>etc...
>
>and it will always start printing the right column at
>the right spot no matter how much text is in the left
>column? assuming left column is < (size of page)/2.
>
Firstly perhaps you would be better off with &printCols( "left",
"right"), that way you don't have to assume that the coder has already
printed the left when they move on to the right..and can also have a
variable number of columns. It might also be an idea to have the
function return the output and not actually print it so that you can
easily choose what file it goes to
eg...to produce the above table to the currently selected filehandle
(usually STDOUT):
$pagewidth = 79;
print "-" x $pagewidth . "\n" ;
print &blankCols( 2);
print &printCols("Some stuff here", "Some more stuff here");
print &blankCols(2);
print &printCols("More stuff here", " ");
print &printCols( " ", "And more here");
print &printCols( " ", " ");
print &blankCols();
print &printCols("Hmm...", "Even more stuff here, this should be
shortened", "ok?");
print &blankCols();
sub blankCols{
return ("-" x $pagewidth ."\n") if $_[0] < 1;
eval('&printCols( " "' . (", ' ' " x ($_[0] - 1)). ');' );
}
sub printCols{
local($cols) = $#_ + 1;
local($pagewidth) = int($pagewidth) || 80;
#Work out the width of each column...decrementing pagewidth to
allow for the final |
local($width) = int(--$pagewidth/$cols);
local($padding,$output, $text) = (0, '', '');
foreach(0..$#_){
# Incase the normal pagewidth/cols isn't an integer
$width = $pagewidth - ($cols - 1) *
int($pagewidth/$cols) if $_ == $#_;
# Make sure this string isn't too long
$text = substr($_[$_], 0, $width - 1);
$output .= "|";
#Take out one for
$padding = $width -1 - length($text);
$output .= (" " x int($padding/2));
$output .= $text;
# Make sure the column width is reached even if
$padding isn't even isn't even
if ($padding % 2){
$output .= (" " x ($padding/2 +.5));
}else{
$output .= (" " x ($padding/2));
}
}
$output .= "|\n";
$output;
}
---
Yours Sincerely,
,
() o /| | |
/\ _ _ _ __ _ _ |___| __| _
/ \| / |/ |/ | / \_/ |/ | | |\| | / | |/
/(__/|_/ | | |_/\__/ | |_/ | |/ \_/|/\_/|_/|__/
/|
\|
(Simon Hyde)
/****************How To Contact Me******************\
| Internet Email: shyde@POBoxes.com |
\***************************************************/
------------------------------
Date: Sun, 23 Mar 1997 08:35:43 -0800
From: Tom Phoenix <rootbeer@teleport.com>
To: "Craig A. Keefner" <keefner@primenet.com>
Subject: Re: Taking parameters from scrollboxes and then displaying a particular html file
Message-Id: <Pine.GSO.3.96.970323083429.739F-100000@kelly.teleport.com>
On 22 Mar 1997, Craig A. Keefner wrote:
> I want to take input parameters from 2 select boxes and then
> if/an pazrameters equal something, then display a certain
> html file.
>
> There are 17 different html files I'd like to display based on whats
> input so I want to avoid having all of them in the actual pl script
> as sub routines to jump to and display. I'd rather just call up
> the existing file outside the script.
That sounds like a good plan. Are you having trouble with it, or did you
merely want to tell us about it? :-)
-- Tom Phoenix http://www.teleport.com/~rootbeer/
rootbeer@teleport.com PGP Skribu al mi per Esperanto!
Randal Schwartz Case: http://www.lightlink.com/fors/
------------------------------
Date: Sun, 23 Mar 1997 08:41:56 -0800
From: Tom Phoenix <rootbeer@teleport.com>
To: Bob Wilkinson <b.wilkinson@NOSPAM.pindar.co.uk>
Subject: Re: TEST for empty DIR
Message-Id: <Pine.GSO.3.96.970323083640.739G-100000@kelly.teleport.com>
On Fri, 21 Mar 1997, Bob Wilkinson wrote:
> From the entry about readdir in pink camel pp.170 -
>
> If there are no more entries, the function returns an undefined value in
> a scalar context, or a null list in an array context.
>
> Therefore, I think that you should be able to do
>
> opendir(D,$d) or die "Can't open directory, $d, $!";
> if (readdir(D)) {
> #directory not empty
> } else {
> #directory empty
> }
> closedir(D)
No, you can't do that on Unix-like systems. There's never a truly empty
directory, since each directory has entries for '.' and '..' at a minimum.
> If you are working under Unix and want to avoid "." and ".." then you'd
> do
>
> if (grep(!/^\.\.?$/,readdir(D)) {
> #directory not empty
> } else {
> #directory empty
> }
And that method reads the entire directory, rather than just the first few
entries. That's wasteful if it's a directory with many items. (But perhaps
having few entries is expected when you're testing for an empty
directory.)
Hope this helps!
-- Tom Phoenix http://www.teleport.com/~rootbeer/
rootbeer@teleport.com PGP Skribu al mi per Esperanto!
Randal Schwartz Case: http://www.lightlink.com/fors/
------------------------------
Date: Sun, 23 Mar 1997 08:44:59 -0800
From: Tom Phoenix <rootbeer@teleport.com>
To: Ross Swanson <swanson@est07.md.essd.northgrum.com>
Subject: Re: Text::ParseWords Error
Message-Id: <Pine.GSO.3.96.970323084412.739H-100000@kelly.teleport.com>
On Sat, 22 Mar 1997, Ross Swanson wrote:
> I get the following error:
> Unmatched quote at ./vhd2abl.pl line 6
>
> with the perl program:
>
> use Text::ParseWords;
> open(INP,"xx");
> $/ = "";
> @file = <INP>;
> $delimit = ';';
> @words = quotewords($delimit,0,@file);
I'm suspicious of what's in the file "xx". Could it perhaps have an
unmatched quote? Hope this helps!
-- Tom Phoenix http://www.teleport.com/~rootbeer/
rootbeer@teleport.com PGP Skribu al mi per Esperanto!
Randal Schwartz Case: http://www.lightlink.com/fors/
------------------------------
Date: 23 Mar 1997 16:38:20 GMT
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: Wildcards in a system (mv, fn, fn) call won't work
Message-Id: <5h3m9s$e1$2@csnews.cs.colorado.edu>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc,
ceolas@celtic.stanford.edu (Ceolas) writes:
: $source = "/img/www/html/submit/bod/*";
: $dest = "/img/www/html/bod/";
: system ("mv", $source, $dest);
:
:Question: is there any way that mv can recognise a * wildcard in a perl
:system() call? If not, is there a way around it, for me to update certain
:files in a directory, without transferring the whole directory across
:every time?
system ("mv $source $dest");
--tom
--
Tom Christiansen tchrist@jhereg.perl.com
Randal said it would be tough to do in sed. He didn't say he didn't
understand sed. Randal understands sed quite well. Which is why he
uses Perl. :-) -- Larry Wall in <7874@jpl-devvax.JPL.NASA.GOV>
------------------------------
Date: 8 Mar 97 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 8 Mar 97)
Message-Id: <null>
Administrivia:
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 164
*************************************
