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