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.9

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