外挂编程

开发平台：
Windows_Unix

Messages.pm：源码内容
							##########################################################
#  OpenKore - Bus System
#  Bus message (de)serializer
#
#  This software is open source, licensed under the GNU General Public
#  License, version 2.
#  Basically, this means that you're allowed to modify and distribute
#  this software. However, if you distribute modified versions, you MUST
#  also distribute the source code.
#  See http://www.gnu.org/licenses/gpl.html for the full license.
#
#  $Revision: 5284 $
#  $Id: Messages.pm 5284 2007-01-01 17:26:40Z vcl_kore $
#
#########################################################################
##
# MODULE DESCRIPTION: Bus message (de)serializer
#
# The core element of the OpenKore Bus System's protocol is the <b>message</b>.
# This module provides functions for easily serializing Perl data structures into
# a message, and to deserialize a message into Perl data structures.
#
# This module is used internally by the rest of the bus system framework.
#
# <h3>Protocol description</h3>
# I call the message format the "Simple Serializable Message" (SSM). This message
# format is binary.
#
# A message contains the following information:
# `l
# - A message identifier (MID). This is a string, which can be anything.
# - A list of arguments. This is either a list of key-value pairs (a key-value map),
#   or a list of scalars (an array).
# `l`
#
# A message is very comparable to a function call. Imagine the following C++ function:
#
# <pre>void copyFile(string from, string to);
# copyFile("foo.txt", "bar.txt");</pre>
#
# `l
# - The message ID would be "copyFile".
# - The key/value pairs would look like this:
# <pre>from = foo.txt
#   to = bar.txt</pre>
# `l`
#
# <h3>Message structure</h3>
# Note that all integers are big-endian.
#
# <h4>Header</h4>
# Each message starts with a header:
# <pre>struct {
#     // Header
#     uint32 length;           // The length of the entire message, in bytes.
#     uint8  options;          // The message type: 0 = key-value map, 1 = array.
#     uint8  MID_length;       // The message ID's length.
#     char   MID[MID_length];  // The message ID, as a UTF-8 string.
# } Header;</pre>
#
# The <tt>options</tt> field allows you to
# If <tt>options</tt> is set to 0, then what comes after the header
# is a list of MapEntry structures, until the end of the message.<br>
# If <tt>options</tt> is set to 1, then what comes after the header
# is a list of ArrayEntry structures, until the end of the message.
#
# <h4>Key-value map entry</h4>
# <pre>struct {
#     uint8  key_length;           // Length of the key.
#     char   key[key_length];      // UTF-8 string.
#
#     uint8  value_type;           // Value type: 0 = binary, 1 = UTF-8 string, 2 = unsigned integer
#     uint24 value_length;         // Length of the value.
#     char   value[value_length];  // The value data.
# } MapEntry;</pre>
#
# <h4>Array entry</h4>
# <pre>struct {
#     uint8  type;                 // Like MapEntry.value_type
#     uint24 length;
#     char   value[length];
# } ArrayEntry;</pre>
package Bus::Messages;
use strict;
use warnings;
use Modules 'register';
use Exporter;
use base qw(Exporter);
use Encode;
use Utils::Exceptions;
our @EXPORT_OK = qw(serialize unserialize);
##
# Bytes Bus::Messages::serialize(String ID, arguments)
# ID: The message ID.
# arguments: Reference to either a hash or an array, as the message arguments.
# Returns: The raw data for the message.
#
# Serialize a Perl data structure into a message.
#
# This symbol is exportable.
sub serialize {
	my ($ID, $arguments) = @_;
	# Header
	my $options = (!$arguments || ref($arguments) eq 'HASH') ? 0 : 1;
	my $ID_bytes = toBytes($ID);
	my $data = pack("N C C a*",
		0,			# Message length
		$options,		# Options
		length($$ID_bytes),	# ID length
		$$ID_bytes);		# ID
	if ($options == 0 && $arguments) {
		# Key-value map arguments.
		my ($key, $value);
		while (($key, $value) = each %{$arguments}) {
			my $key_bytes = toBytes($key);
			my ($type, $value_bytes);
			$value_bytes = valueToData($type, $value);
			$data .= pack("C a* C a3 a*",
				length($$key_bytes),
				$$key_bytes,
				$type,
				toInt24(length($$value_bytes)),
				$$value_bytes
			);
		}
	} elsif ($options == 1) {
		# Array arguments.
		foreach my $entry (@{$arguments}) {
			my ($type, $value_bytes);
			$value_bytes = valueToData($type, $entry);
			$data .= pack("C a3 a*",
				$type,
				toInt24(length($$value_bytes)),
				$$value_bytes
			);
		}
	}
	substr($data, 0, 4, pack("N", length($data)));
	return $data;
}
##
# Bus::Messages::unserialize(Bytes data, String* ID, [int* processed])
# data: The raw message data.
# ID: A reference to a scalar. The message ID will be stored here.
# processed: A reference to a scalar. The number of bytes processed will be stored in
#            here. This argument may be undef.
# Returns: A reference to a hash or an array. These are the arguments of the message.
#          Returns undef if $data is not a complete message.
#
# Unserialize a message into a Perl data structure.
#
# Note that the return values for $ID and $processed are only meaningful if
# the function's return value is not undef.
#
# This symbol is exportable.
sub unserialize {
	my ($data, $r_ID, $processed) = @_;
	my $dataLen = length($data);
	return undef if ($dataLen < 4);
	# Header
	my $messageLen = unpack("N", $data);
	return undef if ($dataLen < $messageLen);
	my ($options, $ID) = unpack("x[N] C C/a", $data);
	Encode::_utf8_on($ID);
	if (!Encode::is_utf8($ID, 1)) {
		UTF8MalformedException->throw("Malformed UTF-8 data in message ID.");
	}
	my $offset = 6 + length($ID);
	my $args;
	if ($options == 0) {
		# Key-value map arguments.
		$args = {};
		while ($offset < $messageLen) {
			# Key and type.
			my ($key, $type) = unpack("x[$offset] C/a C", $data);
			Encode::_utf8_on($key);
			if (!Encode::_utf8_on($key)) {
				UTF8MalformedException->throw("Malformed UTF-8 data in key.");
			}
			$offset += 2 + length($key);
			# Value length.
			my ($valueLen) = substr($data, $offset, 3);
			$valueLen = fromInt24($valueLen);
			$offset += 3;
			# Value.
			my ($value) = substr($data, $offset, $valueLen);
			dataToValue($type, $value);
			$args->{$key} = $value;
			$offset += $valueLen;
		}
	} else {
		# Array arguments.
		$args = [];
		while ($offset < $messageLen) {
			# Type and length.
			my ($type, $len) = unpack("x[$offset] C a3", $data);
			$len = fromInt24($len);
			$offset += 4;
			# Value.
			my ($value) = substr($data, $offset, $len);
			dataToValue($type, $value);
			push @{$args}, $value;
			$offset += $len;
		}
	}
	$$r_ID = $ID;
	$$processed = $messageLen if ($processed);
	return $args;
}
# Converts a String to Bytes, with as little copying as possible.
#
# r_string: A reference to a String.
# Returns: A reference to the UTF-8 data as Bytes.
sub toBytes {
	my ($r_string) = @_;
	if (Encode::is_utf8($$r_string)) {
		my $data = Encode::encode_utf8($$r_string);
		return $data;
	} else {
		return $r_string;
	}
}
# Bytes toInt24(int i)
# Ensures: length(result) == 3
#
# Converts a Perl scalar to a 24-bit unsigned big-endian integer.
sub toInt24 {
	my ($i) = @_;
	return substr(pack("N", $i), 1, 3);
}
# int fromInt24(Bytes data)
# Requires: length($data) == 3
#
# Convert a 24-bit unsigned big-endian integer to a Perl scalar.
sub fromInt24 {
	my ($data) = @_;
	return unpack("N", "" . $data);
}
# Bytes* valueToData(int* type, Scalar* value)
#
# Autodetect the format of $data, and return a reference to a byte
# string, to be used in serializing a message. The data type is
# returned in $type.
sub valueToData {
	my ($type, $value) = @_;
	if (!defined $$value) {
		my $data = '';
		$$type = 0;
		return $data;
	} elsif ($$value =~ /^d+$/) {
		# Integer.
		$$type = 2;
		my $data = pack("N", $$value);
		return $data;
	} elsif (Encode::is_utf8($$value)) {
		# UTF-8 string.
		$$type = 1;
		my $data = Encode::encode_utf8($$value);
		return $data;
	} else {
		# Binary string.
		$$type = 0;
		return $value;
	}
}
sub dataToValue {
	my ($type, $r_value) = @_;
	if ($type == 1) {
		Encode::_utf8_on($$r_value);
		if (!Encode::_utf8_on($$r_value)) {
			UTF8MalformedException->throw("Malformed UTF-8 data in value.");
		}
	} elsif ($type == 2) {
		if (length($$r_value) == 4) {
			$$r_value = unpack("N", $$r_value);
		} else {
			DataFormatException->throw("Integer value with invalid length (" .
				length($$r_value) . ") found.");
		}
	}
}
# sub testPerformance {
# 	use encoding 'utf8';
# 	use Time::HiRes qw(time);
# 
# 	my $begin = time;
# 	for (1..10000) {
# 		serialize("foo", { hello => "world", foo => "bar", int => 1234567 });
# 	}
# 	printf "Serialization time  : %.3f secondsn", time - $begin;
# 
# 	my $data = serialize("foo", { hello => "world", foo => "bar", int => 1234567 });
# 	$begin = time;
# 	for (1..10000) {
# 		my $ID;
# 		my $args = unserialize($data, $ID);
# 	}
# 	printf "Unserialization time: %.3f secondsn", time - $begin;
# }
# 
# sub testCorrectness {
# 	use encoding 'utf8';
# 	no warnings;
# 	my $data = serialize("foo", { hello => "world", foo => "bar", int => 1234567 });
# 	my $ID;
# 	my $args = unserialize($data, $ID);
# 	print "ID = $IDn";
# 	use Data::Dumper;
# 	print Dumper($args);
# }
1;

						