[23659] in Perl-Users-Digest
Perl-Users Digest, Issue: 5866 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Nov 27 14:05:44 2003
Date: Thu, 27 Nov 2003 11:05:08 -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 Thu, 27 Nov 2003 Volume: 10 Number: 5866
Today's topics:
ANNOUNCE: List::Compare v0.22 <jkeen@concentric.net>
Re: aternative grouping and map, deuglification <usenet@morrow.me.uk>
Re: Curses %$#@! Default@IO_Error_1011101.xyz [JDM]
Re: Curses %$#@! Default@IO_Error_1011101.xyz [JDM]
Re: Curses %$#@! Default@IO_Error_1011101.xyz [JDM]
Re: DBI error handling <r_reidy@comcast.net>
Re: floating point <REMOVEsdnCAPS@comcast.net>
Re: Help on TCL Lists <Gerald.Lester@cox.net>
Re: How to create a DBM database in Perl <usenet@morrow.me.uk>
Re: How to create a DBM database in Perl (Steve)
Re: module load question <camattern@acm.org>
Re: number formatting.. <tore@aursand.no>
Re: number formatting.. <noreply@gunnar.cc>
Re: Packages and returning errors <someone@somewhere.com>
Re: Packages and returning errors <nobull@mail.com>
Re: Perl Editor <dragnet@internalysis.com>
Re: Regex Question (Hobbit HK)
regexp: \x0a => \x0d\x0a <sppNOSPAM@monaco377.com>
Re: regexp: \x0a => \x0d\x0a <nobull@mail.com>
Re: Socket Problem... <usenet@morrow.me.uk>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Tue, 25 Nov 2003 23:09:57 GMT
From: "James E Keenan" <jkeen@concentric.net>
Subject: ANNOUNCE: List::Compare v0.22
Message-Id: <Hp0MH2.1LyE@zorch.sf-bay.org>
Version 0.22 of Perl extension List::Compare is now available via
CPAN. See:
http://www.cpan.org/authors/id/J/JK/JKEENAN/List-Compare-0.22.tar.gz
or a CPAN mirror near you.
This version allows the user the option of obtaining unsorted lists
representing the intersection, union, etc. of two or more lists.
Previously, List::Compare sorted all such lists before returning them.
That remains the default behavior, but the user now has an unsorted
option.
This option was added following remarks on the costs entailed in
sorting by Ben Holtzman in the course of a recent presentation at Perl
Seminar New York. Thanks, Ben!
Send comments to the author at jkeenan [AT] cpan.org; please put
'List::Compare' or 'List-Compare' in the Subject line. Thanks.
Jim Keenan
------------------------------
Date: Thu, 27 Nov 2003 14:54:34 +0000 (UTC)
From: Ben Morrow <usenet@morrow.me.uk>
Subject: Re: aternative grouping and map, deuglification
Message-Id: <bq537a$689$4@wisteria.csv.warwick.ac.uk>
Greg Bacon <gbacon@hiwaay.net> wrote:
> In article <776e0325.0311260712.7b0c39cf@posting.google.com>,
> Sara <genericax@hotmail.com> wrote:
>
> : I wish other delimiters had been chosen for alternative grouping, like
> :
> : <CAT|DOG>
> :
> : Since Alterntaive grouping is often not related to capturing $-vars..
>
> Your wish is granted:
>
> (?:pattern)
> (?imsx-imsx:pattern)
> This is for clustering, not capturing; it groups
> subexpressions like "()", but doesn't make back-
> references as "()" does. So
And no, this is Not Good, as (?: ) is more often used than ( ). This
will be remedied in Perl6.
Ben
--
"If a book is worth reading when you are six, * ben@morrow.me.uk
it is worth reading when you are sixty." - C.S.Lewis
------------------------------
Date: Thu, 27 Nov 2003 17:26:21 GMT
From: Default@IO_Error_1011101.xyz [JDM]
Subject: Re: Curses %$#@!
Message-Id: <1tqxb.1643$i81.1234@nwrdny02.gnilink.net>
> On Thu, 27 Nov 2003 05:05:24 +0000, Default wrote:
> > <cry>
> > Not getting any sort of error at all, the program just ends.
>
> Please use the subject of your post as the subject of your post.
>
> > #!
> > use Strict;
> > use Warnings;
>
> What OS are you running? Does it really allow module names to be written
> this way? On Linux, I can't even run this script;
>
> #!/usr/local/bin/perl
> #
> use Strict;
> use Warnings;
>
> That's because there _are no_ modules named 'Strict' and/or 'Warnings'.
> They are named 'strict' and 'warnings'.
>
>
> --
> Tore Aursand <tore@aursand.no>
> "A teacher is never a giver of truth - he is a guide, a pointer to the
> truth that each student must find for himself. A good teacher is
> merely a catalyst." -- Bruce Lee
>
same results with use strict and use warnings remarked out
------------------------------
Date: Thu, 27 Nov 2003 17:30:44 GMT
From: Default@IO_Error_1011101.xyz [JDM]
Subject: Re: Curses %$#@!
Message-Id: <8xqxb.3036$UG2.2500@nwrdny03.gnilink.net>
> Default@IO_Error_1011101.xyz writes:
>
> > Subject: Re: Curses %$#@!
>
> Your question has nothing to do with Curses.
Grin
> Perl module names are case sensative.
I've altered the code... same results but this should narrow it down some.
#!
use strict;
use warnings;
use diagnostics;
use Curses;
use Socket;
$| = 1;
my ($internet_addr, $paddr, $remote_port, $remote_host, $kidpid1,
$kidpid2, $kidpid3, @ports_even1, @ports_odd1, @ports_even2,
@ports_odd2,);
my $counter = 1;
my $p_e_loader1 = 2;
my $p_o_loader1 = 1;
my $p_e_loader2 = 514;
my $p_o_loader2 = 513;
print "\n" . ' ' . '='x78 . "\n";
print "\t\t\t\tPort Scanner\n";
print ' ' . '='x78 . "\n\n";
initscr;
while ($counter <= 256)
{
push (@ports_even1, $p_e_loader1);
$p_e_loader1++;$p_e_loader1++;
$counter++;
if ($counter >= 250) {print "\n@ports_even1\n";my $pause = <STDIN>;}
}
$counter = 1;
while ($counter <= 256)
{
push (@ports_odd1, $p_o_loader1);
$p_o_loader1++;$p_o_loader1++;
$counter++;
}
$counter = 1;
while ($counter <= 256)
{
push (@ports_even2, $p_e_loader2);
$p_e_loader2++;$p_e_loader2++;
$counter++;
}
$counter = 1;
while ($counter <= 256)
{
push (@ports_odd2, $p_o_loader2);
$p_o_loader2++;$p_o_loader2++;
$counter++;
}
undef $counter;
#resolve targets address
$remote_host = shift || 'localhost';
$internet_addr = inet_aton($remote_host) ||
die "Couldn't resolve $remote_host"."'s address\n($!)\n($^E)*";
#create two processes
die "can't fork\n($!)\n($^E)\n*" unless defined($kidpid1 = fork());
if ($kidpid1) #first parent process
{
foreach $remote_port (@ports_even1)
{
my $win = new Curses;
$win->addstr(10, 1, "$remote_port");
$win->refresh;
# print "\b\b\b\b \b\b\b\b";
# print "$remote_port";
socket(SOCK_OUT, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
$paddr = sockaddr_in($remote_port, $internet_addr);
if (connect(SOCK_OUT, $paddr))
{print "\nPort: $remote_port is open.\n";}
eval
{
local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm 1;
close(SOCK_OUT);
alarm 0;
};
}
}
else #first child process
{
#create a third process
die "can't fork\n($!)\n($^E)\n*" unless defined($kidpid2 = fork());
if ($kidpid2) #second parent process
{
foreach $remote_port (@ports_odd1)
{
my $win = new Curses;
$win->addstr(10, 11, "$remote_port");
$win->refresh;
# print "\b\b\b\b \b\b\b\b";
# print "$remote_port";
socket(SOCK_OUT, PF_INET, SOCK_STREAM,
getprotobyname('tcp'));
$paddr = sockaddr_in($remote_port, $internet_addr);
if (connect(SOCK_OUT, $paddr))
{print "\nPort: $remote_port is open.\n";}
eval
{
local $SIG{ALRM} = sub { die "alarm\n" };
alarm 1;
close(SOCK_OUT);
alarm 0;
};
}
}
else #second child process
{
#create a fourth process
die "can't fork\n($!)\n($^E)\n*" unless defined($kidpid3=fork());
if ($kidpid3) #third parent process
{
foreach $remote_port (@ports_even2)
{
my $win = new Curses;
$win->addstr(10, 21, "$remote_port");
$win->refresh;
# print "\b\b\b\b \b\b\b\b";
# print "$remote_port";
socket(SOCK_OUT, PF_INET, SOCK_STREAM,
getprotobyname('tcp'));
$paddr = sockaddr_in($remote_port, $internet_addr);
if (connect(SOCK_OUT, $paddr))
{print "\nPort: $remote_port is open.\n";}
eval
{
local $SIG{ALRM} = sub { die "alarm\n" };
alarm 1;
close(SOCK_OUT);
alarm 0;
};
}
}
else
{
foreach $remote_port (@ports_odd2)
{
my $win = new Curses;
$win->addstr(10, 31, "$remote_port");
$win->refresh;
# print "\b\b\b\b \b\b\b\b";
# print "$remote_port";
socket(SOCK_OUT, PF_INET, SOCK_STREAM,
getprotobyname('tcp'));
$paddr = sockaddr_in($remote_port, $internet_addr);
if (connect(SOCK_OUT, $paddr))
{print "\nPort: $remote_port is open.\n";}
eval
{
local $SIG{ALRM} = sub { die "alarm\n" };
alarm 1;
close(SOCK_OUT);
alarm 0;
};
}
}
}
}
endwin;
kill("TERM", $kidpid1);
kill("TERM", $kidpid2);
kill("TERM", $kidpid3);
print "\nDone.\n" && exit;
------------------------------
Date: Thu, 27 Nov 2003 17:32:54 GMT
From: Default@IO_Error_1011101.xyz [JDM]
Subject: Re: Curses %$#@!
Message-Id: <azqxb.1648$i81.1433@nwrdny02.gnilink.net>
> > What OS are you running? Does it really allow module names to be written
> > this way? On Linux, I can't even run this script;
Windows 2000 $erver
no, my mistake they are indeed case sensitive.
ive altered the code. problem persists.
also is there a version of alarm for win32?
here is the new code.
#!
use strict;
use warnings;
use diagnostics;
use Curses;
use Socket;
$| = 1;
my ($internet_addr, $paddr, $remote_port, $remote_host, $kidpid1,
$kidpid2, $kidpid3, @ports_even1, @ports_odd1, @ports_even2,
@ports_odd2,);
my $counter = 1;
my $p_e_loader1 = 2;
my $p_o_loader1 = 1;
my $p_e_loader2 = 514;
my $p_o_loader2 = 513;
print "\n" . ' ' . '='x78 . "\n";
print "\t\t\t\tPort Scanner\n";
print ' ' . '='x78 . "\n\n";
initscr;
while ($counter <= 256)
{
push (@ports_even1, $p_e_loader1);
$p_e_loader1++;$p_e_loader1++;
$counter++;
if ($counter >= 250) {print "\n@ports_even1\n";my $pause = <STDIN>;}
}
$counter = 1;
while ($counter <= 256)
{
push (@ports_odd1, $p_o_loader1);
$p_o_loader1++;$p_o_loader1++;
$counter++;
}
$counter = 1;
while ($counter <= 256)
{
push (@ports_even2, $p_e_loader2);
$p_e_loader2++;$p_e_loader2++;
$counter++;
}
$counter = 1;
while ($counter <= 256)
{
push (@ports_odd2, $p_o_loader2);
$p_o_loader2++;$p_o_loader2++;
$counter++;
}
undef $counter;
#resolve targets address
$remote_host = shift || 'localhost';
$internet_addr = inet_aton($remote_host) ||
die "Couldn't resolve $remote_host"."'s address\n($!)\n($^E)*";
#create two processes
die "can't fork\n($!)\n($^E)\n*" unless defined($kidpid1 = fork());
if ($kidpid1) #first parent process
{
foreach $remote_port (@ports_even1)
{
my $win = new Curses;
$win->addstr(10, 1, "$remote_port");
$win->refresh;
# print "\b\b\b\b \b\b\b\b";
# print "$remote_port";
socket(SOCK_OUT, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
$paddr = sockaddr_in($remote_port, $internet_addr);
if (connect(SOCK_OUT, $paddr))
{print "\nPort: $remote_port is open.\n";}
eval
{
local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
alarm 1;
close(SOCK_OUT);
alarm 0;
};
}
}
else #first child process
{
#create a third process
die "can't fork\n($!)\n($^E)\n*" unless defined($kidpid2 = fork());
if ($kidpid2) #second parent process
{
foreach $remote_port (@ports_odd1)
{
my $win = new Curses;
$win->addstr(10, 11, "$remote_port");
$win->refresh;
# print "\b\b\b\b \b\b\b\b";
# print "$remote_port";
socket(SOCK_OUT, PF_INET, SOCK_STREAM,
getprotobyname('tcp'));
$paddr = sockaddr_in($remote_port, $internet_addr);
if (connect(SOCK_OUT, $paddr))
{print "\nPort: $remote_port is open.\n";}
eval
{
local $SIG{ALRM} = sub { die "alarm\n" };
alarm 1;
close(SOCK_OUT);
alarm 0;
};
}
}
else #second child process
{
#create a fourth process
die "can't fork\n($!)\n($^E)\n*" unless defined($kidpid3=fork());
if ($kidpid3) #third parent process
{
foreach $remote_port (@ports_even2)
{
my $win = new Curses;
$win->addstr(10, 21, "$remote_port");
$win->refresh;
# print "\b\b\b\b \b\b\b\b";
# print "$remote_port";
socket(SOCK_OUT, PF_INET, SOCK_STREAM,
getprotobyname('tcp'));
$paddr = sockaddr_in($remote_port, $internet_addr);
if (connect(SOCK_OUT, $paddr))
{print "\nPort: $remote_port is open.\n";}
eval
{
local $SIG{ALRM} = sub { die "alarm\n" };
alarm 1;
close(SOCK_OUT);
alarm 0;
};
}
}
else
{
foreach $remote_port (@ports_odd2)
{
my $win = new Curses;
$win->addstr(10, 31, "$remote_port");
$win->refresh;
# print "\b\b\b\b \b\b\b\b";
# print "$remote_port";
socket(SOCK_OUT, PF_INET, SOCK_STREAM,
getprotobyname('tcp'));
$paddr = sockaddr_in($remote_port, $internet_addr);
if (connect(SOCK_OUT, $paddr))
{print "\nPort: $remote_port is open.\n";}
eval
{
local $SIG{ALRM} = sub { die "alarm\n" };
alarm 1;
close(SOCK_OUT);
alarm 0;
};
}
}
}
}
endwin;
kill("TERM", $kidpid1);
kill("TERM", $kidpid2);
kill("TERM", $kidpid3);
print "\nDone.\n" && exit;
------------------------------
Date: Thu, 27 Nov 2003 08:39:09 -0700
From: Ron Reidy <r_reidy@comcast.net>
Subject: Re: DBI error handling
Message-Id: <3FC61A9D.4020102@comcast.net>
Tore Aursand wrote:
> On Thu, 27 Nov 2003 13:44:32 +0100, Lars Purschke wrote:
>
>>I've a perl script which inserts data to a database. Sometime I get an
>>error on the execute() statement. Now I want the script not to die but
>>to exit the loop and to try again with the next record.
>
>
> Well. You could start by telling Perl _not_ to die when something goes
> wrong. That would be a grand opener. :-)
>
> You could also check the return value of the execute() method. As it says
> in the DBI documentation;
>
> An "undef" is returned if an error occurs. A successful "execute"
> always returns true regardless of the number of rows affected, even if
> it's zero (see below). It is always important to check the return status
> of "execute" (and most other DBI methods) for errors if you're not using
> "RaiseError".
>
> So;
>
> my $sth = $dbh->prepare( ... );
> if ( $sth->execute() ) {
> # Everything went fine, obviously
> }
> else {
> # An error occured
> }
> $sth->finish();
>
> See 'perldoc DBI' for more information.
And perldoc -f eval
>
>
--
Ron Reidy
Oracle DBA
------------------------------
Date: Thu, 27 Nov 2003 08:59:30 -0600
From: "Eric J. Roode" <REMOVEsdnCAPS@comcast.net>
Subject: Re: floating point
Message-Id: <Xns944065D781C3Dsdn.comcast@216.196.97.136>
-----BEGIN xxx SIGNED MESSAGE-----
Hash: SHA1
Edo <eddhig22@yahool.com> wrote in news:3FC5D669.5090403@yahool.com:
> Hello
> why my sub cal which is suppose to return 0.879222 when it is
> my $ca = cal (\@abc, \@xyz);
> $ca returns 1.
>
> how can I get it to return whatever the exact value the sub calculates?
Edo,
Nobody here minds a novice programmer. Nobody here minds a person who
is new to the language and who is willing to learn.
But you repeatedly and consistenly ask questions without context,
without nearly enough detail for anyone -- ANYONE who isn't looking over
your shoulder -- to answer. You have been repeatedly asked to provide
enough detail for others to help.
I suggest you start.
- --
Eric
$_ = reverse sort $ /. r , qw p ekca lre uJ reh
ts p , map $ _. $ " , qw e p h tona e and print
-----BEGIN xxx SIGNATURE-----
Version: PGPfreeware 7.0.3 for non-commercial use <http://www.pgp.com>
iQA/AwUBP8YRl2PeouIeTNHoEQLGdwCgls86WzwUksQIl8obVFk4EmlGxJwAnRFW
SmrqRymIPS/VQwNalwBhzPpz
=F5fT
-----END PGP SIGNATURE-----
------------------------------
Date: Thu, 27 Nov 2003 11:06:37 -0600
From: Gerald Lester <Gerald.Lester@cox.net>
Subject: Re: Help on TCL Lists
Message-Id: <haqxb.15829$Ac3.8045@lakeread01>
If I understand your problem correctly, this should do:
#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
set INLIST [exec ProcessThatGeneratesInList]
set ifd [open {InPut File} r]
while {[gets $ifd line] != -1} {
set list [split line {|}]
set keyList {}
foreach {key value} [lrange $list 1 end-1] {
lappend keyList $key
}
set test [join $keyList {->}]
if {[string equal $test $INLIST]} then {
puts stdout [lindex $list end]
}
}
close $ifd
exit
RACHAK wrote:
> InPut File ============ BUCKET|Drawing Type|Assembly|Stage|1|GTTBRG001_ASM|
> BUCKET|Drawing Type|Machining|Stage|2|GTTBRG002| LOCKING BUCKET|Drawing
> Type|Machining|Stage|3|GTTBRG003| NOZZLE TURBINE|Drawing
> Type|Assembly|Stage|3|GTTBSG003_ASM| NOZZLE TURBINE|Drawing
> Type|Machining|Stage|3|GTTBSG003| STUB SHAFT COMPRESSOR|Drawing
> Type|Machining|Stage|0|LOCATION|FWD|GTCPRO000| COMPRESSOR|Drawing
> Type|Machining|Stage|1|LOCATION|FWD|SUB LOCATION|FWD1|GTTCRX001|
>
>
> The above data is in a input file, will be dynamic, can change over a
> period and more Key Value pairs can be added
>
> File Description: First Column is Header Info for each record
> Example: COMPRESSOR Last Column is the Final Value that has to be
> returned. EXAMPLE: GTTCRX001
>
> Remaining Columns are represented/used as Key Value Pairs. Expample:
> Drawing Type, Machining Stage,1 LOCATION,FWD SUB LOCATION, FDW1 We can add
> any number of Key Value pairs for each record.
>
>
> Help: Can some one provide me a solution for doing this task.
>
> Read the File & For each record ( combination of First & Last Column : get
> all the Key Value Pairs ) Check this key value pairs exists in a list
> "INLIST" and if all the Key Value Pairs are found Return the last Column
>
>
> INLIST: ( Is not a file but output of another Process ) {COMPRESSOR->
> Drawing Type->Machining->Linear
> Assembly->BKT->Stage->1->LOCATION->FWD1->SUB LOCATION->FWD1->CAP->Assembly
> }
>
> Example:
>
> Drawing Type->Machining ( Key Value Match found for Column1=COMPRESSOR when
> compared between INLIST and input File ) + Stage->1 ( Key Value Match for
> Column1=COMPRESSOR when compared between INLIST and input File ) +
> LOCATION->FWD1 ( Key Value Match for Column1=COMPRESSOR when compared
> between INLIST and input File ) + SUB LOCATION->FWD1 ( Key Value Match for
> Column1=COMPRESSOR when compared between INLIST and input File )
>
> Since all the 4 Key Value Pairs exists in the "INLIST"
>
> Retrun Last Column from InputFile "GTTCRX001"
>
>
> Thanks in Advance RACHAK
--
+--------------------------------+---------------------------------------+
| Gerald W. Lester | "The man who fights for his ideals is |
| Gerald.Lester@cox.net | the man who is alive." -- Cervantes |
+--------------------------------+---------------------------------------+
------------------------------
Date: Thu, 27 Nov 2003 14:40:57 +0000 (UTC)
From: Ben Morrow <usenet@morrow.me.uk>
Subject: Re: How to create a DBM database in Perl
Message-Id: <bq52dp$689$2@wisteria.csv.warwick.ac.uk>
chris@mkttl.co.uk (Topher) wrote:
> I'm not getting error messages, it's just not working - annoying as
> hell!
When you do start getting error messages, you may find the line
use CGI::Carp qw/fatalsToBrowser/;
at the top useful.
Ben
--
I've seen things you people wouldn't believe: attack ships on fire off the
shoulder of Orion; I've watched C-beams glitter in the darkness near the
Tannhauser Gate. All these moments will be lost, in time, like tears in rain.
Time to die. |-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-| ben@morrow.me.uk
------------------------------
Date: 27 Nov 2003 06:55:38 -0800
From: ineverlookatthis@yahoo.com (Steve)
Subject: Re: How to create a DBM database in Perl
Message-Id: <f0d57f86.0311270655.16d571d9@posting.google.com>
chris@mkttl.co.uk (Topher) wrote in message news:<f4487ccf.0311270246.5a82a5c@posting.google.com>...
> Hi,
...........
> I'm not too hot on this Perl business and am basically winging it with
....
Well I am not playing, but I have to say I find this game very
entertaining. It seems to be happening quite often that someone posts
a merest tease of a hint of what they are trying to do and some
incomprehensible garbled code and everyone tries to guess the task and
the existing errors and then write the code that they think might
address the problem.
I am quite genuinely in awe of the skilled players.
Steve
------------------------------
Date: 27 Nov 2003 09:41:32 -0500
From: Chuck Mattern <camattern@acm.org>
Subject: Re: module load question
Message-Id: <m3zneh3mcj.fsf@gryphon.myth.comcast.net>
Tore Aursand <tore@aursand.no> writes:
> On Wed, 26 Nov 2003 23:29:59 -0500, Chuck Mattern wrote:
> > use a module that was inside of a
> > loop, with each iteration the module was called again. Is it possible
> > that this is part of the memory consumption?
> See for yourself; Move the 'use' parts out of the loops and let the
> program run for a while, and you should see that it still eats up memory.
> Alas, your problem seems to be elsewhere.
Many thanks, in my heart I knew that would be too easy...
--
-----------------------------------------------------------------------
|Chuck Mattern | "People often find it easier to be a result |
|camattern@acm.org | of the past than a cause of the future." |
-----------------------------------------------------------------------
------------------------------
Date: Thu, 27 Nov 2003 16:42:42 +0100
From: Tore Aursand <tore@aursand.no>
Subject: Re: number formatting..
Message-Id: <pan.2003.11.27.15.39.54.919527@aursand.no>
On Thu, 27 Nov 2003 15:11:25 +0200, Jaan Kronberg wrote:
> my $somenumber = 1000000;
>
> I'd like to format this $somenumber to look like 1.000.000,00
> Can it be done with sprintf? Other ways?
This is partly a FAQ;
perldoc -q commas
The decimal part is solved by using sprintf, though.
--
Tore Aursand <tore@aursand.no>
"A teacher is never a giver of truth - he is a guide, a pointer to the
truth that each student must find for himself. A good teacher is
merely a catalyst." -- Bruce Lee
------------------------------
Date: Thu, 27 Nov 2003 18:38:23 +0100
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: number formatting..
Message-Id: <bq5cpn$1v12cq$1@ID-184292.news.uni-berlin.de>
Jaan Kronberg wrote:
>
> my $somenumber = 1000000;
>
> I'd like to format this $somenumber to look like 1.000.000,00
> Can it be done with sprintf? Other ways?
This is a three step solution:
sub numfmt {
local $_ = shift;
$_ = sprintf '%.2f', $_; # 1. Decimals
tr/./,/; # 2. Comma as dec. point
1 while s/^([-+]?\d+)(\d{3})/$1.$2/; # 3. Points added
return $_;
}
print numfmt($somenumber);
I suppose it's possible to have Perl use a comma as the decimal point
by using the locale pragma, but I didn't succeed when testing it.
As Paul and Tore mentioned, there is a Q/A in the FAQ that provides a
couple of methods for adding commas to numbers. I used one of those
methods, exchanging the comma for a point.
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Thu, 27 Nov 2003 17:05:24 -0000
From: "Bigus" <someone@somewhere.com>
Subject: Re: Packages and returning errors
Message-Id: <bq5asl$ov2@newton.cc.rl.ac.uk>
"Brian McCauley" <nobull@mail.com> wrote in message
news:u9k75mc7ly.fsf@wcl-l.bham.ac.uk...
> "Bigus" <someone@somewhere.com> writes:
>
> > I'm attempting to put together my first package, but there's something
> > pretty fundamental that I haven't sussed out:
> >
> > Say you are using the DBI module and you've just performed an query and
you
> > want to see if it returned any errors, you could do something like:
> >
> > if ( $db->errstr ) {print "That failed - ".$db->errstr;}
> >
> > What I don't get is what exactly is "errstr"? I guess it's a function
but
> > how would it work if I have a bit of code that goes:
> >
> > if ( $blah < $blahh ) {
> > $rtnError = "Below practical size";
> > return;
> > }
> > and I then want to test $instance->rtnError in the same way as DBI.
>
> The last error message is conceptually no different from any other bit
> of instance data. However you are storing the rest of your instance
> data, store the error the same way. Create an accesor...
>
> sub rtnError {
> my $self = shift;
> # Do whatever is needed to retrice the last error from $self
> # for example if this class is based on a blessed hash you could
> # say something like...
> $self->{last_error};
> }
I've just been reading the object-oriented tutorial
(http://www.perldoc.com/perl5.6/pod/perltoot.html) and looking through
various packages in my site/lib directory and it makes me realise how much
of Perl I really don't understand (or have difficulty grasping) and I've
been using it for 2 years :-(
Regarding the above rtnError sub, I don't understand what the "my $self =
shift;" line is for. The perldoc function guide says about shift (which is
not incidentally a function I've used before):
"Shifts the first value of the array off and returns it, shortening the
array by 1 and moving everything down. If there are no elements in the
array, returns the undefined value. If ARRAY is omitted, shifts the @_ array
within the lexical scope of subroutines and formats, and the @ARGV array at
file scopes or within the lexical scopes established by the eval '', BEGIN
{}, INIT {}, CHECK {}, and END {} constructs".
Errr, right.. it loses me at the "lexical scopes" point but the first bit
would seem to be the relevant bit in this case anyway. Since you are not
specifying anything after the shift keyword it would look for anything
contained in @_, which would be nothing if you were just calling the
rtnError method to return an error string to you defined elsewhere in the
module. So, what's the point of that line?
Another thing I don't get about shift is why one would want to use it
anyway. If an array of values are passed to a sub, shift will chop the first
one off as it returns it, which seems rather destructive, especially when
you could just as easily reference it with $_[0] and that would leave the @_
array intact.
The line "$self->{last_error}" - in terms of hashes, the dereferencer is
not something I've used before. I've used standard hashes like
"$self{last_error}", and hashes within hashes like
"$self{last_error}{blah}", but why is "$self->{last_error}" different than
"$self{last_error}"?
Back to my package (which I am currently thinking might be out of my depth,
and am considering going back to the idea of just writing a standard CGI
script instead!), I have the following code:
package GD::MyMod;
use strict;
use GD;
# new constructer expects 2 values passed
sub new {
if ( $_[0] < 100 or $_[1] < 100 ) {
my $error = "";
$error = "Specify values >= 100";
return;
}
else {
# do stuff
}
}
sub rtnError {
return $error;
}
1;
Then, in the CGI script that calls it, I have:
#!c:\perl\bin\perl.exe
use GD::MyMod;
$im = new GD::MyMod(20,20);
print "Content-type:text/html\n\n";
if($im->rtnError) {
print $im->rtnError;
}
else {
print "no error";
}
That generates an Apache 500 server error and the erro log shows:
"Global symbol "$error" requires explicit package name at blah"
the line it refers to is the print "no error"; one. So, if I add the line
"my $error = shift;" before it (I don't know what it does, but the OO
tutorial uses it in it's subs) then I don't get a server error but a blank
page and the error log says:
Can't call method "rtnError" on an undefined value at blah, where blah is
the line if($im->rtnError) in my CGI script.
So, it seems that somethings not right with the new sub.. any ideas what?
Thanks
Bigus
------------------------------
Date: 27 Nov 2003 18:41:56 +0000
From: Brian McCauley <nobull@mail.com>
Subject: Re: Packages and returning errors
Message-Id: <u91xrtd56z.fsf@wcl-l.bham.ac.uk>
"Bigus" <someone@somewhere.com> writes:
> "Brian McCauley" <nobull@mail.com> wrote in message
> news:u9k75mc7ly.fsf@wcl-l.bham.ac.uk...
> > Create an accesor...
> >
> > sub rtnError {
> > my $self = shift;
> > # Do whatever is needed to retrice the last error from $self
> > # for example if this class is based on a blessed hash you could
> > # say something like...
> > $self->{last_error};
> > }
>
> I've just been reading the object-oriented tutorial
> (http://www.perldoc.com/perl5.6/pod/perltoot.html) and looking through
> various packages in my site/lib directory and it makes me realise how much
> of Perl I really don't understand (or have difficulty grasping) and I've
> been using it for 2 years :-(
>
> Regarding the above rtnError sub, I don't understand what the "my $self =
> shift;" line is for.
> If an array of values are passed to a sub, shift will chop the first
> one off as it returns it, which seems rather destructive, especially when
> you could just as easily reference it with $_[0] and that would leave the @_
> array intact.
Using $_[0] and so on is ugly and slow.
The only time one usually does that is if one wants to modify
arguments.
The only time you usually need to worry about keeping @_ intact is if
you are going use a goto.
The "self" argument is logically separate from the rest of @_ so to
make this clear I tend to write:
sub not_a_method {
my ( $arg1, $arg2 ) = @_;
# Do stuff
}
sub is_a_instance_method {
my $self = shift;
my ($arg1, $arg2 ) = @_;
# Do stuff
}
sub is_as_class_method {
my $class = shift;
my ($arg1, $arg2 ) = @_;
# Do stuff
}
Some other people prefer to use either list assignment or shift to
unpack the whole of @_ in all cases. It's a style thing.
There are also some other people prefer to use subscripts to unpack
the whole of @_ in all cases. That too is a style thing, a _poor_
style thing!
> The perldoc function guide says about shift (which is
> not incidentally a function I've used before):
In 2 years! Wow!
> "Shifts the first value of the array off and returns it, shortening the
> array by 1 and moving everything down. If there are no elements in the
> array, returns the undefined value. If ARRAY is omitted, shifts the @_ array
> within the lexical scope of subroutines and formats, and the @ARGV array at
> file scopes or within the lexical scopes established by the eval '', BEGIN
> {}, INIT {}, CHECK {}, and END {} constructs".
>
> Errr, right.. it loses me at the "lexical scopes" point but the first bit
> would seem to be the relevant bit in this case anyway. Since you are not
> specifying anything after the shift keyword it would look for anything
> contained in @_, which would be nothing if you were just calling the
> rtnError method to return an error string to you defined elsewhere in the
> module.
Bzzt! It would be nothing if you were just calling the rtnError
_subroutine_ but if you are calling an instance method then $_[0] is
the object on which the method is being called.
> Another thing I don't get about shift is why one would want to use it
> anyway.
Go back at read the OO tutorial again. If there are bits you don't
understand feel free to come here and ask for help. Comming here and
asking for help without reading the tutorial first is a waste of
everyone's time. The answers you get here will probably be inferior
to the tutorial. And it there's anything unclear in the tutorial it
won't help it get fixed.
> The line "$self->{last_error}" - in terms of hashes, the dereferencer is
> not something I've used before. I've used standard hashes like
> "$self{last_error}", and hashes within hashes like
> "$self{last_error}{blah}", but why is "$self->{last_error}" different than
> "$self{last_error}"?
Ah, before you read the OO tutorial you need to read the reference
tutorial. You've come here asking for some coaching with your running
and you've just admitted you've never walked.
> Back to my package (which I am currently thinking might be out of my
> depth,
You are. Way out of your depth.
> and am considering going back to the idea of just writing a standard CGI
> script instead!),
"Chalk and cheese". (Actually I hate that metaphor - cheese and chalk
are both roughly hologeneous solids. They have a lot in common. I
think "Chalk and chastisement" would be a better metaphor).
> I have the following code:
>
> package GD::MyMod;
> use strict;
> use GD;
>
> # new constructer expects 2 values passed
> sub new {
> if ( $_[0] < 100 or $_[1] < 100 ) {
$_[0] will be 'CG::MyGod' if new is called as a method of class
GD::MyMod.
Did you perhaps "forget" to enable warnings?
I'm sure we've explained to you before how rude it is to come here and
ask sentient entities to help you when you've not already asked your
computer.
Are you _trying_ to piss us off?
> my $error = "";
Always use the natual representation of things. If you want to
represent the concept of "no value" in a scalar use the special value
undef. Rather helpfully when you declare a variable using my()
without an explicit initializtion it will be set to the natural
representation of "no value" for that type of variable.
> $error = "Specify values >= 100";
> return;
> }
You are not saving that value anywhere that persists after the return
is executed.
Note your constructor does not construct anything if it gets an error.
You need to fix the scope of $error by moving its declaration outside
the subroutine.
> else {
> # do stuff
I hope that some of that "stuff" includes actually constructing a
CG::MyGod object. Otherwise new() is not a constuctor.
> }
> }
>
> sub rtnError {
> return $error;
> }
$error is out of scope.
Did you perhaps "forget" to enable strictures?
I'm sure we've explained to you before how rude it is to come here and
ask sentient entities to help you when you've not already asked your
computer.
Are you _trying_ to piss us off?
You need to fix the scope of $error.
> 1;
>
> Then, in the CGI script that calls it, I have:
>
> #!c:\perl\bin\perl.exe
> use GD::MyMod;
> $im = new GD::MyMod(20,20);
It's probably bese not to get into the habit of using the indirect
ibject syntax. Oh, and you forgot to declare $im.
my $im = GD::MyMod->new(20,20);
> print "Content-type:text/html\n\n";
>
> if($im->rtnError) {
> print $im->rtnError;
> }
> else {
> print "no error";
> }
>
> That generates an Apache 500 server error and the erro log shows:
>
> "Global symbol "$error" requires explicit package name at blah"
You should not be runnning your scripts under a web server until
you've at least syntax checked them.
> the line it refers to is the print "no error"; one.
No way! Look again.
> So, if I add the line "my $error = shift;" before it (I don't know
> what it does, but the OO tutorial uses it in it's subs)
Don't just do random things. How did you expect $_[0] to contain your
error message?
> then I don't get a server error but a blank page
I do not believe you.
> and the error log says:
>
> Can't call method "rtnError" on an undefined value at blah, where blah is
> the line if($im->rtnError) in my CGI script.
Yep that is correct.
> So, it seems that somethings not right with the new sub.. any ideas what?
You decided that your constuctor would not constuct an object if it
didn't like it's arguments. If it didn't constuct an object you
cannot use the object it constucted to look up the error because there
is no object.
You need to call the rtnError as a class method, just as you did with
new.
Having a class method to return your error is just one approach.
There are other equally good ones.
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: Thu, 27 Nov 2003 14:15:19 GMT
From: Marc Bissonnette <dragnet@internalysis.com>
Subject: Re: Perl Editor
Message-Id: <Xns94405E2BA88B2dragnetinternalysisc@207.35.177.134>
krakle@visto.com (krakle) wrote in news:237aaff8.0311262028.4b975fd4
@posting.google.com:
> Scite.
Ultra Edit
--
Marc Bissonnette
CGI / Database / Web Management Tools: http://www.internalysis.com
Something To Sell? Looking To Buy? http://www.whitewaterclassifieds.ca
Looking for a new ISP? http://www.canadianisp.com
------------------------------
Date: 27 Nov 2003 10:32:59 -0800
From: hobbit_hk@hotmail.com (Hobbit HK)
Subject: Re: Regex Question
Message-Id: <22ee5d47.0311271032.753d4d0a@posting.google.com>
hjkmax@netscape.net (max) wrote in message news:<95401f7d.0311270301.5deffa49@posting.google.com>...
> How do I deal with escaped backslash in patterns?
> Hope the is some light out there...
> I want to match (dublequote anything dublequote) followd by equels
> like ("something"=something)
>
> here are some of the problem pattern
>
> "=\"=\"=\""="=\"=\"=\"" "\\\\\\\\\\"="\\\\\\\\\\" "==="="==="
>
> This is what I have so far.
> I just don't seem to be able to match the no \ before "= unless the are two \\
> I seem to be able to do one pattern but not all of them!
>
> m/
> ^" #begining of line duble quote
> (.*? #anything minimul match
> )
> (?:(?<!\\) #( exept before a back slash
> "=) # a duble quote followed by a equal sign)
> (.*) #anything after
> /x ;
> or
> m/
> ^" #begining of line duble quote
> (.*? #anything minimul match
> )
> (?: #exept before a back slash
> "=) #a duble quote folowed by a equal sign
> (.*) #anything after
> /x ;
>
> Sorry about the unclarity of the mess
> Thanks
> Max
If I understood you right, you want to match some thnig like ("X"=X)?
So I think you need to use:
m/\("(.*?)"=\1\)/
Tell me if I misunderstood...
------------------------------
Date: Thu, 27 Nov 2003 18:05:02 +0100
From: =?ISO-8859-15?Q?S=E9bastien?= Cottalorda <sppNOSPAM@monaco377.com>
Subject: regexp: \x0a => \x0d\x0a
Message-Id: <3fc62ebe$0$2351$626a54ce@news.free.fr>
Hi,
In a file, I have \x0a characters and I'd like to replace them by the couple
\x0d\x0a
How can I do ?
Note: If I have already \x0d\x0a, I don't want to replace \x0a of course.
Thanks in advance.
Sébastien
--
[ retirer NOSPAM pour répondre directement
remove NOSPAM to reply directly ]
------------------------------
Date: 27 Nov 2003 17:48:08 +0000
From: Brian McCauley <nobull@mail.com>
Subject: Re: regexp: \x0a => \x0d\x0a
Message-Id: <u965h5d7on.fsf@wcl-l.bham.ac.uk>
Sébastien Cottalorda <sppNOSPAM@monaco377.com> writes:
> In a file, I have \x0a characters and I'd like to replace them by the couple
> \x0d\x0a
>
> How can I do ?
What happend when you tried the obvious s/// ?
s/\x0a/\x0d\x0a/g;
(If you've not heard of s/// then you need to go back and do some
basic Perl tutorials).
> Note: If I have already \x0d\x0a, I don't want to replace \x0a of course.
You could use a negative look-behind.
s/(?<!\x0d)\x0a/\x0d\x0a/g;
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: Thu, 27 Nov 2003 14:51:37 +0000 (UTC)
From: Ben Morrow <usenet@morrow.me.uk>
Subject: Re: Socket Problem...
Message-Id: <bq531p$689$3@wisteria.csv.warwick.ac.uk>
hobbit_hk@hotmail.com (Hobbit HK) wrote:
> I'm using AtivePerl 5.8 on WinXP and trying to do a script which
> listens and writes to the same socket (with fork of course...). Now,
> everything works great until I'm trying to write to the socket... The
> program just stucks, I think because I'm trying to read and write
> simultaneously... If I comment the read part everything goes smooth
> (except I can't get msgs :)), here's the code:
>
> use IO::Socket;
> $|=1;
> ($host, $port) = @ARGV;
> $port=23 if !$port;
> $sock=new IO::Socket::INET->new(PeerAddr=>$host, PeerPort=>$port,
> Proto=>'tcp') or die "Can't connect to $host on port $port! $!\n";
> $sock->autoflush(1);
> print "[Connected to $host on port $port]\n";
> die "Can't fork! $!\n" unless defined($kidpid=fork());
> if ($kidpid) {
> while (sysread($sock, $byte, 1)==1) {
Why not just use <$sock>? Possibly with '$/ = \1;'.
> print "$byte";
You don't need to quote this.
> }
> kill 9, $kidpid;
kill does not do what you think it does under Win32. See perlport.
> }
> else {
> while (defined($msg=<STDIN>)) {
> print "$msg\n";
Don't you mean 'print $sock "$msg\n";'?
> }
> }
What are you trying to do here? Is there even anything listening on
port 23 of the machine you are talking to?
Ben
--
The cosmos, at best, is like a rubbish heap scattered at random.
- Heraclitus
ben@morrow.me.uk
------------------------------
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 5866
***************************************
