LPMuds.net Forums > Code Vault
perl lpc
(1/1)
quixadhal:
You had to look, didn't you?
Nooooo, silly wabbit. This isn't an LPC interpreter written in perl... or at least, it's only a very tiny bit of one. *smile*
This is, instead, a few useful utilities for those of you (no one) that have been begging for a way to talk to I3 from perl. It's not YET an actual I3 client, but it is the first few steps needed to start thinking about one.
--- Code: ---#!/usr/bin/perl -w
use strict;
use English;
use Data::Dumper;
use JSON;
sub json_to_lpc {
my $thing = shift;
return undef if !defined $thing;
#JSON and LPC are very similar, in fact to convert from
#one to the other, all we REALLY need to do (for purposes
#of using mudmode sockets and LPC data types) is convert
#{ pairs to ([ pairs, and [ pairs to ({ pairs, avoiding
#anything inside double-quoted strings.
my $result = "";
my $nested_mappings = 0;
my $nested_arrays = 0;
my $inside_quotes = 0;
my $is_backslash = 0;
my $is_unicode = 0;
my $unicode = '';
foreach my $ch (split //, $thing) {
if( $inside_quotes ) {
if( $is_backslash ) {
if( $is_unicode ) {
if( length $unicode < 4 ) {
$unicode .= $ch;
} else {
if( $unicode eq '0000' ) {
# This is what the JSON encoder does with NUL bytes, but
# LPC wants \0, so we need to catch and convert it.
$result .= "\\0";
} else {
# We could add a few other recognized things here,
# or just punt and pretend we saw nothing, or
# just leave the escape sequence in here and let
# the LPC thing deal with it.
#$result .= "\\u$unicode";
}
$unicode = '';
$is_unicode = 0;
$is_backslash = 0;
# This is, of course, the next character NOT part of the sequence.
$result .= $ch;
}
} else {
if( $ch eq 'u' ) {
$is_unicode = 1;
$unicode = '';
} else {
$is_backslash = 0;
$result .= "\\$ch";
}
}
} else {
if( $ch eq '\\' ) {
$is_backslash = 1;
} elsif( $ch eq '"' ) {
$inside_quotes = 0;
$result .= $ch;
} else {
$result .= $ch;
}
}
} else {
if( $ch eq '{' ) {
$nested_mappings++;
$result .= '([';
} elsif( $ch eq '[' ) {
$nested_arrays++;
$result .= '({';
} elsif( $ch eq '"' ) {
$inside_quotes = 1;
$result .= $ch;
} elsif( $ch eq ']' ) {
$nested_arrays--;
$result .= '})';
} elsif( $ch eq '}' ) {
$nested_mappings--;
$result .= '])';
} else {
$result .= $ch;
}
}
}
return $result;
}
sub lpc_to_json {
my $thing = shift;
return undef if !defined $thing;
#JSON and LPC are very similar, in fact to convert from
#one to the other, all we REALLY need to do (for purposes
#of using mudmode sockets and LPC data types) is convert
#{ pairs to ([ pairs, and [ pairs to ({ pairs, avoiding
#anything inside double-quoted strings.
my $result = "";
my $nested_arrays = 0;
my $nested_mappings = 0;
my $inside_quotes = 0;
my $is_backslash = 0;
my $got_paren = 0;
my $got_brace = 0;
my $got_bracket = 0;
foreach my $ch (split //, $thing) {
if( $inside_quotes ) {
if( $is_backslash ) {
if( $ch eq '0' ) {
# JSON wants NUL bytes in unicode esaped form...
$is_backslash = 0;
$result .= "u0000";
} else {
$is_backslash = 0;
$result .= $ch;
}
} else {
if( $ch eq '\\' ) {
$is_backslash = 1;
} elsif( $ch eq '"' ) {
$inside_quotes = 0;
}
$result .= $ch;
}
} elsif( $got_paren ) {
if( $ch eq '{' ) {
$nested_arrays++;
$result .= '[';
} elsif( $ch eq '[' ) {
$nested_mappings++;
$result .= '{';
} else {
$result .= $ch;
}
$got_paren = 0;
} elsif( $got_bracket ) {
if( $ch eq ')' ) {
$nested_mappings--;
$result .= '}';
} else {
$result .= $ch;
}
$got_bracket = 0;
} elsif( $got_brace ) {
if( $ch eq ')' ) {
$nested_arrays--;
$result .= ']';
} else {
$result .= $ch;
}
$got_brace = 0;
} else {
if( $ch eq '(' ) {
$got_paren = 1;
} elsif( $ch eq '"' ) {
$inside_quotes = 1;
$result .= $ch;
} elsif( $ch eq ']' ) {
$got_bracket = 1;
} elsif( $ch eq '}' ) {
$got_brace = 1;
} else {
$result .= $ch;
}
}
}
return $result;
}
# The specs for "mudmode" sockets are not really well documented, or
# rather... the documentation is not easy to find... but the basic idea
# is you take a valid LPC data structure and prepend a 4-byte length field
# (which I will *ASSUME* is in network byte order!), and then append a
# NUL byte.
# One presumes NUL bytes within the data structure have already
# been escaped, although it is unclear if any given LPC driver
# actually allows such things to exist anyways.
sub lpc_to_mudmode {
my $thing = shift;
return undef if !defined $thing;
my $len = length $thing;
my $result = pack('N', $len) . $thing . "\0";
return $result;
}
sub mudmode_to_lpc {
my $thing = shift;
return undef if !defined $thing;
my $expected_len = unpack('N', $thing);
my $result = substr($thing, 4, -1);
return $result;
}
# These are just wrappers to make going between socket data and
# perl hashes a one step conversion.
sub to_mudmode {
my $thing = shift;
return undef if !defined $thing;
return lpc_to_mudmode(json_to_lpc(encode_json($thing)));
}
sub mudmode_to {
my $thing = shift;
return undef if !defined $thing;
return decode_json(lpc_to_json(mudmode_to_lpc($thing)));
}
# Could probably use better test data...
my $test_obj = { "hello" => [ 23, -7, "b{\0oo\nfoo", { "blah" => 17.3 } ] };
my $json_serial = encode_json $test_obj;
my $json_obj = decode_json $json_serial;
my $lpc_convert = json_to_lpc($json_serial);
my $json_convert = lpc_to_json($lpc_convert);
my $stage_two = decode_json $json_convert;
my $mudmode = lpc_to_mudmode($lpc_convert);
my $mm_lpc = mudmode_to_lpc($mudmode);
my $stage_three = decode_json(lpc_to_json($mm_lpc));
my $round_trip = mudmode_to(to_mudmode($test_obj));
print "JSON Serialization: $json_serial\n";
print "JSON Deserialization: " . Dumper($json_obj) . "\n";
print "json_to_lpc: $lpc_convert\n";
print "lpc_to_json: $json_convert\n";
print "Stage 2 Deserialization: " . Dumper($stage_two) . "\n";
print "Stage 3 Deserialization: " . Dumper($stage_three) . "\n";
print "Round Trip Deserialization: " . Dumper($round_trip) . "\n";
--- End code ---
Navigation
[0] Message Index
Go to full version