Seeing that there seem to be far too few people using perl with MUSHclient, I thought I'd try to give some starting help and basic ideas to play with. Here is my humble attempt to convert Keldar's lua plugin into perl. I've cut it down a bit, so everyone can use it the way they see fit. All you need to do, is to insert your code at the commented place. I'll make another post later on how to serialize and pass around bigger data structures with perl and MC.
Enjoy!
Enjoy!
<muclient>
<plugin
name="ATCP"
author="Keldar / KP"
id="24aac266a14ff47b5110f780"
language="PerlScript"
purpose="ATCP packet handling"
save_state="y"
date_written="2007-06-26 19:59:34"
requires="4.00"
version="1.0"
>
<description trim="y">
<![CDATA[
Based on Keldars lua plugin.
Credit and a huge 'thank you' go to him for writing it. I only converted it to perl and tried to optimize it where possible.
]]>
</description>
</plugin>
<!-- Get our standard constants -->
<include name="constants.pl"/>
<!-- Script -->
<script>
<![CDATA[
my $client_id = "Muclient 4.0.0";
my $nexus_opts = [
"hello $client_id",
"auth 1",
"char_name 1",
"char_vitals 1",
"room_brief 1",
"room_exits 1",
];
my $codes = {
IAC_WILL_ATCP => "\xFF\xFB\xC8",
IAC_WONT_ATCP => "\xFF\xFC\xC8",
IAC_DO_ATCP => "\xFF\xFD\xC8",
IAC_DONT_ATCP => "\xFF\xFE\xC8",
IAC_SB_ATCP => "\xFF\xFA\xC8",
IAC_SE => "\xFF\xF0",
IAC_DO_EOR => "\xFF\xFD\x19",
IAC_WILL_EOR => "\xFF\xFB\x19",
IAC_GA => "\xFF\xF9",
};
my $leftovers;
sub SendATCP {
my $msg = shift;
$world->SendPkt($codes->{IAC_SB_ATCP} . $msg . $codes->{IAC_SE});
}
sub OnPluginConnect {
my $msg;
foreach my $opt (@$nexus_opts) { $msg = $msg . $opt . "\n"; }
chop $msg;
$world->SendPkt($codes->{IAC_DO_ATCP} . $codes->{IAC_SB_ATCP} . $msg . $codes->{IAC_SE});
}
sub OnPluginPacketReceived {
my $opacket = shift; # $opacket will contain the original packet data as a backup (for debugging for example)
my $ppacket = $opacket; # $ppacket will contain the modified packet that we will send back to MC
$world->Note("ATCP enabled.") if $ppacket =~ s/^(.*)$codes->{IAC_WILL_ATCP}(.*)$/$1$2/s;
$world->Note("ATCP disabled.") if $ppacket =~ /$codes->{IAC_WONT_ATCP}/s;
$ppacket =~ s/^(.*)$codes->{IAC_WILL_EOR}(.*)$/$1$2/s;
my $parsed; # this will be a hash reference containing all the parsed ATCP data
($ppacket,$parsed) = parseATCP($ppacket);
if (exists $parsed->{'Auth.Request CH'}) {
$world->Note("Authorization requested.");
SendATCP('auth ' . atcp_auth($parsed->{'Auth.Request CH'}) . ' ' . $client_id);
}
$world->Note("Authorization accepted.") if exists $parsed->{'Auth.Request ON'};
#
# We are done with parsing and ready to return the modified packet.
# $parsed contains all the ATCP data, that we were able to retrieve.
# Insert your code here and do something with it.
#
return $ppacket;
}
sub parseATCP {
my $packet = shift;
my $parsed;
$packet = $leftovers . $packet;
$leftovers = '';
while ($packet =~ s/$codes->{IAC_SB_ATCP}(.*?)$codes->{IAC_SE}//s) {
my $match = $1;
if ($match =~ /^(.*?)\n(.*)$/s) {
my ($key,$val) = ($1,$2);
if ($key =~ /^(Char.Name)\s(\w+)$/) {
$parsed->{$1} = $2;
$parsed->{'Char.Fullname'} = $val;
} else {
$parsed->{$key} = $val;
}
} elsif ($match =~ /^(Room.*?|Client.*?)\s(.*)$/s) {
$parsed->{$1} = $2;
} elsif ($match =~ /^(.+)$/) {
$parsed->{$1} = '';
}
}
$leftovers = $1 if $packet =~ s/(\xFF\xFA\xC8.*|\xFF\xFA?)$//s;
return $packet, $parsed;
}
sub atcp_auth {
my $seed = shift;
my ($a,$i) = (17, 0);
foreach my $n (unpack("U*",$seed)) {
$n -= 96;
$a += $i % 2 == 0 ? $n * ($i | 13) : -($n * ($i | 11));
$i++;
}
return $a;
}
]]>
</script>
<!-- Plugin help -->
<aliases>
<alias
script="OnHelp"
match="ATCP:help"
enabled="y"
>
</alias>
</aliases>
<script>
<![CDATA[
sub OnHelp
{
my ($sName, $sLine, $wildcards) = @_;
$world->Note ($world->GetPluginInfo ($world->GetPluginID, 3));
}
]]>
</script>
</muclient>