← Index
NYTProf Performance Profile   « line view »
For Makefile.PL
  Run on Sun Mar 1 16:04:44 2015
Reported on Sun Mar 1 16:09:02 2015

FilenameC:/tmp64ng/perl/vendor/lib/Win32/API/Type.pm
StatementsExecuted 1179 statements in 15.6ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1110s0sWin32::API::Type::::BEGIN@15Win32::API::Type::BEGIN@15
1110s0sWin32::API::Type::::BEGIN@16Win32::API::Type::BEGIN@16
1110s0sWin32::API::Type::::BEGIN@161Win32::API::Type::BEGIN@161
1110s0sWin32::API::Type::::BEGIN@17Win32::API::Type::BEGIN@17
1110s0sWin32::API::Type::::BEGIN@21Win32::API::Type::BEGIN@21
1110s0sWin32::API::Type::::BEGIN@22Win32::API::Type::BEGIN@22
1110s0sWin32::API::Type::::BEGIN@23Win32::API::Type::BEGIN@23
1110s0sWin32::API::Type::::CORE:closeWin32::API::Type::CORE:close (opcode)
508710s0sWin32::API::Type::::CORE:matchWin32::API::Type::CORE:match (opcode)
1110s0sWin32::API::Type::::CORE:readlineWin32::API::Type::CORE:readline (opcode)
4110s0sWin32::API::Type::::CORE:substWin32::API::Type::CORE:subst (opcode)
0000s0sWin32::API::Type::::DEBUGWin32::API::Type::DEBUG
0000s0sWin32::API::Type::::PackWin32::API::Type::Pack
0000s0sWin32::API::Type::::UnpackWin32::API::Type::Unpack
1110s0sWin32::API::Type::::is_knownWin32::API::Type::is_known
1110s0sWin32::API::Type::::is_pointerWin32::API::Type::is_pointer
0000s0sWin32::API::Type::::newWin32::API::Type::new
4320s0sWin32::API::Type::::packingWin32::API::Type::packing
45110s0sWin32::API::Type::::pointer_pack_typeWin32::API::Type::pointer_pack_type (xsub)
0000s0sWin32::API::Type::::sizeofWin32::API::Type::sizeof
0000s0sWin32::API::Type::::typedefWin32::API::Type::typedef
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Win32::API::Type;
2
3# See the bottom of this file for the POD documentation. Search for the
4# string '=head'.
5
6#######################################################################
7#
8# Win32::API::Type - Perl Win32 API type definitions
9#
10# Author: Aldo Calpini <dada@perl.it>
11# Maintainer: Cosimo Streppone <cosimo@cpan.org>
12#
13#######################################################################
14
1520s20s
# spent 0s within Win32::API::Type::BEGIN@15 which was called: # once (0s+0s) by Win32::API::BEGIN@62 at line 15
use strict;
# spent 0s making 1 call to Win32::API::Type::BEGIN@15 # spent 0s making 1 call to strict::import
1620s20s
# spent 0s within Win32::API::Type::BEGIN@16 which was called: # once (0s+0s) by Win32::API::BEGIN@62 at line 16
use warnings;
# spent 0s making 1 call to Win32::API::Type::BEGIN@16 # spent 0s making 1 call to warnings::import
1720s20s
# spent 0s within Win32::API::Type::BEGIN@17 which was called: # once (0s+0s) by Win32::API::BEGIN@62 at line 17
use vars qw( %Known %PackSize %Modifier %Pointer $VERSION @ISA );
# spent 0s making 1 call to Win32::API::Type::BEGIN@17 # spent 0s making 1 call to vars::import
18
1910s$VERSION = '0.69';
20
2120s20s
# spent 0s within Win32::API::Type::BEGIN@21 which was called: # once (0s+0s) by Win32::API::BEGIN@62 at line 21
use Carp;
# spent 0s making 1 call to Exporter::import # spent 0s making 1 call to Win32::API::Type::BEGIN@21
2210s
# spent 0s within Win32::API::Type::BEGIN@22 which was called: # once (0s+0s) by Win32::API::BEGIN@62 at line 24
BEGIN{
2320s20s
# spent 0s within Win32::API::Type::BEGIN@23 which was called: # once (0s+0s) by Win32::API::BEGIN@62 at line 23
use Config;
# spent 0s making 1 call to Config::import # spent 0s making 1 call to Win32::API::Type::BEGIN@23
2410s10s}
# spent 0s making 1 call to Win32::API::Type::BEGIN@22
2510srequire Exporter; # to export the constants to the main:: space
2610srequire DynaLoader; # to dynuhlode the module.
2710s@ISA = qw( Exporter DynaLoader );
28
29sub DEBUG {
30 if ($Win32::API::DEBUG) {
31 printf @_ if @_ or return 1;
32 }
33 else {
34 return 0;
35 }
36}
37
38sub pointer_pack_type ();
3910s%Known = ();
4010s%PackSize = ();
4110s%Modifier = ();
4210s%Pointer = ();
43
44# Initialize data structures at startup.
45# Aldo wants to keep the <DATA> approach.
46#
4710smy $section = 'nothing';
4810s10sforeach (<DATA>) {
# spent 0s making 1 call to Win32::API::Type::CORE:readline
491760s3400s next if /^\s*#/ or /^\s*$/;
# spent 0s making 340 calls to Win32::API::Type::CORE:match, avg 0s/call
501570s chomp;
511570s1570s if (/\[(.+)\]/) {
# spent 0s making 157 calls to Win32::API::Type::CORE:match, avg 0s/call
5240s $section = $1;
5340s next;
54 }
551530s if ($section eq 'TYPE') {
56920s my ($name, $packing) = split(/\s+/);
57
58 # DEBUG "(PM)Type::INIT: Known('$name') => '$packing'\n";
59920s450s if ($packing eq '_P') {
# spent 0s making 45 calls to Win32::API::Type::pointer_pack_type, avg 0s/call
60 $packing = pointer_pack_type();
61 }
62920s $Known{$name} = $packing;
63 }
64 elsif ($section eq 'PACKSIZE') {
65150s my ($packing, $size) = split(/\s+/);
66
67 # DEBUG "(PM)Type::INIT: PackSize('$packing') => '$size'\n";
68150s30s if ($size eq '_P') {
# spent 0s making 3 calls to Config::FETCH, avg 0s/call
69 $size = $Config{ptrsize};
70 }
71150s $PackSize{$packing} = $size;
72 }
73 elsif ($section eq 'MODIFIER') {
7420s my ($modifier, $mapto) = split(/\s+/, $_, 2);
7520s my %maps = ();
7620s foreach my $item (split(/\s+/, $mapto)) {
7780s my ($k, $v) = split(/=/, $item);
7880s $maps{$k} = $v;
79 }
80
81 # DEBUG "(PM)Type::INIT: Modifier('$modifier') => '%maps'\n";
8220s $Modifier{$modifier} = {%maps};
83 }
84 elsif ($section eq 'POINTER') {
85440s my ($pointer, $pointto) = split(/\s+/);
86
87 # DEBUG "(PM)Type::INIT: Pointer('$pointer') => '$pointto'\n";
88440s $Pointer{$pointer} = $pointto;
89 }
90}
9110s10sclose(DATA);
# spent 0s making 1 call to Win32::API::Type::CORE:close
92
93sub new {
94 my $class = shift;
95 my ($type) = @_;
96 my $packing = packing($type);
97 my $size = sizeof($type);
98 my $self = {
99 type => $type,
100 packing => $packing,
101 size => $size,
102 };
103 return bless $self;
104}
105
106sub typedef {
107 my $class = shift;
108 my ($name, $type) = @_;
109 $type =~ m/^\s*(.*?)\s*$/;
110 $type =~ m/^(.+?)\s*(\*)$/;
111 $type = $1;
112 $type .= $2 if defined $2;
113 $name =~ m/^\s*(.*?)\s*$/;
114 $name =~ m/^(.+?)\s*(\*)$/;
115 $name = $1;
116 $name .= $2 if defined $2;
117 #FIXME BUG, unsigned __int64 * doesn't pase in typedef, it does in parse_prototype
118 my $packing = packing($type, $name); #FIXME BUG
119 if(! defined $packing){
120 warn "Win32::API::Type::typedef: WARNING unknown type '$_[1]'";
121 return undef;
122 }
123 #Win32::API::Struct logic
124 #limitation, this won't alias a new struct type to an existing struct type
125 #this only creates new struct type pointer types to an existing struct type
126 if($packing eq '>'){
127 if(is_pointer($type)){
128 $packing = 'T';
129 $type =~ s/\s*\*$//; #chop off ' *'
130 $Win32::API::Struct::Pointer{$name} = $type;
131 }
132 else{
133 warn "Win32::API::Type::typedef: aliasing struct \"".$_[0]
134 ."\" to struct \"".$_[1]."\" not supported";
135 return undef;
136 }
137 }
138 DEBUG "(PM)Type::typedef: packing='$packing'\n";
139 if($packing eq 'p'){
140 $Pointer{$name} = $Pointer{$type};
141 }else{
142 $Known{$name} = $packing;
143 }
144 return 1;
145}
146
147
148
# spent 0s within Win32::API::Type::is_known which was called: # once (0s+0s) by Win32::API::parse_prototype at line 573 of Win32/API.pm
sub is_known {
14910s my $self = shift;
15010s my $type = shift;
15110s $type = $self unless defined $type;
15210s10s if (ref($type) =~ /Win32::API::Type/) {
# spent 0s making 1 call to Win32::API::Type::CORE:match
153 return 1;
154 }
155 else {
15610s10s return defined packing($type);
# spent 0s making 1 call to Win32::API::Type::packing
157 }
158}
159
160#const optimize
161
# spent 0s within Win32::API::Type::BEGIN@161 which was called: # once (0s+0s) by Win32::API::BEGIN@62 at line 165
BEGIN {
16210s10s eval ' sub pointer_pack_type () { "'
# spent 0s making 1 call to Config::FETCH
163 .($Config{ptrsize} == 8 ? 'Q' : 'L').
164 '" }';
165115.6ms10s}
# spent 0s making 1 call to Win32::API::Type::BEGIN@161
166
167sub sizeof {
168 my $self = shift;
169 my $type = shift;
170 $type = $self unless defined $type;
171 if (ref($type) =~ /Win32::API::Type/) {
172 return $self->{size};
173 }
174 else {
175 my $packing = packing($type);
176 if ($packing =~ /(\w)\*(\d+)/) {
177 return $PackSize{$1} * $2;
178 }
179 else {
180 return $PackSize{$packing};
181 }
182 }
183}
184# $packing_letter = packing( [$class = 'Win32::API::Type' ,] $type [, $pass_numeric])
185
# spent 0s within Win32::API::Type::packing which was called 4 times, avg 0s/call: # 2 times (0s+0s) by Win32::API::parse_prototype at line 583 of Win32/API.pm, avg 0s/call # once (0s+0s) by Win32::API::Type::is_known at line 156 # once (0s+0s) by Win32::API::parse_prototype at line 588 of Win32/API.pm
sub packing {
186
187 # DEBUG "(PM)Type::packing: called by ". join("::", (caller(1))[0,3]). "\n";
18840s my $self = shift;
18940s my $is_pointer = 0;
19040s40s if (ref($self) =~ /Win32::API::Type/) {
# spent 0s making 4 calls to Win32::API::Type::CORE:match, avg 0s/call
191
192 # DEBUG "(PM)Type::packing: got an object\n";
193 return $self->{packing};
194 }
19540s my $type = ($self eq 'Win32::API::Type') ? shift : $self;
19640s my $name = shift;
19740s my $pass_numeric = shift;
198
199 # DEBUG "(PM)Type::packing: got '$type', '$name'\n";
20040s my ($modifier, $size, $packing);
20140s40s if (exists $Pointer{$type}) {
# spent 0s making 4 calls to Win32::API::Type::CORE:match, avg 0s/call
202
203 # DEBUG "(PM)Type::packing: got '$type', is really '$Pointer{$type}'\n";
204 $type = $Pointer{$type};
205 $is_pointer = 1;
206 }
207 elsif ($type =~ /(\w+)\s+(\w+)/) {
208 $modifier = $1;
209 $type = $2;
210
211 # DEBUG "(PM)packing: got modifier '$modifier', type '$type'\n";
212 }
213
21440s40s $type =~ s/\s*\*$//; #kill whitespace "CHAR " isn't "CHAR"
# spent 0s making 4 calls to Win32::API::Type::CORE:subst, avg 0s/call
215
21640s if (exists $Known{$type}) {
21740s if (defined $name and $name =~ s/\[(.*)\]$//) {
218 $size = $1;
219 $packing = $Known{$type}[0] . "*" . $size;
220
221 # DEBUG "(PM)Type::packing: composite packing: '$packing' '$size'\n";
222 }
223 else {
22440s $packing = $Known{$type};
22540s if ($is_pointer and ($packing eq 'c' or $packing eq 'S')) {
226 $packing = "p";
227 }
228
229 # DEBUG "(PM)Type::packing: simple packing: '$packing'\n";
230 }
23140s if (defined $modifier and exists $Modifier{$modifier}->{$type}) {
232
233# DEBUG "(PM)Type::packing: applying modifier '$modifier' -> '$Modifier{$modifier}->{$type}'\n";
234 $packing = $Modifier{$modifier}->{$type};
235 if(!$pass_numeric) { #for older num unaware calls
236 substr($packing, 0, length("num"), '');
237 }
238 }
23940s return $packing;
240 }
241 else {
242
243 # DEBUG "(PM)Type::packing: NOT FOUND\n";
244 return undef;
245 }
246}
247
248
249
# spent 0s within Win32::API::Type::is_pointer which was called: # once (0s+0s) by Win32::API::parse_prototype at line 574 of Win32/API.pm
sub is_pointer {
25010s my $self = shift;
25110s my $type = shift;
25210s $type = $self unless defined $type;
25310s10s if (ref($type) =~ /Win32::API::Type/) {
# spent 0s making 1 call to Win32::API::Type::CORE:match
254 return 1;
255 }
256 else {
25710s10s if ($type =~ /\*$/) {
# spent 0s making 1 call to Win32::API::Type::CORE:match
258 return 1;
259 }
260 else {
26110s return exists $Pointer{$type};
262 }
263 }
264}
265
266sub Pack {
267 my $type = $_[1];
268
269 my $pack_type = packing($type);
270 #print "Pack: type $type pack_type $pack_type\n";
271 if ($pack_type eq 'p') { #char or wide char pointer
272 #$pack_type = 'Z*';
273 return;
274 }
275 elsif(IVSIZE() == 4 && ($pack_type eq 'q' || $pack_type eq 'Q')){
276 if($_[0]->UseMI64() || ref($_[2])){ #un/signed meaningless
277 $_[2] = Math::Int64::int64_to_native($_[2]);
278 }
279 else{
280 if(length($_[2]) < 8){
281 warn("Win32::API::Call value for 64 bit integer is under 8 bytes long");
282 $_[2] = pack('a8', $_[2]);
283 }
284 }
285 return;
286 }
287 $_[2] = pack($pack_type, $_[2]);
288 return;
289}
290
291sub Unpack {
292 my $type = $_[1];
293
294 my $pack_type = packing($type);
295
296 if ($pack_type eq 'p') {
297 DEBUG "(PM)Type::Unpack: got packing 'p': is a pointer\n";
298 #$pack_type = 'Z*';
299 return;
300 }
301 elsif(IVSIZE() == 4){
302 #todo debugging output
303 if($pack_type eq 'q'){
304 if($_[0]->UseMI64() || ref($_[2])){
305 $_[2] = Math::Int64::native_to_int64($_[2]);
306 DEBUG "(PM)Type::Unpack: returning signed Math::Int64 '".$_[2]."'\n";
307 }
308 return;
309 }elsif($pack_type eq 'Q'){
310 if($_[0]->UseMI64() || ref($_[2])){
311 $_[2] = Math::Int64::native_to_uint64($_[2]);
312 DEBUG "(PM)Type::Unpack: returning unsigned Math::Int64 '".$_[2]."'\n";
313 }
314 return;
315 }
316 }
317 DEBUG "(PM)Type::Unpack: unpacking '$pack_type' '$_[2]'\n";
318 $_[2] = unpack($pack_type, $_[2]);
319 DEBUG "(PM)Type::Unpack: returning '" . ($_[2] || '') . "'\n";
320}
321
32210s1;
323
324#######################################################################
325# DOCUMENTATION
326#
327
328=head1 NAME
329
330Win32::API::Type - C type support package for Win32::API
331
332=head1 SYNOPSIS
333
334 use Win32::API;
335
336 Win32::API::Type->typedef( 'my_number', 'LONG' );
337
338
339=head1 ABSTRACT
340
341This module is a support package for Win32::API that implements
342C types for the import with prototype functionality.
343
344See L<Win32::API> for more info about its usage.
345
346=head1 DESCRIPTION
347
348This module is automatically imported by Win32::API, so you don't
349need to 'use' it explicitly. These are the methods of this package:
350
351=over 4
352
353=item C<typedef NAME, TYPE>
354
355This method defines a new type named C<NAME>. This actually just
356creates an alias for the already-defined type C<TYPE>, which you
357can use as a parameter in a Win32::API call.
358
359When C<TYPE> contains a Win32::API::Struct type declared with
360L<Win32::API::Struct/typedef> with " *" postfixed to C<TYPE> parameter,
361C<NAME> will be a alias for the pointer version of the struct type. Creating
362an alias for a struct type is not supported, you have to call
363L<Win32::API::Struct/typedef> again. Passing a struct type as C<TYPE>
364without the " *" postfix is not supported.
365
366L<Warns|perlfunc/warn> and returns undef if C<TYPE> is unknown, else returns true.
367
368=item C<sizeof TYPE>
369
370This returns the size, in bytes, of C<TYPE>. Acts just like
371the C function of the same name.
372
373=item C<is_known TYPE>
374
375Returns true if C<TYPE> is known by Win32::API::Type, false
376otherwise.
377
378=back
379
380=head2 SUPPORTED TYPES
381
382This module recognizes many commonly used types defined in the Win32 Platform
383SDK header files, but not all. Types less than 13 years old are very unlikely
384to be the in built type database.
385
386Please see the source for this module, in the C<__DATA__> section,
387for the full list of builtin supported types.
388
389
390=head2 NOTES ON SELECT TYPES
391
392=over 4
393
394=item LPVOID
395
396Due to poor design, currently LPVOID is a char *, a string, not a number.
397It should really be a number. It is suggested to replace LPVOID in your
398C prototypes passed to Win32::API with UINT_PTR which is a pointer
399sized number.
400
401=item SOMETYPE **
402
403Currently ** types do not parse.
404
405=item void **
406
407Replace void ** in your C prototype that you pass to Win32::API::More with
408LPHANDLE.
409
410=item unsigned char
411
412=item signed char
413
414These 2 types by name force numeric handling. C<97> not C<"a">. C<UCHAR> is
415not a C<unsigned char> for numeric handling purposes.
416
417=back
418
419=head1 AUTHOR
420
421Aldo Calpini ( I<dada@perl.it> ).
422
423=head1 MAINTAINER
424
425Cosimo Streppone ( I<cosimo@cpan.org> ).
426
427=cut
428
429
430__DATA__
 
