[24135] in Perl-Users-Digest
Perl-Users Digest, Issue: 6329 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Mon Mar 29 11:05:48 2004
Date: Mon, 29 Mar 2004 08:05:11 -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 Mon, 29 Mar 2004 Volume: 10 Number: 6329
Today's topics:
Deleting old files in windows 2000 using Perl (Avinash)
Re: Help!! Cannot insert TIMESTAMP after upgrade. <shah@typhoon.xnet.com>
Re: how to capture multiple lines? <tassilo.parseval@rwth-aachen.de>
Re: how to capture multiple lines? <tadmc@augustmail.com>
Re: how to capture multiple lines? <noreply@gunnar.cc>
Re: how to capture multiple lines? <noreply@gunnar.cc>
Re: how to capture multiple lines? <geoffacox@dontspamblueyonder.co.uk>
Re: how to capture multiple lines? <geoffacox@dontspamblueyonder.co.uk>
Lost data on socket - Can we start over politely? (Vorxion)
Re: LWP cookies (Peter Scott)
Re: LWP cookies <rbell01824@earthlink.net>
Nested POE? <ggershSNACK@CAKEctc.net>
Re: Net::SSH Need example how to use..can't find one.. (cayenne)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 29 Mar 2004 07:57:58 -0800
From: avindia@indiya.com (Avinash)
Subject: Deleting old files in windows 2000 using Perl
Message-Id: <fe5e1363.0403290757.650e4d75@posting.google.com>
Hi,
is someone have perl script wrote to delete files older than 30 days
from diffrent diffretent folders in windows 2000 or similar.
Or some one can guide any URL which can help me to write one.
Pls advice
Avinash
------------------------------
Date: Mon, 29 Mar 2004 15:45:06 +0000 (UTC)
From: Hemant Shah <shah@typhoon.xnet.com>
Subject: Re: Help!! Cannot insert TIMESTAMP after upgrade.
Message-Id: <c49ga2$ol0$1@flood.xnet.com>
While stranded on information super highway W Gemini wrote:
> Hemant Shah wrote:
>> Folks,
>>
>> I recently upgraded/migrated my database from UDB 7.2 on AIX to UDB 8.1 on
>> Linux. Now I cannot insert data into a TIMESTAMP column. The string I am
>> using for TIMESTAMP is in ISO format.
>>
>> The old database was using ISO-8859-1 character set, the new database is
>> using UTF-8. I have a perl script that inserts data into one of the table
>> that has time stamp column. The script worked in UDB 7 database but fails
>> with SQL0180N in UDB 8.
>>
>>
>> 1246: $InsertStmt_CodeChanged_Hdl->execute($SourceNum, $RevBranch, $RevDecimal,
>> 1247: $TimeStamp, $Author, $Command, $SubCommand,
>> 1248: $LinesAdded, $LinesDeleted);
>> DB<2> p $TimeStamp
>> 2004-03-28-17:06:39.816398
>> DB<3> n
>> lidp12|InsertCodeChangedData: DBD::DB2::st execute failed: [IBM][CLI Driver][DB2/LINUX] SQL0180N The syntax of the string representation of a datetime value is incorrect. SQLSTATE=22007
>>
>>
>> I tried to run following command on the client system but that did not help
>> either.
>>
>> db2 bind @db2cli.lst DATETIME ISO blocking all grant public
>> db2 bind @db2ubind.lst DATETIME ISO blocking all grant public
>>
>> How can I fix it? I need to fix it A.S.A.P.
>>
>> Thanks.
>>
>
> Try 2004-03-28-17.06.39.816398.
>
That worked, but I have 2 questions.
1) What could have changed in UDB V8. The script worked fine with UDB 7.2.
2) I get the timestamp from the database using CURRENT TIMESTAMP and the
database returns it in "2004-03-28-17:06:39.816398" format, but when I try
to insert it I get error. Instead of using $TimeStamp, I also tried
"CURRENT TIMESTAMP" in the insert statement and got same error.
Why is it that the database returns it in one format and wants it in
different format for insert?
--
Hemant Shah /"\ ASCII ribbon campaign
E-mail: NoJunkMailshah@xnet.com \ / ---------------------
X against HTML mail
TO REPLY, REMOVE NoJunkMail / \ and postings
FROM MY E-MAIL ADDRESS.
-----------------[DO NOT SEND UNSOLICITED BULK E-MAIL]------------------
I haven't lost my mind, Above opinions are mine only.
it's backed up on tape somewhere. Others can have their own.
------------------------------
Date: 29 Mar 2004 14:13:48 GMT
From: "Tassilo v. Parseval" <tassilo.parseval@rwth-aachen.de>
Subject: Re: how to capture multiple lines?
Message-Id: <c49aus$2la$1@nets3.rz.RWTH-Aachen.DE>
Also sprach Geoff Cox:
> On 29 Mar 2004 13:02:51 GMT, "Tassilo v. Parseval"
><tassilo.parseval@rwth-aachen.de> wrote:
>
>
>>If I understand you right, you want to grab everything that appears in
>><p> tags? Here's an example using HTML::Parser:
>
> Tassilo
>
> The code below will take a bit of thinking about! However I need to
> get the <p> .... </p> text in the order in which it appears in the
> html file, not all together.
Did you try the little program? The text() method is triggered for every
paragraph in the order in which they appear.
> The html file has say
>
><p> ajdkjs ak lsdjas
> asdja dkasj dl asd
> lad akl;sdk a;dkl; </p>
>
><h2 align= etc </h2>
>
><option value = "docs/ etc >text</option>
>
> (when the option line is met I take the path part and use it to search
> another file in order to get some related text)
This is yet another good reason not to use regular expressions and
employ a real parser for that. Recursing into the next file when an
<option> tag is found is incredibly easy. All you have to do is create
another instance of the parser in the start() method and have it parse
the file given through 'value'. That's around three more lines in my
example and you have that working as well:
sub start {
my (undef, $tagname, $attr) = @_;
$in_para = 1 if $tagname eq 'p';
if ($tagname eq 'option') {
__PACKAGE__->new->parse_file($attr{value});
}
}
Tassilo
--
$_=q#",}])!JAPH!qq(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus})!JAPH!qq(rehtona{tsuJbus#;
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexiixesixeseg;y~\n~~dddd;eval
------------------------------
Date: Mon, 29 Mar 2004 07:51:24 -0600
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: how to capture multiple lines?
Message-Id: <slrnc6gaes.bbb.tadmc@magna.augustmail.com>
Geoff Cox <geoffacox@dontspamblueyonder.co.uk> wrote:
> $/ = "\0a\0d";
> $line =~ /<p>(.*?)<\/p>/s;
> $/ = "\0a";
>
> The 3rd line does not appear to put $/ back to the default value??
^^^^^^
^^^^^^
There is nothing about the effect of $/ that can be observed
from the code you posted.
The $/ variable affects the <INPUT> operator.
The code you've posted does not use the <INPUT> operator...
[ snip TOFU ]
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Mon, 29 Mar 2004 16:54:27 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: how to capture multiple lines?
Message-Id: <c49dca$2fhr58$1@ID-184292.news.uni-berlin.de>
Geoff Cox wrote:
> On Mon, 29 Mar 2004 15:43:25 +0200, Gunnar Hjalmarsson
> <noreply@gunnar.cc> wrote:
>> If grabbing everything between <p> tags is *all* there is, I
>> don't understand why something like this wouldn't be sufficient:
>
> It is not all there is - at least I do not think so...the file
> contains blocks of text between <p> and </p>s mixed in with other
> lines such as <h2> haskhdjk ashj </h2>, <option jjaksdjka
> </option> etc and I want to parse through the file in order, taking
> the <p> </p> and <h2> </h2> data into another file. Also when
> finding the <option line I use the extracted path to search another
> fiel to get related text...
Then you'd better just forget about my suggestion and follow Tassilo's
advice.
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Mon, 29 Mar 2004 16:54:30 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: how to capture multiple lines?
Message-Id: <c49dcd$2fhr58$2@ID-184292.news.uni-berlin.de>
Tassilo v. Parseval wrote:
> Also sprach Gunnar Hjalmarsson:
>> If grabbing everything between <p> tags is *all* there is, I
>> don't understand why something like this wouldn't be sufficient:
>>
>> open FH, 'file.html' or die $!;
>> $_ = do { local $/; <FH> };
>> close FH;
>>
>> my @paras;
>> push @paras, $1 while m!<\s*p[^>]*>(.*?)<\s*/\s*p\s*>!igs;
>
> There are some contrived edge cases not captured by the above. For
> instance, there could be a closing </p> in an HTML comment (yeah, I
> know, this happens all the time;-).
Yeah, yeah. As do angle brackets in quoted attribute names...
I know you need to be watchful of those 'edge cases'. If you don't
know they won't appear, even I would go for a module rather than
tweaking the regex further. ;-)
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Mon, 29 Mar 2004 15:29:47 GMT
From: Geoff Cox <geoffacox@dontspamblueyonder.co.uk>
Subject: Re: how to capture multiple lines?
Message-Id: <01gg60prkga74nvc3fmljavbll47o9qr8p@4ax.com>
On Mon, 29 Mar 2004 07:51:24 -0600, Tad McClellan
<tadmc@augustmail.com> wrote:
>Geoff Cox <geoffacox@dontspamblueyonder.co.uk> wrote:
>
>> $/ = "\0a\0d";
>> $line =~ /<p>(.*?)<\/p>/s;
>> $/ = "\0a";
>>
>> The 3rd line does not appear to put $/ back to the default value??
Tad,
but surely if I change the value of $/ from its default value to 0d0a
can I not change it back to its default value after getting the <p>
... </p> text?
certainly changing it to
$/ = "";
seem to give the best results in terms of the main aim of the whole
code. It is just that I gives me text which when I do not use the $/
change idea, I do not get!
Can you de-mystify this for me?!
Geoff
> ^^^^^^
> ^^^^^^
>
>There is nothing about the effect of $/ that can be observed
>from the code you posted.
>
>The $/ variable affects the <INPUT> operator.
>
>The code you've posted does not use the <INPUT> operator...
>
>
>
>[ snip TOFU ]
------------------------------
Date: Mon, 29 Mar 2004 15:46:12 GMT
From: Geoff Cox <geoffacox@dontspamblueyonder.co.uk>
Subject: Re: how to capture multiple lines?
Message-Id: <n7gg60h18dlefbipkkvglugeve62po3l8c@4ax.com>
On Mon, 29 Mar 2004 07:51:24 -0600, Tad McClellan
<tadmc@augustmail.com> wrote:
>Geoff Cox <geoffacox@dontspamblueyonder.co.uk> wrote:
>
>> $/ = "\0a\0d";
>> $line =~ /<p>(.*?)<\/p>/s;
>> $/ = "\0a";
>>
>> The 3rd line does not appear to put $/ back to the default value??
> ^^^^^^
> ^^^^^^
>
>There is nothing about the effect of $/ that can be observed
>from the code you posted.
Tad,
the whole code follows !! I know it has little elegance but apart from
giving me some text which I do not need, it works! Perhaps you can see
why the $/ is not working correctly? The aim by the way is to make a
web site from one which uses MySQL etc to one which does not use a
database.....
Cheers
Geoff
warnings;
use strict;
use File::Find;
my $dir = 'd:/a-keep9/prog-nondb/old-prog';
find sub {
my $name = $_;
if ($name =~ /.htm/) {
open (IN, "$name");
open (OUT, ">>d:/a-keep9/prog-nondb/progs/test/$name");
my $html = "<html>\n<header>\n<title>$name</title>
\n<link rel='stylesheet' type='text/css'
href='assets/style/style-1.css'>
\n</header>\n<body>\n";
print OUT $html;
print OUT ("<table border=1 cellpadding=10>");
while (defined (my $line = <IN>)) {
if (($line =~ /<h2 align/ ) || ($line =~ /<b>/) || ($line =~
/<strong>/) || ($line =~ /<p /)) {
print OUT ("<tr><td colspan=2>" . $line . "<\/td><\/tr>
\n");
}
if ($line =~ /<p>/) {
¶($line);
}
if ($line =~ /<option value="(.*?)">/) {
&choice($1);
}
}
print OUT ("<\/table>\n<\/body>\n<\/html>");
}
}, $dir;
sub choice {
my ($path) = @_;
if ($path =~/btec-first/) {
&intro($path);
&applefirst($path);
} elsif ($path =~ /classroom-notes/) {
&intro($path);
&clasroomnotes($path);
}elsif ($path =~/pears\/assignments/) {
&intro($path);
&pearsassignments($path);
} else {
&intro($path);
&other($path);
}
}
sub intro {
my ($pathhere) = @_;
open (INN, "d:/a-keep9/prog-nondb/db/total-260304.txt");
my $lineintro = <INN>;
while (defined ($lineintro = <INN>)) {
if ($lineintro =~ /$pathhere','(.*?)'\)\;/) {
print OUT ("<tr><td>$1 <p> \</td>\n");
}
}
}
sub applefirst {
my($pattern) = @_;
my $linee = $pattern;
my $c=0;
$linee =~ /.*unit(\d).*?chap(\d)/;
my $u = $1;
my $chap = $2;
open (INNN, "d:/a-keep9/prog-nondb/allphp/allphp.htm");
while (<INNN>){
last if /$pattern/;
}
my ($curr, $next1, $next2, $next3) = <INNN>;
close (INNN);
if ($next3 =~ /\$i\<(\d);/) {
my $nn = $1;
print OUT ("<td>\n");
for (my $c=1;$c<$nn;$c++) {
print OUT ('<a href="'. $pattern . "/unit" . $u . "-chap" .
$chap . "-doc" . $c . ".zip" . '">' . "Document$c" . "</a><br>" .
"\n");
}
print OUT ("</td></tr>\n");
}
}
sub clasroomnotes {
my($pattern) = @_;
my $c=0;
open (INNN, "d:/a-keep9/prog-nondb/allphp/allphp.htm");
while (<INNN>){
last if /$pattern/;
}
my ($curr, $next1, $next2, $next3) = <INNN>;
close (INNN);
if ($next3 =~ /\$i\<(\d);/) {
my $nn = $1;
print OUT ("<td>\n");
for (my $c=1;$c<$nn;$c++) {
print OUT ('<a href="'. $pattern . "-doc" . $c . ".zip" . '">' .
"Document$c" . "</a><br>" . "\n");
}
print OUT ("</td></tr>\n");
}
}
sub other {
my ($pattern) = @_;
print OUT ("<td> \n");
print OUT ('<a href="'. $pattern . ".zip" . '">' . "Document" .
"</a><br>" . "\n");
print OUT ("</td></tr>\n");
}
sub pearsassignments {
my($pattern) = @_;
print OUT ("<td> \n");
print OUT ('<a href="'. $pattern . ".zip" . '">' . "Document" .
"</a><br>" . "\n");
print OUT ('<a href="'. $pattern . "-grid" . ".zip" . '">' . "Grid" .
"</a><br>" . "\n");
print OUT ("</td></tr>\n");
}
sub para {
local ($/ = "\0D\0A");
my ($linepara) = @_;
$linepara =~ /<p>(.*?)<\/p>/s;
# print ("\$1 = $1 \n");
print OUT ("<tr><td colspan=2>" . $1 . "<\/td><\/tr> \n");
$/ = "";
}
>
>The $/ variable affects the <INPUT> operator.
>
>The code you've posted does not use the <INPUT> operator...
>
>
>
>[ snip TOFU ]
------------------------------
Date: 29 Mar 2004 10:46:04 -0500
From: vorxion@knockingshopofthemind.com (Vorxion)
Subject: Lost data on socket - Can we start over politely?
Message-Id: <406844bc_1@news.iglou.com>
In light of some uh...disagreements, I've bent a bit. Hopefully it's taken
as a token of goodwill. I could use the help, I'm willing to bend a bit to
do it. SO...
I've reworked this to both make it shorter, and so that my extra curly
brackets are not present. I also implemented strict and warnings.
In short, connect with anything and toss, say... 4000 thousand lines of
input at the server. It should give up the ghost far early--somewhere
around 1120-2200, depending on the phase of the moon. You'll note that if
you're still connected, you can even send more data. It's purely a
buffering issue.
I've switched to using only buffered reads and writes on the socket fd's,
so that's no longer the issue. I'm sure it was contributing, but nothing
I'm doing here should be affecting it, to the best of my knowledge.
Now that I've cleaned up my code (at least the majority) and am trying to
appease some people, could I please ask for assistance? (Yes, there are a
lot of variables in the our() statements that aren't used here...I trimmed
about 1000 lines of code out this time instead of ~800.)
If you just run it and toss input at it that's newline-separated, you'll
see what I mean. I'm tossing 3900+ lines at it. It gives up at 1123
somtimes, 2316 others, etc. Entirely arbitrary. It's not buffering
corretly, but I know not why at this point.
Any help would be -greatly- appreciated.
Bests,
Vorxion
*****
#!/usr/local/bin/perl5.8.0
########## Initialise.
##### Hot buffers.
$| = 1;
##### Strict.
use strict;
use warnings;
our($total_clients,$bin_dir,$short_bin_name,$version,$program,$local_host,$local_addr,$port,$max_conn,$psep,$timeout_seconds,$timeouts_per_second,$logopen,$waitedpid,$cli_log,$cli_background,$cli_working_dir,$cli_timeouts_per_second,$cli_logging,$cli_logfile,$cli_max_conn,$cli_port,$cli_timeout_seconds,$working_dir,$fltsv_config_dir,$fltsv_spool,$fltsv_host_access_file,$fltsv_nologin_file,$log,$cli_opt_return,$fltsv_query_type_file,$logfile,$oldhandle,$indiv_path,$user_pager,@all_paths,$user_path,$no_pager,$command_file,$env_file,$main_intake_buffer,$valid_type,$server,$line,$client);
our(%positions,%got_length,%got_packet,%timeouts,%child_pids,%child_done,%no_degrade,%packets,%lengths,%got_packets,%got_type,%got_user,%got_pass,%got_query_start,%got_query_lines,%got_query_end,%got_reply_start,%got_reply_end,%query_file,%response_file);
our(@active,@del_sels,@evars,@commands,@query_types,@inactives,@time_sels);
##### Need symbols for sysopen.
use Fcntl;
use Fcntl qw(:flock);
##### Need to get hostname and IP#.
use Socket;
use Sys::Hostname;
$local_host = hostname();
$local_addr = inet_ntoa(scalar(gethostbyname($local_host || 'localhost')));
##### Need IO::Socket.
use IO::Socket;
use IO::Select;
use Net::hostent;
##### Set default values.
$port = 4016;
$timeout_seconds = 30;
$timeouts_per_second = 4;
$log = '9';
########## Begin main processing.
##### Open log if set.
if (defined(${cli_logfile}) and $log ne 'off') {
sysopen(LOGFILE,$logfile,O_CREAT|O_WRONLY|O_TRUNC,0600) or fl_die(1,"Could not open log file.");
$oldhandle = select(LOGFILE);
$|=1;
select($oldhandle);
$logopen = 1;
fl_log("Server starting on $local_addr.");
fl_log("Opened logfile '$logfile'.");
} elsif ($log ne 'off') {
fl_log("Server starting on $local_addr.");
fl_log("Opened logfile [STDOUT].");
}
##### Create socket.
my $sel = IO::Select->new;
$server = IO::Socket::INET->new(
Proto => 'tcp',
LocalPort => $port,
Listen => SOMAXCONN,
ReuseAddr => 1,
Timeout => 0.25
);
fl_die(3,"Cannot create socket.") unless $server;
fl_log("Listening on port $port.") if $log ne 'off';
$server->autoflush(1);
$server->blocking(0);
##### Main server loop.
while (1) {
##### Clean up dead connections.
while (scalar(@del_sels)) {
my $single_conn = shift(@del_sels);
clean_dead($single_conn);
}
##### Resume timers for connections whose children have finished.
foreach my $client ($sel->handles) {
my $found = 0;
my $fd = $client->fileno;
foreach my $child (keys(%child_pids)) {
$found++,last if $child_pids{$child} == $fd;
}
$no_degrade{$fd} = 0 unless $found;
}
##### Update timers for connections that didn't get anything last time.
##### First, determine which processes were active and select the rest
##### for update.
foreach my $inactive (keys(%timeouts)) {
my $found = 0;
foreach my $single_conn (@active) {
$found++ if $single_conn == $inactive;
}
push(@inactives,$inactive) unless $found;
}
##### Make sure to clear the active list for the next cycle.
undef @active;
##### Actually decrement the timers for selected idle connections.
while (scalar(@inactives)) {
my $inactive = shift(@inactives);
$timeouts{$inactive} -= (1 / $timeouts_per_second) * 2 unless $no_degrade{$inactive};
}
##### Clean connections that have timed out entirely.
undef @time_sels;
@time_sels = keys(%timeouts);
while (scalar(@time_sels)) {
my $single_conn = shift(@time_sels);
if ($timeouts{$single_conn} <= 0) {
push(@del_sels,$single_conn);
}
}
while (scalar(@del_sels)) {
my $single_conn = shift(@del_sels);
foreach my $one_sel (${sel}->handles) {
$single_conn = $one_sel, last if $one_sel->fileno == $single_conn;
}
my $remote_hostinfo = gethostbyaddr($single_conn->peeraddr);
my ($remote_hostname);
if (defined($remote_hostinfo)) {
$remote_hostname = $remote_hostinfo->name || $single_conn->peerhost;
} else {
$remote_hostname = inet_ntoa($single_conn->peeraddr);
}
$remote_hostname .= ' (' . $single_conn->fileno . ')';
$single_conn->shutdown(2);
$total_clients--;
fl_log("Connection from $remote_hostname timed out. Disconnected.") if $log ne 'off';
fl_log("$total_clients clients are connected.") if $log ne 'off' and $log > 8;
clean_dead($single_conn);
}
##### Obtain new connections.
undef $client;
$client = $server->accept();
if (defined($client)) {
##### Got one. Initialise everything.
$client->autoflush(1);
$client->blocking(0);
$sel->add($client);
$total_clients++;
my $remote_hostinfo = gethostbyaddr($client->peeraddr);
my ($remote_hostname);
if (defined($remote_hostinfo)) {
$remote_hostname = $remote_hostinfo->name || $client->peerhost;
} else {
$remote_hostname = inet_ntoa($client->peeraddr);
}
$remote_hostname .= ' (' . $client->fileno . ')';
##### Must have passed initial restrictions.
fl_log("Host $remote_hostname connected.") if $log ne 'off';
fl_log("$total_clients clients are connected.") if $log ne 'off' and $log > 8;
}
##### Handle connections with exceptions.
foreach my $single_conn (${sel}->has_exception(1/${timeouts_per_second})) {
##### Handle non-polite connection drops.
unless (defined($single_conn->peeraddr)) {
fl_log("Remote peer abruptly disconnected.") if $log ne 'off';
push(@del_sels,$single_conn);
$single_conn->shutdown(2);
$total_clients--;
fl_log("$total_clients clients are connected.") if $log ne 'off' and $log > 8;
next;
}
##### Handle rest of polite exceptions.
my $remote_hostinfo = gethostbyaddr($single_conn->peeraddr);
my ($remote_hostname);
if (defined($remote_hostinfo)) {
$remote_hostname = $remote_hostinfo->name || $single_conn->peerhost;
} else {
$remote_hostname = inet_ntoa($single_conn->peeraddr);
}
$remote_hostname .= ' (' . $single_conn->fileno . ')';
fl_log("Remote peer $remote_hostname disconnected.") if $log ne 'off';
push(@del_sels,$single_conn);
$single_conn->shutdown(2);
$total_clients--;
fl_log("$total_clients clients are connected.") if $log ne 'off' and $log > 8;
}
##### Delete references to connections that had exceptions.
while (scalar(@del_sels)) {
my $single_conn = shift(@del_sels);
clean_dead($single_conn);
}
##### Handle reading from connections with data ready.
foreach my $single_conn (${sel}->can_read(1/${timeouts_per_second})) {
fl_log("BUFFER: ".length(${main_intake_buffer})."\n");
##### Handle non-polite connection drops.
unless (defined($single_conn->peeraddr)) {
fl_log("Remote peer abruptly disconnected.") if $log ne 'off';
push(@del_sels,$single_conn);
$single_conn->shutdown(2);
$total_clients--;
fl_log("$total_clients clients are connected.") if $log ne 'off' and $log > 8;
next;
}
##### Handle reading on connections that politely hung around.
my $remote_hostinfo = gethostbyaddr($single_conn->peeraddr);
my ($remote_hostname);
if (defined($remote_hostinfo)) {
$remote_hostname = $remote_hostinfo->name || $single_conn->peerhost;
} else {
$remote_hostname = inet_ntoa($single_conn->peeraddr);
}
$remote_hostname .= ' (' . $single_conn->fileno . ')';
##### Try to get packet length.
my $line_number = 0;
while ($single_conn->read($line,102400)) {
foreach my $sub_line (split(/\n/,$line)) {
$line_number++;
fl_log("$line_number: $sub_line") unless $sub_line =~ /\n$/;
$line = $sub_line if $sub_line =~ /\n$/;
}
}
##### Retry for more packets if present.
redo unless $single_conn->eof;
}
##### Clean up any dead connections.
while (scalar(@del_sels)) {
my $single_conn = shift(@del_sels);
clean_dead($single_conn);
}
}
##### Close log if set.
if (defined(${cli_logfile}) and ${cli_logfile} ne '__FLTbogus') {
fl_log("Closing logfile ${logfile}.") if $log ne 'off';
close(LOGFILE) or fl_die(2,"Could not close log file.");
}
##### Done.
exit;
########## Miscellaneous functions.
##### Disassemble packets.
sub get_packet {
my ($in_packet,$msg,$proto,@full,$one,$two);
$in_packet = $_[0];
($one,$two) = split(/${psep}/,$in_packet);
$two = pack("B*",pack("h*",unpack("u*",pack("h*",${two}))));
push(@full,${one},${two});
if (defined(wantarray) and wantarray) {
return(@full);
} else {
return($full[1]);
}
}
##### Custom die.
sub fl_die {
my ($ecode,$emsg,$full_msg);
$ecode = $_[0];
$emsg = $_[1];
if (defined($cli_logfile) and $cli_logfile ne '__FLTbogus' and $logopen) {
syswrite(LOGFILE,"SERVER_ERROR_$ecode: $emsg\n");
close(LOGFILE) if defined($cli_logging);
} else {
syswrite(STDOUT,"SERVER_ERROR_$ecode: $emsg\n");
}
exit($ecode);
}
sub fl_log {
my ($log_str,$timestr);
$log_str = $_[0];
$timestr = localtime(time);
if (defined(${cli_logfile}) and $log ne 'off') {
syswrite(LOGFILE,"$0 [$$] $timestr: $log_str\n");
} elsif ($log ne 'off') {
syswrite(STDOUT,"$0 [$$] $timestr: $log_str\n");
}
return;
}
------------------------------
Date: Mon, 29 Mar 2004 14:41:08 GMT
From: peter@PSDT.com (Peter Scott)
Subject: Re: LWP cookies
Message-Id: <8AW9c.42530$QO2.39890@pd7tw1no>
In article <x7d66wtt96.fsf@mail.sysarch.com>,
Uri Guttman <uri@stemsystems.com> writes:
>>>>>> "RB" == Richard Bell <rbell01824@comcast.net> writes:
>
> RB> In the course of this dance, I neglected to mention that the 18
> RB> previous pages use frames and very heavy scripting (some Java, some
> RB> VB). While I'm new to LWP and don't really know, I'm under the
> RB> impression that frames and LWP don't get on well, to say nothing of
> RB> the scripts. That aside, the code to visit all 18 pages would
> RB> ultimately be IMHO rather worse than the mess with the headers. But
> RB> that is, of course, just my preference.
>
>the backend scripting of java or vb makes NO difference on the client
>side. only javascript can screw up LWP by making the buttons only
>javascript and hard/impossible to click.
>
>as for your 18 pages, it doesn't matter. www::mechanize can scrape that
>in 18 calls. and all without ugly manual header code.
>
>and www::mechanize handles frames as links so that is not a problem
>either.
In fairness to the OP he probably meant JavaScript - that has caused
me problems on mechanizing some sites and I can easily imagine it
being too difficult to figure out what it's doing. Until we get a JS
engine for Perl there's no way to avoid manual inspection.
But as you say, I would first try using mechanize to visit all 18
pages. If that didn't work I'd see if the JavaScript was something
I could figure out easily enough, or use a proxy to see what was
going over the wire.
> RB> To each his own. My real concern, however, remains concerning a
> RB> cookie value forced in the header v. one in the cookie jar as it
> RB> concerns the session cookie. It's working, I'm OK with it, but I'd
> RB> like to be a bit more sure if anyone knows the underlying behavior of
> RB> LWP in this case.
I wouldn't have thought that hardcoding a session cookie was likely to
work. It makes no difference how you send it, the problem is that the
server ought to have forgotten about the original session long ago.
I would expect you'd have to at least visit the page that generates
the session cookie before jumping to the stage that you want. This is
an approach that has usually worked for me with banks in particular;
do the login and then go directly to the desired end page, regardless
of any navigation necessary in an interactive session.
--
Peter Scott
http://www.perldebugged.com/
*** NEW *** http://www.perlmedic.com/
------------------------------
Date: Mon, 29 Mar 2004 14:44:01 GMT
From: Richard Bell <rbell01824@earthlink.net>
Subject: Re: LWP cookies
Message-Id: <n4dg6093bpsnls6b5udc2vak3bfdlu7ktq@4ax.com>
On Mon, 29 Mar 2004 00:02:45 GMT, Uri Guttman <uri@stemsystems.com>
wrote:
>>>>>> "RB" == Richard Bell <rbell01824@comcast.net> writes:
>
> RB> In the course of this dance, I neglected to mention that the 18
> RB> previous pages use frames and very heavy scripting (some Java, some
> RB> VB). While I'm new to LWP and don't really know, I'm under the
> RB> impression that frames and LWP don't get on well, to say nothing of
> RB> the scripts. That aside, the code to visit all 18 pages would
> RB> ultimately be IMHO rather worse than the mess with the headers. But
> RB> that is, of course, just my preference.
>
>the backend scripting of java or vb makes NO difference on the client
>side. only javascript can screw up LWP by making the buttons only
>javascript and hard/impossible to click.
Welcome to the real world where real pages really do real stuff with
script.
>
>as for your 18 pages, it doesn't matter. www::mechanize can scrape that
>in 18 calls. and all without ugly manual header code.
>
>and www::mechanize handles frames as links so that is not a problem
>either.
>
Not a prayer since they interact with the Java script.
> >>
> RB> The point is interesting. I could, as you seem to suggest, force
> RB> the values into the cookie jar and let LWP do a bit more work. It
> RB> turns out that the only real benefit here would be to allow LWP to
> RB> set the content length
>
> RB> $req18->header('Content-Length' => '384');
>
> RB> and of course, remove my concern about the session cookie (I'm still
> RB> not entirely sure which it is)
>
>then just let lwp handle it and stop worrying. you seem to want to
>control stuff you don't NEED to control. lwp is smarter than you are
>here. :)
>
> RB> Still, I'm not sure IMHO that going to the trouble to dump the cookies
> RB> into the jar is worth the return (this is, after all, a perl
> RB> hack). Still it's a thought.
>
>huh? it saves you all the code you wasted on headers and cookies. did
>you see the code i posted? it is like 4 lines to handle all the cookie
>stuff. and that included persistant cookies from a DB (the cookie init
>stuff which needs to be edited).
You are talking about both lines here, right. Two that work as they
are.
>
> RB> To each his own. My real concern, however, remains concerning a
> RB> cookie value forced in the header v. one in the cookie jar as it
> RB> concerns the session cookie. It's working, I'm OK with it, but I'd
> RB> like to be a bit more sure if anyone knows the underlying behavior of
> RB> LWP in this case.
>
>if you are so concerned, look at the source. but you are wasting your
>time (and ours to some extent) fighting over this. massive numbers of
>programs have been written with LWP and most need cookie support. no one
>else seems to go nutso over controlling the cookies like you do. you get
>cookies, you return cookies. the server controls that just fine. only
>when you need to manage cookies (such as with persistance like i had too
>for login reasons) do you get into it more. and even then i never looked
>at the cookies, i just stored/loaded them from the DB if needed.
>
>uri
Not really interested in fighting or any such. Just looking for a
quick answer to a question about a package I'm new to. Of course the
question still remains:
How to figure out which are the session cookies?
What is the packages behavior re cookies in cases such as this?
Said and done, I like LWP. It's working just fine. What I'm trying
to do is to get some information about a boundry condition not covered
the any of the documentation I can find. Were I a real perl hacker,
I'd certainlly turn to the code. In fact, at this point I suppose
I'll have to do that in any case.
Thanks for your interest. While the questions remain unanswered, the
discussion has been useful.
R
------------------------------
Date: Mon, 29 Mar 2004 10:28:34 -0500
From: Greg G <ggershSNACK@CAKEctc.net>
Subject: Nested POE?
Message-Id: <kLmdnbU2OvIL3fXdRVn-hA@ctc.net>
I'm working with POE::Component::SNMP and I need to be able to post from
inside a callback. That is, the boxes that I'm walking have this weird
defect where I have to open a new connection with the card number in the
community to walk that card. For example, if my initial connection is
with community "getinfo" I have to walk the card with community
"getinfo@s1".
However, when I try to do any sort of post from within the callback, I
get this "Can't call method "get_request" on an undefined value at
/usr/local/lib/perl5/site_perl/5.8.0/POE/Component/SNMP.pm line 81."
I'm suspicious that the problem might be in the way that P:C:S gives a
global $kernel variable, and even doing another P:C:S->create didn't
help any.
Any suggesstions?
Thanks.
-Greg G
------------------------------
Date: 29 Mar 2004 07:55:11 -0800
From: chilecayenne@yahoo.com (cayenne)
Subject: Re: Net::SSH Need example how to use..can't find one...
Message-Id: <2deb3d1.0403290755.135856ae@posting.google.com>
"J. Gleixner" <glex_nospam@qwest.invalid> wrote in message news:<8Q19c.249$Qv1.92719@news.uswest.net>...
> If you have the .pm, reading the documentation that comes with it,
> instead of the code, is done by running "perldoc":
>
> perldoc Net::SSH
>
> or if it's not installed on the system and is in your local directory
>
> perldoc ./SSH.pm
>
> or simply look at the documentation on CPAN
>
> http://search.cpan.org/~ivan/Net-SSH-0.08/SSH.pm
>
> Define "do some things". That's too general. Depending on what
> "things" you want to do you'd use ssh_cmd, sshopen2, or sshopen3. To
> see what open2 and open3 are, check the documentation for perlipc
> (perldoc perlipc), or more specifically IPC::Open2 and IPC::Open3.
I've read the pm...and just don't know what to do with it. I've tried
using ssh() and ssh_cmd() like the examples, but, I keep getting
errors.
For instance I'm trying:
print "Removing file = $file_name.tar.gz\n";
ssh_cmd("username\@sid","rm
/data/VOL1/oradata/backups/sid/$directory/$file_name.tar.gz") || die
"ssh: $!";
I've done numerious print statements, and my $directory and $file_name
strings are correct. However, when I try it with the line above, with
ssh_cmd, it blows. Here's the feedback from running this:
Removing file = fred_test_01_Mar_2004.tar.gz
Undefined subroutine &main::ssh_cmd called at clean_backups2.pl line
64.
I tried using the ssh() function which looked similar to the ssh_cmd
function..but, crashed about the same way.
I'm not sure what the => symbols mean in some examples I've seen. The
perldoc and pm give:
ssh('user@hostname', $command);
issh('user@hostname', $command);
ssh_cmd('user@hostname', $command);
ssh_cmd( {
user => 'user',
host => 'host.name',
command => 'command',
args => [ '-arg1', '-arg2' ],
stdin_string => "string\n",
} );
sshopen2('user@hostname', $reader, $writer, $command);
sshopen3('user@hostname', $writer, $reader, $error, $command);
The only example they give is for the sshopen2 function, and it seems
to reading a file or something...I'm not sure what's going on there. I
don't need to open a file, or move one around. I just need to delete
one.
I'm sure this can be done with this package..but, in all my searches
so far...nothing like what I want to do..or they are all using
net::ssh::perl, which is not available to me.
I guess I'm confused as to why the ssh() and ssh_cmd() calls aren't
working..they look simple enough...
Anyway, any simple example or link to one would be greatly
appreciated!!
:-)
chilecayenne
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
#The Perl-Users Digest is a retransmission of the USENET newsgroup
#comp.lang.perl.misc. For subscription or unsubscription requests, send
#the single line:
#
# subscribe perl-users
#or:
# unsubscribe perl-users
#
#to almanac@ruby.oce.orst.edu.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
#To request back copies (available for a week or so), send your request
#to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
#where x is the volume number and y is the issue number.
#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V10 Issue 6329
***************************************
