File Coverage

blib/lib/Data/CompactReadonly/V0/Scalar.pm
Criterion Covered Total %
statement 33 33 100.0
branch 2 2 100.0
condition n/a
subroutine 8 8 100.0
pod n/a
total 43 43 100.0


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;