ebaptist
Newbie
Joined: 16 Oct 2002
Posts: 7
Location: USA
|
 Posted: Fri Apr 01, 2005 11:02 pm
Perl Scripting and Zmud
|
I have a question.. There is very little documentation on getting a perlscript to work with zmud
I have installed the active perl active state and my scripting engine recognizes perl script so now im down to getting it put into zmud so maybe you guys can help
Here is the Perl Script this script contains all the routines i need to call for an aucsearch feature for my mud. it contacts a website as detailed in this script. However if i try to add this into zmud i get errors left and right. I just need to know how i would take this and impliment it into zmud. its actually made for mushclient which uses xml files with the code in them. Im trying to port it into zmud to keep users in zmud and not switching to other clients. So if you get a chance to help let me know Posted below is the actual perl script and the way the aliases/triggers are setup in mushclient (dont know how to make those zmud alias/triggers but could figure that out if i can get perl into zmud)
Aliases triggers
| Code: |
- <aliases>
<alias match="^auc search (.*?)$" enabled="y" regexp="y" sequence="95" script="startsearch" echo_alias="y" name="aucalias" />
<alias match="^auc search (.*?)$" enabled="y" regexp="y" sequence="100" script="stopsearch" echo_alias="y" name="aucaliaswhee" />
<alias match="^auc searchregister" enabled="y" regexp="y" sequence="100" script="register" echo_alias="y" name="aucsearchregister" />
</aliases>
- <triggers>
<trigger enabled="n" group="hidescore" name="getname" match="^Player Information for: (.*?) (.*?)" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" script="gotname" />
<trigger enabled="n" group="hidescore" match="^ Hours Played:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^ Class Level:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^ Race:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^ Class:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^ Hit Points:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^ Spell Points:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^ Stamina:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^ Strength:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^ Knowledge:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^ Wisdom:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^ Agility:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^ Personality:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^ Spell Complexity Comprehension:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^ Proficiency Complexity Comprehension:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^ Wea:" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
<trigger enabled="n" group="hidescore" match="^\* You" omit_from_log="y" omit_from_output="y" regexp="y" sequence="100" />
</triggers>
- <timers>
- <timer name="pausesearch" enabled="n" offset_second="1" second="31" script="enablesearch">
<send />
</timer>
- <timer name="pausescore" enabled="n" second="2" script="stophiding">
|
Perl Script
| Code: |
sub startsearch {
my ($thename, $theoutput, $wildcards) = @_;
$item = $world->getaliasinfo ($thename, 101);
$url = "/~aodojoc/auctions/iqs/aucsearch/outsource.php?name=";
$url .= $world->GetVariable ("name");
$url .= "&item=";
$url .= $item;
$host = "aodojo.com";
$world->EnableAlias("aucalias", false);
$world->EnableTimer("pausesearch", true);
$world->ResetTimer("pausesearch");
$world->SetVariable("host", $host);
$world->SetVariable("url", $url);
GetHTTP2();
}
sub stopsearch {
my ($thename, $theoutput, $wildcards) = @_;
$hey = "You may search again in ";
$hey .= $world->GetTimerInfo ("pausesearch", 13);
$hey .= " seconds.";
$world->ColourNote ("silver", "black", $hey);
$world->sendnoecho(" ");
}
sub register {
my ($thename, $theoutput, $wildcards) = @_;
$hey = "Thanks for choosing to register AODOJO Auctions IQS today. One momment while we establish your registration with the server...";
$world->ColourNote ("silver", "black", $hey);
$world->EnableTriggerGroup("hidescore", TRUE);
$world->EnableTimer("pausescore", TRUE);
$world->sendnoecho("score");
}
sub gotname {
my ($thename, $theoutput, $wildcards) = @_;
$scorename = $world->gettriggerinfo($thename, 101);
$world->SetVariable("name", $scorename);
$world->SaveState ();
}
sub stophiding {
$world->EnableTriggerGroup("hidescore", FALSE);
$world->EnableTimer("pausescore", FALSE);
$scorename = $world->GetVariable("name");
$url = "/~aodojoc/auctions/iqs/aucsearch/outsource.php?register=";
$url .= $scorename;
$host = "aodojo.com";
$world->SetVariable("host", $host);
$world->SetVariable("url", $url);
GetHTTP2();
}
sub enablesearch {
my ($thename, $theoutput, $wildcards) = @_;
$world->EnableAlias("aucalias", true);
$world->EnableTimer("pausesearch", false);
}
sub GetHTTP2 {
my ($thename, $theoutput, $wildcards) = @_;
$port = 80;
$method = "POST";
$version = "LEXICON=2.0";
use Socket;
use URI::Escape;
if (!eval {require 'Socket.pm';} ) {
$socket = "false";
} else {
#use Socket;
$socket = "true";
}
$host = $world->GetVariable ("host");
$url = $world->GetVariable ("url");
$url = uri_escape($url, " ,-");
if (!$url) {
$url = "";
}
if (!$host) {
chop ($host = `hostname`);
}
$AF_INET = 2;
$SOCK_STREAM = 1;
$sockaddr = 'S n a4 x8';
chop ($hostname = `hostname`);
($name, $aliases, $proto) = getprotobyname('tcp');
if ($socket eq "false") {
$AF_INET = 2;
$SOCK_STREAM = 1;
($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
($name, $aliases, $type, $len, $thataddr) = gethostbyname($host);
$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
$that = pack($sockaddr, $AF_INET, $port, $thataddr);
# Make the socket file handle
if (socket(S, $AF_INET, $SOCK_STREAM, $proto)) {
} else {
die("Lexicon: Unable to create socket");
}
} else {
$thisaddr = Socket::inet_aton($hostname);
$thataddr = Socket::inet_aton($host);
$this = Socket::pack_sockaddr_in(0,$thisaddr);
$that = Socket::pack_sockaddr_in($port,$thataddr);
if (socket(S, AF_INET, SOCK_STREAM, $proto)) {
} else {
die("Lexicon: Unable to create socket");
}
}
if (bind(S, $this)) {
} else {
die ("Lexicon: Unable to bind socket, $!");
}
if (connect(S, $that)) {
} else {
$world->note ("We're sorry, but AUC SEARCH was unable to connect to the Aodojo server. Please try again later.");
exit;
}
select (S);
$| = 1;
select (STDOUT);
args_loop:
foreach (@ARGV) {
if (/=/) {
($key, $value) = split("=", $_, 2);
if ($key eq "host" ||
$key eq "url" ||
$key eq "port" ||
$key eq "method"||
$key eq "file") {
next args_loop;
}
if ($query) {$query .= "&";}
$query .= &webcode($key);
$query .= "=";
$query .= &webcode($value);
} else {
# Allow generic strings too.
if ($query) {$query .= "&";}
$query .= &webcode($value);
}
}
if ($query) {$query .= "\015\012\012";}
$method =~ tr/a-z/A-Z/;
if ($query){
if ($method eq 'POST') {
print S "$method $url HTTP/1.0\012",
"User_Agent: AucBot using the Webquery V1.0 code\012",
"Content-type: application/x-www-form-urlencoded\012",
"Content-length: ",length($query)-3,"\012\012";
print S $query;
} else {
print S "$method $url"."?".$query."HTTP/1.0\012",
"User_Agent: AucBot Using Webquery V1.0\012",
"Content-type: application/x-www-form-urlencoded\012";
}
} else {
if ($method eq "POST") {$method = "GET";}
print S "$method $url HTTP/1.0\012",
"User_Agent: MushclientMM V1.0\012\012";
}
if ($outfile) {
open(OUTFILE, '>'.$outfile);
select(OUTFILE);
}
while ( ($len = read(S, $buffer, 1024)) > 0 ) {
$bigbuf .= $buffer;
}
$bigbuf =~ s/^(.*\n){7}//;
$bigbuf =~ s/^(.*\n){7}//;
$bigbuf =~ s/^(.*\n){7}//;
$bigbuf =~ s/^(.*\n){7}//;
$bigbuf =~ s/^(.*\n){7}//;
$bigbuf =~ s/^(.*\n){7}//;
$bigbuf =~ s/^(.*\n){7}//;
$bigbuf =~ s/^(.*\n){7}//;
$world->ColourNote ("silver", "black", $bigbuf);
$world->sendnoecho(" ");
$bigbuf = 0;
sub webcode {
local ($string) = @_;
$string =~ s/[^ a-zA-Z0-9]/sprintf("%%%02x", ord($&))/eg ;
$string =~ tr/ /+/;
return $string;
}
}
|
|
|