# spent 0s within Win32::API::Type::CORE:close which was called: # once (0s+0s) by Win32::API::BEGIN@62 at line 91
sub Win32::API::Type::CORE:close; # opcode
# spent 0s within Win32::API::Type::CORE:match which was called 508 times, avg 0s/call: # 340 times (0s+0s) by Win32::API::BEGIN@62 at line 49, avg 0s/call # 157 times (0s+0s) by Win32::API::BEGIN@62 at line 51, avg 0s/call # 4 times (0s+0s) by Win32::API::Type::packing at line 201, avg 0s/call # 4 times (0s+0s) by Win32::API::Type::packing at line 190, avg 0s/call # once (0s+0s) by Win32::API::Type::is_pointer at line 257 # once (0s+0s) by Win32::API::Type::is_known at line 152 # once (0s+0s) by Win32::API::Type::is_pointer at line 253
sub Win32::API::Type::CORE:match; # opcode
# spent 0s within Win32::API::Type::CORE:readline which was called: # once (0s+0s) by Win32::API::BEGIN@62 at line 48
sub Win32::API::Type::CORE:readline; # opcode
# spent 0s within Win32::API::Type::CORE:subst which was called 4 times, avg 0s/call: # 4 times (0s+0s) by Win32::API::Type::packing at line 214, avg 0s/call
sub Win32::API::Type::CORE:subst; # opcode
# spent 0s within Win32::API::Type::pointer_pack_type which was called 45 times, avg 0s/call: # 45 times (0s+0s) by Win32::API::BEGIN@62 at line 59, avg 0s/call
sub Win32::API::Type::pointer_pack_type; # xsub
Report produced by the NYTProf 5.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.