[19670] in Perl-Users-Digest
Perl-Users Digest, Issue: 1865 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Oct 3 18:10:32 2001
Date: Wed, 3 Oct 2001 15:10:13 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <1002147013-v10-i1865@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Wed, 3 Oct 2001 Volume: 10 Number: 1865
Today's topics:
Re: Perl 5.6.0 bug: best workaround? <newspost@coppit.org>
Re: Perl 5.6.0 bug: best workaround? <newspost@coppit.org>
Re: Perl 5.6.0 bug: best workaround? <goldbb2@earthlink.net>
Perl Guru needed for this extremely frustrating search (Dan Boyce)
Re: Perl Guru needed for this extremely frustrating sea <mbudash@sonic.net>
Re: Pixel Color at particular coordinate <jay@utils.net.nospam>
Re: Pixel Color at particular coordinate <jay@utils.net.nospam>
Re: Pixel Color at particular coordinate <bart.lateur@skynet.be>
Question about split (Dmitry Epstein)
Re: Question about split <glex@qwest.net>
Re: Question about split <mjcarman@home.com>
Re: RegExp /g shall substitute more often <epa98@doc.ic.ac.uk>
Re: RegExp /g shall substitute more often <goldbb2@earthlink.net>
runtime accessor creation? <prlawrence@lehigh.edu>
Re: runtime accessor creation? <prlawrence@lehigh.edu>
Re: Socket closes early on local machine (Long Pham)
Re: Socket closes early on local machine <goldbb2@earthlink.net>
Something wrong with this? <a@b.c>
Re: Sourcing Things in Perl ? <goldbb2@earthlink.net>
Re: Sourcing Things in Perl ? <comdog@panix.com>
Re: strict and undisciplined me <goldbb2@earthlink.net>
Re: vvp:Perl DBI error <jeff@vpservices.com>
Re: Writing files <tsee@gmx.net>
Re: Yet another fork question <goldbb2@earthlink.net>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Wed, 03 Oct 2001 14:01:02 -0400
From: David Coppit <newspost@coppit.org>
To: nobull@mail.com
Subject: Re: Perl 5.6.0 bug: best workaround?
Message-Id: <3BBB525E.5040102@coppit.org>
[posted & mailed]
nobull@mail.com wrote:
> No the prototype is not, I believe, relevant. The relevant thing is
> that you take a reference to @_. The following simplified test case
> produces the error too:
>
> sub foo { die }
> sub bar { foo(\@_) }
> eval { bar() };
> bar();
>
> My advice is avoid anything that takes a reference to @_.
Thanks for the reply. After brushing up on my prototypes, I also learned
that the ref is the problem. So removing the prototype isn't a viable
solution because it changes the semantics of the foo function.
Here's some context: Raphael Manfredi's nifty Getargs::Long module has
the problem code. The module does validation of arguments to functions.
You'd use it like this:
sub try {
my ($x, $y, $z, $t) = getargs(@_, qw(x=i y=ARRAY z t=FOO));
# ...
}
Getargs::Long::getargs looks like this:
sub getargs (\@@) {
_getargs(scalar(caller), 0, "", @_)
}
So I need to be able to use the \@ prototype in order to keep the same
interface to getargs. I tried copying @_ and then deleting it in
getargs, but that didn't help. Any other suggestions? I'm thinking the
person who fixed the bug in 5.6.1 might have some ideas--does anyone
know who it was, or how to find them?
Thanks,
David
------------------------------
Date: Wed, 03 Oct 2001 15:05:05 -0400
From: David Coppit <newspost@coppit.org>
Subject: Re: Perl 5.6.0 bug: best workaround?
Message-Id: <3BBB6161.5070108@coppit.org>
I've found a couple workarounds, all of which are pretty ugly:
Here's the original code that breaks:
sub foo(\@@) { die }
sub bar { foo(@_) }
eval { bar() };
eval { bar() };
Here's one workaround:
sub foo(\@@) {
$_[0] = [ @{ $_[0] } ];
die;
}
sub bar { foo(@_) }
eval { bar() };
eval { bar() };
Pretty hideous. :) It doesn't help you if you want to modify the @_ of
the caller, but it does let you use the (\@@) prototype. Unfortunately,
Getargs::Long *does* expect to modify @_ of the caller, so I guess I'm
out of luck. Users will just have to do this:
sub foo(\@@) { die }
sub bar {
my @args = @_;
foo(@args);
}
eval { bar() };
eval { bar() };
Unless someone has a better solution...
David
------------------------------
Date: Wed, 03 Oct 2001 16:47:16 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Perl 5.6.0 bug: best workaround?
Message-Id: <3BBB7954.1FC16744@earthlink.net>
David Coppit wrote:
>
> [posted & mailed]
>
> nobull@mail.com wrote:
>
> > No the prototype is not, I believe, relevant. The relevant thing is
> > that you take a reference to @_. The following simplified test case
> > produces the error too:
> >
> > sub foo { die }
> > sub bar { foo(\@_) }
> > eval { bar() };
> > bar();
> >
> > My advice is avoid anything that takes a reference to @_.
>
> Thanks for the reply. After brushing up on my prototypes, I also
> learned that the ref is the problem. So removing the prototype isn't a
> viable solution because it changes the semantics of the foo function.
>
> Here's some context: Raphael Manfredi's nifty Getargs::Long module has
> the problem code. The module does validation of arguments to
> functions. You'd use it like this:
>
> sub try {
> my ($x, $y, $z, $t) = getargs(@_, qw(x=i y=ARRAY z t=FOO));
> # ...
> }
>
> Getargs::Long::getargs looks like this:
>
> sub getargs (\@@) {
> _getargs(scalar(caller), 0, "", @_)
> }
>
> So I need to be able to use the \@ prototype in order to keep the same
> interface to getargs. I tried copying @_ and then deleting it in
> getargs, but that didn't help. Any other suggestions?
my ($x, $y, $z, $t) = getargs(@{[@_]}, qw(x=i y=ARRAY z t=FOO));
Or remove the prototype from getargs, and call it as:
my ($x, $y, $z, $t) = getargs( [@_], qw(x=i y=ARRAY z t=FOO) );
Or simply rewrite try to take it's arguments in a different way:
sub try {
my %args = @_;
my ($x, $y, $z, $t) = @args{qw(x y z t)};
croak "x must be an integer" if !defined $x || $x !~ /^\d+\z/;
croak "y must be an array" unless ref $y && $y->isa("ARRAY");
croak "z was unspecified" if !exists $args{z};
croak "t must be a FOO" unless ref $y && $y->isa("FOO");
...
And 'try' would be called like this:
try( x => 2, y => [1,2,3], z => 42, t => FOO->new(666) );
--
"I think not," said Descartes, and promptly disappeared.
------------------------------
Date: 3 Oct 2001 13:58:46 -0700
From: dboyce@phoenixcolor.com (Dan Boyce)
Subject: Perl Guru needed for this extremely frustrating search and replace problem.
Message-Id: <3fac67fd.0110031258.3cce7cd8@posting.google.com>
Perl version - v5.6.0 built for i386-linux
Some how I need to convert the script below to allow me to enter a
directory structure (ie. /home/dan/). Using a script that I have
found in a book I can replace INSTALL_DIR with strings as long as they
do not contain "/" in them.
[root@localhost setup]# ./test
Replace with:
/home/dan/program/
Bareword found where operator expected at -e line 1, near
"s/INSTALL_DIR//home"
syntax error at -e line 1, near "s/INSTALL_DIR//home"
Search pattern not terminated at -e line 1.
test.conf
INSTALL_DIR/conf/config.cfg
[root@localhost setup]#
The following is the test script:
#/bin/sh
echo "Replace with: "
read number_two
cp test.conf test.conf.bak
perl -p -i -e s/INSTALL_DIR/$number_two/ test.conf
echo "test.conf"
more test.conf
For testing purposes my test.conf file contains the following:
INSTALL_DIR/conf/config.cfg
Is this possible to do, if not would anyone be kind enough to help me
write a new one?
Thanks,
Dan
------------------------------
Date: Wed, 03 Oct 2001 21:21:58 GMT
From: Michael Budash <mbudash@sonic.net>
Subject: Re: Perl Guru needed for this extremely frustrating search and replace problem.
Message-Id: <mbudash-A0C5AE.14215903102001@news.sonic.net>
In article <3fac67fd.0110031258.3cce7cd8@posting.google.com>,
dboyce@phoenixcolor.com (Dan Boyce) wrote:
> Perl version - v5.6.0 built for i386-linux
>
> Some how I need to convert the script below to allow me to enter a
> directory structure (ie. /home/dan/). Using a script that I have
> found in a book I can replace INSTALL_DIR with strings as long as they
> do not contain "/" in them.
>
>
>
> [root@localhost setup]# ./test
> Replace with:
>
> /home/dan/program/
> Bareword found where operator expected at -e line 1, near
> "s/INSTALL_DIR//home"
> syntax error at -e line 1, near "s/INSTALL_DIR//home"
> Search pattern not terminated at -e line 1.
> test.conf
> INSTALL_DIR/conf/config.cfg
> [root@localhost setup]#
>
> The following is the test script:
> #/bin/sh
> echo "Replace with: "
> read number_two
> cp test.conf test.conf.bak
> perl -p -i -e s/INSTALL_DIR/$number_two/ test.conf
> echo "test.conf"
> more test.conf
>
>
> For testing purposes my test.conf file contains the following:
> INSTALL_DIR/conf/config.cfg
>
>
> Is this possible to do, if not would anyone be kind enough to help me
> write a new one?
>
> Thanks,
> Dan
try this (untested) replacement line in the test script:
perl -p -i -e 's{INSTALL_DIR}{$number_two}' test.conf
hth-
--
Michael Budash ~~~~~~~~~~ mbudash@sonic.net
------------------------------
Date: Wed, 03 Oct 2001 11:50:42 -0700
From: Jay <jay@utils.net.nospam>
Subject: Re: Pixel Color at particular coordinate
Message-Id: <3BBB5E01.D8EBF94F@utils.net.nospam>
Thanks Bart. Your suggestions are good, but at this point I was
hoping to find out simpler way to get pixel color without going to
other modules. BTW, I am aware of GD and ImageMagick modules.
I already wrote a script which parses out GIF header and the colormap,
I was getting a bit confused about the next pixel storage part.
Here is what I am going to to: I will put my script as another question
under subject "Help with GIF Info"
Thanks.
-jay
Bart Lateur wrote:
> Jay wrote:
>
> >I was wondering if there is some bare bone program, which could
> >ease the job of reading color value for a particular coordinate.
> >
> >For example, an image ( gif/jpeg/ps ) looks like the following:
> >
> >GGGGGGG
> >BBRRRGG
> >BBRRRGG
> >BBBBBBB
> >
> >What I know is: it's a 7x4 image ( this is using the images
> >size program I wrote, for now it understand gif and jpeg )
> >
> >I would like to know what's the color of pixel 'p'
> >which is in row 'x' and column 'y'
> >
> >Any help will be appreciated.
>
> You need at least read the file format, which need not be trivial. Look
> into the GD module, which is an interface to GD which is written in C.
> <http://stein.cshl.org/WWW/software/GD/>. Search for the "getpixel"
> method.
>
> Old versions of GD used to support GIF, but it has been replaced with
> PNG out of protest against Unisys licensing demands (are you prepared to
> pay a few thousand dollars just to be allowed to use GIF?) If you
> insist, use an old version of GD.
>
> I doubt if there's an easy interface for Postscript files. Well... the
> other module for image manipulation in perl, Image::Magick, again just
> an interface to a (free) powerful graphics package, ImageMagick, see
> <http://www.imagemagick.org>, seems to be able to convert between
> various file formats, including GIF and EPS. The Unisys licensing
> troubles make support for GIF a bit iffy.
>
> For such a small image, why do you even need GIF? 28 pixels, h*ll, even
> BMP will do.
>
> HTH,
> Bart.
------------------------------
Date: Wed, 03 Oct 2001 11:53:15 -0700
From: Jay <jay@utils.net.nospam>
Subject: Re: Pixel Color at particular coordinate
Message-Id: <3BBB5E9B.D86E9BD7@utils.net.nospam>
Hello Philip,
Thanks for your replies.
The example I brought up was small, but actual images can be
big ( will not exceed 256x256 )
I have written a script which help me with the header of GIF
files, I am posting another question to improvise that script.
Regards.
~Jay
Philip Newton wrote:
> On Wed, 03 Oct 2001 11:00:55 +0200, Philip Newton
> <pne-news-20011003@newton.digitalspace.net> wrote:
>
> > PPM
>
> (That's Portable PixMap, not the Perl Package Manager, in case anyone
> was confused.)
>
> Cheers,
> Philip
> --
> Philip Newton <nospam.newton@gmx.li>
> That really is my address; no need to remove anything to reply.
> If you're not part of the solution, you're part of the precipitate.
------------------------------
Date: Wed, 03 Oct 2001 21:52:17 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: Pixel Color at particular coordinate
Message-Id: <t22nrto3qu3topjv6jbmiso0th5bpqp645@4ax.com>
Jay wrote:
>I already wrote a script which parses out GIF header and the colormap,
>I was getting a bit confused about the next pixel storage part.
Well, it's likely that this is the part that is compressed. So
extracting it won't be, er, simple. Or maybe even allowed without a
license. ;-)
--
Bart.
------------------------------
Date: 3 Oct 2001 19:09:37 GMT
From: mitia.nospam@northwestern.edu.invalid (Dmitry Epstein)
Subject: Question about split
Message-Id: <Xns912F900C5D382mitianorthwesternedu@129.105.16.55>
This is a really basic question. I want to take the first two
words from a string and assign them to two variables. The rest of
the string is of no interest. But when I do this:
#!/bin/perl -w
use strict;
my $line = 'words, words, words...';
my ($word1, $word2) = split $line;
I get the warning: "Use of uninitialized value in split"
What am I doing wrong? The synax of split is
split /PATTERN/,EXPR,LIMIT
With LIMIT omitted, split sets the limit to one larger than the
number of variables in the list (that is, 3 in this case). So on
the right I should have a list of 3 values, and on the left I have
a list of 2 variables. I should be allowed to assign a longer list
to a shorter list. And in any case, what exactly does the
"uninitialized value" refer to in this case?
I could do something like
my ($word1, $word2, undef) = split(/\s+/, $line, 3);
or
my ($word1, $word2) = split(/\s+/, $line, 3)[0,1];
But that's not quite the same;
--
Dmitry Epstein
Northwestern University, Evanston, IL. USA
mitia(at)northwestern(dot)edu
------------------------------
Date: Wed, 03 Oct 2001 15:27:35 -0500
From: Jeff Gleixner <glex@qwest.net>
Subject: Re: Question about split
Message-Id: <3BBB74B7.821FBF50@qwest.net>
Dmitry Epstein wrote:
>
> This is a really basic question. I want to take the first two
> words from a string and assign them to two variables. The rest of
> the string is of no interest. But when I do this:
>
> #!/bin/perl -w
> use strict;
> my $line = 'words, words, words...';
> my ($word1, $word2) = split $line;
my ($word1, $word2) = split(/\s/, $line);
--
Jeff Gleixner
Bumper Sticker of the moment:
Warning: Dates in Calendar are closer than they appear.
------------------------------
Date: Wed, 03 Oct 2001 15:12:33 -0500
From: Michael Carman <mjcarman@home.com>
Subject: Re: Question about split
Message-Id: <3BBB7131.2EF68F46@home.com>
Dmitry Epstein wrote:
>
> [W]hen I do this:
>
> #!/bin/perl -w
> use strict;
> my $line = 'words, words, words...';
> my ($word1, $word2) = split $line;
>
> I get the warning: "Use of uninitialized value in split"
>
> What am I doing wrong? The synax of split is
>
> split /PATTERN/,EXPR,LIMIT
Heh. You've answered your own question but apparently you can't see the
forest for the trees right now. ;)
Look at the syntax again. You didn't supply a pattern to split(), so
Perl used $line as the pattern and then defaulted to $_ for the
expression. Since $_ hasn't been set yet, you get the "uninitialized
value" error.
-mjc
------------------------------
Date: 03 Oct 2001 18:24:59 +0100
From: Edward Avis <epa98@doc.ic.ac.uk>
Subject: Re: RegExp /g shall substitute more often
Message-Id: <xn9itdw63h0.fsf@voxel01.doc.ic.ac.uk>
"Markus Dehmann" <markus.cl@gmx.de> writes:
>Suppose you have this string:
>$_ = "bla-R carter-R bush-R clinton-R dunnowman-R clinton-R bla-R";
>
>There is always a name "tagged" with 'R'. Now my rule says: Always tag
>clinton with a D if there a two names tagged with R before him. My output
>shall be:
>bla-R carter-R bush-R clinton-D dunnowman-R clinton-D bla-R
>
>But
>s/(\w+-R \w+-R clinton-)R/$1D/;
>delivers, of course, only
>bla-R carter-R bush-R clinton-D dunnowman-R clinton-R bla-R
>
>The rule doesn't apply to the second clinton because he has not two names
>tagged with R before him anymore.
Well, this might be better done not using a regular expression but
just parsing the string components in a more explicit way :-). But
assuming you do want a regexp, how about first changing clinton-R to
clinton-X, make the regexp match 'clinton with two (D or X)es
before him', and in the end change X to D globally. That does require
you have a scratch character like X to play with though.
--
Ed Avis <epa98@doc.ic.ac.uk>
Finger for PGP key
------------------------------
Date: Wed, 03 Oct 2001 17:24:27 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: RegExp /g shall substitute more often
Message-Id: <3BBB820B.B9ABE17F@earthlink.net>
Markus Dehmann wrote:
>
> The two solutions are nice, but because actually my problem is more
> complex they don't help.
Your fault for not describing the actual problem.
> Look-behind works only for a fixed length but my pattern that stands
> before B has in fact a variable length! This is my real problem that
> is more complex than just AAA:
>
> Suppose you have this string:
> $_ = "bla-R carter-R bush-R clinton-R dunnowman-R clinton-R bla-R";
>
> There is always a name "tagged" with 'R'. Now my rule says: Always tag
> clinton with a D if there a two names tagged with R before him. My
> output shall be:
>
> bla-R carter-R bush-R clinton-D dunnowman-R clinton-D bla-R
I see... so what you *want* is to transform Rafael Garcia-Suarez's
solution:
s/(?<=A)A/B/g;
into:
s/(?<=\w+-R \w+-R clinton-)R/D/g;
[This won't work because perl doesn't do variable length lookbehind]
> But s/(\w+-R \w+-R clinton-)R/$1D/; delivers, of course, only
> bla-R carter-R bush-R clinton-D dunnowman-R clinton-R bla-R
That doesn't work for the same reason why:
s/(A)A/$1B/g;
doesn't work.
> The rule doesn't apply to the second clinton because he has not two
> names tagged with R before him anymore.
Erm, no, that's not the reason. It's because in yours, it starts
looking for two Rs starting *after* the substitution... yours has to
match and capture those Rs.
> This:
> s/(?<=\w+-R \w+-R clinton-)R/$1D/;
> produces an error: "variable length lookbehind not implemented"
Right. And even if it was implemented, it would be wrong, since you've
got that stupid $1 in the replacement. If you understood what
lookaheads and lookbehinds did, you would know that you don't need it.
> What can I do?
On solution is to change it to a lookahead, as Jeff Pinyan did.
$_ = "bla-R carter-R bush-R clinton-R dunnowman-R clinton-R bla-R";
$_ = reverse $_;
s/R(?=-notnilc R-\w+ R-\w+)/D/g;
$_ = reverse $_;
Another is to not use s///, but do it in a more 'naive' way:
my @names = split;
for( my $i = $#names; $i >= 2; --$i ) {
if( $names[$i] eq "clinton-R" &&
$names[$i-1] =~ /-R$/ && $names[$i-2] =~ /-R$/ ) {
$names[$i] = "clinton-D";
}
}
print "@names\n";
Whether this is sufficiently fast or not, I don't know, but it's almost
certainly the least obfuscated version.
--
"I think not," said Descartes, and promptly disappeared.
------------------------------
Date: Wed, 3 Oct 2001 15:49:48 -0400
From: "Phil R Lawrence" <prlawrence@lehigh.edu>
Subject: runtime accessor creation?
Message-Id: <9pfq5d$clq@fidoii.CC.Lehigh.EDU>
[CC: martyn@inpharmatica.co.uk, simonm@evolution.com]
This is a very cool issue... Instead of preloading my object with a
bajillion nested objects and associated accessors, I am dynamically
creating the objects, only as they are needed. However, while I can
create and nest the objects into my existing object with no problem, I
don't know how to dynamically create the accessors.
usage:
my $snippet = SQL::Snippet->new();
# create new SQL::Snippet::Parm object and stuffs
# it into the $snippet->parm hash object under 'gender' key
$snippet->parm->new( 'gender' );
# works, of course
print $snippet->parm->{gender}{foo};
# but I want this, requiring an accessor to have been
# created
print $snippet->parm->gender( foo );
Can someone show me how to code the dynamic accessor creation?
Alternatively, perhaps MethodMaker allows this option, only I haven't
found it.
Here is the code, which does everything fine except create the
accessors for objects contained in $snippet->parm;
___________ ./modules/SQL/Snippet/Admissions.pm ________
package SQL::Snippet::Admissions;
use diagnostics;
use strict;
sub new { bless {} };
sub parm {
my ($self,$key) = @_;
if ($key eq 'gender') {
return (
msg_lines => [ 'Blah blah' ],
regex_checks => [ qr/(M|F|U)/ ],
)
}
}
1;
________________________________________________________
___________ ./modules/SQL/Snippet.pm ___________________
#################################
package SQL::Snippet::Parm;
use diagnostics;
use strict;
# We'll only use a couple of these slots
# in this example
use Class::MethodMaker
new_with_init => '_new_parm_obj',
new_hash_init => '_init_args',
boolean => [qw/ allow_null
confirm_values /],
get_set => [qw/ name
label
description /],
list => [qw/ msg_lines
prompt_lines
re_prompt_lines
default_values
values
sql_checks
regex_checks /];
sub init {
my ($self, $name, $repository, %args) = @_;
$self->_init_args( $repository->parm( $name ) );
}
#################################
package SQL::Snippet::ParmHash;
use diagnostics;
use strict;
use vars '@ISA';
@ISA = ( 'SQL::Snippet::Parm' );
sub _ctor {
shift;
my $self = {};
$self->{repository} = shift;
die "Invalid repository object"
unless ref $self->{repository};
bless $self;
}
sub new {
my ($self,$name,%args) = @_ or die;
$self->{$name} = $self->_new_parm_obj(
$name, $self->{repository}, %args
);
}
#################################
package SQL::Snippet;
use diagnostics;
use strict;
use Class::MethodMaker
new_with_init => 'new',
new_hash_init => '_init_args',
boolean => 'interact_mode',
get_set => [ qw/ dbh
repository
select_clause
parm / ],
list => 'baseline_limits';
sub init {
my ($self,%args) = @_;
# set defaults
$self->interact_mode;
# use passed in defaults
$self->_init_args;
$self->parm(
SQL::Snippet::ParmHash->_ctor(
$args{repository}
)
);
}
1;
________________________________________________________
___________ ./working/snippet_test.pl __________________
#!/usr/local/bin/perl -w
use diagnostics;
use strict;
use lib '/u/prl2/perl/modules';
use LUDBI;
use SQL::Snippet;
use SQL::Snippet::Admissions;
my $dbh = LUDBI->lu_connect( {RaiseError => 1} );
my $repository = SQL::Snippet::Admissions->new;
my $snippet = SQL::Snippet->new (
dbh => $dbh,
repository => $repository
);
$snippet->clear_interact_mode;
$snippet->parm->new( 'gender' );
# this works fine... the object is made
print "TEST: gender regex checks: ",
@{ $snippet->parm->{gender}{regex_checks} }, "\n";
# this bombs because there is no accessor!
print "TEST: gender regex checks: ",
@{ $snippet->parm->gender->regex_checks }, "\n";
________________________________________________________
------------------------------
Date: Wed, 3 Oct 2001 16:31:06 -0400
From: "Phil R Lawrence" <prlawrence@lehigh.edu>
Subject: Re: runtime accessor creation?
Message-Id: <9pfsir$i16@fidoii.CC.Lehigh.EDU>
"Phil R Lawrence" <prlawrence@lehigh.edu> wrote:
> This is a very cool issue... Instead of preloading my object with a
> bajillion nested objects and associated accessors, I am dynamically
> creating the objects, only as they are needed. However, while I can
> create and nest the objects into my existing object with no problem, I
> don't know how to dynamically create the accessors.
Ohhh. This is a job for AUTOLOAD. I never used it before...
Phil
------------------------------
Date: 3 Oct 2001 11:15:21 -0700
From: lrmpham@hotmail.com (Long Pham)
Subject: Re: Socket closes early on local machine
Message-Id: <7c70e7a2.0110031015.50f50e18@posting.google.com>
Benjamin,
Awesome code ! Thanks for your quick reply. We're running on NT and
apparently the PERL version we had did not support loadable modules so
we had to install AvtivePerl to get your code to work. However, we're
still getting the same symptoms. A bit of progress is that with the
addition of the line of code '> die "Error reading socket: $!" if $!;'
it now shows us that even if we are getting the entire buffer back
from the listening process on the external machine, we're getting an
unkown error from the script ... which may indicate that the listening
process is sending some funky character regardless of our
configuration and may be sending it back sooner if the script and the
listening process resides on the same machine ? We'll keep pluggin
here and will post our progress. Thanks again for all your help.
Benjamin Goldberg <goldbb2@earthlink.net> wrote in message news:<3BBA8DA5.1E5E5C20@earthlink.net>...
> While I don't know why you are having your particular problem, I *can*
> suggest a solution.
>
> Get rid of all of your Socket.pm code, and replace it with IO::Socket
> code. That will make it much easier to read and maintain.
>
> Also, it looks like this is meant as a CGI script, so you should
> probably be using CGI.pm
>
> #!/usr/local/bin/perl -w
> use CGI::Carp qw(fatalsToBrowser);
> use CGI qw(-nph);
> use IO::Socket;
> use strict;
>
> print header( {Server => $ENV{SERVER_SOFTWARE}} );
>
> my $socket = IO::Socket::INET->new(
> PeerAddr => "208.193.119.100", PeerPort => 2349,
> ) or die "Couldn't connect: $!";
>
> select((select($socket),$|=1)[0]);
>
> print $socket $ARGV[0], "\n";
>
> $! = 0;
> while( sysread( $socket, $_, 1024 ) ) {
> print;
> }
> die "Error reading socket: $!" if $!;
>
> close $socket or die "Error closing socket: $!";
>
> exit 0;
> __END__
>
> Isn't this code all much clearer? Ok, so the select() part is a bit
> less clear, but what I have is a standard perlish idiom which does what
> your select code did, but without needing an extra variable.
------------------------------
Date: Wed, 03 Oct 2001 16:37:15 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Socket closes early on local machine
Message-Id: <3BBB76FB.F9D2D723@earthlink.net>
Long Pham wrote:
>
> Benjamin,
>
> Awesome code ! Thanks for your quick reply. We're running on NT and
> apparently the PERL version we had did not support loadable modules so
> we had to install AvtivePerl to get your code to work. However, we're
> still getting the same symptoms. A bit of progress is that with the
> addition of the line of code '> die "Error reading socket: $!" if $!;'
> it now shows us that even if we are getting the entire buffer back
> from the listening process on the external machine, we're getting an
> unkown error from the script ...
Umm, exactly what *kind* of error?
The entire point of 'use CGI::Carp qw(fatalsToBrowser);' was so that
when you get an error, you will see the error message [as opposed to
seeing 'error 512: internal server error' with no more information].
> which may indicate that the listening
> process is sending some funky character regardless of our
Funky characters would not do it. Errors come from actual errors, like
it being closed early, or something wrong with your computer network.
> configuration and may be sending it back sooner if the script and the
> listening process resides on the same machine ? We'll keep pluggin
> here and will post our progress. Thanks again for all your help.
It's possible [I'm not *entirely* certain if this is it, but it's
possible] that it's reporting an error message when there is no error,
or you're getting an error from the print statement.
Here's some code which will eliminate that problem if that is the
problem.
Replace:
> > $! = 0;
> > while( sysread( $socket, $_, 1024 ) ) {
> > print;
> > }
> > die "Error reading socket: $!" if $!;
With:
my $count;
while( $count = sysread( $socket, $_, 1024 ) ) {
print or die "Error printing: $!";
}
defined($count) or die "Error reading socket: $!";
--
"I think not," said Descartes, and promptly disappeared.
------------------------------
Date: Wed, 03 Oct 2001 14:35:26 -0700
From: BCC <a@b.c>
Subject: Something wrong with this?
Message-Id: <3BBB849E.D6837E5@b.c>
Hello,
I have run into a bug that I am trying to track down related to
uploading a file.
I am running the latest version of apache on a redhat 6.2 machine.
When the file is uploaded, here is a sub that I use to write the file to
disk:
sub saveFile {
my $outfile = "/some/dir/path/file.txt";
my $file = $query->param("upload");
open(QUERY, "> $outfile") or die "Could not open file for writing!";
if ($file ne '') {
while (<$file>) {
print QUERY;
}
}
close(QUERY);
}
This works fine with just about every file. However, in one case where
the file is large (2.5 mb), I get an internal server error because $file
is uninitialized.
Im not sure if this is something I did wrong with CGI.pm, or if it is an
Apache issue. Apache has the default settings, and for CGI, I use this
line for upload size:
$CGI::POST_MAX=1024 * 5000;
Which should leave me plenty of room for a 2.5 meg file.
Any suggestions?
Thanks!
Bryan
------------------------------
Date: Wed, 03 Oct 2001 16:25:22 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Sourcing Things in Perl ?
Message-Id: <3BBB7432.556C3988@earthlink.net>
arnoux wrote:
>
> slightlysprintingdog@ntlworld.com wrote:
>
> > I trying to source some stuff in a Perl Tk script.
> >
> > Basically I have a string setup somewhere else in the program ;
> > $sourceme which contains the full path of the source file.
> >
> > And then I'm using the system command to source it like so :
> >
> > system ( "source $sourceme" );
> >
> > I don't get anything written to the console and the file is
> > definately not sourced.
> >
> > Any ideas ?
>
> I once had to deal with the following :
> how to get some variable initialisation from multiple recursive file :
>
> At tcsh prompt I will do some
> source toto.csh
> and toto.csh would have to source some other titi.csh and so on.
> at the end all variables would be initialized
> then I start the application that needed all this initialisation :
>
> As you cannot fork a child that alter your Environement you've got to
> acquire the variables and then set them so that another child that you
> fork
> will take them into account.
[snip]
> while (<TRALALA>) {
> chop;
> my ($variable,$valeur) = /^(.+?)=(.*)$/;
> $ENV{$variable} = $valeur;
> }
> close TRALALA || die "pb at close ";
>
> After that I can system ('myapplication') ;
And how, precisely, does this differ from the solution I suggested:
foreach( qx[csh -c 'source $sourceme > /dev/null; env'] ) {
chomp;
next unless 2==(my ($key, $val) = split /=/, $_, 2);
$ENV{$key}=$val;
}
system("modelsim");
Of course, Joe Smith's solution:
system("csh","-c","source $sourceme; modelsim");
is probably best.
--
"I think not," said Descartes, and promptly disappeared.
------------------------------
Date: Wed, 03 Oct 2001 16:34:05 -0400
From: brian d foy <comdog@panix.com>
Subject: Re: Sourcing Things in Perl ?
Message-Id: <comdog-E91590.16340503102001@news.panix.com>
In article <3BBB7432.556C3988@earthlink.net>, Benjamin Goldberg
<goldbb2@earthlink.net> wrote:
> And how, precisely, does this differ from the solution I suggested:
>
> foreach( qx[csh -c 'source $sourceme > /dev/null; env'] ) {
> chomp;
> next unless 2==(my ($key, $val) = split /=/, $_, 2);
> $ENV{$key}=$val;
> }
> system("modelsim");
there is module that does this very thing, and even lets you
choose the shell.
http://search.cpan.org/search?mode=module&query=shell%3A%3Asource
--
brian d foy <comdog@panix.com> - Perl services for hire
CGI Meta FAQ - http://www.perl.org/CGI_MetaFAQ.html
Troubleshooting CGI scripts - http://www.perl.org/troubleshooting_CGI.html
------------------------------
Date: Wed, 03 Oct 2001 14:58:11 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: strict and undisciplined me
Message-Id: <3BBB5FC3.E35A8182@earthlink.net>
Just in wrote:
>
> So sorry my system hung, so I didn't finish:-
>
> The error is this:- 'Use of uninitialized value in join at
> C:\Perl\programs\Insert.pl line 56.'
>
> And the code is this:- (yuck! I know . . .)
[snip]
> while($DB->FetchRow())
> {
> undef my %Data;
> undef @Insert;
> %Data = $DB->DataHash();
>
> while((my $Key, my $Val) = each(%Data))
> {
> push @Insert, $Val, "\t";
> }
> print "@Insert\n";
[snip]
> Printing @Insert returns data in the midst of the uninitialised errors
> that print to screen.
This would imply that some elements of @Insert are "uninitialized", or
undef. The solution is to make them not be undef prior to printing.
@Insert = map { defined($_) ? $_ : "NULL" } @Insert;
print @Insert, "\n";
> Please feel free to highlight my inadequacies as a proficient Perl
> programmer,
Ok.
First, you're using Win32::OBDC, which only works on win*. This isn't
necessarily *bad*, but it does mean you'll have to rewrite your script
almost from scratch if/when you have to move to *nix. DBI is portable.
Second, you declare all your variables as globals. Don't do that.
Declare them for the smallest scope which works.
Third, interpolating items from @Date into the sql query string is ugly.
This should probably be replaced with a sprintf statement:
$SQL = sprintf q[
SELECT * FROM Table
WHERE InsertTime > '%d/%d/%d %d:%d:%d'
], @Date[4,3,5,2,1,0];
The place to declare @Date is just before it's used... and considering
it's only used here, in this one place, I would do:
$SQL = sprintf q[
SELECT * FROM Table
WHERE InsertTime > '%02d/%02d/%04d %02d:%02d:%02d'
], do { my @Date = localtime(time() - (31 * 24 * 60 * 60));
$Date[5] += 1900; ++$Date[4];
@Date[4,3,5,2,1,0];
};
Next problem: when you iterate over a hash, the order of keys is
arbitrary. There's no garuntee that on two row-fetches, the keys and
values will end up in the right order. To fix this, you need to choose
an ordering outside of the while loop.
my @FieldsOrder = sort $DB->fetch_the_field_names_somehow();
print join("\t", @FieldsOrder), "\n";
while( $DB->FetchRow ) {
my %Data = $DB->DataHash;
my @Data = @Data{@FieldsOrder};
@Data = map { defined($_) ? $_ : "NULL" } @Data;
print join("\t", @Data), "\n";
}
Last, you are only indenting by one space per level of umm, indent.
It's much more common [and more readable], to use two, four, or eight
spaces, or use a tab.
> and explain to me why I get the uninitialised error.
Because you are doing something which concatenates strings, and one or
more of those strings happens to be undefined.
--
"I think not," said Descartes, and promptly disappeared.
------------------------------
Date: Wed, 03 Oct 2001 12:03:20 -0700
From: Jeff Zucker <jeff@vpservices.com>
Subject: Re: vvp:Perl DBI error
Message-Id: <3BBB60F8.E2914768@vpservices.com>
"Prasad, Victor [FITZ:K500:EXCH]" wrote:
>
> Can't call method "bind_columns" without a package or object reference:
That means that whatever object is calling bind_columns doesn't exist.
> $sth=$dbh->prepare("SELECT first_name,last_name from aaa_emp whe
> re global_id=$sogid");
Do you have RaiseError set to 1? If not, there is no way to know if
your prepare worked since you don't incude a DBI->errstr statement. If
your prepare didn't work, then $sth will be undefined and and any future
calls to it (such as you make with $sth->bind_columns) will fail.
--
Jeff
------------------------------
Date: Wed, 3 Oct 2001 23:54:38 +0200
From: "Steffen Müller" <tsee@gmx.net>
Subject: Re: Writing files
Message-Id: <9pg1k8$lea$04$2@news.t-online.com>
"Gerd Wagner" <info@sharedweb.de> schrieb im Newsbeitrag
news:9pfd0a$24j$03$1@news.t-online.com...
> Hy freaks!
_de_ Das Kompliment kann ich nur zurück geben. _/de_
> I want to code a little site-counter by perl (CGI). This is not difficult.
> But I want to store the count-file at another server as mine. The
> perl-script should be run on my server and the file, where the script
writes
> data should be on a different server. If I code this, there is no result
on
> the server, where the datafile is.
>
> Is it impossible to write with perl on another server or what did I do
> false?? :-/ Please help me! Thanks!
You cannot simply open a file on another machine. You cannot just open some
URI like it was a file. Please look into the LWP module. Your script would
have told you that the open failed if you had checked the return value of
open (I am pretty sure you didn't!).
Then, there is a FAQ entry about hit counters and file locking. It's the
question "I still don't get locking. I just want to increment the number in
the file. How can I do this?". You should read that and maybe even
http://www.goldmark.org/netrants/webstats
Greeting*s* from Germany,
Steffen
------------------------------
Date: Wed, 03 Oct 2001 15:44:25 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Yet another fork question
Message-Id: <3BBB6A99.E79AACE9@earthlink.net>
Mr. Sunblade wrote:
>
> "Benjamin Goldberg" <goldbb2@earthlink.net> wrote in message
> news:3BBA80A6.332296F0@earthlink.net...
> <snip>
> > The obvious fault is that you should be doing:
> > for( 1..3 ) {
> > defined(my $pid = fork()) or die "fork: $!";
> > if(!$pid) {
> > ... do child stuff ...
> > }
> > }
> > for( 1..3 ) {
> > wait;
> > }
> >
> > Note that the wait()ing is all done *after* you've forked all your
> > children.
>
[snip]
> Regarding the 'wait', I already had a $SIG{CHLD} handler set up, so it
> wasn't necessary. Also, it was clear to me that if I stuck the 'wait'
> in there, the code appeared to be running sequentially, whereas when I
> took it out, it was clearly running in parallel (and faster).
That's because you had *you* wait inside the first for loop, and you
called wait() right after you forked your child. In *my* code, I forked
each of the three children, and then called wait three times.
And as to having a signal handler... there's so many ways those can go
wrong. In a simple situation, it's often better to have explicit wait
or waitpid, and no signal handler... this gives you more control over
what's going on.
> I could tell using two very non-scientific methods: watching the
> speed of the output and checking to see when the command prompt came
> back.
If you eliminate the explicit wait, and just have it in the signal
handler, it's possible for the main program to exit while the children
are still running. Sometimes this is desired, but sometimes not.
Consider the following program [adding error checking is an exercise for
the student :)] :
#!/bin/perl
fork or do { sleep 10; exit } for( 1 .. 3 );
__END__
This program will *not* block at all... it will immediately return to
the command prompt. Adding a signal handler will not change this
behavior.
Now consider this one:
#!/bin/perl
fork ? wait : do { sleep 10; exit } for( 1 .. 3 );
__END__
This runs each sleep sequentially... taking 30 seconds to go back to the
command prompt.
Now this third one:
#!/bin/perl
fork or do { sleep 10; exit } for( 1 .. 3 );
wait for( 1 .. 3 );
__END__
This program gives you back a command prompt after 10 seconds.
> With the 'wait' added, it would run slower and the command prompt
> didn't come back until the loop finished.
'cause you put it in the wrong spot.
> Without the 'wait', it ran faster and the command prompt returned
> instantly, before the ssh commands even started.
Right. What you get without the wait is sorta like my first example
program. What you *probably* want, is to run the ssh commands in
parallel, and get a command prompt when *all* of them have finished
excuting, like my third example program.
> Then again, perhaps I just had the 'wait' in the wrong place, or maybe
> adding a second 'wait' when I already had a $SIG{CHLD} handler set up
> screwed it up.
Yeah, having the signal handler can mess things up if you're trying to
call wait() in the main body of your code.
Like I said, signal handlers are really funky things... in general, if
you can, try and avoid having to mess with them.
--
"I think not," said Descartes, and promptly disappeared.
------------------------------
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 1865
***************************************
