File Coverage

examples/convert.pl
Criterion Covered Total %
statement 26 26 100.0
branch 1 2 50.0
condition n/a
subroutine 4 4 100.0
pod n/a
total 31 32 96.8


line stmt bran cond sub pod time code
1             #!/usr/local/bin/perl -w
2             ################################################################################
3             #
4             # Copyright (c) 2002-2020 Marcus Holland-Moritz. All rights reserved.
5             # This program is free software; you can redistribute it and/or modify
6             # it under the same terms as Perl itself.
7             #
8             ################################################################################
9              
10             #===============================================================================
11             #
12             # Parse a C struct and use 'pack', 'unpack', 'sizeof' and 'offsetof'.
13             #
14             #===============================================================================
15              
16 1     1   732 use Convert::Binary::C;
  1         2  
  1         43  
17 1     1   536 use Data::Dumper;
  1         5824  
  1         55  
18 1     1   6 use strict;
  1         2  
  1         1370  
19              
20             #--------------------------------------------------------------
21             # Create an object, configure it, and parse some embedded code.
22             #--------------------------------------------------------------
23              
24 1         70 my $c = Convert::Binary::C->new( LongSize => 4, ShortSize => 2 )
25             ->Alignment( 4 )
26             ->ByteOrder( 'BigEndian' )
27             ->parse( <<'ENDC' );
28              
29             typedef signed long i_32;
30             typedef unsigned long u_32;
31             typedef signed short i_16;
32             typedef unsigned short u_16;
33             typedef signed char i_8;
34             typedef unsigned char u_8;
35              
36             struct convert {
37             i_8 byte;
38             i_16 word[2];
39             i_32 dword;
40             union {
41             u_32 dword;
42             u_8 bytes[ sizeof( u_32 ) ];
43             } c32;
44             };
45              
46             ENDC
47              
48             #-----------------------------------------------------------
49             # Print the offsets and sizes of some of the struct members.
50             #-----------------------------------------------------------
51              
52 1         5 for( qw( byte word dword ) ) {
53 3         50 print "offsetof( 'convert', '$_' ) = ", $c->offsetof( 'convert', $_ );
54 3         29 print ", sizeof( 'convert.$_' ) = ", $c->sizeof( "convert.$_" ), "\n";
55             }
56              
57             #-------------------------------------------------
58             # Pack a Perl data structure into a binary string.
59             # Note that not all members need to be specified.
60             #-------------------------------------------------
61              
62 1         28 my $binary = $c->pack( 'convert', {
63             word => [-30000, 4711],
64             c32 => { dword => 0x01020304 }
65             } );
66              
67             #-------------------------------------------------------
68             # Just a demonstration that pack does the right thing...
69             #-------------------------------------------------------
70              
71 1 50       10 if( $c->sizeof( 'convert' ) == length $binary ) {
72 1         2 print "\nYup, the size matches!\n";
73             }
74              
75             #-------------------------------------------------------
76             # Hexdump the binary string.
77             # Note that all padding regions are initialized to zero.
78             #-------------------------------------------------------
79              
80 1         4 print "\nBinary: ", hexdump( $binary ), "\n\n";
81              
82             #---------------------------------------------------------------
83             # Unpack the binary string and dump the returned data structure.
84             #---------------------------------------------------------------
85              
86 1         13 my $data = $c->unpack( 'convert', $binary );
87 1         10 print Data::Dumper->Dump( [$data], ['data'] );
88              
89             #------------------------------------------------------
90             # You can modify selected elements in the binary string
91             # using the 3-argument version of 'pack'.
92             #------------------------------------------------------
93              
94             # only 'dword' will be modified
95 1         106 $c->pack( 'convert', { dword => -559038737 }, $binary );
96 1         3 print "\nBinary: ", hexdump( $binary ), "\n\n";
97 1         12 print Dumper( $c->unpack( 'convert', $binary ) );
98              
99             #--------------------------------------------------
100             # You can also use pack/unpack on compound members.
101             #--------------------------------------------------
102              
103 1         75 my $array = $c->unpack( 'convert.c32.bytes', 'ABCD' );
104 1         0 print "\n\$array = [ @$array ]\n";
105              
106             #==========================================================
107             # SUBROUTINES
108             #==========================================================
109              
110             sub hexdump
111             {
112 2     2   8 join ' ', map { sprintf "%02X", $_ } unpack "C*", $_[0];
  32         51  
113             }