[22462] in Perl-Users-Digest
Perl-Users Digest, Issue: 4683 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Mar 8 03:06:00 2003
Date: Sat, 8 Mar 2003 00:05:07 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sat, 8 Mar 2003 Volume: 10 Number: 4683
Today's topics:
Re: any simple way to detect the real end of a command <jurgenex@hotmail.com>
Re: Catching errors using DBI <tore@aursand.no>
Re: Counting matches in a regular expression <me@me.com>
Re: Counting matches in a regular expression <goldbb2@earthlink.net>
Re: foreach in while-block cancels while <tore@aursand.no>
Re: Non-fatal error, "script not found or unable to sta (Mike)
Re: Obfuscated Perl Challenge <goldbb2@earthlink.net>
Re: Obfuscated Perl Challenge <goldbb2@earthlink.net>
Re: Perl Mysql uploading a image in a database. <mgjv@tradingpost.com.au>
Re: Regular Expressions <bach@nospamworld.com>
Re: tough regex problem <jurgenex@hotmail.com>
Ugh. Better way to turn strings into trees besides eval <apollock11@hotmail.com>
Re: Ugh. Better way to turn strings into trees besides <goldbb2@earthlink.net>
Re: uninitialized value <tore@aursand.no>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 08 Mar 2003 01:45:49 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: any simple way to detect the real end of a command in a perl script?
Message-Id: <hXbaa.212$Jh1.26@nwrddc03.gnilink.net>
mkkwong wrote:
> I intend to write some simple tools to help myself in writing perl
> programs. The tool will read a perl script and analyze the content and
> perhaps generate some useful information.
>
> One of the first problems I encounter is to figure out whether a ;
> found in a line in the script is really the end of a command. A
> similar problem is how can we tell the end of those commands that may
> not end in a ; (like the last statement in a block).
You know, there is a saying "Only perl can parse Perl".
While you can surely write your own Perl parser I wouldn't even attempt it
unless you have a very solid background in compiler construction.
> Obviously the perl debugger or the useful perltidy() utility has this
> capabilty. I am way too lazy (aka don't know enough) to try to dig
> into those to find out how they do it. I don't really need the full
> power like those tools to parse the complete perl syntax - it is
> enough if I can simply determine that the ; I see is not part of a
> string value, or part of a here doc, or a regex, or a comment etc.
Or, or, or, or. You just listed 4 good reasons why you do need a
full-featured parser or at least a full-featured tokenizer (not sure though
if a tokenizer will be sufficient for Perl).
> Similarly, if I see an enclosing }, how do I know whether that is the
> end of a code block and not part of a hash notation, or part of a
> string value, or a here doc or a regex, etc.
Another 5 good reasons for a Perl parser.
> Does any one know if there is an easy way or if some modules are
> available (without me having to chase through the entire set of perl
> syntax rules) to do those or am I wishing too much?
Contrary to popular believe parsing a programming language is rocket
science.
jue
------------------------------
Date: Sat, 08 Mar 2003 01:37:27 +0100
From: "Tore Aursand" <tore@aursand.no>
Subject: Re: Catching errors using DBI
Message-Id: <pan.2003.03.08.00.25.21.573869@aursand.no>
On Fri, 07 Mar 2003 20:12:26 +0000, Geoff Soper wrote:
> There are times when it is possible that the queries I'm executing
> won't return a result, how can I catch this in the example of the
> code below, i.e. when there is no user_cookie corresponding to the
> username?
>
> my $cookie_value = $dbh->selectrow_array( "SELECT user_cookie
> FROM users
> WHERE username = ?",
> {},
> param("username"));
> my $cookie = cookie(-name => 'user',
> -value => $cookie_value);
The SQL query above is correct; it just doesn't return a defined value if
there aren't any matches.
Just check if '$cookie_value' is defined;
if ( $cookie_value ) {
# create the cookie
}
One other thing - which is _MUCH_ worse - with your code, is that it seems
to be somewhat insecure.
Excactly why it's insecure? Hmm. It's for you to try to find out, but
let me give you a hint: Are you sure that 'param{username}' contains a
"legal" value?
--
Tore Aursand <tore@aursand.no>
------------------------------
Date: Fri, 7 Mar 2003 16:57:40 -0800
From: "Barty" <me@me.com>
Subject: Re: Counting matches in a regular expression
Message-Id: <vjbaa.38$bb6.2725@news.bc.tac.net>
"Anno Siegel" <anno4000@lublin.zrz.tu-berlin.de> wrote in message
news:b47egj$pgn$1@mamenchi.zrz.TU-Berlin.DE...
> Benjamin Goldberg <goldbb2@earthlink.net> wrote in comp.lang.perl.misc:
> > -=-=-=-=-=-
> >
> > Anno Siegel wrote:
> > > Benjamin Goldberg wrote:
> > > > -=-=-=-=-=-
Holy wow! You people are really going hard on this huh? I thought this
thread was dead!
This is excellent stuff, with working out all the three matches combinations
first. I need to read your code!! (And hopefully understand it, I am more
of a scripter than a programmer...)
Oh, and the 7th number is a bonus number which only comes into play in a 5
match situation...
There are definitely no combinations which have never won a 3-match. Now I
am being asked to do a statistical analysis of many times each combination
has won.. Again I'll brute force it.. I am trying the index function
instead of the regexp. It seems to be MUCH faster...
Saw this quote the other day:
"Lotteries are just another tax for people who suck at math!" I guess none
of you play lotteries huh?
Enjoy your weekend!
Ian
------------------------------
Date: Fri, 07 Mar 2003 22:38:22 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Counting matches in a regular expression
Message-Id: <3E6965AE.B194C804@earthlink.net>
This is a multi-part message in MIME format.
--------------46075D6353E2CFDA355FBBD9
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Barty wrote:
[snip]
> Now I am being asked to do a statistical analysis of many times each
> combination has won.. Again I'll brute force it..
Given that each combination has won at least once, it seems to me that
this is going to take a heck of a long time, if you have to examine
*all* combinations.
I've written a bit of code (based on my previous code), which I've
tested up to the point of printing the code to be evalled (and the eval
doesn't immediately die), but which I haven't run to completion.
I've attached it to this message. If it's what you want, good luck!
--
@1=a..c;$;=4;{push@2,map[$;--,@1[0,2,1]=@1
],2..$;x--$|;print"$1[0]=>$1[2]\n";--$;?@1
=@1[1,0,2]:(($;,@1)=@{pop@2||last});redo}
--------------46075D6353E2CFDA355FBBD9
Content-Type: application/x-perl;
name="foo.pl"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="foo.pl"
use strict;
use warnings;
use integer;
print localtime() . " Marking winning combos.\n";
my %winners;
my @subsets;
for my $a ( 0 .. 3 ) { for my $b ( $a + 1 .. 4 ) {
push @subsets, [$a, $b, $_] for $b + 1 .. 5;
} }
open my $csv, '649.csv' or die "Cannot open 649.csv: $!";
while ( <$csv> ) {
# Discard ("649", row-id, date) from front.
my @d = (split /,/)[3..8];
@d == 6 or die "\@d == ".@d;
$_ >= 1 && $_ <= 49 or die $_ for @d;
--$_ for @d; # scale 1..49 down to 0..48
# sort into canonical order.
@d = sort {$a <=> $b} @d;
push @{$winners{"@d[@$_]"}}, "@d" for @subsets;
}
close $csv;
if( 1 ) {
my $count = 0;
$count += @$_ for values %winners;
print localtime() . " $count winning combos marked.\n";
} else {
print localtime() . " Winning combos marked.\n";
}
# Generate some code.
my $losers = 0;
my $code = q{
use vars qw(%won);
%won = ();
};
for my $index ( 0 .. 5 ) {
my $p = $index - 1;
$code .= sprintf qq[for my \$i%s ( %s .. %d ) {\n],
$index, ($index ? "\$i$p + 1" : 0), 48 - 5 + $index;
next if $index < 2;
$code .= q{ local %won} . ($index == 2 ? ";\n" : " = %won;\n");
$code .= q/ @won{map @$_, grep defined, @winners{/;
$code .= join('', map sprintf(
"\n".q[ "$i%d $i%d $i%d",], @$_ ),
grep $index == $_->[2], @subsets );
$code .= qq/\n }} = ();\n/;
}
$code .= q{
++$total_combos;
my $this_combo_won = keys %won;
++$histogram{$this_combo_won};
$total_won += $this_combo_won;
};
$code .= "}}}}}}\n";
print localtime() . " Counting how many times any combo won.\n";
{ local $| = 1; print $code; }
my ($total_combos, $total_won, %histogram) = (0, 0);
eval "$code; 1" or die $@;
print localtime() . " Each combo won ".
($total_combos/$total_won)." on average\n";
for my $won ( sort {$a <=> $b} keys %histogram ) {
print "$won: $histogram{$won}\n";
}
__END__
--------------46075D6353E2CFDA355FBBD9--
------------------------------
Date: Sat, 08 Mar 2003 01:37:27 +0100
From: "Tore Aursand" <tore@aursand.no>
Subject: Re: foreach in while-block cancels while
Message-Id: <pan.2003.03.08.00.08.04.218338@aursand.no>
On Fri, 07 Mar 2003 18:43:40 +0000, W. Citoan wrote:
> [...]
> This will do the opposite of what the OP wants. It will delete the file
> if the process is found. The OP wants to delete it if it's not found.
Ah. I should start reading the posts before I answer them, I guess. :)
--
Tore Aursand <tore@aursand.no>
------------------------------
Date: 7 Mar 2003 23:45:41 -0800
From: csdude@hotmail.com (Mike)
Subject: Re: Non-fatal error, "script not found or unable to stat"
Message-Id: <46cdc619.0303072345.47334d2d@posting.google.com>
Hey, guys,
Thanks for the help. That message was literal, it actually says
[object]. My first thought was Javascript, too, but the only JS I have
running is a clock that I've used on other sites with the same host,
and didn't have a problem. Thanks for the tip, though, I'll ask about
it in a Javascript NG.
About the "join" function, though, I'm opening a flat-text file that's
written as an Excel database, then putting everything into an array:
open INFILE, "$basepath/data.xls" || die "$!";
@data = <INFILE>;
close INFILE;
$current_data = join(/\n/, @data);
@olddata = split(/\n/, $current_data);
The program runs perfectly (as far as I've tested it, anyway), but in
the error log I get something like "/\n/ should probably be \n." I
figure that the word "probably" means that it's just a suggestion, and
that it can be ignored. I used to use chomp, but it's been so long
that I don't remember why it became a problem.
FYI, this is on version 5.6.1.
Thanks again,
Mike
> Mike <csdude@hotmail.com> wrote:
>
> > so I
> > usually leave the -w out
>
>
> Don't do that.
>
> If you are getting warnings, find out what is causing them
> and fix them so that you are not getting warnings.
>
>
> Turning off warnings is like "fixing" the funny noise your car
> is making by turning up the volume on the radio.
>
> Hiding a potential problem is not the same as removing the
> potential for a problem.
------------------------------
Date: Fri, 07 Mar 2003 21:15:23 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Obfuscated Perl Challenge
Message-Id: <3E69523B.CE731197@earthlink.net>
Abigail wrote:
>
> Benjamin Goldberg (goldbb2@earthlink.net) wrote on MMMCDLXXV September
> MCMXCIII in <URL:news:3E685F6E.C3E9A517@earthlink.net>:
> || Can anyone guess/figure out what this code does, without running
> || it?
> ||
> || @1=a..c;$;=4;{push@2,map[$;--,@1[0,2,1]=@1
> || ],2..$;x--$|;print"$1[0]=>$1[2]\n";--$;?@1
> || =@1[1,0,2]:(($;,@1)=@{pop@2||last});redo}
> ||
> || A large part of the obfuscation is because the flow control is
> || significantly different from the way this particular algorithm is
> || normally implemented, so even using Deparse won't significantly
> || help you.
>
> After a few seconds, I guessed "Towers of Hanoi". Running it seems
> to confirm the guess.
>
> The 0, 1, 2 permutations are a giveaway.
Wow -- I wouldn't have made the leap from those 0,2,1 and 1,0,2 to
"Towers of Hanoi". If I'd hidden those permutations, like this:
@1=a..c;$;=4;sub x{@1[@_]=@1[@_[1,0]]}{(push@2,[
$;--,@1]),x 1,2 for 2..$;x--$|;print"$1[0]=>$1[
2]\n";--$;?x 0,1:(($;,@1)=@{pop@2||last});redo}
Would it have been better, less obvious?
(I'm assuming that you guessed that *only* from seeing those 0,1,2
permutations, not due to recognizing the algorithm from the arrangement
of pushes and pops... and that really cool 'x --$|' that acts sortof the
way an "if $iteration++ % 2" modifyer would.)
This version of the code has a fringe "benefit", if it can be called
that, of not being liked by perl 5.6's B::Deparse, for some reason. It
produces the following error:
Can't call method "PADLIST" on an undefined value at
C:/Ben/ActivePerl/Perl/lib/B/Deparse.pm line 1039.
CHECK failed--call queue aborted.
Strange, no? Especially since, IIRC, perl's "PAD" things are where
lexical variables live, and I have no my() variables in my code.
> # Needs perl 5.005_03 or *earlier*.
> %0=map{reverse+chop,$_}ABC,ACB,BAC,BCA,CAB,CBA;
^
Adding in a 'map$_,' here, it will work on later perls.
> $_=shift().AC;1while+s/(\d+)((.)(.))/
> ($0=$1-1)?"$0$3$0{$2}1$2$0$0{$2}$4":"$3 => $4\n"/xeg;
> print#Towers of Hanoi
Of course, your version of the algorithm is cool, too.
--
@1=a..c;$;=4;{push@2,map[$;--,@1[0,2,1]=@1
],2..$;x--$|;print"$1[0]=>$1[2]\n";--$;?@1
=@1[1,0,2]:(($;,@1)=@{pop@2||last});redo}
------------------------------
Date: Sat, 08 Mar 2003 00:05:04 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Obfuscated Perl Challenge
Message-Id: <3E697A00.EF9FDCF1@earthlink.net>
[posting and mailing this, so others can see my explanation, too.]
"David K. Wall" wrote:
>
> On 07 Mar 2003, you wrote in comp.lang.perl.misc:
>
> > Can anyone guess/figure out what this code does, without running
> > it?
>
> I can't even figure out what it's doing after running it.
>
> > @1=a..c;$;=4;{push@2,map[$;--,@1[0,2,1]=@1
> > ],2..$;x--$|;print"$1[0]=>$1[2]\n";--$;?@1
> > =@1[1,0,2]:(($;,@1)=@{pop@2||last});redo}
It's a solution to the Tower of Hanoi puzzle, for 4 disks.
You've got three towers, and N disks. At the start, the first tower
holds 4 disks, the others are empty. The disks are numbered; you're not
allowed to move more than one disk at a time, nor move a larger numbered
disk onto a smaller numbered disk. The task is to move all the disks
from the starting tower to the ending tower.
The optimal solution takes 2**N-1 steps. You do it by first moving N-1
disks from the starting tower to the 'spare' tower, then move the Nth
disk from the starting tower to the end tower, then move the N-1 disks
from the spare tower onto the end tower.
Obviously the sub-task of moving N-1 disks can be done using the same
solution as the main problem (but with different towers serving the
purposes of being source, spare, and destination), making this into a
basic (common? classic? cliched?) excercise for learning recursion.
Normally, this would be done as:
sub hanoi {
my ($n, $source, $spare, $dest) = @_;
return unless $n;
hanoi($n-1, $source, $dest, $spare);
print "Move a disk from $source to $dest\n";
hanoi($n-1, $spare, $source, $dest);
}
hanoi(4, a..c);
> > A large part of the obfuscation is because the flow control is
> > significantly different from the way this particular algorithm is
> > normally implemented, so even using Deparse won't significantly
> > help you.
Here's how I produced my wierd looking code for solving the Towers of
Hanoi puzzle, from the above, much simpler, code.
First, I rewrote it to use a stack, dividing the code into the part
before the print, and the part after, using an extra variable, something
like:
my @stack = [4, 0, a..c];
while( @stack ) {
my ($n, $print, $source, $spare, $dest) = @{pop @stack};
next unless $n;
if( $print ) {
print "Move a disk from $source to $dest\n";
push @stack, [$n-1, 0, $spare, $source, $dest];
} else {
push @stack, [$n , 1, $source, $spare, $dest];
push @stack, [$n-1, 0, $source, $dest, $spare];
}
}
Then, I saw that in the !$print case, I could do a whole bunch of pushes
in a row until I was in a situation where $print would normally be true.
my @stack = [4, 0, 'a'..'c'];
while( @stack ) {
my ($n, $print, $source, $spare, $dest) = @{pop @stack};
unless( $print ) {
for my $i ( 0 .. $n - 2 ) {
push @stack, [$n-$i, 1, $source, $spare, $dest];
($spare, $dest) = ($dest, $spare);
}
$n = 1;
}
print "Move a disk from $source to $dest\n";
push @stack, [$n-1, 0, $spare, $source, $dest] if $n > 1;
}
Then I realized that pushing data onto the stack, then immediately
popping it back off, could be eliminated by moving the declarations of
the variables outside of the loop and the pop to the end.
my @stack;
my ($n, $print, $source, $spare, $dest) = (4, 0, a..c);
while(1) {
unless( $print ) {
for my $i ( 0 .. $n - 2 ) {
push @stack, [$n-$i, 1, $source, $spare, $dest];
($spare, $dest) = ($dest, $spare);
}
$n = 1;
}
print "Move a disk from $source to $dest\n";
if( $n > 1 ) {
($n, $print, $source, $spare, $dest) =
($n-1, 0, $spare, $source, $dest);
} else {
last unless @stack;
($n, $print, $source, $spare, $dest) = @{pop @stack};
}
}
It should be obvious that $print is always 1 when popped from the stack,
and always 0 when we don't access the stack; thus, we can avoid storing
it in the stack itself.
my @stack;
my ($n, $print, $source, $spare, $dest) = (4, 0, a..c);
while(1) {
unless( $print ) {
for my $i ( 0 .. $n - 2 ) {
push @stack, [$n-$i, $source, $spare, $dest];
($spare, $dest) = ($dest, $spare);
}
$n = 1;
}
print "Move a disk from $source to $dest\n";
if( $n > 1 ) {
$print = 0;
($n, $source, $spare, $dest) =
($n-1, $spare, $source, $dest);
} else {
last unless @stack;
$print = 1;
($n, $source, $spare, $dest) = @{pop @stack};
}
}
Further analysis showed that every other pass through the loop had
$print true, and every other pass had it false. For behavior *that*
simple, I could simply use a toggle. I'd seen --$| used as a toggle in
one of Abigail's JAPHs (and used it once in one of my own), and used in
place of $print.
I think that all the other obfuscations should be ... well, if not
immediately obvious, then at least understandable with a bit of thought.
> > If you give up on figuring it out, run it. It should be quite
> > recognizable to most programmers as the output of a basic learning
> > excercise for ... well, that would be a spoiler :). If you don't
> > recognize it, send me a private email, and I'll tell you.
>
> Consider yourself asked. :-) I suppose it's something I would have
> learned in Comp Sci classes had I taken something more than intros
> to Basic, Fortran, Pascal, and a numerical methods class. (I was a
> math and stats major)
Surely the intros covered recursion?
If they did, and you never saw this ... well, maybe the Towers of Hanoi
aren't as well-known a puzzle as I thought they were.
> > Hopefully (for the sake of having fun), even once you understand
> > what it's producing, it'll be difficult to see *how* it's doing
> > what it's doing :)
> >
> > Have fun, and Good Luck!
>
> Oh, I am having fun. It's keeping me away from real work. (But I'm
> having to work on some ancient data on a mainframe *shudder*) I'd
> like to claim there's something vaguely familiar there, but maybe I'm
> flattering myself.
If you've ever done the Towers of Hanoi puzzle, then the output should
look vaguely familiar. Well, asside from mine printing "$from=>$to"
instead of "Move a disk from $from to $to".
--
@1=a..c;$;=4;{push@2,map[$;--,@1[0,2,1]=@1
],2..$;x--$|;print"$1[0]=>$1[2]\n";--$;?@1
=@1[1,0,2]:(($;,@1)=@{pop@2||last});redo}
------------------------------
Date: Sat, 8 Mar 2003 11:45:45 +1100
From: Martien Verbruggen <mgjv@tradingpost.com.au>
Subject: Re: Perl Mysql uploading a image in a database.
Message-Id: <slrnb6if9p.747.mgjv@martien.heliotrope.home>
On 7 Mar 2003 07:18:52 -0800,
niels <niels_bond@hotmail.com> wrote:
> my($afbeelding);
> {
> local $/=undef;
You need to open the image, and use binmode.
> $afbeelding=<$reclame_image>;
This, confusingly, does not read from the file, but will treat
$reclame_image as a glob pattern (see the glob entry in perlfunc).
> }
> close $reclame_image;
You don't need this.
Replace all that came before with something like:
my ($afbeelding);
{
local $/;
open my $handle, $reclame_image or
die "Cannot open $reclame_image: $!\n"
binmode $handle;
$afbeelding = <$handle>;
# No need to close. $handle will go out of scope, and will be
# closed automatically.
}
If you have a Perl before 5.6, you may need to use a localised
old-fashioned file handle:
my ($afbeelding);
{
local ($/, *HANDLE);
open HANDLE, $reclame_image or
die "Cannot open $reclame_image: $!\n"
binmode HANDLE;
$afbeelding = <HANDLE>;
}
There are other ways to do this, but this is closest to what you seem to
be trying.
> if($afbeelding)
> {
> $afbeelding=Quote_Chars($afbeelding);
> $afbeelding=Escape_Chars($afbeelding);
Wait... Wait.. What are you doing here? You're calling escpaing
functions on the image data? $afbeelding is supposed to contain image
data, right?
> binmode($afbeelding);
And why the binmode here?
> $sql="insert into imgarchief(image)values(\"$afbeelding\")";
> $sth=Execute_Query($sql); (Dit is een eigen functie, werkt goed)
I wouldn't store image data in a database, so I won't try to comment on
whether this is the right way to do it. I would never use bare SQL like
this anyway, but would use DBI's functionality. I believe others have
already commented on that.
> #He saves the image, but i don't know if he does it right. Maybe he
> saves a part of the image.
I suspect that it never even read in the complete image..
Martien
--
|
Martien Verbruggen | My friend has a baby. I'm writing down all
| the noises the baby makes so later I can ask
| him what he meant - Steven Wright
------------------------------
Date: Sat, 08 Mar 2003 06:42:57 GMT
From: "bach" <bach@nospamworld.com>
Subject: Re: Regular Expressions
Message-Id: <Rhgaa.70575$em1.12259@news04.bloor.is.net.cable.rogers.com>
Thanks for your concern, Anno, but Benjamin Goldberg already answered with
very useful information. I guess that my gibberish didn't bother him too
much - though yes, I admit, my examples were pseudo-code. I guess he was
able to look past my incompetence, ignorance and other faux-pas to provide
help that would actually direct me on the right path. Go figure...
> You just landed yourself in a number of killfiles
> of those who could potentially help you.
My, I didn't know I could instill so much fear (or disdain). Such a serious
reaction to such an innocent little post...this is almost funny.
Be well,
b@
"Anno Siegel" <anno4000@lublin.zrz.tu-berlin.de> wrote in message
news:b4a1is$q1o$1@mamenchi.zrz.TU-Berlin.DE...
> bach <bach@nospamworld.com> wrote in comp.lang.perl.misc (in reply to
> Nobull):
>
> [...]
> > P.S. Next time someone makes a mistake, try to be candid in showing them
the
> > right way instead of evangilizing. Trust me, you'll feel better, and
people
> > will want to pay more attention to your gibberish.
>
> The gibberish was in your posting (and could have been easily avoided
> by application of some common sense). The one who has to worry about
> attention is you. You just landed yourself in a number of killfiles
> of those who could potentially help you.
>
> Anno
------------------------------
Date: Sat, 08 Mar 2003 01:51:55 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: tough regex problem
Message-Id: <%0caa.214$Jh1.106@nwrddc03.gnilink.net>
Domenico Discepola wrote:
> Is it fair to state that Microsoft
> Windows XP automatically converts a \n to \r\n?
No. You are just plain mistaken.
Perl converts the logical line end symbol "\n" to whatever physical
character combination is used on a specific platform. And these physical
characters happen to be different on Unix, Mac, and Windows.
jue
------------------------------
Date: Fri, 07 Mar 2003 16:01:05 -0800
From: Arvin Portlock <apollock11@hotmail.com>
Subject: Ugh. Better way to turn strings into trees besides eval?
Message-Id: <b4bc18$cu5$1@agate.berkeley.edu>
I've been staring at this problem for days now trying to come
up with a simple, elegant solution and now I have resorted to
eval(). Ugh. Is anybody in the mood to come up with something
nifty for translating a series of strings into a tree structure?
Ideally I would like to turn a flat series of hash keys into
a tree structure:
"NAME-1"
"NAME-1-1"
"NAME-1-2"
"NAME-1-3"
"NAME-1-3-1"
etc. As they are hash keys they can be in any order but they
are always always complete, i.e. if there is a "NAME-1-3" then
you know there must be a "NAME-1-1" and a "NAME-1-2".
Ideally each node of the tree will contain a {sub} key containing
a reference to its first child and a {next} key containing a
reference to its right sibling.
node1->{next} = node2
node1->{sub} = node1-1
Ideally the solution should be recursive.
I was not able to do the tree above but I came up with something
that works passably:
foreach my $key (keys %{$post_data}) {
if ($key =~ /([A-Z0-9_]+)-\d/) {
my @chain = split (/-/, $key);
my $rootname = shift @chain;
my $eval_string = "\$struct->{'$rootname'}";
my $value = $post_data->{$key};
foreach my $num (@chain) {
$eval_string .= "\->{children}\->{$num}";
}
eval ("$eval_string\->{value} = \"$value\";");
print "$eval_string\->{value} = \"$value\";\n"
}
}
The print statement is just so I can see what's what. It generates
something like this (please excuse line-wrapping):
$struct->{'NAME'}->{children}->{1}->{value} = "This is Child 1";
$struct->{'NAME'}->{children}->{1}->{children}->{1}->{value} = "This is
Grandchild 1";
$struct->{'NAME'}->{children}->{1}->{children}->{2}->{value} = "This is
Grandchild 2";
$struct->{'NAME'}->{children}->{1}->{children}->{3}->{value} = "This is
Grandchild 3";
$struct->{'NAME'}->{children}->{1}->{children}->{3}->{children}->{1}->{value}
= "This is GreatGrandchild 3";
This actually works and I can navigate the result, but
awkwardly. I know there are people out there that can visualize
the solution in a heartbeat but it makes my head hurt! I know
There's More Than One Way To Do It but this is absurd.
Help!
------------------------------
Date: Fri, 07 Mar 2003 21:33:26 -0500
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Ugh. Better way to turn strings into trees besides eval?
Message-Id: <3E695676.7A9F02B2@earthlink.net>
Arvin Portlock wrote:
>
> I've been staring at this problem for days now trying to come
> up with a simple, elegant solution and now I have resorted to
> eval(). Ugh. Is anybody in the mood to come up with something
> nifty for translating a series of strings into a tree structure?
>
> Ideally I would like to turn a flat series of hash keys into
> a tree structure:
>
> "NAME-1"
> "NAME-1-1"
> "NAME-1-2"
> "NAME-1-3"
> "NAME-1-3-1"
[snip]
> $struct->{'NAME'}->{children}->{1}->{value} = "This is Child 1";
> $struct->{'NAME'}->{children}->{1}->{children}->{1}->{value} =
> "This is Grandchild 1";
> $struct->{'NAME'}->{children}->{1}->{children}->{2}->{value} =
> "This is Grandchild 2";
> $struct->{'NAME'}->{children}->{1}->{children}->{3}->{value} =
> "This is Grandchild 3";
> $struct->{'NAME'}->{children}->{1}->{children}->{3}
> ->{children}->{1}->{value} = "This is GreatGrandchild 3";
>
> This actually works and I can navigate the result, but
> awkwardly. I know there are people out there that can visualize
> the solution in a heartbeat but it makes my head hurt! I know
> There's More Than One Way To Do It but this is absurd.
my %struct;
while( my ($key, $value) = each %$post_data ) {
next unless $key =~ /^\w+(?:-\d+)+\z/;
my @parts = split /-/, $key;
my $node = \%struct;
for my $subkey ( @parts ) {
$node = $node->{children}{$subkey} ||= {};
}
$node->{value} = $value;
}
Note that this produces the same data structure as you're using, just
without the eval"".
Here's code to produce a simpler data structure:
my %struct;
while( my ($key, $value) = each %$post_data ) {
next unless $key =~ /^\w+(?:-\d+)+\z/;
my @parts = split /-/, $key;
my $node = \\%struct;
for my $subkey ( @parts ) {
$node = \$$node->{$subkey};
}
$$node->{value} = $value;
}
--
@1=a..c;$;=4;{push@2,map[$;--,@1[0,2,1]=@1
],2..$;x--$|;print"$1[0]=>$1[2]\n";--$;?@1
=@1[1,0,2]:(($;,@1)=@{pop@2||last});redo}
------------------------------
Date: Sat, 08 Mar 2003 01:37:27 +0100
From: "Tore Aursand" <tore@aursand.no>
Subject: Re: uninitialized value
Message-Id: <pan.2003.03.08.00.18.14.101905@aursand.no>
On Fri, 07 Mar 2003 19:54:41 +0000, Tony wrote:
> "Use of uninitialized value in concatenation (.) or string..."
Which means that a variable you're using isn't holding any value it all.
It's not even blank. :)
> #use strict;
Don't (!) comment this out. Instead, add a line;
#!/usr/bin/perl
#
use strict;
use warnings;
And - if you're really smart - add this line after the two above:
use diagnostics;
They _are_ helpful!
> my $name=param("name");
> print "<h2>You entered: $name <p>\n";
What happens you you don't enter a name? Will '$name' contain a value, or
will it be undefined? It it's undefined, Perl will certainly spit out the
warning ("Use of uninitalized value...").
I prefer doing this:
my $string = $cgi->param( 'string' ) || '';
my $number = $cgi->param( 'number' ) || 0;
That is, if I'm certain that I want a string, I 'or' it so I get an empty
string if the boolean value of $cgi->param('string') is false. The same
goes for the "number strategy".
The same "strategy" can of course be adopted to arrays;
my @values = $cgi->param( 'value' ) || ();
BTW: Your HTML code above won't validate. :)
Conclusion: _Always_ be sure that your variables are defined. In my
applications, I tend to check this almost too often - just to be sure.
--
Tore Aursand <tore@aursand.no>
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
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.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.
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 V10 Issue 4683
***************************************
