File Coverage

blib/lib/IO/Handle/Packable.pm
Criterion Covered Total %
statement 33 34 97.0
branch 5 10 50.0
condition 8 32 25.0
subroutine 7 7 100.0
pod 2 2 100.0
total 55 85 64.7


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2018 -- leonerd@leonerd.org.uk
5              
6             package IO::Handle::Packable;
7              
8 4     4   175553 use strict;
  4         32  
  4         95  
9 4     4   19 use warnings;
  4         6  
  4         96  
10 4     4   19 use base qw( IO::File );
  4         5  
  4         1849  
11              
12             our $VERSION = '0.01';
13              
14             use constant {
15 4         1851 BYTES_FMT_i => length( pack "i", 0 ),
16             BYTES_FMT_f => length( pack "f", 0 ),
17             BYTES_FMT_d => length( pack "d", 0 ),
18 4     4   28768 };
  4         8  
19              
20             =head1 NAME
21              
22             C - add C and C methods to an C
23              
24             =head1 SYNOPSIS
25              
26             use IO::Handle::Packable;
27              
28             my $fh = IO::Handle::Packable->new;
29             $fh->open( "my-data.dat", ">" );
30              
31             while( my ( $x, $y, $value ) = $fh->unpack( "S S i" ) ) {
32             print "Value at ($x,$y) is $value\n";
33             }
34              
35             =head1 DESCRIPTION
36              
37             This subclass of L adds two new methods to an IO handle; L
38             and L. These provide the ability to write or read packed binary
39             values to and from the filehandle, using the same kind of format strings as
40             the core perl functions of the same names.
41              
42             =head2 Unpack Format
43              
44             Note that due to limitations in the way core perl's C function
45             works, this module has to know in advance how many bytes will be needed per
46             C call, before it can unpack the data. As a result, it cannot cope
47             with all of the features that core's C can do.
48              
49             The following features are supported:
50              
51             a A # binary and ASCII data of fixed length
52              
53             c C s S i I l L q Q # integers
54              
55             n N v V # legacy fixed-endian integers
56              
57             f d # native floating-point
58              
59             s< s> # endian specifiers
60              
61             a123 i45 # repeat counts
62              
63             The following features are not currently supported, though should be
64             relatively easy to add:
65              
66             b B # bitstrings
67              
68             F D # perl-internal floating-point
69              
70             i! # native-length integers
71              
72             (c c s) # groups
73              
74             # # comments
75              
76             Due to needing to know lengths in advance, the following features will be much
77             harder to implement without at least some redesign to the current
78             implementation:
79              
80             z* # NUL-terminated ASCIIZ strings
81              
82             n/A # length-prefixed strings
83              
84             . @ x # positioning control
85              
86             =head1 METHODS
87              
88             =cut
89              
90             sub _length_of_packformat
91             {
92 3     3   4 my ( $format ) = @_;
93 3         5 local $_ = $format;
94              
95 3         5 my $bytes = 0;
96 3         8 while( length ) {
97 5         11 s/^\s+//;
98 5 50       11 length or last;
99              
100 5         5 my $this;
101              
102             # Basic template
103 5 0 100     31 s/^[aAcC]// and $this = 1 or
      50        
      66        
      50        
      33        
      0        
      33        
      0        
      0        
      0        
      0        
      0        
      0        
104             s/^[sSnv]// and $this = 2 or
105             s/^[iI]// and $this = BYTES_FMT_i or
106             s/^[lLNV]// and $this = 4 or
107             s/^[qQ]// and $this = 8 or
108             s/^f// and $this = BYTES_FMT_f or
109             s/^d// and $this = BYTES_FMT_d or
110 0         0 die "TODO: unrecognised template char ${\substr $_, 0, 1}\n";
111              
112             # Ignore endian specifiers
113 5         10 s/^[<>]//;
114              
115             # Repeat count
116 5 100       14 s/^(\d+)// and $this *= $1;
117              
118 5         10 $bytes += $this;
119             }
120              
121 3         5 return $bytes;
122             }
123              
124             =head2 pack
125              
126             $fh->pack( $format, @values )
127              
128             Uses the core C function to pack the values given the format into a
129             binary string, then writes the result to the filehandle.
130              
131             =cut
132              
133             sub pack
134             {
135 1     1 1 820 my $self = shift;
136 1         4 my ( $format, @values ) = @_;
137              
138 1         13 $self->print( pack $format, @values );
139             }
140              
141             =head2 unpack
142              
143             @values = $fh->unpack( $format )
144              
145             Uses the core C function to unpack bytes read from the filehandle
146             using the given format.
147              
148             =cut
149              
150             sub unpack
151             {
152 3     3 1 1963 my $self = shift;
153 3         7 my ( $format ) = @_;
154              
155 3         7 my $len = _length_of_packformat $format;
156 3 50       14 defined( my $ret = $self->read( my $buf, $len ) ) or return undef;
157 3 50       26 $ret or return;
158              
159 3         20 return unpack $format, $buf;
160             }
161              
162             =head1 AUTHOR
163              
164             Paul Evans
165              
166             =cut
167              
168             0x55AA;