Messages.pm.svn-base
上传用户:market2
上传日期:2018-11-18
资源大小:18786k
文件大小:9k
源码类别:

外挂编程

开发平台:

Windows_Unix

  1. ##########################################################
  2. #  OpenKore - Bus System
  3. #  Bus message (de)serializer
  4. #
  5. #  This software is open source, licensed under the GNU General Public
  6. #  License, version 2.
  7. #  Basically, this means that you're allowed to modify and distribute
  8. #  this software. However, if you distribute modified versions, you MUST
  9. #  also distribute the source code.
  10. #  See http://www.gnu.org/licenses/gpl.html for the full license.
  11. #
  12. #  $Revision$
  13. #  $Id$
  14. #
  15. #########################################################################
  16. ##
  17. # MODULE DESCRIPTION: Bus message (de)serializer
  18. #
  19. # The core element of the OpenKore Bus System's protocol is the <b>message</b>.
  20. # This module provides functions for easily serializing Perl data structures into
  21. # a message, and to deserialize a message into Perl data structures.
  22. #
  23. # This module is used internally by the rest of the bus system framework.
  24. #
  25. # <h3>Protocol description</h3>
  26. # I call the message format the "Simple Serializable Message" (SSM). This message
  27. # format is binary.
  28. #
  29. # A message contains the following information:
  30. # `l
  31. # - A message identifier (MID). This is a string, which can be anything.
  32. # - A list of arguments. This is either a list of key-value pairs (a key-value map),
  33. #   or a list of scalars (an array).
  34. # `l`
  35. #
  36. # A message is very comparable to a function call. Imagine the following C++ function:
  37. #
  38. # <pre>void copyFile(string from, string to);
  39. # copyFile("foo.txt", "bar.txt");</pre>
  40. #
  41. # `l
  42. # - The message ID would be "copyFile".
  43. # - The key/value pairs would look like this:
  44. # <pre>from = foo.txt
  45. #   to = bar.txt</pre>
  46. # `l`
  47. #
  48. # <h3>Message structure</h3>
  49. # Note that all integers are big-endian.
  50. #
  51. # <h4>Header</h4>
  52. # Each message starts with a header:
  53. # <pre>struct {
  54. #     // Header
  55. #     uint32 length;           // The length of the entire message, in bytes.
  56. #     uint8  options;          // The message type: 0 = key-value map, 1 = array.
  57. #     uint8  MID_length;       // The message ID's length.
  58. #     char   MID[MID_length];  // The message ID, as a UTF-8 string.
  59. # } Header;</pre>
  60. #
  61. # The <tt>options</tt> field allows you to
  62. # If <tt>options</tt> is set to 0, then what comes after the header
  63. # is a list of MapEntry structures, until the end of the message.<br>
  64. # If <tt>options</tt> is set to 1, then what comes after the header
  65. # is a list of ArrayEntry structures, until the end of the message.
  66. #
  67. # <h4>Key-value map entry</h4>
  68. # <pre>struct {
  69. #     uint8  key_length;           // Length of the key.
  70. #     char   key[key_length];      // UTF-8 string.
  71. #
  72. #     uint8  value_type;           // Value type: 0 = binary, 1 = UTF-8 string, 2 = unsigned integer
  73. #     uint24 value_length;         // Length of the value.
  74. #     char   value[value_length];  // The value data.
  75. # } MapEntry;</pre>
  76. #
  77. # <h4>Array entry</h4>
  78. # <pre>struct {
  79. #     uint8  type;                 // Like MapEntry.value_type
  80. #     uint24 length;
  81. #     char   value[length];
  82. # } ArrayEntry;</pre>
  83. package Bus::Messages;
  84. use strict;
  85. use warnings;
  86. use Modules 'register';
  87. use Exporter;
  88. use base qw(Exporter);
  89. use Encode;
  90. use Utils::Exceptions;
  91. our @EXPORT_OK = qw(serialize unserialize);
  92. ##
  93. # Bytes Bus::Messages::serialize(String ID, arguments)
  94. # ID: The message ID.
  95. # arguments: Reference to either a hash or an array, as the message arguments.
  96. # Returns: The raw data for the message.
  97. #
  98. # Serialize a Perl data structure into a message.
  99. #
  100. # This symbol is exportable.
  101. sub serialize {
  102. my ($ID, $arguments) = @_;
  103. # Header
  104. my $options = (!$arguments || ref($arguments) eq 'HASH') ? 0 : 1;
  105. my $ID_bytes = toBytes($ID);
  106. my $data = pack("N C C a*",
  107. 0, # Message length
  108. $options, # Options
  109. length($$ID_bytes), # ID length
  110. $$ID_bytes); # ID
  111. if ($options == 0 && $arguments) {
  112. # Key-value map arguments.
  113. my ($key, $value);
  114. while (($key, $value) = each %{$arguments}) {
  115. my $key_bytes = toBytes($key);
  116. my ($type, $value_bytes);
  117. $value_bytes = valueToData($type, $value);
  118. $data .= pack("C a* C a3 a*",
  119. length($$key_bytes),
  120. $$key_bytes,
  121. $type,
  122. toInt24(length($$value_bytes)),
  123. $$value_bytes
  124. );
  125. }
  126. } elsif ($options == 1) {
  127. # Array arguments.
  128. foreach my $entry (@{$arguments}) {
  129. my ($type, $value_bytes);
  130. $value_bytes = valueToData($type, $entry);
  131. $data .= pack("C a3 a*",
  132. $type,
  133. toInt24(length($$value_bytes)),
  134. $$value_bytes
  135. );
  136. }
  137. }
  138. substr($data, 0, 4, pack("N", length($data)));
  139. return $data;
  140. }
  141. ##
  142. # Bus::Messages::unserialize(Bytes data, String* ID, [int* processed])
  143. # data: The raw message data.
  144. # ID: A reference to a scalar. The message ID will be stored here.
  145. # processed: A reference to a scalar. The number of bytes processed will be stored in
  146. #            here. This argument may be undef.
  147. # Returns: A reference to a hash or an array. These are the arguments of the message.
  148. #          Returns undef if $data is not a complete message.
  149. #
  150. # Unserialize a message into a Perl data structure.
  151. #
  152. # Note that the return values for $ID and $processed are only meaningful if
  153. # the function's return value is not undef.
  154. #
  155. # This symbol is exportable.
  156. sub unserialize {
  157. my ($data, $r_ID, $processed) = @_;
  158. my $dataLen = length($data);
  159. return undef if ($dataLen < 4);
  160. # Header
  161. my $messageLen = unpack("N", $data);
  162. return undef if ($dataLen < $messageLen);
  163. my ($options, $ID) = unpack("x[N] C C/a", $data);
  164. Encode::_utf8_on($ID);
  165. if (!Encode::is_utf8($ID, 1)) {
  166. UTF8MalformedException->throw("Malformed UTF-8 data in message ID.");
  167. }
  168. my $offset = 6 + length($ID);
  169. my $args;
  170. if ($options == 0) {
  171. # Key-value map arguments.
  172. $args = {};
  173. while ($offset < $messageLen) {
  174. # Key and type.
  175. my ($key, $type) = unpack("x[$offset] C/a C", $data);
  176. Encode::_utf8_on($key);
  177. if (!Encode::_utf8_on($key)) {
  178. UTF8MalformedException->throw("Malformed UTF-8 data in key.");
  179. }
  180. $offset += 2 + length($key);
  181. # Value length.
  182. my ($valueLen) = substr($data, $offset, 3);
  183. $valueLen = fromInt24($valueLen);
  184. $offset += 3;
  185. # Value.
  186. my ($value) = substr($data, $offset, $valueLen);
  187. dataToValue($type, $value);
  188. $args->{$key} = $value;
  189. $offset += $valueLen;
  190. }
  191. } else {
  192. # Array arguments.
  193. $args = [];
  194. while ($offset < $messageLen) {
  195. # Type and length.
  196. my ($type, $len) = unpack("x[$offset] C a3", $data);
  197. $len = fromInt24($len);
  198. $offset += 4;
  199. # Value.
  200. my ($value) = substr($data, $offset, $len);
  201. dataToValue($type, $value);
  202. push @{$args}, $value;
  203. $offset += $len;
  204. }
  205. }
  206. $$r_ID = $ID;
  207. $$processed = $messageLen if ($processed);
  208. return $args;
  209. }
  210. # Converts a String to Bytes, with as little copying as possible.
  211. #
  212. # r_string: A reference to a String.
  213. # Returns: A reference to the UTF-8 data as Bytes.
  214. sub toBytes {
  215. my ($r_string) = @_;
  216. if (Encode::is_utf8($$r_string)) {
  217. my $data = Encode::encode_utf8($$r_string);
  218. return $data;
  219. } else {
  220. return $r_string;
  221. }
  222. }
  223. # Bytes toInt24(int i)
  224. # Ensures: length(result) == 3
  225. #
  226. # Converts a Perl scalar to a 24-bit unsigned big-endian integer.
  227. sub toInt24 {
  228. my ($i) = @_;
  229. return substr(pack("N", $i), 1, 3);
  230. }
  231. # int fromInt24(Bytes data)
  232. # Requires: length($data) == 3
  233. #
  234. # Convert a 24-bit unsigned big-endian integer to a Perl scalar.
  235. sub fromInt24 {
  236. my ($data) = @_;
  237. return unpack("N", "" . $data);
  238. }
  239. # Bytes* valueToData(int* type, Scalar* value)
  240. #
  241. # Autodetect the format of $data, and return a reference to a byte
  242. # string, to be used in serializing a message. The data type is
  243. # returned in $type.
  244. sub valueToData {
  245. my ($type, $value) = @_;
  246. if (!defined $$value) {
  247. my $data = '';
  248. $$type = 0;
  249. return $data;
  250. } elsif ($$value =~ /^d+$/) {
  251. # Integer.
  252. $$type = 2;
  253. my $data = pack("N", $$value);
  254. return $data;
  255. } elsif (Encode::is_utf8($$value)) {
  256. # UTF-8 string.
  257. $$type = 1;
  258. my $data = Encode::encode_utf8($$value);
  259. return $data;
  260. } else {
  261. # Binary string.
  262. $$type = 0;
  263. return $value;
  264. }
  265. }
  266. sub dataToValue {
  267. my ($type, $r_value) = @_;
  268. if ($type == 1) {
  269. Encode::_utf8_on($$r_value);
  270. if (!Encode::_utf8_on($$r_value)) {
  271. UTF8MalformedException->throw("Malformed UTF-8 data in value.");
  272. }
  273. } elsif ($type == 2) {
  274. if (length($$r_value) == 4) {
  275. $$r_value = unpack("N", $$r_value);
  276. } else {
  277. DataFormatException->throw("Integer value with invalid length (" .
  278. length($$r_value) . ") found.");
  279. }
  280. }
  281. }
  282. # sub testPerformance {
  283. #  use encoding 'utf8';
  284. #  use Time::HiRes qw(time);
  285. #  my $begin = time;
  286. #  for (1..10000) {
  287. #  serialize("foo", { hello => "world", foo => "bar", int => 1234567 });
  288. #  }
  289. #  printf "Serialization time  : %.3f secondsn", time - $begin;
  290. #  my $data = serialize("foo", { hello => "world", foo => "bar", int => 1234567 });
  291. #  $begin = time;
  292. #  for (1..10000) {
  293. #  my $ID;
  294. #  my $args = unserialize($data, $ID);
  295. #  }
  296. #  printf "Unserialization time: %.3f secondsn", time - $begin;
  297. # }
  298. # sub testCorrectness {
  299. #  use encoding 'utf8';
  300. #  no warnings;
  301. #  my $data = serialize("foo", { hello => "world", foo => "bar", int => 1234567 });
  302. #  my $ID;
  303. #  my $args = unserialize($data, $ID);
  304. #  print "ID = $IDn";
  305. #  use Data::Dumper;
  306. #  print Dumper($args);
  307. # }
  308. 1;