line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::CompactReadonly::V0::Scalar; |
2
|
|
|
|
|
|
|
our $VERSION = '0.0.6'; |
3
|
|
|
|
|
|
|
|
4
|
9
|
|
|
9
|
|
53
|
use warnings; |
|
9
|
|
|
|
|
15
|
|
|
9
|
|
|
|
|
280
|
|
5
|
9
|
|
|
9
|
|
49
|
use strict; |
|
9
|
|
|
|
|
15
|
|
|
9
|
|
|
|
|
158
|
|
6
|
9
|
|
|
9
|
|
38
|
use base 'Data::CompactReadonly::V0::Node'; |
|
9
|
|
|
|
|
15
|
|
|
9
|
|
|
|
|
3715
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
sub _init { |
9
|
999
|
|
|
999
|
|
2239
|
my($class, %args) = @_; |
10
|
999
|
|
|
|
|
1605
|
my $root = $args{root}; |
11
|
|
|
|
|
|
|
|
12
|
999
|
|
|
|
|
2188
|
my $word = $root->_bytes_at_current_offset($class->_num_bytes()); |
13
|
999
|
|
|
|
|
2329
|
return $class->_decode_word($word); |
14
|
|
|
|
|
|
|
} |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# turn a sequence of bytes into an integer |
17
|
|
|
|
|
|
|
sub _decode_word { |
18
|
1670
|
|
|
1670
|
|
2826
|
my($class, $word) = @_; |
19
|
|
|
|
|
|
|
|
20
|
1670
|
|
|
|
|
2070
|
my $value = 0; |
21
|
1670
|
|
|
|
|
4174
|
foreach my $byte (split(//, $word)) { |
22
|
2514
|
|
|
|
|
3184
|
$value *= 256; |
23
|
2514
|
|
|
|
|
3725
|
$value += ord($byte); |
24
|
|
|
|
|
|
|
} |
25
|
1670
|
|
|
|
|
5232
|
return $value; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub _create { |
29
|
54
|
|
|
54
|
|
178
|
my($class, %args) = @_; |
30
|
54
|
|
|
|
|
97
|
my $fh = $args{fh}; |
31
|
54
|
|
|
|
|
237
|
$class->_stash_already_seen(%args); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
print $fh $class->_type_byte_from_class(). |
34
|
54
|
|
|
|
|
298
|
$class->_get_bytes_from_word(abs($args{data})); |
35
|
54
|
|
|
|
|
449
|
$class->_set_next_free_ptr(%args); |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub _get_bytes_from_word { |
39
|
65761
|
|
|
65761
|
|
118640
|
my($class, $word) = @_; |
40
|
65761
|
|
|
|
|
151149
|
return $class->_encode_word_as_number_of_bytes($word, $class->_num_bytes()); |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
# given an integer and a number of bytes, encode that int |
44
|
|
|
|
|
|
|
# as a sequence of bytes, zero-padding if necessary |
45
|
|
|
|
|
|
|
sub _encode_word_as_number_of_bytes { |
46
|
197073
|
|
|
197073
|
|
294924
|
my($class, $word, $num_bytes) = @_; |
47
|
|
|
|
|
|
|
|
48
|
197073
|
|
|
|
|
243355
|
my $bytes = ''; |
49
|
197073
|
|
|
|
|
344332
|
while($word) { |
50
|
459369
|
|
|
|
|
784985
|
$bytes = chr($word & 0xff).$bytes; |
51
|
459369
|
|
|
|
|
764443
|
$word >>= 8; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# zero-pad if needed |
55
|
197073
|
100
|
|
|
|
329214
|
$bytes = (chr(0) x ($num_bytes - length($bytes))).$bytes |
56
|
|
|
|
|
|
|
if(length($bytes) < $num_bytes); |
57
|
|
|
|
|
|
|
|
58
|
197073
|
|
|
|
|
2437419
|
return $bytes; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
1; |