line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::CompactReadonly::V0::Scalar; |
2
|
|
|
|
|
|
|
our $VERSION = '0.1.0'; |
3
|
|
|
|
|
|
|
|
4
|
9
|
|
|
9
|
|
63
|
use warnings; |
|
9
|
|
|
|
|
20
|
|
|
9
|
|
|
|
|
319
|
|
5
|
9
|
|
|
9
|
|
48
|
use strict; |
|
9
|
|
|
|
|
19
|
|
|
9
|
|
|
|
|
207
|
|
6
|
9
|
|
|
9
|
|
58
|
use base 'Data::CompactReadonly::V0::Node'; |
|
9
|
|
|
|
|
17
|
|
|
9
|
|
|
|
|
4333
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
sub _init { |
9
|
1036
|
|
|
1036
|
|
2868
|
my($class, %args) = @_; |
10
|
1036
|
|
|
|
|
1799
|
my $root = $args{root}; |
11
|
|
|
|
|
|
|
|
12
|
1036
|
|
|
|
|
2943
|
my $word = $root->_bytes_at_current_offset($class->_num_bytes()); |
13
|
1036
|
|
|
|
|
2775
|
return $class->_decode_word($word); |
14
|
|
|
|
|
|
|
} |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# turn a sequence of bytes into an integer |
17
|
|
|
|
|
|
|
sub _decode_word { |
18
|
1733
|
|
|
1733
|
|
3541
|
my($class, $word) = @_; |
19
|
|
|
|
|
|
|
|
20
|
1733
|
|
|
|
|
2649
|
my $value = 0; |
21
|
1733
|
|
|
|
|
5137
|
foreach my $byte (split(//, $word)) { |
22
|
2581
|
|
|
|
|
4047
|
$value *= 256; |
23
|
2581
|
|
|
|
|
4559
|
$value += ord($byte); |
24
|
|
|
|
|
|
|
} |
25
|
1733
|
|
|
|
|
6742
|
return $value; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub _create { |
29
|
58
|
|
|
58
|
|
227
|
my($class, %args) = @_; |
30
|
58
|
|
|
|
|
127
|
my $fh = $args{fh}; |
31
|
58
|
|
|
|
|
323
|
$class->_stash_already_seen(%args); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
print $fh $class->_type_byte_from_class(). |
34
|
58
|
|
|
|
|
352
|
$class->_get_bytes_from_word(abs($args{data})); |
35
|
58
|
|
|
|
|
581
|
$class->_set_next_free_ptr(%args); |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
sub _get_bytes_from_word { |
39
|
65778
|
|
|
65778
|
|
141182
|
my($class, $word) = @_; |
40
|
65778
|
|
|
|
|
173928
|
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
|
197117
|
|
|
197117
|
|
384579
|
my($class, $word, $num_bytes) = @_; |
47
|
|
|
|
|
|
|
|
48
|
197117
|
|
|
|
|
310882
|
my $bytes = ''; |
49
|
197117
|
|
|
|
|
420155
|
while($word) { |
50
|
459407
|
|
|
|
|
983153
|
$bytes = chr($word & 0xff).$bytes; |
51
|
459407
|
|
|
|
|
968120
|
$word >>= 8; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# zero-pad if needed |
55
|
197117
|
100
|
|
|
|
386630
|
$bytes = (chr(0) x ($num_bytes - length($bytes))).$bytes |
56
|
|
|
|
|
|
|
if(length($bytes) < $num_bytes); |
57
|
|
|
|
|
|
|
|
58
|
197117
|
|
|
|
|
3331857
|
return $bytes; |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
1; |