[29071] in Perl-Users-Digest
Perl-Users Digest, Issue: 315 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Apr 7 16:10:08 2007
Date: Sat, 7 Apr 2007 13:09:06 -0700 (PDT)
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, 7 Apr 2007 Volume: 11 Number: 315
Today's topics:
Re: Creating Word Documents with Perl <bik.mido@tiscalinet.it>
How to transparently download multiple files? <edMbj@aes-intl.com>
Re: How to transparently download multiple files? <jurgenex@hotmail.com>
Re: How to transparently download multiple files? <purlgurl@purlgurl.net>
I don't understand this semaphore output <cdalten@gmail.com>
Re: more robust way to handle missing modules? <bik.mido@tiscalinet.it>
Re: more robust way to handle missing modules? <m@rtij.nl.invlalid>
Passing hash to a subroutine <raykyoto@gmail.com>
Re: Passing hash to a subroutine (Jens Thoms Toerring)
Re: Passing hash to a subroutine <bik.mido@tiscalinet.it>
Re: Passing hash to a subroutine <bik.mido@tiscalinet.it>
Re: Passing hash to a subroutine <tadmc@augustmail.com>
Perl Developers Kit (Zip or Cab) <anonymous@127.0.0.1>
Should be a simple parsing problem <tbbooher@gmail.com>
Re: Should be a simple parsing problem <m@rtij.nl.invlalid>
Re: Should be a simple parsing problem <bik.mido@tiscalinet.it>
Re: Should be a simple parsing problem <tadmc@augustmail.com>
Re: Should be a simple parsing problem <purlgurl@purlgurl.net>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 07 Apr 2007 12:46:47 +0200
From: Michele Dondi <bik.mido@tiscalinet.it>
Subject: Re: Creating Word Documents with Perl
Message-Id: <5hte13ht0vm7qc4lobipska4hog6fp6vk8@4ax.com>
On Fri, 06 Apr 2007 21:18:36 -0400, Amer Neely
<perl4hire@softouch.on.ca> wrote:
>Have you looked at the 'format' command in perl? I've done some pretty
>nifty emails using it, and you don't need to attach anything - it's all
>inline.
Not to mention various modules which are supposed to also assist the
creation of pure text reports, like Perl6::Form.
Michele
--
{$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
(($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
.'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,
------------------------------
Date: Sat, 07 Apr 2007 10:17:29 -0700
From: Ed Jay <edMbj@aes-intl.com>
Subject: How to transparently download multiple files?
Message-Id: <oojf13l0179o4eaumeodb1e7c1p6hkefme@4ax.com>
I have 'n' files, sequentially numbered, on my server. I wish to download
the files without operator intervention to a local folder of my choice.
I've tried the following script, but it has a couple of issues.
Issue first is that it asks me whether to open/save. I want the script to
automatically either save or open without asking.
Issue second is that while the below script indeed downloads all the files,
it downloads them as a single file with the identity of filename0. IOW, all
three files are contained within filename0.
The script (hard coded for $imgCode and $imgCnt, which are normally
retrieved with param()):
#!/usr/bin/perl
use warnings;
use strict;
use CGI ':standard';
use CGI::Carp qw(fatalsToBrowser);
my $imgPath = "/home/wwwbrea/public_html/uploads/";
my $imgCode = 'Threeimages040407';
my $imgCnt = 3;
for (my $i = 0; $i < 3; $i++) {
my $imgName = '';;
my @fileCon = '';
$imgName = $imgPath.$imgCode.$i.'.jpg';
open(DLFH, "<$imgName") || Error('open', 'file');
@fileCon = <DLFH>;
close (DLFH) || Error ('close', 'file');
print "Content-Disposition:attachment;filename=$imgName\n\n";
print @fileCon;
}
Any help or direction will be appreciated. TIA.
--
Ed Jay (remove 'M' to respond by email)
------------------------------
Date: Sat, 07 Apr 2007 18:15:02 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: How to transparently download multiple files?
Message-Id: <GcRRh.1281$Rg2.3@trndny02>
Ed Jay wrote:
> I have 'n' files, sequentially numbered, on my server.
WAIS? FTP? HTTP? GOPHER? NFS? ...
> I wish to
> download the files without operator intervention to a local folder of
> my choice.
If you are talking about HTTP then one of the LWP modules will help you as
suggested in the FAQ "How do I fetch an HTML file?"
> I've tried the following script, but it has a couple of issues.
>
> Issue first is that it asks me whether to open/save. I want the
> script to automatically either save or open without asking.
No, your script does nothing of that sort. It is the client side web browser
that is asking the person who surfs the web.
> Issue second is that while the below script indeed downloads all the
> files, it downloads them as a single file with the identity of
> filename0. IOW, all three files are contained within filename0.
Your script generates something that it returns to the web server and it
claims it is the proper HTTP response to whatever HTTP request the server
had.
You may want to check the HTTP protocol to find out if and how to include
multiple files in a single HTTP response. If that is not possible, then
maybe use a protocol that was designed to transfer files rather than
hypertext.
BTW: I would call it a MAJOR security hole if some odd web site would be
able to
<quote>
download the files without operator intervention to a local folder of my
choice.
</quote>
It sounds like an awfully bad idea to me.
jue
------------------------------
Date: Sat, 07 Apr 2007 11:39:02 -0700
From: Purl Gurl <purlgurl@purlgurl.net>
Subject: Re: How to transparently download multiple files?
Message-Id: <88idnSHppa_ReIrbnZ2dnUVZ_rGinZ2d@giganews.com>
Ed Jay wrote:
> I have 'n' files, sequentially numbered, on my server. I wish to download
> the files without operator intervention to a local folder of my choice.
Use the LWP module for this operation.
Stein's CGI.pm is not your best choice for this operation.
> Issue first is that it asks me whether to open/save. I want the script to
> automatically either save or open without asking.
This is a result of the content type you are using in your script.
> Issue second is that while the below script indeed downloads all the files,
> it downloads them as a single file with the identity of filename0. IOW, all
> three files are contained within filename0.
This is expected. You are opening and printing three files. Upon flushing
your print via CGI, all three files are printed as one. You cannot print
three separate files to a single browser instance, even if a download print.
You are also printing your content type, three times.
A lack of "binmode" for your open and your print _might_ create issues
even if you only open and print a single file.
> my $imgCnt = 3;
You never use this variable.
What you are trying to perform is simply impossible. You cannot send three
"downloads" to a browser in a single httpd transaction. What you are doing
is sending three files, combined as one. Even if you download and save,
this file will be corrupted and impossible to open for viewing.
Research and learn about the LWP module. This LWP will perform precisely
your task, with no intervention needed on your part. You only need to
invoke your script through a browser, print some message to yourself,
then LWP will fetch files and store files for you, in the background.
You can also invoke your LWP script from a command line; no browser
is needed for this task of yours. If you do not have command line
access, maybe your site is hosted on a server, then use a browser
to access and invoke your cgi based script.
http://www.perlmonks.org/?node_id=18565
http://search.cpan.org/dist/libwww-perl/bin/lwp-download
http://perl.active-venture.com/lib/LWP/Simple.html
The "Image-Grab" module might prove even better for your task.
This module is dedicated specifically to your task,
http://mah.everybody.org/hacks/perl/Image-Grab/
----
Here is a simple example cgi script which will allow you to download
your images and look at your images, in one shot. You only need
to decide if to use LWP, LWP::Simple or Image-Grab, maybe some
other technique you learn about during your research.
#!perl
# here you invoke a module, LWP, Image-Grab, whatever
# coding examples are all over the web for you to use
# you can add a "success" print to your html output
print "Content-type: text/html\n\n";
print "<HTML>";
# change $imgPath to your server location:
$imgPath = "http://localhost/~test/";
$imgCode = 'Threeimages040407';
for (my $i = 0; $i < 3; $i++)
{
$imgName = $imgPath.$imgCode.$i.'.jpg';
print "<img src = \"$imgName\"><BR>";
}
# if download by a module is successful you
# could print a "success" message here
if ($return eq "success")
{ print "<BR><H2> Download Successful </H2>"; }
else
{ print "<BR><H2> FUBAR! </H2>"; }
print "</HTML>";
Purl Gurl
------------------------------
Date: 7 Apr 2007 10:27:52 -0700
From: "grocery_stocker" <cdalten@gmail.com>
Subject: I don't understand this semaphore output
Message-Id: <1175966872.565535.96650@b75g2000hsg.googlegroups.com>
The following code is taken from
http://www.cim.mcgill.ca/~franco/OpSys-304-427/messages/node81.html
#!/usr/bin/perl -w
# Get a semaphore
my $sem=semget(&IPC_PRIVATE, 1, &IPC_CREAT | 0666) || die "semget: $!
\n";
warn "semid= $sem\n";
# Initialize via sem signal: this is ugly, but couldn't get
# semctl(..SETVAL) to # work :-( maybe a bug in perl?
semsign($sem);
if(fork()) {
# Parent
my $i;
for $i (1..10) {
warn "Parent waits\n";
semwait($sem);
warn "Parent's in and sings\n";
warn "..Freude schoner gotterfunken..\n";
semsign($sem);
sleep(1);
semsign($sem);
sleep(1);
}
}
else {
# Child
my $i;
for $i (1..10) {
warn "Child waits\n";
semwait($sem);
warn "Child's in and sings\n";
warn "..Va pensiero su l'ali dorate..\n";
semsign($sem) || die "semop 2: $!\n";
sleep(1);
}
exit(0);
}
# Reap child, remove sem, exit
wait;
semctl($sem, 0, &IPC_RMID, 0) || die "semctl: $!\n";
exit;
#
# Constant definitions, etc, from <sys/ipc.h> and <sys/sem.h>
#
sub IPC_PRIVATE {0};
sub IPC_RMID {10};
sub IPC_CREAT {0001000};
sub GETVAL {5};
sub semwait {
my $sem=shift;
semop($sem, pack("s3", 0, -1, 0)) || die "semw: $!\n";
}
sub semsign {
my $sem=shift;
semop($sem, pack("s3", 0, +1, 0)) || die "sems: $!\n";
}
And here is the output.
[cdalten@localhost perl]$ ./sem.pl
semid= 458756
Child waits
Child's in and sings
..Va pensiero su l'ali dorate..
Parent waits
Parent's in and sings
..Freude schoner gotterfunken..
Child waits
Child's in and sings
..Va pensiero su l'ali dorate..
Parent waits
Parent's in and sings
..Freude schoner gotterfunken..
Child waits
Child's in and sings
..Va pensiero su l'ali dorate..
Child waits
Child's in and sings
..Va pensiero su l'ali dorate..
Parent waits
Parent's in and sings
..Freude schoner gotterfunken..
Child waits
Child's in and sings
..Va pensiero su l'ali dorate..
Child waits
Child's in and sings
..Va pensiero su l'ali dorate..
Parent waits
Parent's in and sings
..Freude schoner gotterfunken..
Child waits
Child's in and sings
..Va pensiero su l'ali dorate..
Child waits
Child's in and sings
..Va pensiero su l'ali dorate..
Parent waits
Parent's in and sings
..Freude schoner gotterfunken..
Child waits
Child's in and sings
..Va pensiero su l'ali dorate..
Child waits
Child's in and sings
..Va pensiero su l'ali dorate..
Parent waits
Parent's in and sings
..Freude schoner gotterfunken..
Parent waits
Parent's in and sings
..Freude schoner gotterfunken..
Parent waits
Parent's in and sings
..Freude schoner gotterfunken..
Parent waits
Parent's in and sings
..Freude schoner gotterfunken..
Parent waits
Parent's in and sings
..Freude schoner gotterfunken..
semctl: Invalid argument
[cdalten@localhost perl]$
I'm really not seeing what this code is doing. Can someone please
clarify.
Chad
------------------------------
Date: Sat, 07 Apr 2007 12:55:04 +0200
From: Michele Dondi <bik.mido@tiscalinet.it>
Subject: Re: more robust way to handle missing modules?
Message-Id: <itte1314uc9mbp5geu3n0ofjvq2vlbqjlb@4ax.com>
On 7 Apr 2007 00:44:10 -0700, "dt" <ppc@cheapbooks.com> wrote:
>I use about 15 different web hosting companies to host my site. I am
>having trouble with one particular module, since it either is not
>located on each web host account or I can't upload it.
>
>usually I just upload my own version and everything runs fine, but in
>some cases I get an error message that says that the module conflicts
>with another version of the same module. my only solution has been to
>not use that web host for that piece of code, which I have to manually
>disable.
Since you don't show any code, it's hard do say. How do you manage
@INC? If you put your private library first and the wanted module is
there, then it will be found first. Generally you just
use lib 'something';
>is there any way to use an eval {} or something similar to try to
>require a module without having the server fail with a server 500
>error?
Certainly. Search the group for something like "conditional module
inclusion" or "loading a module at runtime". Or else
perldoc -f use
and the answer is there, in front of you!
Michele
--
{$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
(($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
.'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,
------------------------------
Date: Sat, 7 Apr 2007 12:54:51 +0200
From: Martijn Lievaart <m@rtij.nl.invlalid>
Subject: Re: more robust way to handle missing modules?
Message-Id: <pan.2007.04.07.10.55.07@rtij.nl.invlalid>
On Sat, 07 Apr 2007 00:44:10 -0700, dt wrote:
> is there any way to use an eval {} or something similar to try to
> require a module without having the server fail with a server 500 error?
I think this will do the trick.
BEGIN { unless (eval "use nonexistent") { print "not found\n"; exit; } }
HTH,
M4
------------------------------
Date: 7 Apr 2007 04:46:25 -0700
From: "Ray" <raykyoto@gmail.com>
Subject: Passing hash to a subroutine
Message-Id: <1175946385.849599.266600@n76g2000hsh.googlegroups.com>
Hi all,
I've been trying to figure out how to pass a hash (and a hash of
hashes) into a function. After some fiddling around and reading
perlreftut, I think I got it. However, I turned on "use strict" and
it is warning me that what I am doing is "deprecated" and may not be
supported in the future. So, even though it works (I mean...I get the
right answer), can someone tell me what the supported way?
I made a small example to demonstrate my problem:
-----
#!/usr/bin/perl -w
use strict;
use diagnostics;
my %cities;
my %states;
sub printStates {
my $href = shift @_;
## Next line is deprecated
printf (STDOUT "* %s\n", %{$href} -> {"New York"});
}
sub printCities {
my $href = shift @_;
## Next line is also deprecated
printf (STDOUT "* %s\n", %{$href} -> {"San Francisco"}{"LA"});
}
$cities{"San Francisco"}{"LA"} = "near";
$cities{"San Francisco"}{"New York"} = "far";
$states{"San Francisco"} = "California";
$states{"New York"} = "New York";
printf (STDOUT "%s\n", $cities{"San Francisco"}{"LA"});
printf (STDOUT "%s\n", $cities{"San Francisco"}{"New York"});
printf (STDOUT "%s\n", $states{"San Francisco"});
printf (STDOUT "%s\n", $states{"New York"});
printf (STDOUT "%s\n", \%states);
printStates (\%states);
printCities (\%cities);
-----
The warnings are:
Using a hash as a reference is deprecated at ./foo.pl line 11 (#1)
(D deprecated) You tried to use a hash as a reference, as in
%foo->{"bar"} or %$ref->{"hello"}. Versions of perl <= 5.6.1
used to allow this syntax, but shouldn't have. It is now
deprecated, and will
be removed in a future version.
Using a hash as a reference is deprecated at ./foo.pl line 17 (#1)
which are good in telling me what I did wrong, but I have no clue on
how to correct it. Any ideas?
Thanks in advance!
Ray
------------------------------
Date: 7 Apr 2007 13:03:03 GMT
From: jt@toerring.de (Jens Thoms Toerring)
Subject: Re: Passing hash to a subroutine
Message-Id: <57pj47F2d7gs6U1@mid.uni-berlin.de>
Ray <raykyoto@gmail.com> wrote:
> I've been trying to figure out how to pass a hash (and a hash of
> hashes) into a function. After some fiddling around and reading
> perlreftut, I think I got it. However, I turned on "use strict" and
> it is warning me that what I am doing is "deprecated" and may not be
> supported in the future. So, even though it works (I mean...I get the
> right answer), can someone tell me what the supported way?
> I made a small example to demonstrate my problem:
> -----
> #!/usr/bin/perl -w
> use strict;
> use diagnostics;
> my %cities;
> my %states;
> sub printStates {
> my $href = shift @_;
A simple
my $href = shift;
will also do.
> ## Next line is deprecated
> printf (STDOUT "* %s\n", %{$href} -> {"New York"});
That looks rather strange (and, yes, it's deprecated). Just use
printf (STDOUT "* %s\n", $href->{"New York"});
It looks simpler and makes the warning go away;-)
When you have a hash you access the values the reference points to
using the '->' after the reference (the same holds if you have an
array reference). E.g.
my %h = (a => 1, b => 2);
my $hr = \%h;
print "$h{a} == $hr->{a}\n";
my @a = (1, 2);
my $ar = \@a;
print "$a[0] == $ar->[0]\n";
Regards, Jens
--
\ Jens Thoms Toerring ___ jt@toerring.de
\__________________________ http://toerring.de
------------------------------
Date: Sat, 07 Apr 2007 15:23:42 +0200
From: Michele Dondi <bik.mido@tiscalinet.it>
Subject: Re: Passing hash to a subroutine
Message-Id: <hj5f13132feisqnqtma20dm06bekjda0t2@4ax.com>
On 7 Apr 2007 04:46:25 -0700, "Ray" <raykyoto@gmail.com> wrote:
>I've been trying to figure out how to pass a hash (and a hash of
>hashes) into a function. After some fiddling around and reading
Strictly speacking, you can't. You can pass a list of key-value pairs
and store that in a hash. You can pass a hashref. You can use the \%
prototype and the ref will be taken for you. In this last sense, you
can.
>perlreftut, I think I got it. However, I turned on "use strict" and
>it is warning me that what I am doing is "deprecated" and may not be
>supported in the future. So, even though it works (I mean...I get the
>right answer), can someone tell me what the supported way?
Really? strict.pm triggers *errors* for some contructs that become
syntactically incorrect. It does not issue warnings.
>I made a small example to demonstrate my problem:
You may have made it smaller. Lots of inessential stuff there.
>The warnings are:
>
>Using a hash as a reference is deprecated at ./foo.pl line 11 (#1)
[snip]>which are good in telling me what I did wrong, but I have no
clue on
>how to correct it. Any ideas?
They mean exactly what they mean either use
${$href}{"New York"}
or
$href->{"New York"}
Michele
--
{$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
(($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
.'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,
------------------------------
Date: Sat, 07 Apr 2007 15:35:43 +0200
From: Michele Dondi <bik.mido@tiscalinet.it>
Subject: Re: Passing hash to a subroutine
Message-Id: <9t6f13t9cde5e8ioeifn7d8aduimjihr8a@4ax.com>
On 7 Apr 2007 04:46:25 -0700, "Ray" <raykyoto@gmail.com> wrote:
>I made a small example to demonstrate my problem:
In my first post I addressed your immediate problem. There are more
issues with your code, though. I will briefly go through them now.
>#!/usr/bin/perl -w
use warnings; # is better nowadays
>sub printStates {
> my $href = shift @_;
shift() will act implicitly on @_ and it won't add to clarity. So you
either
my $href=shift;
or
my ($href)=@_;
but the latter syntax is not convenient, IMHO, for a single variable.
> ## Next line is also deprecated
> printf (STDOUT "* %s\n", %{$href} -> {"San Francisco"}{"LA"});
This is Perl, not C. and print() will suffice. Also, STDOUT is
select()ed by default.
print $href->{'San Francisco'}{'LA'}, "\n";
You can avoid the newline if you set $\ accordingly, usually on a
local() basis. Whether this is convenient or not, depends on the
actual situation. If you need it on all print()s, then you may want
the -l cmd line switch, but that is often considered Evil^TM if the
program is more than tiny. Too bad we've not had say() to begin with.
Michele
--
{$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
(($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
.'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,
------------------------------
Date: Sat, 7 Apr 2007 09:13:36 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: Passing hash to a subroutine
Message-Id: <slrnf1f9og.lk5.tadmc@tadmc30.august.net>
Ray <raykyoto@gmail.com> wrote:
> I've been trying to figure out how to pass a hash (and a hash of
> hashes) into a function.
You *have* figured out how to pass a hash into a function.
What you haven't figured out is how to dereference it within
the function body.
> After some fiddling around and reading
> perlreftut, I think I got it.
perlreftut describes two different ways of dereferencing.
You are applying *both* ways.
> can someone tell me what the supported way?
Deferencing once, using either way, is the supported way.
> sub printStates {
> my $href = shift @_;
>
> ## Next line is deprecated
> printf (STDOUT "* %s\n", %{$href} -> {"New York"});
> }
printf (STDOUT "* %s\n", ${$href}{"New York"}); # Use Rule 1
or
printf (STDOUT "* %s\n", $href->{"New York"}); # Use Rule 2
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Sat, 7 Apr 2007 11:28:00 -0400
From: "Jim Carlock" <anonymous@127.0.0.1>
Subject: Perl Developers Kit (Zip or Cab)
Message-Id: <4617b887$0$18898$4c368faf@roadrunner.com>
I'm looking for Zip or Cab files (not MSI). Do such exist?
Or is there a way to extract the contents of the MSI to a folder
without installing?
Thanks.
--
Jim Carlock
Post replies to the group.
------------------------------
Date: 7 Apr 2007 04:21:22 -0700
From: "Tim" <tbbooher@gmail.com>
Subject: Should be a simple parsing problem
Message-Id: <1175944882.107189.99570@q75g2000hsh.googlegroups.com>
Hello all, I am trying to get a simple Perl script working to
transform some data, but have an incredibly onerous solution that
looks more like visual basic than perl using lots of conditional
statements, while loops and the shift function. Something inside
doesn't feel right about that, plus I think I am missing out on
expanding my limited Perl knowledge.
My data is in the general form:
_________________________
TEXT {
title: test
font: script
}
POLYGON {
name: foo
type: good
POINTS 3 {
4,3
2,16
633,2
}
}
JUNK {
title: nothing
}
POLYGON {
name: foo2
type: bad
POINTS 2 {
7,9
3,2
}
}
Now I want to extract the points where the polygon type is 'good' so
my
output would be:
4,3
2,16
633,2
I can get Text::Balanced to work on a single line, but don't know how
to elegantly parse down to the fields I need. Any thoughts would be
greatly appreciated. Not committed to Text::Balanced, but it seems
like it should work.
best,
Tim
------------------------------
Date: Sat, 7 Apr 2007 15:21:01 +0200
From: Martijn Lievaart <m@rtij.nl.invlalid>
Subject: Re: Should be a simple parsing problem
Message-Id: <pan.2007.04.07.13.21.16@rtij.nl.invlalid>
On Sat, 07 Apr 2007 04:21:22 -0700, Tim wrote:
> Hello all, I am trying to get a simple Perl script working to transform
> some data, but have an incredibly onerous solution that looks more like
> visual basic than perl using lots of conditional statements, while loops
> and the shift function. Something inside doesn't feel right about that,
> plus I think I am missing out on expanding my limited Perl knowledge.
>
> My data is in the general form:
> _________________________
> TEXT {
> title: test
> font: script
> }
>
> POLYGON {
> name: foo
> type: good
> POINTS 3 {
> 4,3
> 2,16
> 633,2
> }
> }
>
> JUNK {
> title: nothing
> }
>
> POLYGON {
> name: foo2
> type: bad
> POINTS 2 {
> 7,9
> 3,2
> }
>
> }
>
> Now I want to extract the points where the polygon type is 'good' so my
> output would be:
> 4,3
> 2,16
> 633,2
>
> I can get Text::Balanced to work on a single line, but don't know how to
> elegantly parse down to the fields I need. Any thoughts would be greatly
> appreciated. Not committed to Text::Balanced, but it seems like it
> should work.
>
OTTOMH:
while (<>) {
/^POLYGON\s+{/ and do {
while (<>) {
/\stype:\sgood\s*$/ {
//handle point here in the same way
/^}\s*$/ and last;
}
/^}\s*$/ and last;
}
}
}
This obviously assumes your input is always formatted in the same way, is
always correct and type: comes before the POINT.
HTH
M4
------------------------------
Date: Sat, 07 Apr 2007 15:24:54 +0200
From: Michele Dondi <bik.mido@tiscalinet.it>
Subject: Re: Should be a simple parsing problem
Message-Id: <rr6f13pg964qf3fav0pcobcdhk2aaacots@4ax.com>
On 7 Apr 2007 04:21:22 -0700, "Tim" <tbbooher@gmail.com> wrote:
>I can get Text::Balanced to work on a single line, but don't know how
>to elegantly parse down to the fields I need. Any thoughts would be
>greatly appreciated. Not committed to Text::Balanced, but it seems
>like it should work.
The task seems complicated enough as to require a real parser. How
about the oft mentioned Parse::RecDescent?
Michele
--
{$_=pack'B8'x25,unpack'A8'x32,$a^=sub{pop^pop}->(map substr
(($a||=join'',map--$|x$_,(unpack'w',unpack'u','G^<R<Y]*YB='
.'KYU;*EVH[.FHF2W+#"\Z*5TI/ER<Z`S(G.DZZ9OX0Z')=~/./g)x2,$_,
256),7,249);s/[^\w,]/ /g;$ \=/^J/?$/:"\r";print,redo}#JAPH,
------------------------------
Date: Sat, 7 Apr 2007 09:56:25 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: Should be a simple parsing problem
Message-Id: <slrnf1fc8p.lk5.tadmc@tadmc30.august.net>
Tim <tbbooher@gmail.com> wrote:
> Now I want to extract the points where the polygon type is 'good' so
> my
> output would be:
> 4,3
> 2,16
> 633,2
--------------------------
#!/usr/bin/perl
use warnings;
use strict;
use Text::Balanced 'extract_bracketed';
local $/ = ''; # enable paragraph mode, see perlvar.pod
while ( <DATA> ) {
next unless /type: good.*POINTS\s+\d+/gs;
my $bracketed = extract_bracketed();
print "$bracketed\n";
}
__DATA__
TEXT {
title: test
font: script
}
POLYGON {
name: foo
type: good
POINTS 3 {
4,3
2,16
633,2
}
}
JUNK {
title: nothing
}
POLYGON {
name: foo2
type: bad
POINTS 2 {
7,9
3,2
}
}
--------------------------
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Sat, 07 Apr 2007 09:40:54 -0700
From: Purl Gurl <purlgurl@purlgurl.net>
Subject: Re: Should be a simple parsing problem
Message-Id: <1_OdnWPcTZAGVIrbnZ2dnUVZ_ualnZ2d@giganews.com>
Tim wrote:
> My data is in the general form:
Your "general" is inappropriate. Provide precise
and exacting examples of your data or do not write
articles to post here. If you cannot provide exact
and precise examples because of length of data or
similar, then clearly and precisely state your
data parameters.
With programming, "general" is an allusion to "guess."
Guessing is not a viable programming method.
My intent is not to be terse rather to inform you none
can provide viable and efficient programming solutions
without knowledge of your precise data parameters. All
can only guess which, most often, leads to a waste of
time for both writers and readers of this group.
There are many solutions available for any given problem.
Stating "guess" parameters for data severely limits the
number of possible solutions, and often leads to incorrect
solutions being afforded; a waste of time.
Below you will find an efficient and simple solution
based on your given data, precisely as displayed. This
solution is free of modules, free of complexity and
is quick and efficient. If this solution does not meet
your needs, this is a result of your failure to provide
precise and exacting data parameters.
> TEXT {
> title: test
> font: script
(snipped data example)
#!perl
while (<DATA>)
{
if (index ($_, "good") > -1)
{ $good = "true"; }
if ($good eq "true")
{
if (index ($_, " ") > -1)
{
$_ =~ tr/ //d;
print $_;
}
}
if (index ($_, "bad") > -1)
{ $good = "false"; }
}
__DATA__
TEXT {
title: test
font: script
}
POLYGON {
name: foo
type: good
POINTS 3 {
4,3
2,16
633,2
}
}
JUNK {
title: nothing
}
POLYGON {
name: foo2
type: bad
POINTS 2 {
7,9
3,2
}
}
PRINTED RESULTS:
4,3
2,16
633,2
Purl Gurl
------------------------------
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.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
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 V11 Issue 315
**************************************
