1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
use Config;
$file = @ARGV ? shift : 'examples/perltypes.pl';
open OUT, ">$file" or die "Can't create $file: $!";
print OUT <<"!GROK!THIS!";
$Config{startperl} -w
!GROK!THIS!
print OUT <<'!NO!SUBS!';
################################################################################
#
# $Project: /Convert-Binary-C $
# $Author: mhx $
# $Date: 2009/03/15 04:10:53 +0100 $
# $Revision: 17 $
# $Source: /bin/perltypes.PL $
#
################################################################################
#
# Copyright (c) 2002-2009 Marcus Holland-Moritz. All rights reserved.
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
################################################################################
#===============================================================================
#
# Parse perl's header files and play around with the types they define.
#
#===============================================================================
use Convert::Binary::C;
use Data::Dumper;
use strict;
my $base;
-d "$_/include" and $base = "$_/include" and last for qw( tests ../tests );
defined $base or die <<MSG;
Please run this script from either the 'examples' directory
or the distribution base directory.
MSG
#-------------------------------------
# Create an object, set configuration.
#-------------------------------------
my $cfg = require "$base/config.pl";
my $c = new Convert::Binary::C %$cfg;
#------------------
# Parse the C file.
#------------------
eval { $c->parse_file( "$base/include.c" ) };
#-----------------------
# Check for parse error.
#-----------------------
if( $@ ) {
die "Parse error: $@";
}
#----------------------------
# Dump out the configuration.
#----------------------------
print Dumper( $c->configure );
#----------------------------
# Print all the enumerations.
#----------------------------
my @enums = $c->enum_names;
print "\nenums: @enums\n\n";
#---------------------------------------------------------------------------
# Print all structs, sorted by size; skip all structs smaller than 50 bytes.
#---------------------------------------------------------------------------
print "large structs:\n\n";
my @structs = sort { $c->sizeof( $b ) <=> $c->sizeof( $a ) }
grep { $c->sizeof( $_ ) >= 50 }
$c->struct_names;
for my $struct ( @structs ) {
printf "struct %-20s => %4d bytes\n", $struct, $c->sizeof( $struct );
}
print "\n";
#-----------------------------------------------
# Dump the definition of the __socket_type enum
#-----------------------------------------------
print Data::Dumper->Dump( [$c->enum('__socket_type')], ['__socket_type'] );
!NO!SUBS!
close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
|
