# create object my $cayman = default_web->new ('NETLOC' => '192.168.1.254', 'PORT' => '80', 'REALM' => 'Cayman-3000', 'UNAME' => 'admin', 'PASSWD' => 'cayman', 'DEBUG' => '1', ); print "get status page\n"; $cayman->web_get('URL' => "UE/StatTool/show+ip+interfaces"); sleep 3; # grab redirect? $cayman->web_get('URL' => "StatTool"); ----------------------------- package default_web; use LWP qw (:Debug :UserAgent :HTTP); my $DEBUG = 0; # debug flag # constructor sub new { my($type) = shift; my(%params) = @_; my($self) = {}; # populate self with params # need some future error checking here and return failure if not de +fined $self->{"NETLOC"} = $params{"NETLOC"}; # ip address $self->{"PORT"} = $params{"PORT"}; # port number $self->{"REALM"} = $params{"REALM"}; # Cayman-3000 $self->{"UNAME"} = $params{"UNAME"}; # user name $self->{"PASSWD"} = $params{"PASSWD"}; # password $DEBUG = $params{"DEBUG"}; # Create the user agent object $self{'USR_AGENT'} = LWP::UserAgent->new(); # set authentication credentials my $netloc = $self->{"NETLOC"} . ":" . $self->{"PORT"}; # MUST INCL +UDE PORT my $realm = $self->{"REALM"}; my $uname = $self->{"UNAME"}; my $passwd = $self->{"PASSWD"}; $self{'USR_AGENT'}->credentials( $netloc, $realm, $uname, $passwd); # allow redirection # push @{ $self{'USR_AGENT'}->requests_redirectable}, 'POST'; # set user agent string $self{'USR_AGENT'}->agent('robot'); # create and return object bless $self, $type; return $self; } sub web_post { my $self = shift; my(%params) = @_; $param{'URL'} = $params{'URL'}; $param{'COMMAND'} = $params{'COMMAND'}; # Set up a request. We will use the same request object for all U +RLs. # HTTP is part of LWP my $IP = $self->{"NETLOC"}; my $port = $self->{"PORT"}; my $url = $param{'URL'}; my $post = "http://$IP\:$port/$url"; print "DEBUG: post: $post\n" if ($DEBUG); my $request = HTTP::Request->new(POST => $post); $request->content_type('application/x-www-form-urlencoded'); my $command = $param{'COMMAND'}; print "DEBUG: command: $command\n" if ($DEBUG); $request->content($command); # Send the request and get a response back from the server $response = $self{'USR_AGENT'}->request($request); my $output = $response->as_string; print "DEBUG: output: $output\n" if ($DEBUG); return $output; } sub web_get { my $self = shift; my(%params) = @_; my $url = $params{'URL'}; my $IP = $self->{"NETLOC"}; my $port = $self->{"PORT"}; my $get = "http://$IP\:$port/$url"; print "DEBUG: get: $get\n" if ($DEBUG); # Set up a request. We will use the same request object for all U +RLs. $request = HTTP::Request->new(GET => $get); # Send the request and get a response back from the server $self{'USR_AGENT'}->redirect_ok($request); $response = $self{'USR_AGENT'}->request($request); if ($response->is_success) { print "DEBUG: get success\n" } else { print "DEBUG: get failure\n"; } ($response->is_redirect()? print "is redirect!\n" : print "not red +irect\n"); my $output = $response->as_string; print $output if ($DEBUG); return $output; } sub web_clear { my $self = shift; web_get($self, 'URL' => "UE/ClearOptions"); } return 1; ================================== output looks like this: ================================== get status page DEBUG: get: http://192.168.1.254:80/UE/StatTool/show+ip+interfaces DEBUG: get failure is redirect! HTTP/1.1 303 See Other Location: http://192.168.1.254:80/StatTool Server: Allegro-Software-RomPager/4.03 Content-Length: 0 Client-Date: Thu, 19 Jun 2003 16:43:43 GMT Client-Peer: 192.168.1.254:80 Client-Response-Num: 1 DEBUG: get: http://192.168.1.254:80/StatTool DEBUG: get success not redirect HTTP/1.1 200 OK Date: Wed, 26 Dec 2001 00:07:08 GMT Pragma: no-cache Server: Allegro-Software-RomPager/4.03 Content-Type: text/html Expires: Thu, 26 Oct 1995 00:00:00 GMT Last-Modified: Wed, 26 Dec 2001 00:07:08 GMT Client-Date: Thu, 19 Jun 2003 16:43:46 GMT Client-Peer: 192.168.1.254:80 Client-Response-Num: 1 Refresh: 0; URL=http://192.168.1.254/SmartDevice
In reply to Re: Re: libwww and grab redirect
by jweden
in thread libwww and grab redirect
by jweden
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |