Re: What is going on?
- From: Jim Gibson <jgibson@xxxxxxxxxxxxxxxxx>
- Date: Fri, 15 Apr 2005 13:56:14 -0700
In article <1113575996.933420.146800@xxxxxxxxxxxxxxxxxxxxxxxxxxxx>,
<giraffe6044@xxxxxxxxx> 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 =---
.
- References:
- What is going on?
- From: giraffe6044
- What is going on?
- Prev by Date: Re: regex help
- Next by Date: Re: Creating o non-existing database
- Previous by thread: Re: What is going on?
- Next by thread: FAQ 1.9 How does Perl compare with other languages like Java, Python, REXX, Scheme, or Tcl?
- Index(es):
Relevant Pages
|
