File Coverage

blib/lib/IO/SWF/Bit.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             package IO::SWF::Bit;
2              
3             #
4             # This module is transport from
5             #
6              
7 2     2   21428 use strict;
  2         3  
  2         67  
8 2     2   9 use warnings;
  2         4  
  2         54  
9              
10 2     2   10 use base 'Class::Accessor::Fast';
  2         6  
  2         1671  
11              
12             __PACKAGE__->mk_accessors( qw(
13             _data
14             _byte_offset
15             _bit_offset
16             _hash
17             ));
18              
19             sub new {
20             my ($class, $args) = @_;
21             my $self;
22             if(ref $args eq 'HASH') {
23             $self = $class->SUPER::new($args);
24             }else{
25             $self = $class->SUPER::new;
26             $self->input('');
27             }
28             return $self;
29             }
30              
31             ###
32             #
33             # data i/o method
34             #
35             # ##
36             sub input {
37             my ($self, $data) = @_;
38             $self->_data($data);
39             $self->_byte_offset(0);
40             $self->_bit_offset(0);
41             }
42              
43             sub output {
44             my ($self, $offset) = @_;
45             $offset ||= 0;
46             my $output_len = $self->_byte_offset;
47             if ($self->_bit_offset > 0) {
48             $output_len++;
49             }
50             if (length($self->_data) == $output_len) {
51             return $self->_data;
52             }
53             return substr($self->_data, $offset, $output_len);
54             }
55              
56             ###
57             #
58             # offset method
59             #
60             ###
61             sub hasNextData {
62             my ($self, $length) = @_;
63             $length ||= 1;
64             if (length($self->_data) < $self->_byte_offset + $length) {
65             return 0;
66             }
67             return 1;
68             }
69              
70             sub setOffset {
71             my ($self, $byte_offset, $bit_offset) = @_;
72             $self->_byte_offset($byte_offset);
73             $self->_bit_offset($bit_offset);
74             return 1;
75             }
76              
77             sub incrementOffset {
78             my ($self, $byte_offset, $bit_offset) = @_;
79             $self->_byte_offset($self->_byte_offset + $byte_offset);
80             $self->_bit_offset($self->_bit_offset + $bit_offset);
81             while ($self->_bit_offset >= 8) {
82             $self->_byte_offset($self->_byte_offset + 1);
83             $self->_bit_offset($self->_bit_offset - 8);
84             }
85             while ($self->_bit_offset < 0) {
86             $self->_byte_offset($self->_byte_offset - 1);
87             $self->_bit_offset($self->_bit_offset + 8);
88             }
89             return 1;
90             }
91              
92             sub getOffset {
93             my $self = shift;
94             return ($self->_byte_offset, $self->_bit_offset);
95             }
96              
97             sub byteAlign {
98             my $self = shift;
99             if ($self->_bit_offset > 0) {
100             $self->_byte_offset($self->_byte_offset + 1);
101             $self->_bit_offset(0);
102             }
103             }
104              
105             ###
106             #
107             # get method
108             #
109             ###
110             sub getData {
111             my ($self, $length) = @_;
112              
113             $self->byteAlign();
114             my $data = substr($self->_data, $self->_byte_offset, $length);
115             $self->_byte_offset($self->_byte_offset + length($data));
116             return $data;
117             }
118              
119             sub getDataUntil {
120             my ($self, $delimiter) = @_;
121              
122             $self->byteAlign();
123             my $pos = defined $delimiter ? index($self->_data, $delimiter, $self->_byte_offset) : undef;
124             my ($length, $delim_len);
125             if (!defined $pos || $pos < 0) {
126             $length = length($self->_data) - $self->_byte_offset;
127             $delim_len = 0;
128             } else {
129             $length = $pos - $self->_byte_offset;
130             $delim_len = length($delimiter);
131             }
132             my $data = $self->getData($length);
133             if ($delim_len > 0) {
134             $self->_byte_offset($self->_byte_offset + $delim_len);
135             }
136             return $data;
137             }
138              
139             sub getUI8 {
140             my $self = shift;
141             $self->byteAlign();
142             my $value = unpack('C', substr($self->_data, $self->_byte_offset, 1));
143             $self->_byte_offset($self->_byte_offset + 1);
144             return $value;
145             }
146              
147             sub getSI8 {
148             my $self = shift;
149             my $value = $self->getUI8();
150             $value -= (1<<8) if ($value>=(1<<7));
151             return $value;
152             }
153              
154             sub getUI16BE {
155             my $self = shift;
156             $self->byteAlign();
157             my $ret = unpack('n', substr($self->_data, $self->_byte_offset, 2));
158             $self->_byte_offset($self->_byte_offset + 2);
159             return $ret;
160             }
161              
162             sub getUI32BE {
163             my $self = shift;
164             $self->byteAlign();
165             my $ret = unpack('N', substr($self->_data, $self->_byte_offset, 4));
166             $self->_byte_offset($self->_byte_offset + 4);
167             return $ret;
168             }
169              
170             sub getUI16LE {
171             my $self = shift;
172             $self->byteAlign();
173             my $ret = unpack('v', substr($self->_data, $self->_byte_offset, 2));
174             $self->_byte_offset($self->_byte_offset + 2);
175             return $ret;
176             }
177              
178             sub getSI16LE {
179             my $self = shift;
180             my $value = $self->getUI16LE();
181             $value -= (1<<16) if ($value>=(1<<15));
182             return $value;
183             }
184              
185             sub getUI32LE {
186             my $self = shift;
187             $self->byteAlign();
188             my $ret = unpack('V', substr($self->_data, $self->_byte_offset, 4));
189             $self->_byte_offset($self->_byte_offset + 4);
190             return $ret;
191             }
192              
193             sub getSI32LE {
194             my $self = shift;
195             my $value = $self->getUI32LE();
196             $value -= (2**32) if ($value>=(2**31));
197             return $value;
198             }
199              
200             sub getUIBit {
201             my $self = shift;
202             if (length($self->_data) <= $self->_byte_offset) {
203             my $data_len = length($self->_data);
204             my $offset = $self->_byte_offset;
205             die "getUIBit: $data_len <= $offset";
206             }
207             my $value = ord(substr($self->_data, $self->_byte_offset, 1));
208             $value = 1 & ($value >> (7 - $self->_bit_offset)); # MSB(Bit) first
209             $self->_bit_offset($self->_bit_offset + 1);
210             if (8 <= $self->_bit_offset) {
211             $self->_byte_offset($self->_byte_offset + 1);
212             $self->_bit_offset(0);
213             }
214             return $value;
215             }
216              
217             sub getUIBits {
218             my ($self, $width) = @_;
219             my $value = 0;
220             for (my $i = 0 ; $i < $width ; $i++) {
221             $value <<= 1;
222             $value |= $self->getUIBit();
223             }
224             return $value;
225             }
226              
227             sub getSIBits {
228             my ($self, $width) = @_;
229             my $value = $self->getUIBits($width);
230             my $msb = $value & (1 << ($width - 1));
231             if ($msb) {
232             my $bitmask = (2 * $msb) - 1;
233             $value = - ($value ^ $bitmask) - 1;
234             }
235             return $value;
236             }
237              
238             # start with the LSB(least significant bit)
239             sub getUIBitLSB {
240             my $self = shift;
241             if (length($self->_data) <= $self->_byte_offset) {
242             my $data_len = length($self->_data);
243             my $offset = $self->_byte_offset;
244             die "getUIBitLSB: $data_len <= $offset";
245             }
246             my $value = ord(substr($self->_data, $self->_byte_offset, 1));
247             $value = 1 & ($value >> $self->_bit_offset); # LSB(Bit) first
248             $self->_bit_offset($self->_bit_offset + 1);
249             if (8 <= $self->_bit_offset) {
250             $self->_byte_offset($self->_byte_offset + 1);
251             $self->_bit_offset(0);
252             }
253             return $value;
254             }
255              
256             sub getUIBitsLSB {
257             my ($self, $width) = @_;
258             my $value = 0;
259             for (my $i = 0 ; $i < $width ; $i++) {
260             $value |= $self->getUIBitLSB() << $i; # LSB(Bit) order
261             }
262             return $value;
263             }
264              
265             sub getSIBitsLSB {
266             my ($self, $width) = @_;
267             my $value = $self->getUIBitsLSB($width);
268             my $msb = $value & (1 << ($width - 1));
269             if ($msb) {
270             my $bitmask = (2 * $msb) - 1;
271             $value = - ($value ^ $bitmask) - 1;
272             }
273             return $value;
274             }
275              
276             ###
277             #
278             # put method
279             #
280             ###
281             sub putData {
282             my ($self, $data) = @_;
283             $self->byteAlign();
284             $self->_data($self->_data . $data);
285             $self->_byte_offset($self->_byte_offset + length($data));
286             return 1;
287             }
288              
289             sub putUI8 {
290             my ($self, $value) = @_;
291             $self->byteAlign();
292             $self->_data($self->_data . pack('C', $value));
293             $self->_byte_offset($self->_byte_offset + 1);
294             return 1;
295             }
296              
297             sub putSI8 {
298             my ($self, $value) = @_;
299             if ($value < 0) {
300             $value = $value + 0x100; # 2-negative reverse
301             }
302             return $self->putUI8($value);
303             }
304              
305             sub putUI16BE {
306             my ($self, $value) = @_;
307             $self->byteAlign();
308             $self->_data($self->_data . pack('n', $value));
309             $self->_byte_offset($self->_byte_offset + 2);
310             return 1;
311             }
312              
313             sub putUI32BE {
314             my ($self, $value) = @_;
315             $self->byteAlign();
316             $self->_data($self->_data . pack('N', $value));
317             $self->_byte_offset($self->_byte_offset + 4);
318             return 1;
319             }
320              
321             sub putUI16LE {
322             my ($self, $value) = @_;
323             $self->byteAlign();
324             $self->_data($self->_data . pack('v', $value));
325             $self->_byte_offset($self->_byte_offset + 2);
326             return 1;
327             }
328              
329             sub putSI16LE {
330             my ($self, $value) = @_;
331             if ($value < 0) {
332             $value = $value + 0x10000; # 2-negative reverse
333             }
334             return $self->putUI16LE($value);
335             }
336              
337             sub putUI32LE {
338             my ($self, $value) = @_;
339             $self->byteAlign();
340             $self->_data($self->_data . pack('V', $value));
341             $self->_byte_offset($self->_byte_offset + 4);
342             return 1;
343             }
344              
345             sub putSI32LE {
346             my ($self, $value) = @_;
347             return $self->putUI32LE($value); # XXX
348             }
349              
350             sub _allocData {
351             my ($self, $need_data_len) = @_;
352             if (!defined $need_data_len) {
353             $need_data_len = $self->_byte_offset;
354             }
355             my $data_len = length($self->_data);
356             if ($data_len < $need_data_len) {
357             my $buff = '';
358             while(length($buff) < $need_data_len - $data_len) { $buff .= chr(0) };
359             $self->_data($self->_data . $buff);
360             }
361             return 1;
362             }
363              
364             sub putUIBit {
365             my ($self, $bit) = @_;
366             $self->_allocData($self->_byte_offset + 1);
367             if ($bit > 0) {
368             my $value = ord(substr($self->_data, $self->_byte_offset, 1));
369             $value |= 1 << (7 - $self->_bit_offset);
370             my $new_data = $self->_data;
371             substr($new_data, $self->_byte_offset, 1, chr($value));
372             $self->_data($new_data);
373             }
374             $self->_bit_offset($self->_bit_offset + 1);
375             if (8 <= $self->_bit_offset) {
376             $self->_byte_offset($self->_byte_offset + 1);
377             $self->_bit_offset(0);
378             }
379             return 1;
380             }
381              
382             sub putUIBits {
383             my ($self, $value, $width) = @_;
384             for (my $i = $width - 1 ; $i >= 0 ; $i--) {
385             my $bit = ($value >> $i) & 1;
386             my $ret = $self->putUIBit($bit);
387             if (!$ret) {
388             return $ret;
389             }
390             }
391             return 1;
392             }
393              
394             sub putSIBits {
395             my ($self, $value, $width) = @_;
396             if ($value < 0) {
397             my $msb = 1 << ($width - 1);
398             my $bitmask = (2 * $msb) - 1;
399             $value = (-$value - 1) ^ $bitmask;
400             }
401             return $self->putUIBits($value, $width);
402             }
403              
404             # start with the LSB(least significant bit)
405             sub putUIBitLSB {
406             my ($self, $bit) = @_;
407             $self->_allocData($self->_byte_offset + 1);
408             if ($bit > 0) {
409             my $value = ord(substr($self->_data, $self->_byte_offset, 1));
410             $value |= 1 << $self->_bit_offset; # LSB(Bit) first
411             my $new_data = $self->_data;
412             substr($new_data, $self->_byte_offset, length($value), chr($value));
413             $self->_data($new_data);
414             }
415             $self->_bit_offset($self->_bit_offset + 1);
416             if (8 <= $self->_bit_offset) {
417             $self->_byte_offset($self->_byte_offset + 1);
418             $self->_bit_offset(0);
419             }
420             return 1;
421             }
422              
423             sub putUIBitsLSB {
424             my ($self, $value, $width) = @_;
425             for (my $i = 0 ; $i < $width ; $i--) { # LSB(Bit) order
426             my $bit = ($value >> $i) & 1;
427             my $ret = $self->putUIBit($bit);
428             if (!$ret) {
429             return $ret;
430             }
431             }
432             return 1;
433             }
434              
435             sub putSIBitsLSB {
436             my ($self, $value, $width) = @_;
437             if ($value < 0) {
438             my $msb = 1 << ($width - 1);
439             my $bitmask = (2 * $msb) - 1;
440             $value = (-$value - 1) ^ $bitmask;
441             }
442             return $self->putUIBits($value, $width);
443             }
444              
445             ###
446             #
447             # set method
448             #
449             ###
450             sub setUI32LE {
451             my ($self, $value, $byte_offset) = @_;
452             my $data = pack('V', $value);
453             my $new_data = $self->_data;
454             substr($new_data, $byte_offset, length($data), $data);
455             $self->_data($new_data);
456             return 1;
457             }
458              
459             ###
460             #
461             # need bits
462             #
463             ###
464             sub need_bits_unsigned {
465             my ($self, $n) = @_;
466             my $i;
467             for ($i = 0 ; $n ; $i++) {
468             $n >>= 1;
469             }
470             return $i;
471             }
472              
473             sub need_bits_signed {
474             my ($self, $n) = @_;
475             my $ret;
476             if ($n < -1) {
477             $n = -1 - $n;
478             }
479             if ($n >= 0) {
480             my $i;
481             for ($i = 0 ; $n ; $i++) {
482             $n >>= 1;
483             }
484             $ret = 1 + $i;
485             } else { # $n == -1
486             $ret = 1;
487             }
488             return $ret;
489             }
490              
491             #
492             # general purpose hexdump routine
493             #
494             sub hexdump {
495             my ($self, $offset, $length, $limit) = @_;
496             print(" 0 1 2 3 4 5 6 7 8 9 a b c d e f 0123456789abcdef\n");
497             my $dump_str = '';
498             my $i;
499             if ($offset % 0x10) {
500             printf("0x%08x ", $offset - ($offset % 0x10));
501             $dump_str = " " x ($offset % 0x10);
502             }
503             for ($i = 0; $i < $offset % 0x10; $i++) {
504             if ($i == 0) {
505             print ' ';
506             }
507             if ($i == 8) {
508             print ' ';
509             }
510             print ' ';
511             }
512             for ($i = $offset ; $i < $offset + $length; $i++) {
513             if ((defined($limit)) && ($i >= $offset + $limit)) {
514             last;
515             }
516             if (($i % 0x10) == 0) {
517             printf("0x%08x ", $i);
518             }
519             if ($i%0x10 == 8) {
520             print ' ';
521             }
522             if ($i < length($self->_data)) {
523             my $chr = substr($self->_data, $i, 1);
524             my $value = ord($chr);
525             if ((0x20 < $value) && ($value < 0x7f)) { # XXX: printable
526             $dump_str .= $chr;
527             } else {
528             $dump_str .= ' ';
529             }
530             printf("%02x ", $value);
531             } else {
532             $dump_str .= ' ';
533             print ' ';
534             }
535             if (($i % 0x10) == 0x0f) {
536             print " ";
537             print $dump_str;
538             print "\n";
539             $dump_str = '';
540             }
541             }
542             if (($i % 0x10) != 0) {
543             print ' ' x (3 * (0x10 - ($i % 0x10)));
544             if ($i < 8) {
545             print ' ';
546             }
547             print " ";
548             print $dump_str;
549             print "\n";
550             }
551             if ((defined($limit)) && ($i >= $offset + $limit)) {
552             print "...(truncated)...\n";
553             }
554             }
555              
556             1;
557              
558             __END__