Register to post in forums, or Log in to your existing account
 

Play RetroMUD
Post new topic  Reply to topic     Home » Forums » zMUD General Discussion
ebaptist
Newbie


Joined: 16 Oct 2002
Posts: 7
Location: USA

PostPosted: 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;
}

}

Reply with quote
Display posts from previous:   
Post new topic   Reply to topic     Home » Forums » zMUD General Discussion All times are GMT
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum

© 2009 Zugg Software. Hosted by Wolfpaw.net