[25740] in Perl-Users-Digest
Perl-Users Digest, Issue: 7980 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Apr 15 18:05:44 2005
Date: Fri, 15 Apr 2005 15:05:13 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Fri, 15 Apr 2005 Volume: 10 Number: 7980
Today's topics:
Creating a non-existing database through Perl <hackeras@gmail.com>
Re: Creating a non-existing database through Perl <noreply@gunnar.cc>
Re: Creating a non-existing database through Perl <hackeras@gmail.com>
Re: Creating a non-existing database through Perl <noreply@gunnar.cc>
Re: Creating o non-existing database <noreply@gunnar.cc>
Re: Creating o non-existing database xhoster@gmail.com
Finding CPU stats on Win? guice666@gmail.com
Re: Finding CPU stats on Win? <thepoet_nospam@arcor.de>
Re: Finding CPU stats on Win? <guice666@gmail.com>
Help with downloading large files sales@Downloads4Dialups.com
Re: Help with downloading large files <tadmc@augustmail.com>
Re: Net::FTP problem <thepoet_nospam@arcor.de>
Re: Net::FTP problem axel@white-eagle.invalid.uk
Re: Net::FTP problem soup_or_power@yahoo.com
Re: Net::FTP problem soup_or_power@yahoo.com
Re: PDF and Word to screen axel@white-eagle.invalid.uk
regex help <smcbutler@hotmail.com>
Re: regex help <sbryce@scottbryce.com>
Re: regex help <noreply@gunnar.cc>
Re: regex help <noreply@gunnar.cc>
Re: regex help (Anno Siegel)
Re: regex help axel@white-eagle.invalid.uk
Re: regex help ioneabu@yahoo.com
SIGPIPE delay on open2 exec failure <gglynn@nickelkid.com>
Re: trouble with very simple regexp <tadmc@augustmail.com>
Re: What is going on? <tadmc@augustmail.com>
Re: What is going on? <jgibson@mail.arc.nasa.gov>
Re: while loop into database insert not working <pilkowsk@informatik.uni-marburg.de>
Re: while loop into database insert not working <darkon.tdo@gmail.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Fri, 15 Apr 2005 21:42:33 +0300
From: beatnik <hackeras@gmail.com>
Subject: Creating a non-existing database through Perl
Message-Id: <d3p1uj$cf8$2@nic.grnet.gr>
Yes but actually "nikos_db" would be the first database in existance.
There is no other database created before it. My aproiach so far was to
create that database "nikos_db" from console *manually* othewise i was
getting an error. On the other hand if the database existed then it
could conenct to it first and then delete it? But what about the first
time that need to be created?
------------------------------
Date: Fri, 15 Apr 2005 21:24:43 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: Creating a non-existing database through Perl
Message-Id: <3cairkF6ihjr6U1@individual.net>
[ Provide some context when replying to a message, and don't
unnecessarily start a new thread.
Study the posting guidelines for this group before posting again.
http://mail.augustmail.com/~tadmc/clpmisc/clpmisc_guidelines.html ]
beatnik wrote:
> Yes but actually "nikos_db" would be the first database in existance.
<snip>
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Fri, 15 Apr 2005 22:45:37 +0300
From: beatnik <hackeras@gmail.com>
Subject: Re: Creating a non-existing database through Perl
Message-Id: <d3p5kq$ggj$1@nic.grnet.gr>
Gunnar Hjalmarsson wrote:
> [ Provide some context when replying to a message, and don't
> unnecessarily start a new thread.
>
> Study the posting guidelines for this group before posting again.
> http://mail.augustmail.com/~tadmc/clpmisc/clpmisc_guidelines.html ]
>
> beatnik wrote:
>
>> Yes but actually "nikos_db" would be the first database in existance.
Sorry, here is the relevant code i was talking about:
<code>
This is some per of my make.pl
Its supposed to create first time the database nikos_db or if its
already there to just delete it and recreate it.
$db = ($ENV{'SERVER_NAME'} ne 'nikolas.50free.net')
? DBI->connect('DBI:mysql:nikos_db', 'root', '')
: DBI->connect('DBI:mysql:nikos_db:50free.net', 'nikos_db', '*****')
or print font({-size=>5, -color=>'Lime'}, $DBI::errstr) and exit 0;
$db->do( "drop database if exists nikos_db" );
$db->do( "create database nikos_db" );
$db->do( "use nikos_db" );
</code>
------------------------------
Date: Fri, 15 Apr 2005 22:22:19 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: Creating a non-existing database through Perl
Message-Id: <3cam7nF6nv6d7U1@individual.net>
beatnik wrote:
> Gunnar Hjalmarsson wrote:
>> [ Provide some context when replying to a message, and don't
>> unnecessarily start a new thread.
>>
>> Study the posting guidelines for this group before posting again.
>> http://mail.augustmail.com/~tadmc/clpmisc/clpmisc_guidelines.html ]
>
> Sorry, here is the relevant code i was talking about:
We've already seen the code.
http://groups-beta.google.com/group/comp.lang.perl.misc/msg/d6138c23eac6a8b0
The "Webmin" hint is still my best shot.
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Fri, 15 Apr 2005 21:16:32 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: Creating o non-existing database
Message-Id: <3caic8F6kpdsuU1@individual.net>
Spock wrote:
> Whats Webmin?
http://www.google.com/
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: 15 Apr 2005 21:05:10 GMT
From: xhoster@gmail.com
Subject: Re: Creating o non-existing database
Message-Id: <20050415170510.279$BV@newsreader.com>
Nikos <hackeras@gmail.com> wrote:
> This is soem per of my make.pl
> Its supposed to create first time the database nikos_db or if its
> already there to just delete it and recreate it.
>
> $db = ($ENV{'SERVER_NAME'} ne 'nikolas.50free.net')
> ? DBI->connect('DBI:mysql:nikos_db', 'root', '')
? DBI->connect('DBI:mysql', 'root', '')
> : DBI->connect('DBI:mysql:nikos_db:50free.net', 'nikos_db', '*****')
: DBI->connect('DBI:mysql::50free.net', 'nikos_db', '*****')
> or print font({-size=>5, -color=>'Lime'}, $DBI::errstr) and exit 0;
>
> $db->do( "drop database if exists nikos_db" );
> $db->do( "create database nikos_db" );
> $db->do( "use nikos_db" );
>
> If the database alrady exists no problem but if it want to be creates at
> the time then the first db gives an error when i run make.pl and i must
> then manually create it through mysql statemets in console.
If you read the error it gives, then it should have been obvious what the
problem was. You can't connect to the server and specify a non-existant
database as your default. Connect the server without specifying any default
database, (re)create the database you want, then switch into it.
Xho
--
-------------------- http://NewsReader.Com/ --------------------
Usenet Newsgroup Service $9.95/Month 30GB
------------------------------
Date: 15 Apr 2005 11:08:03 -0700
From: guice666@gmail.com
Subject: Finding CPU stats on Win?
Message-Id: <1113586785.387235.172060@l41g2000cwc.googlegroups.com>
I need to used perl to gather CPU counts and stats of each processor
(speed, RAM cache, Hyperthreaded, etc).
Anybody know of a way, or a script, to gather this information? ASPN
was of little help. Currently running ASPerl 5.8.3 on Win2k Systems.
Philip
------------------------------
Date: Fri, 15 Apr 2005 20:41:22 +0200
From: Christian Winter <thepoet_nospam@arcor.de>
Subject: Re: Finding CPU stats on Win?
Message-Id: <42600abf$0$7518$9b4e6d93@newsread2.arcor-online.net>
guice666@gmail.com wrote:
> I need to used perl to gather CPU counts and stats of each processor
> (speed, RAM cache, Hyperthreaded, etc).
>
> Anybody know of a way, or a script, to gather this information? ASPN
> was of little help. Currently running ASPerl 5.8.3 on Win2k Systems.
This can be accomplished with the use of Win32::OLE and
WMI. I've put together a few lines that give a simple
example:
-------------------------------------------------------
#!C:/perl/bin/perl
use strict;
use warnings;
use Win32::OLE qw(in);
my $wmi = Win32::OLE->GetObject(
'winmgmts:{'.
'impersonationLevel=impersonate'.
',(security)'.
'}//'.
$ENV{COMPUTERNAME}.
'\\root\\cimv2' );
my $procs = $wmi->ExecQuery('SELECT * FROM Win32_Processor');
foreach my $processor ( in($procs) ) {
print "Processor ID ".$processor->{DeviceId}.": $/";
print "Manufacturer: ".$processor->{Manufacturer}.$/;
print "Model Name: ".$processor->{Name}.$/;
print "Processor Speed is ".$processor->{MaxClockSpeed}." MHz$/";
print "Level 2 Cache size is ".$processor->{L2CacheSize}." KB$/";
}
__END__
-------------------------------------------------------
(only tested under XP)
Which hardware classes to query and which attributes they
carry can be looked up on the Microsoft Developer Network
homepage at
[Attention: line break]
http://msdn.microsoft.com/library/default.asp?url=/library/
en-us/wmisdk/wmi/win32_processor.asp
HTH
-Chris
------------------------------
Date: 15 Apr 2005 13:02:50 -0700
From: "guice666" <guice666@gmail.com>
Subject: Re: Finding CPU stats on Win?
Message-Id: <1113595370.376094.259980@f14g2000cwb.googlegroups.com>
Nice, now I just gotta find out if there's a way to read if a CPU has
Hyperthreading enabled or not (or if it's possible).
I searched for Hyperthread on the MS Library site and came back with
zero results. Know where I might need to look to find this out?
------------------------------
Date: 15 Apr 2005 12:31:03 -0700
From: sales@Downloads4Dialups.com
Subject: Help with downloading large files
Message-Id: <1113593463.285941.39590@g14g2000cwa.googlegroups.com>
If you are having difficulty downloading large files, please check out
www.Downloads4Dialups.com. Mention this newsgroup in the "Special
Instructions" window on the Shipping Form, and receive a 20% discount.
Help with downloading large files
------------------------------
Date: Fri, 15 Apr 2005 15:29:15 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: Help with downloading large files
Message-Id: <slrnd6090r.d17.tadmc@magna.augustmail.com>
sales@Downloads4Dialups.com <sales@Downloads4Dialups.com> wrote:
> If you are having difficulty downloading large files, please check out
I strongly urge all readers of this message to think long
and hard before doing business with a spammer.
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Fri, 15 Apr 2005 20:59:25 +0200
From: Christian Winter <thepoet_nospam@arcor.de>
Subject: Re: Net::FTP problem
Message-Id: <42600efc$0$7511$9b4e6d93@newsread2.arcor-online.net>
soup_or_power@yahoo.com wrote:
> The following code is generating the error: can't connect (in the code
> below) I'm guessing the FTP is sending the username and hostname
> separated by @ instead of sending just the host name followed by user
> name and password and commands.
Net::FTP will never send user:pass@host, because this is
just a way some clients allow the data to be entered.
However, your code doesn't even reach the login line.
> It worked fine for some time but now
> quit on me. Thanks for any of your help.
So something must have been changed. Did you alter your
script in some other parts? If no, has the server been
altered (ip changed, ftp daemon stopped)? Has someone
changed the firewall you are behind (if there is one)?
Does your
> sub get_ftp_handle {
> my($self, $ftp_host, $ftp_user, $ftp_pwd)=@_;
>
> my $ftp_site = $ftp_host || "storm";
> my $ftp_pass = $ftp_pwd || "pqww2o4";
> $ftp_user ||= "qauser";
>
> my $ftp = Net::FTP->new($ftp_site) || do {
> warn "$ftp_user\@$ftp_site: can't connect\n";
> return -1;
> };
From the perldoc of Net::FTP's constructor:
------------------------------------------------------------
If the constructor fails undef will be returned and an error
message will be in $@.
------------------------------------------------------------
So make the code above
my $ftp = Net::FTP->new($ftp_site) or do {
warn "Unable to connect to $ftp_site. Error is: $@\n";
return -1;
};
to find out why the connection failed.
HTH
-Chris
------------------------------
Date: Fri, 15 Apr 2005 14:01:09 -0500
From: axel@white-eagle.invalid.uk
Subject: Re: Net::FTP problem
Message-Id: <kM2dnRn7JoLokv3fRVn-2A@adelphia.com>
soup_or_power@yahoo.com wrote:
> The following code is generating the error: can't connect (in the code
> below) I'm guessing the FTP is sending the username and hostname
> separated by @ instead of sending just the host name followed by user
No. The error message is misleading. The routine attempts to make a
connexion to the $ftp_host. This fails.
> name and password and commands. It worked fine for some time but now
> quit on me. Thanks for any of your help.
This is a major clue that this function is not at fault but that
something external has changed.
Perhaps the values that are being handed to the function mean that
$ftp_host receives a invalid value which in turn sets $host_site to be
invalid.
Or maybe there have been system or network changes so that the host
is no longer reachable either through the network or by whatever name is
being used - perhaps someone removed "storm" from the /etc/aliases file
- just a wild guess.
The best thing is to try a direct FTP session from the command line to
the host and see if a connexion can be made.
> sub get_ftp_handle {
> my($self, $ftp_host, $ftp_user, $ftp_pwd)=@_;
>
> my $ftp_site = $ftp_host || "storm";
> my $ftp_pass = $ftp_pwd || "pqww2o4";
> $ftp_user ||= "qauser";
>
> my $ftp = Net::FTP->new($ftp_site) || do {
> warn "$ftp_user\@$ftp_site: can't connect\n";
Should be:
warn "$ftp_site: can't connect\n";
> return -1;
> };
> $ftp->login($ftp_user, $ftp_pass) || warn "$ftp_user\@$ftp_site:
> can't login\n";
> $ftp->binary();
> return $ftp || die("cannot open ftp connection");
> }
Axel
------------------------------
Date: 15 Apr 2005 14:33:23 -0700
From: soup_or_power@yahoo.com
Subject: Re: Net::FTP problem
Message-Id: <1113600803.200092.280920@l41g2000cwc.googlegroups.com>
Thanks for trying to help me out. The $@ is empty. The connection is
successful but the login is reporting an error. There is no problem
with manually trying to connect to the host. The fact is this code
worked perfectly fine for some time. And it is broke all of a sudden.
Our system administrators are unable to help me because they don't
know perl.
------------------------------
Date: 15 Apr 2005 14:59:25 -0700
From: soup_or_power@yahoo.com
Subject: Re: Net::FTP problem
Message-Id: <1113602365.837586.208020@z14g2000cwz.googlegroups.com>
The problem got resolved by resetting the passwords. Thanks for your
help!
------------------------------
Date: Fri, 15 Apr 2005 13:13:49 -0500
From: axel@white-eagle.invalid.uk
Subject: Re: PDF and Word to screen
Message-Id: <OOWdnTG2vtnAmf3fRVn-iA@adelphia.com>
rob_1029384756@hotmail.co.uk wrote:
> I'm having a few difficulties with perl. I have a database (mysql)
> full of files, in particular medium blobs all of which are word
> documents (for 1 type) and pdf's (for another type). I can download
> these quite happily (all works / no corruption).
> However, what I would really like to do is load a page with some text,
> the infomation on the word document, and the info on the pdf.
> Is this possible? I have been searching, but am finding nothing except
> a little about creating pdf/docs. If so, it would be a great help if
> someone could point me in the right direction or link me to any
> documentation.
You might find the following of use:
xpdf http://www.foolabs.com/xpdf/
pdftohtml http://pdftohtml.sourceforge.net/
Axel
------------------------------
Date: 15 Apr 2005 13:32:35 -0700
From: "si" <smcbutler@hotmail.com>
Subject: regex help
Message-Id: <1113597155.750215.94370@f14g2000cwb.googlegroups.com>
hi all, i had a regex question for the group:
i'm trying to do parse a string 'a = 3 b = 4 c = 5 d = 6'
and would like to extract an array of pairs of values
ie: myArray(a) = 3
myArray(b) = 4
myArray(c) = 5 etc
one complication is that i don't know how many pairs of values will be
in the original string
any idea of how I can do this with regex?
------------------------------
Date: Fri, 15 Apr 2005 14:45:50 -0600
From: Scott Bryce <sbryce@scottbryce.com>
Subject: Re: regex help
Message-Id: <nsGdncs7UZtjuv3fRVn-qw@comcast.com>
si wrote:
> hi all, i had a regex question for the group:
>
> i'm trying to do parse a string 'a = 3 b = 4 c = 5 d = 6'
>
> and would like to extract an array of pairs of values
>
>
> ie: myArray(a) = 3
> myArray(b) = 4
> myArray(c) = 5 etc
>
> one complication is that i don't know how many pairs of values will be
> in the original string
>
> any idea of how I can do this with regex?
Do you HAVE to use a regex?
use strict;
use warnings;
my $string = 'a = 3 b = 4 c = 5 d = 6';
$string =~ s/=//g;
my %hash = split / */, $string;
foreach my $key (keys %hash)
{
print "$key = $hash{$key}\n";
}
------------------------------
Date: Fri, 15 Apr 2005 22:44:13 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: regex help
Message-Id: <3cangrF6oua18U1@individual.net>
si wrote:
> hi all, i had a regex question for the group:
>
> i'm trying to do parse a string 'a = 3 b = 4 c = 5 d = 6'
>
> and would like to extract an array of pairs of values
In Perl such an associative array is called a hash.
> ie: myArray(a) = 3
> myArray(b) = 4
> myArray(c) = 5 etc
>
> one complication is that i don't know how many pairs of values will be
> in the original string
One approach:
my %myHash;
while ( $string =~ /(\w+)\s*=\s*(\w+)/g ) {
$myHash{$1} = $2;
}
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Fri, 15 Apr 2005 22:52:14 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: regex help
Message-Id: <3canvtF6ns0tqU1@individual.net>
Scott Bryce wrote:
> si wrote:
>> any idea of how I can do this with regex?
>
> Do you HAVE to use a regex?
<snip>
> $string =~ s/=//g;
--------------^^^
> my %hash = split / */, $string;
-------------------^^^^
You just used two regular expressions. ;-)
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: 15 Apr 2005 21:06:49 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: regex help
Message-Id: <d3pad9$iav$2@mamenchi.zrz.TU-Berlin.DE>
si <smcbutler@hotmail.com> wrote in comp.lang.perl.misc:
>
> hi all, i had a regex question for the group:
>
> i'm trying to do parse a string 'a = 3 b = 4 c = 5 d = 6'
[...]
> any idea of how I can do this with regex?
my $str = 'a = 3 b = 4 c = 5 d = 6';
my %hash = $str =~ /(\w+)\s*=\s*(\d+)/g;
Anno
------------------------------
Date: Fri, 15 Apr 2005 16:33:04 -0500
From: axel@white-eagle.invalid.uk
Subject: Re: regex help
Message-Id: <SYKdnTIvdqeNrv3fRVn-rg@adelphia.com>
Scott Bryce <sbryce@scottbryce.com> wrote:
> my $string = 'a = 3 b = 4 c = 5 d = 6';
> $string =~ s/=//g;
>
> my %hash = split / */, $string;
This would not work as expected if a value such as 'e = 23' appeared.
my %hash = split / +/, $string;
might be better.
Axel
------------------------------
Date: 15 Apr 2005 14:54:30 -0700
From: ioneabu@yahoo.com
Subject: Re: regex help
Message-Id: <1113602070.178251.57960@g14g2000cwa.googlegroups.com>
Anno Siegel wrote:
> si <smcbutler@hotmail.com> wrote in comp.lang.perl.misc:
> >
> > hi all, i had a regex question for the group:
> >
> > i'm trying to do parse a string 'a = 3 b = 4 c = 5 d = 6'
>
> [...]
>
> > any idea of how I can do this with regex?
>
> my $str = 'a = 3 b = 4 c = 5 d = 6';
> my %hash = $str =~ /(\w+)\s*=\s*(\d+)/g;
>
> Anno
not as good but different:
#!/usr/bin/perl
use strict;
use warnings;
my $str = 'a = 3 b = 4 c = 5 d = 6';
$str =~ s/[^a-z0-9]+/ /g;
my %hash = split / /, $str;
print "$_ = $hash{$_}\n" for keys %hash;
wana
------------------------------
Date: Fri, 15 Apr 2005 14:24:02 -0500
From: George Glynn <gglynn@nickelkid.com>
Subject: SIGPIPE delay on open2 exec failure
Message-Id: <37udnTu-b-hPif3fRVn-qw@netlabs.net>
Perl 5.8.5 on Fedora Core 3...
Can anyone tell me why my SIGPIPE handler doesn't run until I hit the enter
key when running this program from a TTY?
1: #!/usr/bin/perl
2:
3: use FileHandle;
4: use IPC::Open2;
5:
6: sub pipeHandler {
7: die("I piped");
8: }
9:
10: $SIG{PIPE} = \&pipeHandler;
11:
12: $pid = open2( \*FROMPROC, \*TOPROC, "/path/to/nonexistent/program");
13: TOPROC->autoflush();
14:
15: print TOPROC "Garbage in...";
16: print <FROMPROC>;
17:
18: while(<STDIN>) {
19: print TOPROC $_;
20: print <FROMPROC>;
21: }
I get the error message:
open2: exec of /path/to/nonexistent/program failed at foowrap line 12
right away, but the program sits waiting until I hit the enter key, then
dies and prints on STDERR:
I piped at script_name line 7, <STDIN> line 1.
Why didn't it hit the SIGPIPE handler trying to write to TOPROC on line 15?
I've also tried trapping __DIE__ with the following handler:
a: sub dieHandler {
b: die("I died");
c: }
This handler runs right away, and the message:
I died at script_name line b.
prints instead of the "open2: exec ... failed ..." message, as one would
expect, but then it still sits there waiting for me to hit enter again, at
which point it prints:
I died at script_name line b, <STDIN> line 1.
I'm sure I'm just missing the subtleties of IPC, so can anyone clue me in as
to what's happening here?
In case you're wondering, I ultimately want to have the program die right
away if the exec in the open2() program fails.
------------------------------
Date: Fri, 15 Apr 2005 10:55:15 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: trouble with very simple regexp
Message-Id: <slrnd5vov3.ck1.tadmc@magna.augustmail.com>
BerkHolz, Steven <spamtrap@Astrumtech.com> wrote:
> I will try the joe[_-]?blow or joe(_|-)?blow.
> Is one more efficient than the other
perldoc Benchmark
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Fri, 15 Apr 2005 11:04:33 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: What is going on?
Message-Id: <slrnd5vpgh.ck1.tadmc@magna.augustmail.com>
giraffe6044@gmail.com <giraffe6044@gmail.com> wrote:
> Subject: What is going on?
You will greatly increase the chances of getting your question
answered if you put the subject of your article in the Subject
of your article.
> I was given this perl script as a example of a program to control our
> remote powerdevices. Problem is i do not know Perl.
You could learn Perl or you could hire someone who knows Perl or
you could ask whoever provided you with that code.
> Can someone help explain to me what this script is doing to get the
> STATUS of the RPS.
What is an "RPS" ?
> is it a form post?
It makes an HTTP GET request.
> or is it requesting a URL
Even POST requests a URL.
I think you don't understand HTTP, perhaps you should read up
on it a bit.
> use LWP::UserAgent;
Did you try reading the documentation for the module being used?
> $response = $ua->get($base.$_);
^^^
^^^
Clearly a GET request.
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Fri, 15 Apr 2005 13:56:14 -0700
From: Jim Gibson <jgibson@mail.arc.nasa.gov>
Subject: Re: What is going on?
Message-Id: <150420051356149310%jgibson@mail.arc.nasa.gov>
In article <1113575996.933420.146800@l41g2000cwc.googlegroups.com>,
<giraffe6044@gmail.com> wrote:
> I was given this perl script as a example of a program to control our
> remote powerdevices. Problem is i do not know Perl. I am creating the
> site in Coldfusion
> Can someone help explain to me what this script is doing to get the
> STATUS of the RPS.
I will explain some of the easy stuff. I have not used the
LWP::UserAgent module, however.
>
> is it a form post? or is it requesting a URL and if so what URL.
It is requesting a URL. The device in question (a Digital Loggers
Ethernet Power Controller) contains a built-in web server for
management.
>
> here is the device.
> http://www.digital-loggers.com/EPC.html
>
> Thank you very much for any help
>
> #!/usr/bin/perl -w
Use the Perl interpreter located at /usr/bin/perl and turn on warnings
(you could instead put a 'use warnings;' line right after this line).
> #----------------------------------------------------------------------
> use LWP::UserAgent;
Load in the LWP::UserAgent module. For more information on this module,
type 'perldoc LWP::UserAgent' on a command line on the system on which
the Perl program is installed. LWP::UserAgent is a module that emulates
the functions of a web browser, allowing one to automate actions that
would otherwise need to be done manually via a web browser.
> #----------------------------------------------------------------------
> $ua = LWP::UserAgent->new();
Create a user agent object and store the reference to this object in
the variable $ua;
> #----------------------------------------------------------------------
>
> if ($#ARGV <= 1)
Command-line options to the program are stored in the array @ARGV, and
$#ARGV is the array index of the last variable entered. Therefore, if
$#ARGV is <= 1, there are zero, one, or two arguments and the program
will exit. It wants at least three arguments.
> {
> print STDERR 'Usage: UserUtil <Host>[:port] <login:password>
> <[n]{on|off|pulse|status}> ...'."\n";
> exit -1;
Print Usage message and exit if less than 3 command-line arguments.
> }
> ($epc, $auth)=splice(@ARGV,0,2);
splice removes 2 elements starting at the zero'th (first) position of
the @ARGV array and puts them in the $epc and $auth variables.
> $base='http://'.$auth.'@'.$epc.'/';
$base contains the string 'http://' concatenated with the contents of
the $auth variable plus an '@' sign character plus the contents of the
$epc variable plus a '/' character.
>
> foreach (@ARGV)
> {
Iterate over the remaining contents of the @ARGV array, which should
contains things like 'on', 'off', 'pulse', 'status' strings. Put the
actual string in the $_ variable (Perl can use funny variable names
like $_; it is just another scalar variable, but with special uses).
> $_=lc;
Convert the contents of $_ to lower case.
> s/(^[^1-8])/a$1/;
Add an 'a' character to the front of the string in the $_ variable
unless it starts with one of the characters 1-8.
> if (/^([1-8a])on$/)
> {
> RelLink('outleton?'.$1);
If the $_ variable now contains one the characters 1-8 or a followed by
'on', call the RelLink subroutine (defined at the end of the program)
with the arguments 'outleton?' and the first character of $_ (1-8 or a,
now stord in the special $1 variable).
> }
> elsif (/^([1-8a])off$/)
> {
> RelLink('outletoff?'.$1);
If the $_ variable contains 1-8 or a followed by 'off', call RelLink
with 'outletoff?' and first character of $_.
> }
> elsif (/^([1-8a])pulse$/)
> {
> RelLink('outletgl?'.$1);
Likewise for 'pulse'.
> }
> elsif (/^([1-8a])status$/)
> {
If @ARGV element contains 'status', then
> $n=$1;
Put first character of $_ into $n.
> defined($response) && ($response->content =~/<a href=outleto/) ||
> RelLink('');
If a previous call to RelLink resulted in the variable $response being
defined, and the content of that response contains the substring '<a
href=outleto', call RelLink with an empty string argument ('');
> $content=$response->content;
Save the return value of the $response->content subroutine.
> while ($content =~ /<a href=outlet(on|off)\?([1-8])>/ig)
Iterate over each substring '<a href=outleton?n>' and
'<a href=outletoff?n>' substring, ignoring case, where n is a digit
from 1 to 8, and extract the 'on' or 'off' substring and digit for each
match into the $1 and $2 variables, respectively.
> {
> if (($2 eq $n) || ($n eq 'a'))
If the contents of $2 are equal to the contents of $n, or if $n
contains 'a', continue. Otherwise, skip the next 9 lines down to the
second following 'else' line and terminate the program.
> {
> if ($1 eq "on")
> {print $2," OFF\n";}
> else
> {print $2," ON\n";}
> }
> }
> }
> else
> {
> die "Unknown command $_\n";
Terminate the program printing "Unknown command ", the contents of the
$_ variable, and a newline.
> }
> }
>
> sub RelLink
Define the RelLink subroutine.
> {
> local ($_) = @_;
Create a new, local value for the $_ variable and store within it the
argument passed to the subroutine.
> #print STDERR $base.$_,"\n";
Do nothing, as this line has been commented out.
> $response = $ua->get($base.$_);
Send an HTTP request to the URL stored in the $base variable (a
program-global variable and hence accessible to this subroutine) and
save the response in the global $response variable.
> $response->is_error() && die $response->status_line;
If the response indicated an error, terminate the program after
printing the return value of the status_line subroutine.
> }
>
The exact information presented by this program depends upon the
protocol used by the device. It looks like you are mostly getting a
series of '1 ON' or '2 OFF' lines for 1-8 things.
Hope this helps.
----== Posted via Newsfeeds.Com - Unlimited-Uncensored-Secure Usenet News==----
http://www.newsfeeds.com The #1 Newsgroup Service in the World! >100,000 Newsgroups
---= East/West-Coast Server Farms - Total Privacy via Encryption =---
------------------------------
Date: Fri, 15 Apr 2005 20:30:17 +0200
From: Fabian Pilkowski <pilkowsk@informatik.uni-marburg.de>
Subject: Re: while loop into database insert not working
Message-Id: <3caffgF5bh00fU1@individual.net>
* David K. Wall schrieb:
> Unknown <perlguru2b@bobotheclown.org> wrote:
>>
>> my $filedir = '/var/backuplogs';
[...]
>> my $inuse;
>
> Most of these variables are only used inside the foreach loop, so
> it's best to declare them at the top of the loop, confining their
> scope to ONLY the foreach loop. That way you don't have to worry
> about re-initializing them at the end of the loop. (Maybe this is
> the problem?)
Additionally, I propose to use a hash for this. Then you have not to
declare all those vars and you can simplify the sql statement below.
>
>> opendir(DIR, $filedir) or die "could not open logfile directory: $!";
>> my @filestoparse = grep { /\.txt$/ } readdir(DIR);
>> closedir(DIR);
>> foreach my $filename (@filestoparse) {
>> my $complete = "$filedir/" . "$filename";
>
> Why not just say
>
> foreach my $logname (@filestoparse) {
> my $complete = "$filedir/$logname";
You can do all of this in one step by using glob(). But then you lose
the var $logname also. If necessary, determine it afterwards, e.g.
foreach my $complete ( glob "$filedir/*.txt" ) {
my $hash;
( $hash{logfile} ) = $complete =~ m#([^/]+)$#;
>
>> while (<FH>) {
>> if ($_ =~ /^Job\sserver:\s+(.*)$/) { $servername = $1;}
>
> You can shorten this. Pattern matches automatically look at $_
> if you don't specify a string.
>
> if ( /^Job\sserver:\s+(.*)$/ ) { $servername = $1;}
>
>> if ($_ =~ /^Job\sname:\s+(.*)$/) { $jobname = $1;}
>> if ($_ =~ /^Job\sstarted:\s+(.*)$/) { $jobstarted = $1;}
>> if ($_ =~ /^Media.*Label:\s+(.*)$/) { $medialabel = $1;}
>> if ($_ =~ /^Job\sended:\s+(.*)$/) { $jobended = $1;}
>> if ($_ =~ /^Job\scompletion\sstatus:\s+(.*)$/) { $status = $1;}
>> if ($_ =~ /^(\d+)\s+files\swere\sin.*$/) {push(@inuse, $1);}
>
> Later on you just add up the numbers collected in @inuse, so why not
> eliminate the array and add them up as you go?
>
> if ( /^(\d+)\s+files\swere\sin.*$/) { $inuse += $1 }
>
>> if ($_ =~ /^(\d+)\s+items/) {push(@skipped, $1);}
>> if ($_ =~ /^(\d+)\s+corrupt/) {push(@corrupt, $1);}
Here, I prefer to put the condition behind the assignment: This saves
many parentheses and provides more readability.
$hash{servername} = $1 if /^Job\sserver:\s+(.*)$/;
$hash{jobname} = $1 if /^Job\sname:\s+(.*)$/;
$hash{jobstarted} = $1 if /^Job\sstarted:\s+(.*)$/;
$hash{medialabel} = $1 if /^Media.*Label:\s+(.*)$/;
$hash{jobended} = $1 if /^Job\sended:\s+(.*)$/;
$hash{status} = $1 if /^Job\scompletion\sstatus:\s+(.*)$/;
$hash{inuse} += $1 if /^(\d+)\s+files\swere\sin.*$/;
$hash{skipped} += $1 if /^(\d+)\s+items/;
$hash{corrupt} += $1 if /^(\d+)\s+corrupt/;
>> }
>
>> my $sth = $dbh->prepare("INSERT INTO
>> backuplogs(jobname,jobstarted,logfile,servername,status,inuse,jobended,skipped,corrupt,medialabel,testlogfile)
>> VALUES
>> ('$jobname','$jobstarted','$logfile','$servername','$status','$inuse','$jobended','$skipped','$corrupt','$medialabel','<a
>> href=http://[snip]/oldlogs/$logfile>$logfile</a>')")
>> or die "Error preparing row: $DBI::errstr\n"; $sth->execute() or die "$DBI::errstr\n";
Since all needed values are gathered in the new hash ('testlogfile'
could be added separately), we could build up this statement a little
bit easier, I think.
my $keys = join ',', keys %hash;
my $bind = join ',', ('?') x keys %hash;
my $sth = $dbh->prepare( "INSERT INTO backuplogs ($keys) VALUES ($bind)" )
or die "Error preparing row: $DBI::errstr\n";
$sth->execute( values %hash ) or die "$DBI::errstr\n";
This will work because keys() and values() return their lists for one
hash in the same order. And using binding vars in the statement (»?«)
will be less fragile than that *ugly* self-made-quoting.
>
>> $servername = "";
>> $jobname = "";
>> $jobstarted = "";
>> $medialabel = "";
>> $jobended = "";
>> $status = "";
>
> These re-initializations can be dropped when you confine the variables
> to the smallest possible scope (as mentioned above).
But the arrays @inuse, @skipped and @corrupt keep their values, there is
no reset for them. As a result, the sums $inuse etc contain the sum of
all numbers ever found. If this is really wanted? I don't know. But due
to using a hash, we could delete some vars explicitly. Perhaps by
my @keys = qw( servername jobname jobstarted medialabel jobended status );
@hash{ @keys } = ('') x @keys;
Otherwise its easier to declare the hash inside of the for loop.
>
> This sub becomes unnecessary if you accumulate the sum as you go. But
> even so, it could be shorter (but not *too* short, I hope).
>
> sub addnums {
> return 0 unless @_;
You can throw away this line as well if you want to shorten this sub. If
@_ is *false* the loop below won't entered, so $totel remains at zero.
And returning zero is nothing else you're doing here ;-)
> my $total = 0;
> local $_; # don't step on $_
> $total += $_ for @_;
> return $total;
> }
We do not need this sub, but don't "don't step on $_" here. A for loop
is localizing $_ implicitly. Try out:
$_ = 'sum = ';
my $total = 0;
$total += $_ for 1, 2, 3;
print $_, $total;
__END__
sum = 6
regards,
fabian
Postscript: Finally, I want to summarize the code -- just for clarity.
#!/usr/bin/perl
use warnings;
use strict;
use DBI;
use DBD::Pg;
my $filedir = '/var/backuplogs';
my %hash = ();
my $dbh = DBI->connect( "dbi:Pg:dbname=backup", "[snip]", "[snip]")
or die "Cannot connect to PGSQL DB\n";
foreach my $file ( glob "$filedir/*.txt" ) {
# read in the file
open FH, '<', $file or die "Cannot open file '$file': $!";
while ( <FH> ) {
$hash{servername} = $1 if /^Job\sserver:\s+(.*)$/;
$hash{jobname} = $1 if /^Job\sname:\s+(.*)$/;
$hash{jobstarted} = $1 if /^Job\sstarted:\s+(.*)$/;
$hash{medialabel} = $1 if /^Media.*Label:\s+(.*)$/;
$hash{jobended} = $1 if /^Job\sended:\s+(.*)$/;
$hash{status} = $1 if /^Job\scompletion\sstatus:\s+(.*)$/;
$hash{inuse} += $1 if /^(\d+)\s+files\swere\sin.*$/;
$hash{skipped} += $1 if /^(\d+)\s+items/;
$hash{corrupt} += $1 if /^(\d+)\s+corrupt/;
}
close FH;
( $hash{logfile} ) = $file =~ m#([^/]+)$#;
$hash{testlogfile} = "<a href=http://[snip]/oldlogs/$hash{logfile}>$hash{logfile}</a>";
# send it to db
my $keys = join ',', keys %hash;
my $bind = join ',', ('?') x keys %hash;
my $sth = $dbh->prepare( "INSERT INTO backuplogs ($keys) VALUES ($bind)" )
or die "Error preparing row: $DBI::errstr\n";
$sth->execute( values %hash ) or die "$DBI::errstr\n";
# reset some values
my @keys = qw( servername jobname jobstarted medialabel jobended status );
@hash{ @keys } = ('') x @keys;
}
$dbh->disconnect;
__END__
------------------------------
Date: Fri, 15 Apr 2005 19:49:33 -0000
From: "David K. Wall" <darkon.tdo@gmail.com>
Subject: Re: while loop into database insert not working
Message-Id: <Xns9639A0FD438AFdkwwashere@216.168.3.30>
nobull@mail.com <nobull@mail.com> wrote:
> David K. Wall wrote:
>
>> my $total = 0;
>> local $_; # don't step on $_
>
> The for statement qualifier will localize $_ properly anyhow.
>
> local($_) on the other hand, will do bad things if $_ happens to
> be an alias for an element of a tied agregate.
I don't often have a need for tied variables in the little utility
programs I mostly write, so I don't really see the problem. Could you
elaborate on this?
------------------------------
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 7980
***************************************
