Problems with Perl and LWP

Questions about programming languages and debugging
Post Reply
User avatar
GODhack
On the way to fame!
On the way to fame!
Posts: 36
Joined: 15 Aug 2005, 16:00
18

Problems with Perl and LWP

Post by GODhack »

I am writing little web program with Perl and LWP(this is my first program with LWP (not LWP::Simple and not Socket). It works now, but there is still a lot of work to do.
My biggest problem by now is that I want to make HTTP reqest:

Code: Select all

POST .....
....
...

action=go+to+minurl
For this task I wrote this:

Code: Select all

#!c:\perl\bin

use LWP;
use HTTP::Cookies;

#lots of other tasks


my ($tur, $msg, $is) = do_POST(
'http://site.is/here',
[ 'action'=> "go+to+minurl" ],
);
print "$msg\n$is";

#lots of other tasks

sub do_POST {
  $browser = LWP::UserAgent->new( ) unless $browser;
  $browser ->default_header(Cookie=>$sausainis);
  my $resp = $browser->post(@_);
  return ($resp->content, $resp->status_line, $resp->is_success, $resp)
    if wantarray;
  return unless $resp->is_success;
  return $resp->content;
}

#other sub's
I do not paste other code here because post will be wry big then.
And everything looks god just not woks. :cry:
So I turned on netwoks snifer, and done this request to server with Opera and later with my program.
Snifer from Opera captures:
go+to+minurl
And form my program:
go%2Bto%2Bminurl
I know that %2B is just encoded +, but if it makes difference to snifer maybe webserver can not understand this too?

Any ideas or sugestions? :roll:

User avatar
bad_brain
Site Owner
Site Owner
Posts: 11636
Joined: 06 Apr 2005, 16:00
19
Location: In your eye floaters.
Contact:

Post by bad_brain »

hm, it´s been a while since I´ve worked with Perl, maybe you´ll find some useful info here:
http://www.xav.com/perl/site/lib/LWP.html

Code: Select all

# Create a request
  my $req = new HTTP::Request POST => 'http://www.perl.com/cgi-bin/BugGlimpse';
  $req->content_type('application/x-www-form-urlencoded');
  $req->content('match=www&errors=0');
your request-part seems to be not properly... :wink:

User avatar
GODhack
On the way to fame!
On the way to fame!
Posts: 36
Joined: 15 Aug 2005, 16:00
18

Post by GODhack »

My reguest part works fine with other data, problems only with that go+to+minurl. But I will try to remake request with your code.

User avatar
GODhack
On the way to fame!
On the way to fame!
Posts: 36
Joined: 15 Aug 2005, 16:00
18

Post by GODhack »

Bug fixed, now works(I just removed all "+". It looks like LWP atomaticly add +(for protocol) and if + exist it is used as data:

Code: Select all

#!c:\perl\bin 

use LWP; 
use HTTP::Cookies; 

#lots of other tasks 


my ($tur, $msg, $is) = do_POST( 
'http://site.is/here', 
[ 'action'=> "go to minurl" ], 
); 
print "$msg\n$is"; 

#lots of other tasks 

sub do_POST { 
  $browser = LWP::UserAgent->new( ) unless $browser; 
  $browser ->default_header(Cookie=>$sausainis); 
  my $resp = $browser->post(@_); 
  return ($resp->content, $resp->status_line, $resp->is_success, $resp) 
    if wantarray; 
  return unless $resp->is_success; 
  return $resp->content; 
} 

#other sub's
Jeee. :D
THX for help.

User avatar
bad_brain
Site Owner
Site Owner
Posts: 11636
Joined: 06 Apr 2005, 16:00
19
Location: In your eye floaters.
Contact:

Post by bad_brain »

w00t! :D

User avatar
GODhack
On the way to fame!
On the way to fame!
Posts: 36
Joined: 15 Aug 2005, 16:00
18

Post by GODhack »

Today i finished that program it woks OK now.
here:

Code: Select all

#!c:\perl\bin 


use LWP; 
use HTTP::Cookies; 

if (@ARGV < 2) { 
die ("outbreakgame.com serchbot by GODhack v0.9.4eng 
usage: serchbot.pl user pass 
Do not forget to enter your outbrakgame.com site Cookie ito this code
In Opera you can found it: tools advanced cookies...");
} 

$user = @ARGV[0]; 
$pass = @ARGV[1]; 


sub do_GET { 
  $browser = LWP::UserAgent->new( ) unless $browser; 
  my $some_file = 'A.lwp'; 
  $browser->cookie_jar(HTTP::Cookies->new('file' => $file, 'autosave' => 1 
  )); 
  my $resp = $browser->get(@_); 
  return ($resp->content, $resp->status_line, $resp->is_success, $resp) 
    if wantarray; 
  return unless $resp->is_success; 
  return $resp->content; 
} 

sub c_GET { 
  $browser = LWP::UserAgent->new( ) unless $browser; 
  $browser ->default_header(Cookie=>$sausainis); 
  my $resp = $browser->get(@_); 
  return ($resp->content, $resp->status_line, $resp->is_success, $resp) 
    if wantarray; 
  return unless $resp->is_success; 
  return $resp->content; 
} 

sub do_POST { 
  $browser = LWP::UserAgent->new( ) unless $browser; 
  $browser ->default_header(Cookie=>$sausainis); 
  my $resp = $browser->post(@_); 
  return ($resp->content, $resp->status_line, $resp->is_success, $resp) 
    if wantarray; 
  return unless $resp->is_success; 
  return $resp->content; 
} 

sub talk { 
$txt = <STDIN>; 
my ($tur, $msg, $is) = do_POST( 
'http://outbreakgame.com/communicate.cgi', 
[ 'text' => "$txt", 'action' => "Speak", 'channel'=> "Fire+Team" ], 
); 
print "pasakyta $txt\n statusas: $msg\n$is"; 
} 


my $sausainis = "outbreak-mercenary="; 
#anter Cookie here afer = (it looks like):  #password&xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx&mercenary&nick)!!! 

$a = do_GET("http://outbreakgame.com/"); 
if ($a) { 
print "server statusas: OK\n"; 
} else { 
die ("outbreakgame.com nepasiekiamas!"); 
} 


my ($tur, $msg, $is) = do_POST( 
'http://outbreakgame.com/login.cgi', 
[ 'mercenary' => "$user", 'password' => "$pass", 'action'=> "Login" ], 
); 
print "loginamies: $msg\n$is"; 

$data1 = c_GET("http://outbreakgame.com/game.cgi"); 
&stats; 

#&talk; 
if ($arm < 900) { 
&ieskom; 
} else { 
&battle; 
} 

sub ieskom { 
print "Saugi padetis ieskom daiktu\n"; 
do { 
my ($tur2, $msg, $is) = do_POST( 
'http://outbreakgame.com/search.cgi', 
[ 'action' => "Search" ], 
); 
print "Ieinam i paiesku skilti: $msg\n$is"; 
#print "$tur2"; 

for ($l = 1; $l < 49; $l++) { 
$z = 0; 
chop ($z) unless ($l < 10); 
print "ieskom: $z$l\n"; 
$tur = c_GET("http://outbreakgame.com/search.cgi?location=$z$l"); 
} 

my ($tur2, $msg, $is) = do_POST( 
'http://outbreakgame.com/search.cgi', 
[ 'action' => "Return to Game" ], 
); 
print "gryztam atgal: $msg\n$is"; 
#print "$tur2"; 

$data1 = c_GET("http://outbreakgame.com/game.cgi"); 
&stats; 
} while ($arm < 900); 
&battle;              #kovos sub !!!! 
} 


my ($tur, $msg, $is) = do_POST( 
'http://outbreakgame.com/logout.cgi', 
[ 'action'=> "Logout" ], 
); 
print "logout: $msg\n$is"; 

sub stats { 
@datas = split (/Health|Rocks/, $data1); 
@kitas = split (/>|</, @datas[1]); 
$dada = 0; 

#visa lentele jei reik isispauzdint 
#while ($dada <= @kitas) { 
#print "$dada, @kitas[$dada]\n"; 
#$dada++; 
#} 

$sov = @kitas[46]; 
$arm = @kitas[28]; 
$exp = @kitas[94]; 
$she = @kitas[62]; 
$arm =~ s/,//; 
$exp =~ s/,//; 
$sov =~ s/,//; 
print "Soviniu 9mm/12mm: $sov/$she, sarvu: $arm, kreditu: $exp\n"; 
} 

sub battle { 
print "!!! kovos padetis isjugngus programa reik pasislept rankiniu budu !!!\n"; 

my ($tur2, $msg, $is) = do_POST( 
'http://outbreakgame.com/engine.cgi', 
[ 'action' => "Exit" ], 
); 
print "Iseinam laukan: $msg\n$is"; 
#print "$tur2"; 

do { 

$data1 = c_GET("http://outbreakgame.com/game.cgi"); 
&mobs; 

my ($tur, $msg, $is) = do_POST( 
'http://outbreakgame.com/engine.cgi', 
[ 'target' => "$blg", 'source' => "$gun", 'action'=> "Attack" ], 
); 
print "Atakuojam $blg: $msg\n$is"; 

$data1 = c_GET("http://outbreakgame.com/game.cgi"); 
&stats; 

$blog = ""; 

$blg = 0; 

} while ($she > 10 && $sov > 10 && $arm > 500); 

my ($tur2, $msg, $is) = do_POST( 
'http://outbreakgame.com/engine.cgi', 
[ 'action' => "Enter" ], 
); 
print "Ieinam vidun: $msg\n$is\!!!kovos padetis anuliojama!!!"; 
#print "$tur2"; 

&ieskom; 
} 

sub mobs { 
@kitas2 = split (/You are standing |Someone has spray painted/, $data1); 
$data1 = @kitas2[1]; 
#print "$data1\n"; 

#giklu rinkimosi if'as. 
if ($sov > 20) { 
$gun = "Machinegun"; 
} else { 
$gun = "Pump Shotgun"; 
} 
$blg = "Ghoul" if ($data1 =~ /Ghoul/); 
$blg = "Grunt" if ($data1 =~ /Grunt/); 
$blg = "Imp" if ($data1 =~ /Imp/); 
$blg = "Gatekeeper" if ($data1 =~ /Gatekeeper/); 
}
Bot uses shotgun and machine gun by default. To change this enter line:
$gun = "gun name" before last "}".

HF ;)

Post Reply