[19740] in Perl-Users-Digest
Perl-Users Digest, Issue: 1935 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Oct 15 18:10:50 2001
Date: Mon, 15 Oct 2001 15:10:10 -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: <1003183810-v10-i1935@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Mon, 15 Oct 2001 Volume: 10 Number: 1935
Today's topics:
putting $1..$9 into a replacement string such as $repl= (=?ISO-8859-1?Q?sh=F2wd=F6g?=)
Re: putting $1..$9 into a replacement string such as $r <bernard.el-hagin@lido-tech.net>
Re: putting $1..$9 into a replacement string such as $r (=?ISO-8859-1?Q?sh=F2wd=F6g?=)
Re: putting $1..$9 into a replacement string such as $r (=?ISO-8859-1?Q?sh=F2wd=F6g?=)
Socket read/write select problem <sean.egan@eei.ericsson.se>
Re: sort - only want unique records <djberge@uswest.com>
Re: sort an array and print out biggest number <djberge@uswest.com>
Re: String To List <jay@utils.net.nospam>
Re: String To List <jeff@vpservices.com>
Troubles with Debian Potato Apache + mod_perl (Pete Ashdown)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 15 Oct 2001 10:01:45 -0700
From: showdog@my-deja.com (=?ISO-8859-1?Q?sh=F2wd=F6g?=)
Subject: putting $1..$9 into a replacement string such as $repl="=csinfo$1$2^$3"
Message-Id: <187c116b.0110150901.1c296e43@posting.google.com>
problem
the program reads tokens from a text file, with lines like
\=csinfo(.*)([A-Za-z]+)\/([A-Za-z]+)|=csinfo$1$2^$3
these lines are separated by the |, and are read into $search and
$replace:
$search="\=csinfo(.*)([A-Za-z]+)\/([A-Za-z]+)";
$replace="=csinfo$1$2^$3";
I then try
s{$search}{$replace}g;
and I get (for example):
=csinfo 00000130c/c overruled on other grounds
becomes
=csinfo$1$2^$3 overruled on other grounds
so the numbered variables are not being evaluated, they are being
treated as literal strings. What shall I do?
------------------------------
Date: 15 Oct 2001 17:12:09 GMT
From: Bernard El-Hagin <bernard.el-hagin@lido-tech.net>
Subject: Re: putting $1..$9 into a replacement string such as $repl="=csinfo$1$2^$3"
Message-Id: <slrn9sm5rg.85e.bernard.el-hagin@gdndev25.lido-tech>
On 15 Oct 2001 10:01:45 -0700, shòwdög <showdog@my-deja.com> wrote:
> problem
>
> the program reads tokens from a text file, with lines like
> \=csinfo(.*)([A-Za-z]+)\/([A-Za-z]+)|=csinfo$1$2^$3
> these lines are separated by the |, and are read into $search and
> $replace:
>
> $search="\=csinfo(.*)([A-Za-z]+)\/([A-Za-z]+)";
> $replace="=csinfo$1$2^$3";
>
> I then try
> s{$search}{$replace}g;
> and I get (for example):
>
>=csinfo 00000130c/c overruled on other grounds
> becomes
>=csinfo$1$2^$3 overruled on other grounds
>
> so the numbered variables are not being evaluated, they are being
> treated as literal strings. What shall I do?
You're not using warnings, are you. When you try to set the
variable $replace you're using double quotes which causes the
variables $1, $2 and $3 to be interpolated. Since during the
assignment they have no values the $replace variable is set
to:
'=csinfo' . undef . undef. '^' . undef
and that's what you're replacing with in the substitution.
Had you enabled warnings you would have learned that on your own.
Cheers,
Bernard
------------------------------
Date: 15 Oct 2001 14:36:54 -0700
From: showdog@my-deja.com (=?ISO-8859-1?Q?sh=F2wd=F6g?=)
Subject: Re: putting $1..$9 into a replacement string such as $repl="=csinfo$1$2^$3"
Message-Id: <187c116b.0110151336.245fcc32@posting.google.com>
Bernard El-Hagin <bernard.el-hagin@lido-tech.net> wrote in message news:<slrn9sm5rg.85e.bernard.el-hagin@gdndev25.lido-tech>...
> On 15 Oct 2001 10:01:45 -0700, shòwdög <showdog@my-deja.com> wrote:
> > problem
> >
> > the program reads tokens from a text file, with lines like
> > \=csinfo(.*)([A-Za-z]+)\/([A-Za-z]+)|=csinfo$1$2^$3
> > these lines are separated by the |, and are read into $search and
> > $replace:
> >
> > $search="\=csinfo(.*)([A-Za-z]+)\/([A-Za-z]+)";
> > $replace="=csinfo$1$2^$3";
> >
> > I then try
> > s{$search}{$replace}g;
> > and I get (for example):
> >
> >=csinfo 00000130c/c overruled on other grounds
> > becomes
> >=csinfo$1$2^$3 overruled on other grounds
> >
> > so the numbered variables are not being evaluated, they are being
> > treated as literal strings. What shall I do?
>
>
> You're not using warnings, are you. When you try to set the
> variable $replace you're using double quotes which causes the
> variables $1, $2 and $3 to be interpolated.
Yes I am using warnings, and strict:
use strict;
use warnings;
Actually my code above was misleading. I am reading these expressions
from a file as such:
my @lines = `type "$filename"`;
chomp (@lines);
foreach my $line (@lines) { #lines look like: /UU|Ü
my @tokens = split (/\|/, $line);
$hECodes{$counter++} = \@tokens;
# I quotemeta the lh expression elsewhere in the code
}
@sortedECodeKeys = sort { $a <=> $b } keys %hECodes;
Then later in the code I do this:
while (<INPUTFILE>) {
chomp;
foreach my $ecode (@sortedECodeKeys) {
my $source = $hECodes{$ecode}[0];
my $dest = $hECodes{$ecode}[1];
s{$source}{$dest}g;
}
}
SO, when $source equals '\=csinfo(.*)([A-Za-z]+)\/([A-Za-z]+)'
and $dest equals '=csinfo$1$2^$3'
and $_ equals '=csinfo 00000130c/c overruled on other grounds'
Then,
s{$source}{$dest}g
sets $_ equal to '=csinfo$1$2^$3 overruled on other grounds'
so the digits variables are being taken literally.
> > <snip>
> Since during the assignment they have no <snip> ...
> ... Had you enabled warnings you would have learned that on your own.
yeah. thanks. hope I clarified.
and thanks in advance for SOLID help -- deja takes about 6 hours to
show my posts ...
>
>
> Cheers,
> Bernard
------------------------------
Date: 15 Oct 2001 14:44:07 -0700
From: showdog@my-deja.com (=?ISO-8859-1?Q?sh=F2wd=F6g?=)
Subject: Re: putting $1..$9 into a replacement string such as $repl="=csinfo$1$2^$3"
Message-Id: <187c116b.0110151344.73b0e1f3@posting.google.com>
Bernard El-Hagin <bernard.el-hagin@lido-tech.net> wrote in message news:<slrn9sm5rg.85e.bernard.el-hagin@gdndev25.lido-tech>...
> On 15 Oct 2001 10:01:45 -0700, shòwdög <showdog@my-deja.com> wrote:
> > problem
> >
> > the program reads tokens from a text file, with lines like
> > \=csinfo(.*)([A-Za-z]+)\/([A-Za-z]+)|=csinfo$1$2^$3
> > these lines are separated by the |, and are read into $search and
> > $replace:
> >
> > $search="\=csinfo(.*)([A-Za-z]+)\/([A-Za-z]+)";
> > $replace="=csinfo$1$2^$3";
> >
> > I then try
> > s{$search}{$replace}g;
> > and I get (for example):
> >
> >=csinfo 00000130c/c overruled on other grounds
> > becomes
> >=csinfo$1$2^$3 overruled on other grounds
> >
> > so the numbered variables are not being evaluated, they are being
> > treated as literal strings. What shall I do?
>
>
> You're not using warnings, are you. When you try to set the
> variable $replace you're using double quotes which causes the
> variables $1, $2 and $3 to be interpolated. Since during the
> assignment they have no values the $replace variable is set
> to:
>
>
> '=csinfo' . undef . undef. '^' . undef
another point... based on this assertion, instead of
=csinfo$1$2^$3 overruled on other grounds
which is what I got, I would have gotten
=csinfo^
which is not what I got... so I don't _think_ quoting is the problem.
Another related question, when you read a line :
while <FOO> {}
is $_ a single quoted or double quoted variable? based on what i see
it is neither, if that makes sense.
------------------------------
Date: Mon, 15 Oct 2001 21:38:33 +0200
From: Sean Egan <sean.egan@eei.ericsson.se>
Subject: Socket read/write select problem
Message-Id: <3BCB3B39.3617FC68@eei.ericsson.se>
This is a multi-part message in MIME format.
--------------F44C149EB154EB3600886557
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Hi,
I'm writing some perl code that uses INET sockets. I have added some
functionality to see if the socket is ready for read (or write).
Basically I want to be able to timeout on a read/write from/to a socket.
The client wants to write two messages to the socket, and then read a
reply.
The server should read the two messages and send a reply.
The problem is, that after the client has sent the second message the
two side
(client and server) wait (until timeout) for a read.
I have attached some perl code that produces this problem.
I am using Solaris 2.6 and Perl 5.6, although it's repeatable on Perl
5.5 also.
To run the code, put in your own path to perl,
then on one window run "test_soc.plx -server" and on the
other run "test_soc.plx"
I you uncomment the 'sleep 3' in the code the problem goes away...
Thanks in advance, Sean.
--------------F44C149EB154EB3600886557
Content-Type: text/plain; charset=us-ascii;
name="test_soc.plx"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
filename="test_soc.plx"
#!/usr/local/bin/perl --
#
# Socket select test script.
#
use strict;
use sigtrap;
use English;
use File::Basename;
use Getopt::Long;
use IO::Socket;
use IO::Select;
use vars qw( $opt_help $opt_server );
#
# Port to use, read/write timeout.
#
my $Port = 28181;
my $Host = 'localhost';
my $Timeout = 60; # In seconds.
#
# Forward declarations.
#
sub write_msg( $$ );
sub read_msg( $ );
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#
# Get options if any
#
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
GetOptions( 'help', 'server' );
if ( defined( $opt_help ) and ( $opt_help == 1 ) )
{
print( "\n\n Socket test script.\n" .
"\nUsage: " . basename( $0 ) . " [-server] [-help]\n\n"
);
exit 0;
}
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#
# Setup server side.
#
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
if ( defined( $opt_server ) )
{
#
# Setup socket.
#
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
my $main_sock = IO::Socket::INET->new( Listen => 10,
LocalPort => $Port,
Proto => 'tcp',
Reuse => 1,
Type => SOCK_STREAM
);
if ( ! defined( $main_sock ) )
{
print( "Failed to setup socket '$Port' '$!'\n" );
exit 1;
}
print( "Listening on port '$Port'\n" );
#
# Setup select arguments.
#
my $rHandle = IO::Select->new( $main_sock );
my ( $new_rHandle, $sock );
while ( 1 ) {
( $new_rHandle ) = IO::Select->select( $rHandle, undef, undef, 120 );
foreach $sock ( @$new_rHandle )
{
if ( $sock == $main_sock )
{
my $a_soc = $sock->accept();
my $rep = 1;
while ( 1 )
{
read_msg( $a_soc );
read_msg( $a_soc );
write_msg( $a_soc, "Test message reply from server $rep" );
$rep++;
}
}
else
{
print( "Warning, this socket '$sock' should not be selected.\n" );
}
}
# Do some house keeping.
}
exit;
}
else
{
my $sock = IO::Socket::INET->new( PeerAddr => $Host,
PeerPort => $Port,
Proto => 'tcp',
Type => SOCK_STREAM
);
if ( ! defined( $sock ) )
{
print( "Failed to connect to socket '$Host' '$Port'\n" );
exit 1;
}
print( "Connected to host $Host on port $Port.\n" );
my $value;
foreach ( 1 ... 10 )
{
write_msg( $sock, "Test message from client $ARG" );
# sleep 3; # Allow time for the second read.
write_msg( $sock, "Test message from client $ARG - 1" );
read_msg( $sock );
}
}
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#
# Write message to the given socket.
#
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub write_msg( $$ ) {
my ( $sock, $msg ) = @_;
if ( can_write( $sock, $Timeout ) < 1 )
{
print( "Timeout waiting for write.\n" );
exit 1;
}
my $error;
$sock->print( "$msg\n" );
if ( ( $error = $sock->error() ) )
{
print( "Failed to write msg '$msg' ($error)\n" );
exit 1;
}
}
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#
# Write message to the given socket.
#
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub read_msg( $ ) {
my ( $sock ) = @_;
if ( can_read( $sock, $Timeout ) < 1 )
{
print( "Timeout waiting for read.\n" );
exit 1;
}
my $msg;
if ( ! defined( $msg = $sock->getline() ) )
{
my $error;
if ( ( $error = $sock->error() ) )
{
print( "Failed to read from socket ($error).\n" );
exit 1;
}
print( "Connection closed.\n" );
exit 0;
}
print( "Received: $msg" );
}
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#
# Check if the socket can be written/read to/from.
#
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub _select( $$$ ) {
my ( $sock, $timeout, $rw ) = @_;
return 1 unless $timeout;
my ( $rin, $win, $ein ) = ( "", "", "" );
vec( $rin, fileno( $sock ), 1 ) = 1;
$win = $rw ? undef : $rin;
$rin = undef unless $rw;
my $nfound = select( $rin, $win, undef, $timeout );
print( "Select value $nfound\n" );
if ( $nfound < 0 )
{
print( "Select failed for " . ($rw ? "read" : "write") . " ($!)\n" );
}
return $nfound;
}
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#
# Check if the socket can be read from.
#
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub can_read( $$ ) {
my ( $sock, $timeout ) = @_;
print( "Checking if read ready\n" );
_select( $sock, $timeout, 1 );
}
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#
# Check if the socket can be written to.
#
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub can_write ( $$ ) {
my ( $sock, $timeout ) = @_;
print( "Checking if ready for write\n" );
_select( $sock, $timeout, 0 );
}
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#
# General Cleanup.
#
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sub END {
}
--------------F44C149EB154EB3600886557--
------------------------------
Date: Mon, 15 Oct 2001 14:16:42 -0500
From: Mr Sunblade <djberge@uswest.com>
Subject: Re: sort - only want unique records
Message-Id: <3BCB361A.2AAEE0DF@uswest.com>
Tim O'Sullivan wrote:
> Hi,
> I'm new to Perl. I'm trying to sort a numerical list and retrieve
> only unique records. Sorting isn't a problem, I use:
>
> sub numerically { $a <=> $b }
> @sortedsessions = sort numerically @sessions;
>
> I cannot find how to retrieve only unique records. Can you help?
>
> Tim.
use Set::Array;
Set::Array->new(@sessions)->unique->sort(sub{$a<=>$b})->join->print(1);
Regards,
Mr. Sunblade
--
"Evil will always triumph because Good is *dumb*."
-- Dark Helmet, 'Spaceballs: The Movie'
------------------------------
Date: Mon, 15 Oct 2001 13:47:02 -0500
From: Mr Sunblade <djberge@uswest.com>
Subject: Re: sort an array and print out biggest number
Message-Id: <3BCB2F26.75D4581E@uswest.com>
Tim wrote:
> Hi,
>
> Could someone please help me on this ?
>
> Problem:
>
> I would like to print out the largest number in any array.
>
> For example:
> @array (1,2,5,7,9);
> As, you can see, the largest number is 9.
>
> Here is my solution:
>
> @array (1,2,5,7,9);
> @array = sort (@array);
> print "The largest number is $array[4];
>
> This is not very good solution since I hardcoded the script.
>
> Please offer me with better solution.
>
> Thanks,
It doesn't seem that you really need sorting but here it is anyway...
use Set::Array;
# Without sorting
Set::Array->new(@array)->max->print(1);
# With sorting
Set::Array->new(@array)->sort(sub{$a<=>$b})->max->print(1);
Regards,
Mr. Sunblade
--
"Evil will always triumph because Good is *dumb*."
-- Dark Helmet, 'Spaceballs: The Movie'
------------------------------
Date: Mon, 15 Oct 2001 12:31:34 -0700
From: Jay <jay@utils.net.nospam>
Subject: Re: String To List
Message-Id: <3BCB3996.1B3E3D6C@utils.net.nospam>
Thanks Eric and Benjamin for very useful information.
It's definitely a nice suggestion to use DBI module. I could certainly
try it.
The only big problem I have is, users of that interface might not be
confident entering a SQL Query.
Any suggestions on what will be the simplest form of getting in query
data from user. So that I can construct SQL query in my code. It's a
pre-built interface and all the space I could get on the front-end is a
string field.
BTW, that matchStr was a typo, my code was on unix machine,
which is not connected to internet. It indeed is $matchStr.
Thanks.
-jay
Benjamin Goldberg wrote:
> Jay wrote:
> >
> > Here is what I am trying to do:
> > In the sample 4 field text file attached below, I would like to select
> > particular lines based on user input, which is a string. What will be
> > the better choice for the format of this user string, so that user can
> > provide fieldName(s) and fieldValue or fieldName(s) and pattern
>
> The better choice for the format of the user string would be SQL,
> because there are modules which will parse it and use it for you.
>
> [snip]
> > Text File:
> >
> > field1 field2 field3 field4
> > -----------------------------------------------
> > pplus drawing 14 0
> > cont drawing 6 0
> > m1 drawing 8 0
> > m1 vss 8 2
> > m1 vdd 8 1
> > via1 drawing 19 0
> > m2 drawing 10 0
> > m2 vss 10 2
> > m2 vdd 10 1
> > via2 drawing 29 0
> > m3 drawing 30 0
> > m3 vss 30 2
> > m3 vdd 30 1
> > --------------------------------------------
>
> #!/usr/local/bin/perl -w
> use strict;
> use DBI;
>
> open( THEFILE, "</foo/bar/thefile" )
> or die "Could not open /foo/bar/thefile: $!";
>
> my $dbi = DBI->connect( "DBI:AnyData" )
> or die $DBI::errstr;
>
> my @fields;
> GETFIELDS: {
> defined(local $_ = <THEFILE>) or die "No data in the file!\n";
> redo if /^-*$/;
> @fields = split;
> }
>
> $dbi->import( "thetable", "ARRAY", [
> \@fields, map [split], grep !/^-*$/, <THEFILE>
> ], "ad_import" );
>
> print "Please enter your SQL querys, each terminated by a semicolon\n";
> print "Remember, the table is named 'thetable', and the fields are:\n";
> print "'", join("', '", @fields), "'\n";
> print "Enter an empty statement to exit.\n";
>
> for( my $i = 1; ; ++$i ) {
> print "Query number $i.\n";
> local $/ = ";";
> defined(my $SQL = <STDIN>) or last;
> chomp $SQL;
> last if /^\s*$/;
> unless( my $sth = $dbi->prepare($SQL) ) {
> print STDERR "Invalid SQL query: $DBI::errstr\n";
> next;
> }
> unless( $sth->execute ) {
> print STDERR "Error executing SQL query: $DBI::errstr\n";
> next;
> }
> unless( my $all = $sth->fetchall_arrayref ) {
> print STDERR "Error fetching data: $DBI::errstr\n";
> next;
> }
> my @fields = @{$sth->{NAME}};
> my @lengths = map length, @fields;
> foreach my $row ( @$all ) { for my $col (0..$#fields) {
> $lengths[$col] = length $row->[$col]
> if length $row->[$col] > $lengths[$col];
> } }
> my $format = qq[@{[map "%$_s", @lengths]}\n];
> my $dashes = qq[@{[map "-"x$_, @lengths]}\n];
> printf $format, @fields;
> print $dashes, "\n"
> printf $format, @$_ foreach @$rows;
> print $dashes;
> }
>
> __END__
>
> NB: This code is untested.
> The output it produces isn't quite the same as it expects for input.
>
> --
> "Just how stupid are you Kuno?"
> "Verily, Tatewaki Kuno knows no limits."
------------------------------
Date: Mon, 15 Oct 2001 13:29:01 -0700
From: Jeff Zucker <jeff@vpservices.com>
Subject: Re: String To List
Message-Id: <3BCB470D.A804F21@vpservices.com>
Jay wrote:
>
> Any suggestions on what will be the simplest form of getting in query
> data from user. So that I can construct SQL query in my code. It's a
> pre-built interface and all the space I could get on the front-end is a
> string field.
# assuming $user_input is a string something like
# "field2=drawing"
#
my($fieldname,$fieldvalue) = split /=/, $user_input;
my $sql = "SELECT * FROM $table";
if( defined $fieldname and defined $fieldvalue ) {
$sql .= " WHERE $fieldname = " . $dbh->quote($fieldvalue);
}
my $sth=$dbh->prepare($sql);
...
--
Jeff
------------------------------
Date: 15 Oct 2001 12:22:10 -0600
From: pashdown@slack.xmission.com (Pete Ashdown)
Subject: Troubles with Debian Potato Apache + mod_perl
Message-Id: <9qf9gi$8r6$1@slack.xmission.com>
Apache is throwing me this error:
Can't locate object method "request" via package "Apache" at /usr/lib/perl5/5.005/CGI.pm line 264.
CPAN barfs when I update CGI. I recompiled mod_perl to no avail. Any
ideas?
--
Pneumatic tubes are killing the Internet.
Pete Ashdown pashdown@xmission.com ICQ:5717723 Salt Lake City, Utah
XMission Internet Access - http://www.xmission.com - Voice: 801 539 0852
------------------------------
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 1935
***************************************
