knu-perlstorable 0.1.1

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
Files changed (2) hide show
  1. data/lib/perlstorable.rb +428 -0
  2. metadata +54 -0
@@ -0,0 +1,428 @@
1
+ # -*- mode: ruby; coding: utf-8 -*-
2
+ #--
3
+ # perlstorable.rb - a library that emulates deserialization of Perl's Storable module
4
+ #++
5
+ # Copyright (c) 2009 Akinori MUSHA <knu@iDaemons.org>
6
+ #
7
+ # All rights reserved. You can redistribute and/or modify it under the same
8
+ # terms as Ruby.
9
+ #
10
+ # == Overview
11
+ #
12
+ # This library deals with data serialized by Perl's Storable module.
13
+ #
14
+ # This library requires ruby 1.8.7 or better (including 1.9) at the moment.
15
+
16
+ require 'stringio'
17
+
18
+ #
19
+ # This module handles the data structure defined and implemented by
20
+ # Perl's Storable module.
21
+ #
22
+ module PerlStorable
23
+ #
24
+ # call-seq:
25
+ # PerlStorable.thaw(str) => object
26
+ #
27
+ # Deserializes a string serialized by Perl's Storable module.
28
+ #
29
+ # Only data frozen by Storable::nfreeze() is supported at the
30
+ # moment.
31
+ #
32
+ # Blessed Perl objects can be distinguished by using
33
+ # PerlStorable.blessed?(), and the package name of a blessed object
34
+ # can be obtained by PerlBlessed#perl_class.
35
+ #
36
+ # A list of currently unsupported data types includes:
37
+ # - Tied objects (scalar/array/hash etc.)
38
+ # - Weak reference
39
+ # - Code references
40
+ #
41
+ def self.thaw(string_or_iolike)
42
+ if string_or_iolike.respond_to?(:read)
43
+ io = string_or_iolike
44
+ need_close = false
45
+ else
46
+ io = StringIO.new(string_or_iolike)
47
+ need_close = true
48
+ end
49
+
50
+ case magic = io.read(2)
51
+ when "\x05\x07"
52
+ # data frozen by Storable::nfreeze()
53
+ else
54
+ raise ArgumentError, 'unsupported format'
55
+ end
56
+
57
+ PerlStorable::Reader.new(io).read
58
+ ensure
59
+ io.close if need_close
60
+ end
61
+
62
+ SX_OBJECT = 0 # Already stored object
63
+ SX_LSCALAR = 1 # Scalar (large binary) follows (length, data)
64
+ SX_ARRAY = 2 # Array forthcominng (size, item list)
65
+ SX_HASH = 3 # Hash forthcoming (size, key/value pair list)
66
+ SX_REF = 4 # Reference to object forthcoming
67
+ SX_UNDEF = 5 # Undefined scalar
68
+ SX_INTEGER = 6 # Integer forthcoming
69
+ SX_DOUBLE = 7 # Double forthcoming
70
+ SX_BYTE = 8 # (signed) byte forthcoming
71
+ SX_NETINT = 9 # Integer in network order forthcoming
72
+ SX_SCALAR = 10 # Scalar (binary, small) follows (length, data)
73
+ SX_TIED_ARRAY = 11 # Tied array forthcoming
74
+ SX_TIED_HASH = 12 # Tied hash forthcoming
75
+ SX_TIED_SCALAR = 13 # Tied scalar forthcoming
76
+ SX_SV_UNDEF = 14 # Perl's immortal PL_sv_undef
77
+ SX_SV_YES = 15 # Perl's immortal PL_sv_yes
78
+ SX_SV_NO = 16 # Perl's immortal PL_sv_no
79
+ SX_BLESS = 17 # Object is blessed
80
+ SX_IX_BLESS = 18 # Object is blessed, classname given by index
81
+ SX_HOOK = 19 # Stored via hook, user-defined
82
+ SX_OVERLOAD = 20 # Overloaded reference
83
+ SX_TIED_KEY = 21 # Tied magic key forthcoming
84
+ SX_TIED_IDX = 22 # Tied magic index forthcoming
85
+ SX_UTF8STR = 23 # UTF-8 string forthcoming (small)
86
+ SX_LUTF8STR = 24 # UTF-8 string forthcoming (large)
87
+ SX_FLAG_HASH = 25 # Hash with flags forthcoming (size, flags, key/flags/value triplet list)
88
+ SX_CODE = 26 # Code references as perl source code
89
+ SX_WEAKREF = 27 # Weak reference to object forthcoming
90
+ SX_WEAKOVERLOAD = 28 # Overloaded weak reference
91
+ SX_ERROR = 29 # Error
92
+
93
+ SHF_TYPE_MASK = 0x03
94
+ SHF_LARGE_CLASSLEN = 0x04
95
+ SHF_LARGE_STRLEN = 0x08
96
+ SHF_LARGE_LISTLEN = 0x10
97
+ SHF_IDX_CLASSNAME = 0x20
98
+ SHF_NEED_RECURSE = 0x40
99
+ SHF_HAS_LIST = 0x80
100
+
101
+ SHT_SCALAR = 0
102
+ SHT_ARRAY = 1
103
+ SHT_HASH = 2
104
+ SHT_EXTRA = 3
105
+
106
+ SHT_TSCALAR = 4 # 4 + 0 -- tied scalar
107
+ SHT_TARRAY = 5 # 4 + 1 -- tied array
108
+ SHT_THASH = 6 # 4 + 2 -- tied hash
109
+
110
+ def self.inspect_value(value, const_regex = nil) # :rdoc
111
+ names = constants.select { |name|
112
+ (!const_regex || const_regex.match(name)) &&
113
+ const_get(name) == value
114
+ }
115
+ if names.empty?
116
+ value.inspect
117
+ else
118
+ "%s (%s)" % [value.inspect, names.join(" | ")]
119
+ end
120
+ end
121
+
122
+ class PlaceHolder # :nodoc:
123
+ end
124
+
125
+ PH_REF = PlaceHolder.new
126
+ PH_TIED = PlaceHolder.new
127
+
128
+ class Reader # :nodoc: all
129
+ def initialize(io)
130
+ @io = io
131
+ @objects = []
132
+ @packages = []
133
+ end
134
+
135
+ def read_byte
136
+ @io.getbyte
137
+ end
138
+
139
+ def read_netint32
140
+ n = @io.read(4).unpack('N').first
141
+ if n <= 2147483647
142
+ n
143
+ else
144
+ n - 4294967296
145
+ end
146
+ end
147
+
148
+ def read_int32
149
+ read_netint32
150
+ end
151
+
152
+ def read_flexlen
153
+ len = read_byte
154
+ if (len & 0x80) != 0
155
+ read_int32
156
+ else
157
+ len
158
+ end
159
+ end
160
+
161
+ def read_blob(len)
162
+ @io.read(len)
163
+ end
164
+
165
+ if defined?(::Encoding)
166
+ def read_string(len)
167
+ @io.read(len).force_encoding('UTF-8')
168
+ end
169
+ else
170
+ def read_string(len)
171
+ @io.read(len)
172
+ end
173
+ end
174
+
175
+ def remember_object(object)
176
+ if @bless
177
+ object = PerlStorable.bless(object, @bless)
178
+ end
179
+ unless object.nil?
180
+ @objects.each_index { |i|
181
+ @objects[i] = object if @objects[i].is_a?(PlaceHolder)
182
+ }
183
+ end
184
+ @objects << object
185
+ object
186
+ end
187
+
188
+ def remember_tied()
189
+ @objects << PH_TIED
190
+ end
191
+
192
+ def remember_ref()
193
+ @objects << PH_REF
194
+ end
195
+
196
+ def remember_ref_undo()
197
+ @objects.pop while @objects.last.equal?(PH_REF)
198
+ end
199
+
200
+ def lookup_object(index)
201
+ @objects[index]
202
+ end
203
+
204
+ def remember_package(package)
205
+ @packages << package
206
+ package
207
+ end
208
+
209
+ def read_object(type)
210
+ case type
211
+ when SX_SCALAR
212
+ remember_object(read_blob(read_byte))
213
+ when SX_LSCALAR
214
+ remember_object(read_blob(read_int32))
215
+ when SX_BYTE
216
+ remember_object(read_byte - 128)
217
+ when SX_NETINT
218
+ remember_object(read_netint32)
219
+ when SX_UTF8STR
220
+ remember_object(read_string(read_byte))
221
+ when SX_LUTF8STR
222
+ remember_object(read_string(read_int32))
223
+ when SX_ARRAY
224
+ len = read_int32
225
+ ary = Array.new(len)
226
+ remember_object(ary)
227
+ len.times { |i|
228
+ ary[i] = read
229
+ }
230
+ ary
231
+ when SX_HASH
232
+ size = read_int32
233
+ hash = Hash.new
234
+ remember_object(hash)
235
+ size.times {
236
+ value = read
237
+ key = read_object(SX_LSCALAR)
238
+ hash[key] = value
239
+ }
240
+ hash
241
+ when SX_FLAG_HASH
242
+ frozen = (read_byte != 0)
243
+ size = read_int32
244
+ hash = Hash.new
245
+ remember_object(hash)
246
+ size.times {
247
+ value = read
248
+ flag = (read_byte != 0)
249
+ if flag
250
+ key = read_object(SX_LUTF8STR)
251
+ else
252
+ key = read_object(SX_LSCALAR)
253
+ end
254
+ hash[key] = value
255
+ }
256
+ hash.freeze if frozen
257
+ hash
258
+ when SX_REF
259
+ # In Perl, both an object and a reference to it must be
260
+ # remembered but in Ruby, there is no difference between them
261
+ # because everything is a reference, so remember the object
262
+ # twice. remember_ref puts a placeholder for forward reference.
263
+ remember_ref
264
+ read
265
+ when SX_OBJECT
266
+ # The following object is already remembered, so cancel
267
+ # remembering.
268
+ remember_ref_undo
269
+ lookup_object(read_int32)
270
+ when SX_OVERLOAD
271
+ read
272
+ when SX_BLESS
273
+ package = read_blob(read_flexlen)
274
+ remember_package(package)
275
+ # Blessing an object is simply labeling (does not produce a
276
+ # new reference), so there is no extra remember_object()
277
+ # needed here, but it has to be made sure that the following
278
+ # object is blessed and that is exactly what read_blessed()
279
+ # does.
280
+ object = read_blessed(package)
281
+ when SX_IX_BLESS
282
+ package = @packages[read_flexlen]
283
+ object = read_blessed(package)
284
+ when SX_HOOK
285
+ flags = read_byte
286
+
287
+ if (flags & SHF_IDX_CLASSNAME) != 0
288
+ package = @packages[read_int32]
289
+ elsif (flags & SHF_LARGE_CLASSLEN) != 0
290
+ package = read_blob(read_int32)
291
+ else
292
+ package = read_blob(read_byte)
293
+ end
294
+
295
+ if (flags & SHF_LARGE_STRLEN) != 0
296
+ string = read_blob(read_int32)
297
+ else
298
+ string = read_blob(read_byte)
299
+ end
300
+
301
+ remember_object(string)
302
+
303
+ if (flags & SHF_HAS_LIST) != 0
304
+ raise TypeError, 'SX_HOOK having a list not implemented'
305
+ case flags & SHF_TYPE_MASK
306
+ when SHT_TSCALAR
307
+ when SHT_TARRAY
308
+ when SHT_THASH
309
+ end
310
+ else
311
+ PerlStorable.bless(string, package)
312
+ end
313
+ when SX_TIED_SCALAR, SX_TIED_ARRAY, SX_TIED_HASH
314
+ # Tying an object produces a new object, so there has to be a
315
+ # placeholder just like the SX_REF case. However, it may not
316
+ # be affected by remember_ref_undo() because tie always
317
+ # produces a new object, hence remember_tied() instead of
318
+ # remember_ref().
319
+ remember_tied
320
+ read
321
+ when SX_SV_YES
322
+ true
323
+ when SX_SV_NO
324
+ false
325
+ when SX_UNDEF, SX_SV_UNDEF
326
+ nil
327
+ else
328
+ raise TypeError, 'unknown data type: %s' % PerlStorable.inspect_value(type, /^SX_/)
329
+ end
330
+ end
331
+
332
+ def read_blessed(package)
333
+ # Make sure the following object is blessed before it is
334
+ # remembered.
335
+ @bless = package
336
+ read
337
+ ensure
338
+ @bless = nil
339
+ end
340
+
341
+ # Reads an object at the posision.
342
+ def read
343
+ read_object(read_byte)
344
+ end
345
+ end
346
+
347
+ # This module is used to represent a Perl object blessed in a
348
+ # package by extending an object to hold a package name.
349
+ module PerlBlessed
350
+ # Returns the Perl class the object was blessed into.
351
+ attr_reader :perl_class
352
+
353
+ # call-seq:
354
+ # perl_bless(perl_class) => self
355
+ #
356
+ # Blesses the object into +perl_class+ (String).
357
+ def perl_bless(perl_class)
358
+ @perl_class = perl_class
359
+ self
360
+ end
361
+
362
+ # :stopdoc:
363
+ def inspect_blessed
364
+ '#<PerlBlessed(%s, %s)>' % [inspect_unblessed, perl_class.inspect]
365
+ end
366
+
367
+ def self.included(mod)
368
+ mod.module_eval {
369
+ alias inspect_unblessed inspect
370
+ alias inspect inspect_blessed
371
+ }
372
+ end
373
+ # :startdoc:
374
+
375
+ end
376
+
377
+ class PerlScalar
378
+ def initialize(value)
379
+ @value = value
380
+ end
381
+
382
+ def inspect
383
+ '#<%s:%s>' % [self.class, @value.inspect]
384
+ end
385
+ end
386
+
387
+ # call-seq:
388
+ # bless(object, perl_class) => self
389
+ #
390
+ # Blesses a given object into +perl_class+ (String).
391
+ def self.bless(obj, perl_class)
392
+ if !obj.is_a?(PerlBlessed)
393
+ # Use include instead of extend for PerlBlessed.included to be
394
+ # called
395
+ begin
396
+ class << obj
397
+ include PerlBlessed
398
+ end
399
+ rescue
400
+ obj = PerlScalar.new(obj)
401
+ class << obj
402
+ include PerlBlessed
403
+ end
404
+ end
405
+ end
406
+ obj.perl_bless(perl_class)
407
+ end
408
+
409
+ # call-seq:
410
+ # blessed?(object) => boolean
411
+ #
412
+ # Tests if an object is blessed.
413
+ def self.blessed?(obj)
414
+ obj.is_a?(PerlBlessed)
415
+ end
416
+ end
417
+
418
+ if $0 == __FILE__
419
+ eval DATA.read, nil, $0, __LINE__+4
420
+ end
421
+
422
+ __END__
423
+
424
+ # TODO: Real tests needed
425
+
426
+ require 'pp'
427
+ obj = PerlStorable.thaw(ARGF.read)
428
+ pp obj
metadata ADDED
@@ -0,0 +1,54 @@
1
+ --- !ruby/object:Gem::Specification
2
+ name: knu-perlstorable
3
+ version: !ruby/object:Gem::Version
4
+ version: 0.1.1
5
+ platform: ruby
6
+ authors:
7
+ - Akinori MUSHA
8
+ autorequire:
9
+ bindir: bin
10
+ cert_chain: []
11
+
12
+ date: 2009-05-13 00:00:00 -07:00
13
+ default_executable:
14
+ dependencies: []
15
+
16
+ description: A Ruby module that emulates deserialization of Perl's Storable module.
17
+ email: knu@idaemons.org
18
+ executables: []
19
+
20
+ extensions: []
21
+
22
+ extra_rdoc_files: []
23
+
24
+ files:
25
+ - lib/perlstorable.rb
26
+ has_rdoc: true
27
+ homepage: http://github.com/knu/ruby-perlstorable
28
+ post_install_message:
29
+ rdoc_options:
30
+ - --inline-source
31
+ - --charset=UTF-8
32
+ require_paths:
33
+ - lib
34
+ required_ruby_version: !ruby/object:Gem::Requirement
35
+ requirements:
36
+ - - ">="
37
+ - !ruby/object:Gem::Version
38
+ version: 1.8.7
39
+ version:
40
+ required_rubygems_version: !ruby/object:Gem::Requirement
41
+ requirements:
42
+ - - ">="
43
+ - !ruby/object:Gem::Version
44
+ version: "0"
45
+ version:
46
+ requirements: []
47
+
48
+ rubyforge_project:
49
+ rubygems_version: 1.2.0
50
+ signing_key:
51
+ specification_version: 2
52
+ summary: A Ruby module that emulates deserialization of Perl's Storable module.
53
+ test_files: []
54
+