thanks a lot for your help. here is my reply though: $ua->redirect(1); causes a run time error. cookies are not being used by the server. -------------------------------------------- key script components: executive and driver -----------------------------------------------------------
# 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

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.