See the 'e' at the end of the s/// block? That turns on Execution of the
code contained inside the right-hand-side of the substitution statement.

Useful trick, sometimes...


--
Chris Devers

$previous_message =~ s/block/statement/;



--
Chris Devers

I took a look at socket options ( setsockopt() ) but I don't see anyting
that would change the time_wait timer ,but I didn't look that hard :).
What
OS are you using? You may have tomodify some kernel settings if you are
using UNIX/LINUX. With windows, here are a few links that may help

http://www.winguides.com/registry/display.php/878/

http://www.windowsitpro.com/Web/Article/Ar...3276/23276.html




---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.802 / Virus Database: 545 - Release Date: 11/26/2004



--
To unsubscribe, e-mail: [Email Removed] For additional
commands, e-mail: [Email Removed] <http://learn.perl.org/>
<http://learn.perl.org/first-response>



--
To unsubscribe, e-mail: [Email Removed]
For additional commands, e-mail: [Email Removed]
<http://learn.perl.org/> <http://learn.perl.org/first-response>

Nope.

Someone (someone else?) is inserting "spam:" in the subjects, which is
about as pointless & annoying.

Spam, and futile efforts to ban it, will kill email yet, just you
watch... :-(


--
Chris Devers

Probably not, since there may be commas elsewhere in the string.

Perhaps. I'm dealing with many thousands of files on perl 5.4, which
doesn't handle globbing correctly on large numbers of files. This script
has to be super-portable, meaning I can't guarantee that the destination
platform will have any modules installed (which I don't know how to do
anyway).

- B

Should be ipv4_chkip, not ipv4_checkip

You should contact the module author to see if he's interested in improving
the error handling for this kind of thing...

Anything suggest itself now? :-)

--
Peter Scott
http://www.perldebugged.com/
*** NEW *** http://www.perlmedic.com/

As mentioned, Curses is a wrapper for standard lib[n]curses. A google search
for "curses tutorial" turns up some candidates.

You need to call initwin() to "turn on" curses and endwin() to "turn off"
curses at the end of your program. There are other initialization things you
may or may not need to do, depending on the application.

Here's an initialization example from a program I have:

use Curses;

....

# initalize curses
initscr(); # init screen buffers
curs_set(0); # turn off cursor
cbreak(); # canonical mode
noecho(); # no echo of input chars
eval { keypad(1) }; # allow keypad entry
END { endwin(); }

Well, I have a set of script files. Each file is split into an init
section and several different scripts. The init section is eval'd right
away and each script section is eval'd when needed.

The reason I went this way was to make these script files as simple as
possible and, more importantly, so that I can reload them as many times
as I want without having to exit the program.

When a warning happens in the script file below, it works fine because I
know which file, script, and section is being executed. So
handle_warn() can properly display the error.

But if another script file defines a function in its INIT section, and
this script calls that function, I still think the warning came from
this file. The only way I see around this is to see that this file was
(eval 12) and the other file was (eval 10) so when I see (eval 10) in
the warning I can know that the line number refers to the other file.

Here is an example script file:

--------------------------------------------------------------------
# SECTION(INIT)
script_name 'Bookmarks';
script_version '0.1';
script_desc 'Scripts to add and remove bookmarks';

###############################################################################
# USER SCRIPT(add_bookmark): Adds a new bookmark
# SECTION(INFO)

argument 'sector', required => 1, prompt => 'Bookmark which sector?',
type => 'integer', min => 1,
max => sub {return $game_data{'game_settings'}{'max_sectors'}},
default => sub {return $game_data{'user'}{'curr_sector'}};

argument 'name', required => 1, prompt => 'Name the bookmark', type => 'string';

# SECTION(CODE)

if ($name =~ /^d+$/) {
print_text($RED . "ERROR: Bookmark name must not contain only numbers!n" . $WHITE);
} else {
if (exists $game_data{'bookmarks'}{$name}) {
print_text($RED . "ERROR: Bookmark '$name' already exists!n" . $WHITE);
} else {
$game_data{'bookmarks'}{$name} = $sector;
print_text($GREEN . "Bookmark $name => $sector added.n" . $WHITE);
}
}
###############################################################################
# USER SCRIPT(remove_bookmark): Removes a bookmark
# SECTION(INFO)

argument 'name', required => 1, prompt => 'Remove which bookmark', type => 'string', complete => sub {
my @ret;
if (exists $game_data{'bookmarks'}) {
@ret = (keys %{$game_data{'bookmarks'}});
}
return @ret;
};

# SECTION(CODE)

if (exists $game_data{'bookmarks'}{$name}) {
delete $game_data{'bookmarks'}{$name};
print_text($GREEN . "Bookmark $name removed.n" . $WHITE);
} else {
print_text($RED . "ERROR: Bookmark '
--------------------------------------------------------------------

Here is some of the code that parses this:

my %scripts;
my $curr_script_section;
my $curr_script_file;
my $curr_script;

sub handle_warn {
my $warning = $_[0];
my $file = $curr_script_file;
if ($curr_script) {
$file .= '(' . $curr_script . ')'
}
if ($curr_script_section) {
$file .= '[' . $curr_script_section . ']'
}
my $line = 0;
if ($warning =~ s/(eval d+) line (d+).$/$file/) {
$line = $1;
$line -= 2;
$warning .= "line $line.";
}
print_text($RED . "WARNING: $WHITE");
print_text_wrap($warning . "n");
}
$SIG{__WARN__} = &handle_warn;

sub remove_script_file {
my ($file) = @_;
delete $scripts{$file};
}

sub eval_script_code {
my ($script_file, $script, $section, $code) = @_;
local $SIG{__WARN__} = sub {
return if $_[0] =~ /redefined at/;
&handle_warn(@_);
};
$curr_script_section = $section;
$curr_script_file = $script_file;
$curr_script = $script;
debug("Executing $script($section) from file $script_file");
eval $code;
$curr_script_file = 'main';
$curr_script = '';
$curr_script_section = '';
if ($@) {
print_text("Error(s) in script file '$script_file' $script($section) (aborting and unloading)n", $@);
remove_script_file($script_file);
return 0;
}
return 1;
}

sub process_script_file {
my ($file) = @_;
if ($scripts{$file}{'sections'}{'INIT'}) {
eval_script_code $file, '', 'INIT', $scripts{$file}{'sections'}{'INIT'} or return 0;
}
foreach my $script (keys %{$scripts{$file}{'scripts'}}) {
if ($scripts{$file}{'scripts'}{$script}{'sections'}{'INFO'}) {
eval_script_code $file, $script, 'INFO', $scripts{$file}{'scripts'}{$script}{'sections'}{'INFO'} or return 0;
}
if ($scripts{$file}{'scripts'}{$script}{'sections'}{'FUNCTIONS'}) {
eval_script_code $file, $script, 'FUNCTIONS', $scripts{$file}{'scripts'}{$script}{'sections'}{'FUNCTIONS'} or return 0;
}
}
return 1;
}

sub read_script_file {
my ($file) = @_;
return unless $file;
remove_script_file($file);
if (is_script_file_disabled($file)) {
print_text(" Skipping $file (disabled)n");
return;
}
if (open(CODE, "$global_data{'settings'}{'main'}{'script_dir'}/$file")) {
print_text(" Reading $file...");
my $section = '';
my $script = '';
while (my $line = <CODE>) {
if ($line =~ /^s*#s*SECTION(([^)]+))/) {
$section = $1;
} elsif ($line =~ /^s*#s*SCRIPT(([^)]+)): (.+)/) {
$script = $1;
$scripts{$file}{'scripts'}{$script}{'name'} = $script;
$scripts{$file}{'scripts'}{$script}{'desc'} = $2;
} elsif ($line =~ /^s*#s*USERs+SCRIPT(([^)]+)): (.+)/) {
$script = $1;
$scripts{$file}{'scripts'}{$script}{'name'} = $script;
$scripts{$file}{'scripts'}{$script}{'desc'} = $2;
$scripts{$file}{'scripts'}{$script}{'user'} = 1;
} else {
$line =~ s/__SCRIPT_FILE__/'$file'/g;
if ($script) {
$scripts{$file}{'scripts'}{$script}{'sections'}{$section} .= $line;
} else {
$scripts{$file}{'sections'}{$section} .= $line;
}
}
}
close CODE;
if (process_script_file($file)) {
print_text("$GREEN OK$WHITE.n");
$scripts{$file}{'mod_time'} = (stat("$global_data{'settings'}{'main'}{'script_dir'}/$file"))[9];
}
}
}

Thank you! Your solution worked great!

Brian

Or modules for that matter. When I first read the eval trickery my first
thought was "WHY???".

You need to rewrite a shell script that does file transfer in Perl?

Ok, Perl can do that.

How are you trying to transfer the files? There are a lot of ways that
would work -- ftp, scp, rsync, cp over NFS mount (or SMB mount, or DAV
mount, or...), etc. We need to know what options to go with.

If the shell script isn't very long, can you paste it in a message to
the list? If it is long, can you paste a section with the parts you need
to rewrite in Perl?

Out of curiosity, if the shell script works, why rewrite it? I like Perl
and all, but not to the point that every perfectly good script in some
other language needs to be rewritten in Perl...


I think he wants to call the shell script from a different perl script.
qx( shell script which does ftp)

right ?

Chetak


--
To unsubscribe, e-mail: [Email Removed]
For additional commands, e-mail: [Email Removed]
<http://learn.perl.org/> <http://learn.perl.org/first-response>

__________________________________
Do you Yahoo!?
Dress up your holiday email, Hollywood style. Learn more.
http://celebrity.mail.yahoo.com

__________________________________
Do you Yahoo!?
Read only the mail you want - Yahoo! Mail SpamGuard.
http://promotions.yahoo.com/new_mail

__________________________________
Do you Yahoo!?
Send holiday email and support a worthy cause. Do good.
http://celebrity.mail.yahoo.com

XML::SAX + XML::SAX::Base

You can write a very simple filter for this kind of thing.

The usual idiom is something like this:

$foo = join( ", ", keys %bar );

So in this case, maybe...

$sMainTable[2] = join( ", ", keys %PCEs[$case_count] );

....or something to that effect.

If you have _Perl Cookbook_, it has sections on commifying lists.



--
Chris Devers

I usually just write in a way similar to this:

my $q = new CGI;
my $nUserId = $q->param("userId") or die "No valid ID for User";

Or if I'm feeling less draconian,

my $nUserId = $q->param("userId") or "No valid ID for User";

Which will set $nUserId to "No valid ID for User" if userId isn't
defined. In a lot of cases, this is acceptable, but in your code, maybe
everything falls apart without a userid and it really does need to die.

In any case, I think the '$foo = $bar || "default";' construct is very
useful: it's succinct, clear, and generally does what you want...



--
Chris Devers

LWP does it for you. That can be a major PITA when you're trying
to call braindead CGI code that can't handle quoted-printable
characters in an URI.

HTH,
Thomas

param() will return undef in scalar context, or an empty list in list
context if the parameter is totally absent.

So if the query string is 'xyz=0&abc', param('xyz') will return '0'.

If the query string is 'xyz=&abc', param('xyz') will return ''.

If the query string is 'abc=foo', param('xyz') will return undef (in scalar
context)

So, you can do something like:

my $xyz = param('xyz');
if (defined $xyz) {
print "parameter xyz was present. it's value is [$xyz]n";
}

I should add that if this is coming from a form submission and they've left
the field blank, you can't test for that with defined(). You need to test
for whatever you consider a blank field to be.

I often do something like this:

die "You must enter an idn" unless $q->param('id') =~ /S/;

That will die if they leave the field blank or just put whitespace in it.

__________________________________
Do you Yahoo!?
Yahoo! Mail - Easier than ever with enhanced search. Learn more.
http://info.mail.yahoo.com/mail_250

In Perl, you can use ucase and lcase.
In Korn, you can use tr (see man pages for details)

Larry

Hello,

You can use tr in both perl:

perl -pe'tr/V/v/' file.in > file.out

and the shell:

tr V v < file.in > file.out


John
--
use Perl;
program
fulfillment

In 10, is the structure of the hash preserved? What happens if you pass
the hash by reference?
In 11, you are using the hash as a reference. What you want is something
like:

my $type = $hashref->{base_type};

alfred,

Siegfried Heintze wrote:

--
Perl is my reason for following the Sun;

In which case you would also want to use

my ($me, $hashref) = @_;

--
Scott R. Godin
Laughing Dragon Services
www.webdragon.net

I'd go even a step farther and suggest that you make sure of
your arguments, too:

open( IN, $file ) or die "Can't open '$file': $!n";

That helps a lot in tracking down problems that arise
because of wrong assumptions (i.e. that you've got a
filename right).

HTH,
Thomas

This line is bogus. It should be either

if (defined($tail))

or simply

if ($tail)

This line creates a new node each time through the loop (the [ ] operators
here are an anonymous array constructor):

my $node = [ undef, $_ * $_ ];

$node is a reference to that newly-created node.

These lines hook the node on to the end of the list and move $tail to point
to the new end of the list.

$tail -> [ NEXT ] = $node;
$tail = $node;

Add this to the end of the program to see what it builds:

use Data::Dumper;
print Dumper($list);

($list is a reference to the head node)

I suggest /s+/ instead. This splits on any whitespace,
and it'll also remove trailing whitespace like those
pesky trailing n:


#!/usr/bin/perl -w

use strict;

my $string = "foo baz barn";

foreach my $word (split/[ t]+/, $string) {
print "'$word'n";
}

foreach my $word ( split/s+/, $string ) {
print "'$word'n";
}


HTH,
Thomas

Welcome!

qw() means "quote words". It's a shortcut for specifying a list of
LITERAL strings without having to use quotes and commas.

What you want is:

@group = split ' ', $names;

qw() is documented in perldoc perlop. For the documentation on split(),
see perldoc -f split

And further, use split(' ',$numbers), which is a special case that splits on
all whitespace, ignoring initial whitespace. Just a bare "split" does that
by default.

Try this:

perl -e '$_ = " 1 2 3 4 5 "; print "method 1: ", join(",",split /s+/),
"n", "method 2: ", join(",",split), "n";'

- B

--------------------------------------------------------------------------------

Wild Technology Pty Ltd , ABN 98 091 470 692
Sales - Ground Floor, 265/8 Lachlan Street, Waterloo NSW 2017
Admin - Level 4 Tiara, 306/9 Crystal Street, Waterloo NSW 2017
Telephone 1300-13-9453 | Facsimile 1300-88-9453
http://www.wildtechnology.net
DISCLAIMER & CONFIDENTIALITY NOTICE: The information contained in this email message and any attachments may be confidential information and may also be the subject of client legal - legal professional privilege. If you are not the intended recipient, any use, interference with, disclosure or copying of this material is unauthorised and prohibited. This email and any attachments are also subject to copyright. No part of them may be reproduced, adapted or transmitted without the written permission of the copyright owner. If you have received this email in error, please immediately advise the sender by return email and delete the message from your system.

Should it?

I always thought that !~ was the inverse of =~

I.e.
$var !~ /pattern/
was the equivalent of
!($var =~ /pattern/)

(at least within test conditions anyway)

Is there something I'm missing? :)

Thanks!


Regards,


Michael S. E. Kraus
B. Info. Tech. (CQU), Dip. Business (Computing)
Software Developer
Wild Technology Pty Ltd
_______________________________
ABN 98 091 470 692
Level 4 Tiara, 306/9 Crystal Street, Waterloo NSW 2017, Australia
Telephone 1300-13-9453 | Facsimile 1300-88-9453
http://www.wildtechnology.net

The information contained in this email message and any attachments may
be confidential information and may also be the subject of client legal
- legal professional privilege. If you are not the intended recipient,
any use, interference with, disclosure or copying of this material is
unauthorised and prohibited. This email and any attachments are also
subject to copyright. No part of them may be reproduced, adapted or
transmitted without the written permission of the copyright owner. If
you have received this email in error, please immediately advise the
sender by return email and delete the message from your system.



--------------------------------------------------------------------------------

Wild Technology Pty Ltd , ABN 98 091 470 692
Sales - Ground Floor, 265/8 Lachlan Street, Waterloo NSW 2017
Admin - Level 4 Tiara, 306/9 Crystal Street, Waterloo NSW 2017
Telephone 1300-13-9453 | Facsimile 1300-88-9453
http://www.wildtechnology.net
DISCLAIMER & CONFIDENTIALITY NOTICE: The information contained in this email message and any attachments may be confidential information and may also be the subject of client legal - legal professional privilege. If you are not the intended recipient, any use, interference with, disclosure or copying of this material is unauthorised and prohibited. This email and any attachments are also subject to copyright. No part of them may be reproduced, adapted or transmitted without the written permission of the copyright owner. If you have received this email in error, please immediately advise the sender by return email and delete the message from your system.

yep - strictly hardcoded for this useage.

Thanks Lee - that does look like what I was thinking of.
I'm now using
while (<RAWREPORT>) {
my @linesToDiscard = ( q(f), q(^DATE : ), q(^s{15,}PART ),
q(^COUNTER QTY), q(^s+$) ) ;
my $lineItem = $_ ;
next if grep { $lineItem =~ /$_/ } @linesToDiscard ;
etc.....

Hi John - I did think of using the | in the regex, but didn't that
wasn't what I was after.
Long term I _may_ use this for different reports, or the report _may_
change, and I wanted
and easy spot to make changes.
I read that FAQ, and I don't understand it...:-) ....yet. Thanks,
I see how it applies,
but I think I'll skip using it until I get how that suggestion works.
I've made a note
to revisit later.

So, now I'm off to figure out this scoping problem I have....
But I'm learning !

Brian

--
"I don't understand," said the scientist, "why you lemmings all rush
down
to the sea and drown yourselves."
"How curious," said the lemming. "The one thing I don't understand is
why
you human beings don't."
-- James Thurber

great ;p

Why redefine @linesToDiscard which each $_ ?

my @linesToDiscard = ('f','^DATE : ','^s{15,}PART ','^COUNTER
QTY','^s+$');
while(<RAWREPORT>) {
...