[25481] in Perl-Users-Digest
Perl-Users Digest, Issue: 7726 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Feb 2 14:05:27 2005
Date: Wed, 2 Feb 2005 11:05:10 -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 Wed, 2 Feb 2005 Volume: 10 Number: 7726
Today's topics:
ANNOUNCE: Net::Packet 2.00 released (GomoR)
Re: Compile perl code/files via STDIN <tadmc@augustmail.com>
Free perl obfuscation service Liraz.Siri@gmail.com
Re: Free perl obfuscation service <apokrif1@yahoo.com>
GD filehandle problem <mislam@spamless.uiuc.edu>
Re: GD filehandle problem <jgibson@mail.arc.nasa.gov>
Re: Hashtable of arrays <nobull@mail.com>
Re: Hashtable of arrays <mikevh2.1@netzero.com>
Re: How bad is $'? (Was: "Get substring of line") <jl_post@hotmail.com>
Re: how to write a tutorial <xah@xahlee.org>
Re: how to write a tutorial <xah@xahlee.org>
in line editing (roller)
Re: in line editing <perl@my-header.org>
Re: in line editing <spamtrap@dot-app.org>
Re: in line editing <emschwar@fc.hp.com>
Newbie Looking for Advice/Comments on Script dgp@dodgeit.com
Re: Newbie Looking for Advice/Comments on Script <mritty@gmail.com>
Re: Newbie quesion: Scientific notation mdfoster44@netscape.net
Re: perl quick date convert <toreau@gmail.com>
Re: stop extra lines from printing <tadmc@augustmail.com>
Re: stop extra lines from printing <phaylon@dunkelheit.at>
Uninitialised value error stumping me.. (Len)
Re: Uninitialised value error stumping me.. <noeltd@hotmail.com>
Re: Uninitialised value error stumping me.. <mritty@gmail.com>
Re: what's OOP's jargons and complexities? <bradd+news@szonye.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Fri, 28 Jan 2005 07:23:09 GMT
From: gomor-usenet@gomor.org (GomoR)
Subject: ANNOUNCE: Net::Packet 2.00 released
Message-Id: <IBACCA.19sz@zorch.sf-bay.org>
Changes since 1.28:
- major release, backward compatibility broken
- full documentation
- a battery of tests
- new layers:
o Layer2/SLL
o Layer2/RAW
o Layer2/NULL
o Layer3/IPv6
- sending frames at DescL4 now fully works
- huge speed improvements
- some memory usage improvements
- many many bugfixes
README:
Net::Packet version 2.00
====================
This module is a unified framework to craft, send and receive packets
at layers 2, 3, 4 and 7.
Basically, you forge each layer of a frame (Net::Packet::IPv4 for
layer 3, Net::Packet::TCP for layer 4 ; for example), and pack all
of this into a Net::Packet::Frame object. Then, you can send the
frame to the network, and receive it easily, since the response is
automatically searched for and matched against the request.
If you want some layer 2, 3 or 4 protocol encoding/decoding to be
added, just ask, and give a corresponding .pcap file ;)
EXAMPLE:
# Load main module, it also initializes a Net::Packet::Env object
use Net::Packet qw($Env);
# Build IPv4 header
use Net::Packet::IPv4;
my $ip = Net::Packet::IPv4->new(dst => '192.168.0.1');
# Build TCP header
use Net::Packet::TCP;
my $tcp = Net::Packet::TCP->new(dst => 22);
# Assemble frame
# It will also open a Net::Packet::DescL3 descriptor
# and a Net::Packet::Dump object
use Net::Packet::Frame;
my $frame = Net::Packet::Frame->new(l3 => $ip, l4 => $tcp);
$frame->send;
# Print the reply just when it has been received
until ($Env->dump->timeout) {
if ($frame->recv) {
print $frame->reply->l3, "\n";
print $frame->reply->l4, "\n";
last;
}
}
--
^ ___ ___ FreeBSD Network - http://www.GomoR.org/ <-+
| / __ |__/ Security Engineer, searching for work |
| \__/ | \ ---[ zsh$ alias psed='perl -pe ' ]--- |
+--> Net::Packet <=> http://search.cpan.org/~gomor/ <--+
------------------------------
Date: Wed, 2 Feb 2005 08:12:44 -0600
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: Compile perl code/files via STDIN
Message-Id: <slrnd01nus.4ev.tadmc@magna.augustmail.com>
mseele <mseele@gmail.com> wrote:
> yes you're write,
*Who* is right?
If you are following up to something that was posted earlier, then:
1) post a followup in the same thread, do not start a
new unconnected thread
2) quote a bit of the text that you are going to comment on
Have you seen the Posting Guidelines that are posted here frequently?
> i want to provide my code by typing
> directly from the command line, rather than executing a pre-existing
> file containing perl code.
Why do you want to provide your code by typing directly from the
command line, rather than executing a pre-existing file containing
perl code?
That is, what do you hope to gain be being able to do that?
> i want to use the -c option, get the result
The -c command line switch does not _have_ a "result", other than
perhaps some output on STDERR.
Are you thinking that it makes the byte codes available somehow?
> and want to put new
> perl code into the perl process a later time. how can i do this?
The way the FAQ suggests.
> is it
> actually possible?
You are expected to check the Perl FAQ *before* posting to the
Perl newsgroup:
perldoc -q compile
How can I compile my Perl program into byte code or C?
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 2 Feb 2005 04:53:08 -0800
From: Liraz.Siri@gmail.com
Subject: Free perl obfuscation service
Message-Id: <1107348788.908873.19520@g14g2000cwa.googlegroups.com>
Perl readability keeping you up at night? Worried someone else might
one day understand your spaghetti code? Say no more! Your job security
woes are over!
I needed to obfuscate a bunch of Perl scripts a while ago. Now Perl is
famous for being naturally obfuscated, but I had something more extreme
in mind. As the thought of further obfuscating my Perl scripts by hand
horrified me, I looked around for a free automated solution.
Long story short, I didn't find anything decent, so I wrote my own.
It's pretty neat, and handles (almost) all Perl constructs. I kept
working out the bugs until it was powerful enough to obfuscate itself
recursively an arbitrary amount of passes.
Anyway, the pricing for the commercial obfuscation stuff is absolutely
outrageous:
"The Stunnix Perl-Obfus Single Developer License costs $879, and can be
purchased online in our store. May be used by the same user on any
number of machines. Full text of the license is here."
So I turned my obfuscator program into a web service anybody can use
for free:
http://liraz.org/obfus.html
Enjoy!
------------------------------
Date: 02 Feb 2005 19:31:25 +0100
From: Apokrif <apokrif1@yahoo.com>
Subject: Re: Free perl obfuscation service
Message-Id: <80wttqzude.fsf@apokrif.xyz>
Liraz Siri :
> So I turned my obfuscator program into a web service anybody can use
> for free:
>
> http://liraz.org/obfus.html
Why doesn't it rename variable names ?
--
`cat ~/.signature`
------------------------------
Date: Wed, 02 Feb 2005 11:11:52 -0600
From: Sharif Islam <mislam@spamless.uiuc.edu>
Subject: GD filehandle problem
Message-Id: <ctr1ko$64h$1@news.ks.uiuc.edu>
I am making a png file using a filehandle.
__BEGIN CODE___
use GD;
# create a new image
my $im = new GD::Image(100,100);
# allocate some colors
my $white = $im->colorAllocate(255,255,255);
my $black = $im->colorAllocate(0,0,0);
my $red = $im->colorAllocate(255,0,0);
my $blue = $im->colorAllocate(0,0,255);
# make the background transparent and interlaced
$im->transparent($white);
$im->interlaced('true');
# Put a black frame around the picture
$im->rectangle(0,0,99,99,$black);
# Draw a blue oval
$im->arc(50,50,95,75,0,360,$blue);
# And fill it with red
$im->fill(50,50,$red);
open(GRAPH, ">test.png") || die "cannot open file test.png";
binmode STDOUT;
print GRAPH $im->png;
close GRAPH;
____END CODE__
When I run this, I get a png file that is not readable.
# file test.png
test.png: data
However, if I don't use a filehandle, the file seems to be ok.
I replace the last four lines with:
binmode STDOUT;
print $im->png;
Then
# perl test.pl > test.png
# file test.png
test.png: PNG image data, 300 x 400, 8-bit colormap, non-interlaced
What I am doing wrong with the filehandle?
Thanks.
--
Sharif Islam http://www.sharifislam.com
------------------------------
Date: Wed, 02 Feb 2005 09:48:39 -0800
From: Jim Gibson <jgibson@mail.arc.nasa.gov>
Subject: Re: GD filehandle problem
Message-Id: <020220050948397714%jgibson@mail.arc.nasa.gov>
In article <ctr1ko$64h$1@news.ks.uiuc.edu>, Sharif Islam
<mislam@spamless.uiuc.edu> wrote:
> I am making a png file using a filehandle.
>
> __BEGIN CODE___
[drawing statements snipped]
> open(GRAPH, ">test.png") || die "cannot open file test.png";
> binmode STDOUT;
binmode GRAPH;
[rest snipped]
----== Posted via Newsfeeds.Com - Unlimited-Uncensored-Secure Usenet News==----
http://www.newsfeeds.com The #1 Newsgroup Service in the World! >100,000 Newsgroups
---= East/West-Coast Server Farms - Total Privacy via Encryption =---
------------------------------
Date: 2 Feb 2005 04:44:22 -0800
From: "nobull@mail.com" <nobull@mail.com>
Subject: Re: Hashtable of arrays
Message-Id: <1107348262.644817.314510@g14g2000cwa.googlegroups.com>
mike wrote:
> 0. You should declare your variables with my and use strict.
> 1. Hash values cannot be arrays. They may be references to arrays.
Good advice.
> 2. Use exists() to tell whether a hash key exists, not defined().
True, but it if (as in this case) you know that it won't exist without
being not only defined but also true (i.e. not '0' or '') then it is
more ideomatic to use neither.
> 3. I don't think you want to add a definition to an already existing
> key if that definition already exists.
In other words you thing the OP wants a set. In that case as valueless
hash is the more natural representation to work with. Using grep() and
and arrays is definitely the 'B' answer. (Using a regex match to
emulate the string equality operator drops it to a 'C').
> | for my $word (@words_left) {
> | unless (exists($translations{$word})) {
> | $translations{$word} = [ @words_right ];
> | } else {
> | for my $nw (@words_right) {
> | unless (grep /^$nw$/, @{$translations{$word}}) {
> | push(@{$translations{$word}}, $nw);
> | }
> | }
> | }
> | }
This is unduely complex, use a HoH.
| for my $word (@words_left) {
| @{$translations{$word}}{@right_words} = ();
| }
Or if you are feeling really terse:
| @{$translations{$_}}{@right_words} = () for @words_left;
Finally once %translations is fully populated as a HoH you can simply
convert to a HoA if you really want one.
| $_ = [ keys %$_ ] for values %translations;
------------------------------
Date: 2 Feb 2005 09:54:34 -0800
From: "mike" <mikevh2.1@netzero.com>
Subject: Re: Hashtable of arrays
Message-Id: <1107366874.953539.128190@g14g2000cwa.googlegroups.com>
Thanks, nobull. Good advice all around. I was feeling guilty about
that grep... You're right, poor style, and I deserve to get
called on it.
I agree that a HoH would be better here than a HoA, but didn't want to
do too much violence to the OP's original implementation.
Without changing the HoA implementation, I came up with this, which I
think is better than what I had before:
| for my $word (@words_left) {
| if (!exists($trans{$word})) {
| $trans{$word} = [ @words_right ];
| } else {
| for my $nw (@words_right) {
| my $found = 0;
| for (my $i=0; $i<@{$trans{$word}} && !$found; $i++) {
| $found++ if $trans{$word}->[$i] eq $nw;
| }
| push(@{$trans{$word}}, $nw) if !$found;
| }
| }
| }
You're right, though, still "unduly complex." The HoH would be much
better.
------------------------------
Date: 2 Feb 2005 09:37:25 -0800
From: "jl_post@hotmail.com" <jl_post@hotmail.com>
Subject: Re: How bad is $'? (Was: "Get substring of line")
Message-Id: <1107365845.357677.64920@g14g2000cwa.googlegroups.com>
bik.mido@gmail.com wrote:
>
> Well, every now and again I give a peek into google-groups...
You're welcome every time, then!
> Well, but then I _think_ (although I'm not really _sure_)
> that even if you're running the code through a string eval()
> the interpreters run to execute the code _are_ still affected
> by the side effect of using $', or, as you say, 'taintedness'.
>
> Why do I think so? Because, still as of the docs and as already
> hinted above eval()ed strings are parsed and run in _the lexical
> context_ of the current program. But let's check for ourselves;
> consider this script:
I agree with you completely when you say that code running through a
string eval() is still tainted, but I think you're missing one key
point: The code is not tainted if the string containing the $' has not
been eval()ed yet. Take your example code:
> | #!/usr/bin/perl
> |
> | use strict;
> | use warnings;
> | use Benchmark qw/:all :hireswallclock/;
> |
> | # 'aaaa' =~ /a/ and $';
> |
> | timethis -30, q{ 'aaaa' =~ /a/ }, 'all';
> |
> | __END__
Commenting out the line with $' will cause the Benchmark code to be
tainted, exactly as you say. But, if the $' line is eval()ed AFTER the
Benchmark code, then it cannot taint the Benchmark code, as the Perl
interpreter does not know yet that the $' variable exists.
To illustrate, consider the following code (which is just your code
with a few modifications):
#!/usr/bin/perl
use strict;
use warnings;
use Benchmark qw/:all :hireswallclock/;
timethis -30, q{ 'aaaa' =~ /a/ }, 'before';
timethis 1, q{ 'aaaa' =~ /a/ and $' }, 'ignore';
timethis -30, q{ 'aaaa' =~ /a/ }, 'after';
__END__
This modified code differs from your original code in that the "good"
code is benchmarked twice: Once before the $' is eval()ed and once
after (according to "perldoc Benchmark", a string passed into
timethis() is eval()ed). The output I get (slightly edited for
clarity) is:
| before: 32.0156 wallclock secs @ 2853800.97/s (n=90562520)
| after: 30.4844 wallclock secs @ 589883.69/s (n=17724825)
(I left out the output of the second benchmark, since its only purpose
is to "taint" the code.)
As you can see, if the "tainted" code tainted ALL the code, then both
"before" and "after" benchmarks would have roughly the same output.
But we see from the output that the "before" benchmark performed much
faster than the "after" benchmark.
Therefore, since the only thing that happened between the two
benchmarks was an eval/benchmark of the "tainter" code, it stands to
reason that any eval()ed code with $' only taints code that is eval()ed
after, and not before.
This supports the benchmark code findings that you wrote about. In
your benchmark, the $' variable was essentially eval()ed right before
run time, while the benchmarked code was eval()ed during run time (and
was therefore affected by the $' variable).
So if you wanted to modify your benchmark program, you could change the
taint line from:
| # 'aaaa' =~ /a/ and $';
to:
| # eval( q{ 'aaaa' =~ /a/ and $' } );
And place it AFTER the call to timethis(). Then you'll see that it
makes no difference whether it is commented or not. In case you're
interested, the output I got was:
COMMENTED: ... @ 3028027.55/s (n=93959695)
UNCOMMENTED: ... @ 3085748.57/s (n=95321859)
The code that eval()ed the $' actually ran slightly faster than the
code that had the $' line commented. In this special case, it doesn't
mean that $' made any code any faster, but just that it made no
difference in the end, and that the speed difference between the two
runs is negligible.
(In all my benchmarks that I included in this thread's original post, I
made sure that the code without $' was always eval()ed or benchmarked
before the code that used it.)
Anyway, thanks again for your comments, Michele.
-- Jean-Luc
------------------------------
Date: 2 Feb 2005 06:29:00 -0800
From: "Xah Lee" <xah@xahlee.org>
Subject: Re: how to write a tutorial
Message-Id: <1107354540.608556.305540@z14g2000cwz.googlegroups.com>
in the doc for re module
http://python.org/doc/lib/module-re.html
4.2.2 on Matching vs Searching
http://python.org/doc/lib/matching-searching.html
Its mentioning of Perl is irrelevant, since the majority reading that
page will not have expertise with Perl regex. The whole section should
be deleted, because it only adds confusion. (later section 4.2.3 on
search and match methods plainly indicated their difference.)
(the mentioning of perl there is a combination of author masterbation,
ass kissing, and Python fanaticism. All together innocently done as
ignorance of standard authors.)
A detailed explanation of their difference or the mentioning of Perl
should be in FAQ or such material.
in section 4.2.6 Examples, there needs to be more and simple examples.
(e.g. http://xahlee.org/perl-python/regex.html.) The beginning large
section about some scaf() should be deleted for the same reason as the
Perl above.
-------------------------
in section 11.12.2 SMTP Examples
http://python.org/doc/lib/SMTP-example.html
the example given is turgid.
In a tutorial or documentation, you want to give example as short and
to the point as possible. In this case, it is illustrating how to use
smtplib, not how to preamble with nice command line interface. A better
example would be like:
import smtplib
smtpServer='smtp.yourdomain.com';
fromAddr='xah@xahlee.org';
toAddr='xah@xahlee.org';
text='''Subject: test test
Hi ...
'''
server = smtplib.SMTP(smtpServer)
server.set_debuglevel(1)
server.sendmail(fromAddr, toAddr, text)
server.quit()
Xah
xah@xahlee.org
http://xahlee.org/PageTwo_dir/more.html
------------------------------
Date: 2 Feb 2005 08:44:31 -0800
From: "Xah Lee" <xah@xahlee.org>
Subject: Re: how to write a tutorial
Message-Id: <1107362671.182505.22180@c13g2000cwb.googlegroups.com>
i've noticed that in Python official doc
http://python.org/doc/lib/module-re.html
and also How-To doc
http://www.amk.ca/python/howto/regex/
both mentions the book "Mastering Regular Expressions" by Jeffrey
Friedl.
I suggest it be dropped in both places. The mentioning of this book in
the Perl/Python community is mostly a fawning behavior and confession
that the author is among "in the know". This book and its mentioning is
a cultish behavior among OpenSource morons.
Most of the time, its mentioning as a reference is irrelevant. 99% uses
of regex are the simplest uses. Spending time to read this book of
specialization, from economy perspective, is a waste of time.
Xah
xah@xahlee.org
http://xahlee.org/PageTwo_dir/more.html
------------------------------
Date: 2 Feb 2005 09:28:10 -0800
From: kitoclick1@yahoo.co.uk (roller)
Subject: in line editing
Message-Id: <4d1f122c.0502020928.6928bac0@posting.google.com>
Perl Gurus I need some help,
I am currently using a shell script to read in a file of usernames and
then for each matching one in a seperate file change the matching
line. The problem is I do this by grep -v username file1 > file1.temp
and then move file1.temp over file1. What this does is it sticks all
the changes at the bottom. I need to preserve the structure in file1
which is like this:
# Comment
username -soft server:/export/vol00/users:username
Because the comment explains some details of the user below. How can I
use perl to read in a file of usernames then for each match in file1
do an in line edit using
s/server/another_server/
This way I can ensure the comment above each matching line still
explains the line below.
Thanks
------------------------------
Date: Wed, 02 Feb 2005 18:48:08 +0100
From: Matija Papec <perl@my-header.org>
Subject: Re: in line editing
Message-Id: <pc42019vv4r49rse284a696dufrqgfn88p@4ax.com>
X-Ftn-To: roller
kitoclick1@yahoo.co.uk (roller) wrote:
>Because the comment explains some details of the user below. How can I
>use perl to read in a file of usernames then for each match in file1
>do an in line edit using
>
>s/server/another_server/
>
>This way I can ensure the comment above each matching line still
>explains the line below.
This is FAQ, perldoc Tie::File
--
Matija
------------------------------
Date: Wed, 02 Feb 2005 12:50:52 -0500
From: Sherm Pendley <spamtrap@dot-app.org>
Subject: Re: in line editing
Message-Id: <u-SdnR9kyrVjj5zfRVn-ug@adelphia.com>
roller wrote:
> Because the comment explains some details of the user below. How can I
> use perl to read in a file of usernames then for each match in file1
> do an in line edit using
>
> s/server/another_server/
Easy as "pie". :-)
perl -p -i.bak -e 's/server/another_server/' filename
sherm--
--
Cocoa programming in Perl: http://camelbones.sourceforge.net
Hire me! My resume: http://www.dot-app.org
------------------------------
Date: Wed, 02 Feb 2005 10:55:00 -0700
From: Eric Schwartz <emschwar@fc.hp.com>
Subject: Re: in line editing
Message-Id: <eto1xby6e4r.fsf@wilson.emschwar>
Matija Papec <perl@my-header.org> writes:
> X-Ftn-To: roller
> kitoclick1@yahoo.co.uk (roller) wrote:
>>Because the comment explains some details of the user below. How can I
>>use perl to read in a file of usernames then for each match in file1
>>do an in line edit using
>>
>>s/server/another_server/
>>
>>This way I can ensure the comment above each matching line still
>>explains the line below.
>
> This is FAQ, perldoc Tie::File
That's overkill for a problem that can be solved with a simple
perl -pi.bak -e 's/this/that/' file
don't you think? 'perldoc perlrun' for more information on what those
flags do-- and please do run this perldoc, as none of this is magic,
and you might figure out how to save another trip to USENET next time.
-=Eric
--
Come to think of it, there are already a million monkeys on a million
typewriters, and Usenet is NOTHING like Shakespeare.
-- Blair Houghton.
------------------------------
Date: 2 Feb 2005 09:58:33 -0800
From: dgp@dodgeit.com
Subject: Newbie Looking for Advice/Comments on Script
Message-Id: <1107367113.310715.142690@g14g2000cwa.googlegroups.com>
I'm new to Perl, and would like any advice/input on the following
script. It is written to open a file provided by a command-line
argument, seach for "SECTION" header, grab the next 112 lines into an
array, then write out the array in a specific order. It seems to work,
but I'm looking for comments on how it might be improved. I'd
specifically like to do the following:
1) Remove leading and trailing whitespace from the lines that are
"pushed" onto @points. I can't seem to figure it out.
2) I borrowed the scalar<INF> for 1..112 from another topic in this
group. What is this doing? Is there a clearer way to grab the 112 lines
following the "SECTION" header?
3) I'd like check that a command line argument was provided, if not,
prompt the user for $infile.
#!C:\Perl\bin\perl.exe
# rpt2ibl.pl
# Generates ProE IBL File from BladeRunner RPT File
# Requires input filename as commandline argument.
# Example: rpt2ibl.pl inputfile.rpt
use warnings;
$infile = $ARGV[0]; #Get input filename from command line argument.
$outfile = $infile;
$outfile =~ s/\.[^.]+$/.ibl/; #Change output filename extension to ibl.
open (INF, "<$infile") or die "Cannot open $infile for read.\n$!\n";
open (OUTF, ">$outfile") or die "Cannot open $outfile for
write.\n$!\n";
print OUTF "Closed Index Pointwise\n\n"; #Write File Header
while (<INF>) { #Reads each line into $_
if ($_ =~ /SECTION\s\w-\w/) {
++$section; #Increment Section Number
@points=''; #Clear points array
push @points, scalar<INF> for 1..112; #Read points
print OUTF "Begin section ! $section\n"; #Write Section Header
print OUTF "\tBegin curve ! 1\n"; #Write curve header
print OUTF "@points[105..112]";
print OUTF "@points[1..9]";
print OUTF "\tBegin curve ! 2\n"; #Write curve header
print OUTF "@points[9..49]";
print OUTF "\tBegin curve ! 3\n"; #Write curve header
print OUTF "@points[49..65]";
print OUTF "\tBegin curve ! 4\n"; #Write curve header
print OUTF "@points[65..105]";
}
}
close INF;
close OUTF;
Thank you for any help you can provide.
Dave
------------------------------
Date: Wed, 02 Feb 2005 18:29:59 GMT
From: "Paul Lalli" <mritty@gmail.com>
Subject: Re: Newbie Looking for Advice/Comments on Script
Message-Id: <H_8Md.10890$8a6.6101@trndny09>
<dgp@dodgeit.com> wrote in message
news:1107367113.310715.142690@g14g2000cwa.googlegroups.com...
> I'm new to Perl
http://learn.perl.org is an excellent place to start
>, and would like any advice/input on the following
> script. It is written to open a file provided by a command-line
> argument, seach for "SECTION" header, grab the next 112 lines into an
> array, then write out the array in a specific order. It seems to work,
> but I'm looking for comments on how it might be improved. I'd
> specifically like to do the following:
> 1) Remove leading and trailing whitespace from the lines that are
> "pushed" onto @points. I can't seem to figure it out.
Please check the Perl FAQ *before* posting:
perldoc -q space
"How do I strip blank space from the beginning/end of a string?"
> 2) I borrowed the scalar<INF> for 1..112 from another topic in this
> group. What is this doing?
the actual line:
push @points, scalar<INF> for 1..112;
is syntactic sugar for:
for (1..112) {
push @points, scalar<INF>;
}
In a scalar context, <INF> will return the 'next' line from the opened
file. So you are adding the next line of the file to @points 112 times.
The 'scalar' is necessary because otherwise <INF> would be evaluated in
a list context, which would cause it to return ALL remaining lines in
the file.
> Is there a clearer way to grab the 112 lines following the "SECTION"
header?
You could do a looping construct, taking note of the $. variable, which
holds the current input file line number, and break out of the loop when
$. is 112 more than it was when you found "SECTION".
> 3) I'd like check that a command line argument was provided, if not,
> prompt the user for $infile.
Command line arguments are stored in @ARGV. If @ARGV is empty, there
were no arguments provided.
> #!C:\Perl\bin\perl.exe
> # rpt2ibl.pl
> # Generates ProE IBL File from BladeRunner RPT File
> # Requires input filename as commandline argument.
> # Example: rpt2ibl.pl inputfile.rpt
use strict;
Always use strictures. They help prevent errors. After adding this
line, you will have to declare your variables with 'my'. This is a good
thing.
> use warnings;
Good!!
> $infile = $ARGV[0]; #Get input filename from command line argument.
> $outfile = $infile;
> $outfile =~ s/\.[^.]+$/.ibl/; #Change output filename extension to
ibl.
>
>
> open (INF, "<$infile") or die "Cannot open $infile for read.\n$!\n";
> open (OUTF, ">$outfile") or die "Cannot open $outfile for
> write.\n$!\n";
Most people prefer lexical filehandle references these days instead of
the all-caps barewords
open my $inf, '<', $infile or die "Cannot open $infile: $!";
(similar for OUTF)
>
> print OUTF "Closed Index Pointwise\n\n"; #Write File Header
>
> while (<INF>) { #Reads each line into $_
> if ($_ =~ /SECTION\s\w-\w/) {
pattern matches default to $_. There is no reason to make it explicit.
(ie, remove "$_ =~ ")
> ++$section; #Increment Section Number
Your formatting is atrocious. I'm guessing this is due to the method
with which you have posted this to usenet. I'm also guessing you used
Google Groups to do so. Please don't. Google Groups has been
contacted - by many people - about their senseless stripping of
whitespace, and have thus far not responded. Until they do, use a real
newsreader.
> @points=''; #Clear points array
This does not clear the @points array. This sets the @points array to
contain exactly one element, the empty string. To clear an array, do
@points = ();
However, this should be unnecessary, as you should be declaring @points
lexically at this stage. Change this line to
my @points;
and you will get a fresh copy of the lexical array @points for each
iteration of the loop.
> push @points, scalar<INF> for 1..112; #Read points
> print OUTF "Begin section ! $section\n"; #Write Section Header
> print OUTF "\tBegin curve ! 1\n"; #Write curve header
> print OUTF "@points[105..112]";
You are adding extra spaces in front of each line. You are doing this
because you've chosen to interpolate the array slice. Interpolated
arrays and slices are separated by the $" variable, which defaults to a
single space. To fix this, either locally set $" to the empty string:
local $" = '';
or, preferred, don't interpolate the slices. Just print them out:
print OUTF @points[105..112];
> print OUTF "@points[1..9]";
> print OUTF "\tBegin curve ! 2\n"; #Write curve header
> print OUTF "@points[9..49]";
> print OUTF "\tBegin curve ! 3\n"; #Write curve header
> print OUTF "@points[49..65]";
> print OUTF "\tBegin curve ! 4\n"; #Write curve header
> print OUTF "@points[65..105]";
> }
> }
>
> close INF;
> close OUTF;
>
> Thank you for any help you can provide.
Hope this is helpful to you.
Paul Lalli.
P.S. I will preemptively say this: If you choose to reply, please quote
what you are replying to. This newsgroup has seen a rash of Google
Groups posters who choose to reply without quoting anything. Only a
small fraction of the readers of this newsgroup use Google Groups to
read Usenet, for various and valid reasons. Thank you.
------------------------------
Date: 2 Feb 2005 10:59:38 -0800
From: mdfoster44@netscape.net
Subject: Re: Newbie quesion: Scientific notation
Message-Id: <1107370778.883872.141710@f14g2000cwb.googlegroups.com>
Anno Siegel wrote:
> <mdfoster44@netscape.net> wrote in comp.lang.perl.misc:
> >
> > Anno Siegel wrote:
> > > <mdfoster44@netscape.net> wrote in comp.lang.perl.misc:
>
> > > > Hi,
> > > > I'm trying to upload some data into a MySQL database.
>
> [...]
>
> > > > How do I upload the number to the database? If I do it as
above it
> > is
> > > > incorrect.
> > >
> > > Incorrect how? Is the data rejected by the database? Is it
accepted
> > > but not the values you expect it to be? Be specific.
> >
> > Well the number it uploads is not the float, in this case double,
that
> > I want it to be.
>
> Please be specific! Telling us it is not what you want it to be
helps
> no-one.
>
> What is the data your code offers to the DB? How does the DB receive
it?
> What does the DB give back, if anything? That's the kind of info we
> need.
The data point
-------
The data (pt, x)
P1 4.50015068000000D-004
-------
>From the regex I have sofar,
$number = 4.50015068000000D-004
This is now just a string, I've been incorrectly feeding this to the
database,
where it is expecting a double( double(20,6)).
Which explains why the DB returns
"4.500151"
I need to convert the string stored in $number to a double number.
string to double (strtod). So from perldoc -q "is a number", I've
used:
use POSIX qw(strtod);
my $double = strtod($number);
However, the strtod function doesn't like the "D" in my number, ie
4.50015068000000D-004 needs to be 4.50015068000000e-004. So I do a
quick
substitution.
Thanks for your pointer, sorry for my being vague.
Martin.
------------------------------
Date: Wed, 02 Feb 2005 13:20:54 +0100
From: Tore Aursand <toreau@gmail.com>
Subject: Re: perl quick date convert
Message-Id: <BA3Md.7073$IW4.151099@news2.e.nsc.no>
Gunnar Hjalmarsson wrote:
>>> Hi Whats the smoothest way of converting the date string
>>> "2004-10-10 12:14:23" to "Tue, 10 Oct 2004 12:14:23"?
>> [...]
> [...]
>
> To the OP: Why do you want to convert *from* a universally readable and
> ISO compliant format?
Readability? :-)
--
Tore Aursand <tore@aursand.no>
"Those people who think they know everything are a great annoyance to
those of us who do." (Isaac Asimov)
------------------------------
Date: Wed, 2 Feb 2005 08:31:29 -0600
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: stop extra lines from printing
Message-Id: <slrnd01p21.4ev.tadmc@magna.augustmail.com>
pauliecat@sasktel.net <pauliecat@sasktel.net> wrote:
> sometimes I get
> the subject printing in the wrong record, or blank lines between each
> subject
> for my $line (@lines)
The problem must be in the data contained in @lines.
Since you haven't shown us how you are loading @lines, we
cannot help you with your problem.
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Wed, 02 Feb 2005 17:16:53 +0100
From: phaylon <phaylon@dunkelheit.at>
Subject: Re: stop extra lines from printing
Message-Id: <pan.2005.02.02.16.16.52.354014@dunkelheit.at>
pauliecat@sasktel.net wrote:
> having all sorts of problems extracting the data. The file I am extracting
> on is library catalog records. For instance sometimes I get the subject
> printing in the wrong record, or blank lines between each subject (some
> records have more than one subject field)
I'm sorry, but this is way to less information to work with. Could you
post some example formatted data you read in? (if @lines is just the sum
of all lines in file)
p
--
http://www.dunkelheit.at/
Thru the darkness of futures past, the magician longs to see.
One chants out between two worlds: Fire, walk with me.
-- Twin Peaks, »Bob«
------------------------------
Date: 2 Feb 2005 09:59:15 -0800
From: evillen@innocent.com (Len)
Subject: Uninitialised value error stumping me..
Message-Id: <527f11c0.0502020959.58e998ca@posting.google.com>
Hi
I am a newbie so be kind ;) The code below is used to process the data
below it. The code works fine on some larger data of identical (I
believe) format, however on this small data it throws the error:
"Use of uninitialized value in join or string at report13a.txt line
16, <> line 7"
Any help would be great - I'm sure it's something easy but it's
driving me crazy...
Thanks
Len
----------
#! perl -w
use strict;
my ($line, @fields, $refdes, @symbol, $count);
$refdes = "NEW"; #refdes enables symbol count
$symbol[0] = "EMPTY";
while ($line = <>){
chomp($line);
next if $line =~ /(^A|^J|MECHANICAL)/; #drop out if begins with A or
J or includes Mechanical
@fields = split /!/, $line; #Change separator
if (($refdes eq "new")||($fields[1] ne $refdes)){ #New refdes
$count = 0; #Reset counter
print "$refdes array is:@symbol\n"; #Print previous refdes symbol
array
$refdes = $fields[1]; #Reset refdes
@symbol = (); #Reset symbol array
$symbol[0] = $fields[2]; #Put symbol name at front of array
}
else{
$count++;
$symbol[$count] = $fields[4];
}
}
print "Final $refdes array is: @symbol\n"; #Print final symbol array
-------------
A!REFDES!SYM_NAME!GRAPHIC_DATA_7!
J!C:\PCB_DATA_DUMP\test.brd!Mon Jan 31 12:46:35
2005!-75.000!-170.000!425.000!190.000!0.001!millimeters!TOP_LEVEL!31.496063
mil!2!UP TO DATE!
S!CN5!MTG_2_40CP1_70!used:01BAiss2/USB programmer!
S!CN5!MTG_2_40CP1_70!rev:1,NJH,28/09/04!
S!CN5!MTG_2_40CP1_70!1.700!
S!CN5!MTG_2_40CP1_70!2.400!
S!CN6!CONN_UMP_3MM_SMT!PACKAGE!sym.req:0554!
S!CN6!CONN_UMP_3MM_SMT!PACKAGE!lib.name:conn_ump_3mm_smt!
S!CN6!CONN_UMP_3MM_SMT!PACKAGE!height:3.00mm!
S!CN6!CONN_UMP_3MM_SMT!PACKAGE!used:01ATiss1/Whitney RF!
S!CN6!CONN_UMP_3MM_SMT!PACKAGE!rev:2,NJH,26/05/04!
--------------
------------------------------
Date: Wed, 02 Feb 2005 18:29:29 GMT
From: "Atlantis" <noeltd@hotmail.com>
Subject: Re: Uninitialised value error stumping me..
Message-Id: <d_8Md.300$_n5.251@newsfe4-gui.ntli.net>
"Len" <evillen@innocent.com> wrote in message
news:527f11c0.0502020959.58e998ca@posting.google.com...
> Hi
>
> I am a newbie so be kind ;) The code below is used to process the data
> below it. The code works fine on some larger data of identical (I
> believe) format, however on this small data it throws the error:
>
> "Use of uninitialized value in join or string at report13a.txt line
> 16, <> line 7"
>
> Any help would be great - I'm sure it's something easy but it's
> driving me crazy...
>
> Thanks
> Len
>
> ----------
>
> #! perl -w
> use strict;
>
> my ($line, @fields, $refdes, @symbol, $count);
> $refdes = "NEW"; #refdes enables symbol count
> $symbol[0] = "EMPTY";
>
> while ($line = <>){
>
> chomp($line);
> next if $line =~ /(^A|^J|MECHANICAL)/; #drop out if begins with A or
> J or includes Mechanical
> @fields = split /!/, $line; #Change separator
>
> if (($refdes eq "new")||($fields[1] ne $refdes)){ #New refdes
> $count = 0; #Reset counter
> print "$refdes array is:@symbol\n"; #Print previous refdes symbol
> array
> $refdes = $fields[1]; #Reset refdes
> @symbol = (); #Reset symbol array
> $symbol[0] = $fields[2]; #Put symbol name at front of array
> }
>
> else{
> $count++;
> $symbol[$count] = $fields[4];
> }
> }
>
> print "Final $refdes array is: @symbol\n"; #Print final symbol array
>
> -------------
>
> A!REFDES!SYM_NAME!GRAPHIC_DATA_7!
> J!C:\PCB_DATA_DUMP\test.brd!Mon Jan 31 12:46:35
>
2005!-75.000!-170.000!425.000!190.000!0.001!millimeters!TOP_LEVEL!31.496063
> mil!2!UP TO DATE!
> S!CN5!MTG_2_40CP1_70!used:01BAiss2/USB programmer!
> S!CN5!MTG_2_40CP1_70!rev:1,NJH,28/09/04!
> S!CN5!MTG_2_40CP1_70!1.700!
> S!CN5!MTG_2_40CP1_70!2.400!
> S!CN6!CONN_UMP_3MM_SMT!PACKAGE!sym.req:0554!
> S!CN6!CONN_UMP_3MM_SMT!PACKAGE!lib.name:conn_ump_3mm_smt!
> S!CN6!CONN_UMP_3MM_SMT!PACKAGE!height:3.00mm!
> S!CN6!CONN_UMP_3MM_SMT!PACKAGE!used:01ATiss1/Whitney RF!
> S!CN6!CONN_UMP_3MM_SMT!PACKAGE!rev:2,NJH,26/05/04!
>
> --------------
I think the origin of your problem is in the "else" part of your "if"
statement. I'd add some debug (before/after) to see what values and
elements are being set by the $symbol[$count] = $field[4]; assignment.
------------------------------
Date: Wed, 02 Feb 2005 18:37:55 GMT
From: "Paul Lalli" <mritty@gmail.com>
Subject: Re: Uninitialised value error stumping me..
Message-Id: <769Md.10438$W16.2603@trndny07>
"Len" <evillen@innocent.com> wrote in message
news:527f11c0.0502020959.58e998ca@posting.google.com...
> I am a newbie so be kind ;) The code below is used to process the data
> below it. The code works fine on some larger data of identical (I
> believe) format, however on this small data it throws the error:
>
> "Use of uninitialized value in join or string at report13a.txt line
> 16, <> line 7"
In the future, it would be helpful to know exactly which line is line
16, without us having to guess where your line breaks actually are.
>
> #! perl -w
> use strict;
>
> my ($line, @fields, $refdes, @symbol, $count);
Don't do this. Define your variables in the smallest scope possible.
> $refdes = "NEW"; #refdes enables symbol count
> $symbol[0] = "EMPTY";
>
> while ($line = <>){
>
> chomp($line);
> next if $line =~ /(^A|^J|MECHANICAL)/; #drop out if begins with A or
> J or includes Mechanical
> @fields = split /!/, $line; #Change separator
>
> if (($refdes eq "new")||($fields[1] ne $refdes)){ #New refdes
> $count = 0; #Reset counter
> print "$refdes array is:@symbol\n"; #Print previous refdes symbol
array
Here, you are interpolating @symbol - that is, printing each element of
@symbol.
> $refdes = $fields[1]; #Reset refdes
> @symbol = (); #Reset symbol array
Here, you clear @symbol (which would likely not be needed if you'd
declared it in the correct scope.
> $symbol[0] = $fields[2]; #Put symbol name at front of array
Here you add one element to @symbol, so it's size is now 1.
> }
>
> else{
> $count++;
> $symbol[$count] = $fields[4];
In the else statement, you are setting some unknown element of @symbol.
Say for example that at this stage, $count is 2. Then you would be
setting the 3rd element of @count. Assuming @symbol still has the same
single value it had in the if statement, @symbol now contains:
($fields[2], undef, $fields[4])
Then when you go back to the top of the if statement, you attempt to
again print out all the elements of @symbol. One of those elments is
undefined. That is the cause of the warning message.
From the looks of things, I'd guess your algorithm needs a little work.
> }
> }
>
> print "Final $refdes array is: @symbol\n"; #Print final symbol array
>
<input data snipped>
Paul Lalli
------------------------------
Date: Wed, 02 Feb 2005 17:21:38 GMT
From: "Bradd W. Szonye" <bradd+news@szonye.com>
Subject: Re: what's OOP's jargons and complexities?
Message-Id: <slrnd02312.nk0.bradd+news@szonye.com>
Grumble <devnull@kma.eu.org> wrote:
> Pascal Bourguignon wrote:
>
>> You forgot to mention the coordinates of your secret mountain compound:
>>
>> 28 deg 5 min N, 86 deg 58 min E
>
> Mount Everest?
Shhh!
--
Bradd W. Szonye
http://www.szonye.com/bradd
------------------------------
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 V10 Issue 7726
***************************************
