← 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/Struct.pm
StatementsExecuted 20 statements in 0s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1110s0sWin32::API::Struct::::BEGIN@10Win32::API::Struct::BEGIN@10
1110s0sWin32::API::Struct::::BEGIN@11Win32::API::Struct::BEGIN@11
1110s0sWin32::API::Struct::::BEGIN@14Win32::API::Struct::BEGIN@14
1110s0sWin32::API::Struct::::BEGIN@15Win32::API::Struct::BEGIN@15
1110s0sWin32::API::Struct::::BEGIN@16Win32::API::Struct::BEGIN@16
1110s0sWin32::API::Struct::::BEGIN@313Win32::API::Struct::BEGIN@313
1110s0sWin32::API::Struct::::BEGIN@9Win32::API::Struct::BEGIN@9
0000s0sWin32::API::Struct::::DEBUGWin32::API::Struct::DEBUG
0000s0sWin32::API::Struct::::DumpWin32::API::Struct::Dump
0000s0sWin32::API::Struct::::EXISTSWin32::API::Struct::EXISTS
0000s0sWin32::API::Struct::::FETCHWin32::API::Struct::FETCH
0000s0sWin32::API::Struct::::FIRSTKEYWin32::API::Struct::FIRSTKEY
0000s0sWin32::API::Struct::::FromMemoryWin32::API::Struct::FromMemory
0000s0sWin32::API::Struct::::NEXTKEYWin32::API::Struct::NEXTKEY
0000s0sWin32::API::Struct::::PackWin32::API::Struct::Pack
0000s0sWin32::API::Struct::::STOREWin32::API::Struct::STORE
0000s0sWin32::API::Struct::::TIEHASHWin32::API::Struct::TIEHASH
0000s0sWin32::API::Struct::::UnpackWin32::API::Struct::Unpack
0000s0sWin32::API::Struct::::alignWin32::API::Struct::align
0000s0sWin32::API::Struct::::ck_typeWin32::API::Struct::ck_type
0000s0sWin32::API::Struct::::getPackWin32::API::Struct::getPack
0000s0sWin32::API::Struct::::getUnpackWin32::API::Struct::getUnpack
0000s0sWin32::API::Struct::::is_knownWin32::API::Struct::is_known
0000s0sWin32::API::Struct::::membersWin32::API::Struct::members
0000s0sWin32::API::Struct::::newWin32::API::Struct::new
0000s0sWin32::API::Struct::::recognizeWin32::API::Struct::recognize
0000s0sWin32::API::Struct::::sizeofWin32::API::Struct::sizeof
0000s0sWin32::API::Struct::::to_base_structWin32::API::Struct::to_base_struct
0000s0sWin32::API::Struct::::typedefWin32::API::Struct::typedef
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1#
2# Win32::API::Struct - Perl Win32 API struct Facility
3#
4# Author: Aldo Calpini <dada@perl.it>
5# Maintainer: Cosimo Streppone <cosimo@cpan.org>
6#
7
8package Win32::API::Struct;
920s20s
# spent 0s within Win32::API::Struct::BEGIN@9 which was called: # once (0s+0s) by Win32::API::BEGIN@63 at line 9
use strict;
# spent 0s making 1 call to Win32::API::Struct::BEGIN@9 # spent 0s making 1 call to strict::import
1020s20s
# spent 0s within Win32::API::Struct::BEGIN@10 which was called: # once (0s+0s) by Win32::API::BEGIN@63 at line 10
use warnings;
# spent 0s making 1 call to Win32::API::Struct::BEGIN@10 # spent 0s making 1 call to warnings::import
1120s20s
# spent 0s within Win32::API::Struct::BEGIN@11 which was called: # once (0s+0s) by Win32::API::BEGIN@63 at line 11
use vars qw( $VERSION @ISA );
# spent 0s making 1 call to Win32::API::Struct::BEGIN@11 # spent 0s making 1 call to vars::import
1210s$VERSION = '0.65';
13
1420s20s
# spent 0s within Win32::API::Struct::BEGIN@14 which was called: # once (0s+0s) by Win32::API::BEGIN@63 at line 14
use Carp;
# spent 0s making 1 call to Exporter::import # spent 0s making 1 call to Win32::API::Struct::BEGIN@14
1520s20s
# spent 0s within Win32::API::Struct::BEGIN@15 which was called: # once (0s+0s) by Win32::API::BEGIN@63 at line 15
use Win32::API::Type;
# spent 0s making 1 call to Exporter::import # spent 0s making 1 call to Win32::API::Struct::BEGIN@15
1620s20s
# spent 0s within Win32::API::Struct::BEGIN@16 which was called: # once (0s+0s) by Win32::API::BEGIN@63 at line 16
use Config;
# spent 0s making 1 call to Config::import # spent 0s making 1 call to Win32::API::Struct::BEGIN@16
17
1810srequire Exporter;
1910srequire DynaLoader;
2010s@ISA = qw(Exporter DynaLoader);
21
2210smy %Known = ();
23
24sub DEBUG {
25 if ($Win32::API::DEBUG) {
26 printf @_ if @_ or return 1;
27 }
28 else {
29 return 0;
30 }
31}
32
33sub typedef {
34 my $class = shift;
35 my $struct = shift;
36 my ($type, $name, @recog_arr);
37 my $self = {
38 align => undef,
39 typedef => [],
40 };
41 while (defined($type = shift)) {
42 $name = shift;
43 $name =~ s/;$//;
44 @recog_arr = recognize($type, $name);
45#http://perlmonks.org/?node_id=978468, not catching the type not found here,
46#will lead to a div 0 later
47 if(@recog_arr != 3){
48 carp "Win32::API::Struct::typedef: unknown member type=\"$type\", name=\"$name\"";
49 return undef;
50 }
51 push(@{$self->{typedef}}, [@recog_arr]);
52 }
53
54 $Known{$struct} = $self;
55 $Win32::API::Type::Known{$struct} = '>';
56 return 1;
57}
58
59
60#void ck_type($param, $proto, $param_num)
61sub ck_type {
62 my ($param, $proto) = @_;
63 #legacy LP prefix check
64 return if substr($proto, 0, 2) eq 'LP' && substr($proto, 2) eq $param;
65 #check if proto can be converted to base struct name
66 return if exists $Win32::API::Struct::Pointer{$proto} &&
67 $param eq $Win32::API::Struct::Pointer{$proto};
68 #check if proto can have * chopped off to convert to base struct name
69 $proto =~ s/\s*\*$//;
70 return if $proto eq $param;
71 croak("Win32::API::Call: supplied type (LP)\"".
72 $param."\"( *) doesn't match type \"".
73 $_[1]."\" for parameter ".
74 $_[2]." ");
75}
76
77#$basename = to_base_struct($pointername)
78sub to_base_struct {
79 return $Win32::API::Struct::Pointer{$_[0]}
80 if exists $Win32::API::Struct::Pointer{$_[0]};
81 die "Win32::API::Struct::Unpack unknown type";
82}
83
84sub recognize {
85 my ($type, $name) = @_;
86 my ($size, $packing);
87
88 if (exists $Known{$type}) {
89 $packing = '>';
90 return ($name, $packing, $type);
91 }
92 else {
93 $packing = Win32::API::Type::packing($type);
94 return undef unless defined $packing;
95 if ($name =~ s/\[(.*)\]$//) {
96 $size = $1;
97 $packing = $packing . '*' . $size;
98 }
99 DEBUG "(PM)Struct::recognize got '$name', '$type' -> '$packing'\n";
100 return ($name, $packing, $type);
101 }
102}
103
104sub new {
105 my $class = shift;
106 my ($type, $name, $packing);
107 my $self = {typedef => [],};
108 if ($#_ == 0) {
109 if (is_known($_[0])) {
110 DEBUG "(PM)Struct::new: got '$_[0]'\n";
111 if( ! defined ($self->{typedef} = $Known{$_[0]}->{typedef})){
112 carp 'Win32::API::Struct::new: unknown type="'.$_[0].'"';
113 return undef;
114 }
115 foreach my $member (@{$self->{typedef}}) {
116 ($name, $packing, $type) = @$member;
117 next unless defined $name;
118 if ($packing eq '>') {
119 $self->{$name} = Win32::API::Struct->new($type);
120 }
121 }
122 $self->{__typedef__} = $_[0];
123 }
124 else {
125 carp "Unknown Win32::API::Struct '$_[0]'";
126 return undef;
127 }
128 }
129 else {
130 while (defined($type = shift)) {
131 $name = shift;
132
133 # print "new: found member $name ($type)\n";
134 if (not exists $Win32::API::Type::Known{$type}) {
135 carp "Unknown Win32::API::Struct type '$type'";
136 return undef;
137 }
138 else {
139 push(@{$self->{typedef}},
140 [$name, $Win32::API::Type::Known{$type}, $type]);
141 }
142 }
143 }
144 return bless $self;
145}
146
147sub members {
148 my $self = shift;
149 return map { $_->[0] } @{$self->{typedef}};
150}
151
152sub sizeof {
153 my $self = shift;
154 my $size = 0;
155 my $align = 0;
156 my $first = '';
157
158 for my $member (@{$self->{typedef}}) {
159 my ($name, $packing, $type) = @{$member};
160 next unless defined $name;
161 if (ref $self->{$name} eq q{Win32::API::Struct}) {
162
163 # If member is a struct, recursively calculate its size
164 # FIXME for subclasses
165 $size += $self->{$name}->sizeof();
166 }
167 else {
168
169 # Member is a simple type (LONG, DWORD, etc...)
170 if ($packing =~ /\w\*(\d+)/) { # Arrays (ex: 'c*260')
171 $size += Win32::API::Type::sizeof($type) * $1;
172 $first = Win32::API::Type::sizeof($type) * $1 unless defined $first;
173 DEBUG "(PM)Struct::sizeof: sizeof with member($name) now = " . $size
174 . "\n";
175 }
176 else { # Simple types
177 my $type_size = Win32::API::Type::sizeof($type);
178 $align = $type_size if $type_size > $align;
179 my $type_align = (($size + $type_size) % $type_size);
180 $size += $type_size + $type_align;
181 $first = Win32::API::Type::sizeof($type) unless defined $first;
182 }
183 }
184 }
185
186 my $struct_size = $size;
187 if (defined $align && $align > 0) {
188 $struct_size += ($size % $align);
189 }
190 DEBUG "(PM)Struct::sizeof first=$first totalsize=$struct_size\n";
191 return $struct_size;
192}
193
194sub align {
195 my $self = shift;
196 my $align = shift;
197
198 if (not defined $align) {
199
200 if (!(defined $self->{align} && $self->{align} eq 'auto')) {
201 return $self->{align};
202 }
203
204 $align = 0;
205
206 foreach my $member (@{$self->{typedef}}) {
207 my ($name, $packing, $type) = @$member;
208
209 if (ref($self->{$name}) eq "Win32::API::Struct") {
210 #### ????
211 }
212 else {
213 if ($packing =~ /\w\*(\d+)/) {
214 #### ????
215 }
216 else {
217 $align = Win32::API::Type::sizeof($type)
218 if Win32::API::Type::sizeof($type) > $align;
219 }
220 }
221 }
222 return $align;
223 }
224 else {
225 $self->{align} = $align;
226
227 }
228}
229
230sub getPack {
231 my $self = shift;
232 my $packing = "";
233 my $packed_size = 0;
234 my ($type, $name, $type_size, $type_align);
235 my @items = ();
236 my @recipients = ();
237 my @buffer_ptrs = (); #this contains the struct_ptrs that were placed in the
238 #the struct, its part of "C func changes the struct ptr to a private allocated
239 #struct" code, it is push/poped only for struct ptrs, it is NOT a 1 to
240 #1 mapping between all struct members, so don't access it with indexes
241
242 my $align = $self->align();
243
244 foreach my $member (@{$self->{typedef}}) {
245 my ($name, $type, $orig) = @$member;
246 if ($type eq '>') {
247 my ($subpacking, $subitems, $subrecipients, $subpacksize, $subbuffersptrs) =
248 $self->{$name}->getPack();
249 DEBUG "(PM)Struct::getPack($self->{__typedef__}) ++ $subpacking\n";
250 push(@items, @$subitems);
251 push(@recipients, @$subrecipients);
252 push(@buffer_ptrs, @$subbuffersptrs);
253 $packing .= $subpacking;
254 $packed_size += $subpacksize;
255 }
256 else {
257 my $repeat = 1;
258 if ($type =~ /\w\*(\d+)/) {
259 $repeat = $1;
260 $type = "a$repeat";
261 }
262
263 DEBUG "(PM)Struct::getPack($self->{__typedef__}) ++ $type\n";
264
265 if ($type eq 'p') {
266 $type = Win32::API::Type::pointer_pack_type();
267 push(@items, Win32::API::PointerTo($self->{$name}));
268 }
269 elsif ($type eq 'T') {
270 $type = Win32::API::Type::pointer_pack_type();
271 my $structptr;
272 if(ref($self->{$name})){
273 $self->{$name}->Pack();
274 $structptr = Win32::API::PointerTo($self->{$name}->{buffer});
275 }
276 else{
277 $structptr = 0;
278 }
279 push(@items, $structptr);
280 push(@buffer_ptrs, $structptr);
281 }
282 else {
283 push(@items, $self->{$name});
284 }
285 push(@recipients, $self);
286 $type_size = Win32::API::Type::sizeof($orig);
287 $type_align = (($packed_size + $type_size) % $type_size);
288 $packing .= "x" x $type_align . $type;
289 $packed_size += ( $type_size * $repeat ) + $type_align;
290 }
291 }
292
293 DEBUG
294 "(PM)Struct::getPack: $self->{__typedef__}(buffer) = pack($packing, $packed_size)\n";
295
296 return ($packing, [@items], [@recipients], $packed_size, \@buffer_ptrs);
297}
298
299# void $struct->Pack([$priv_warnings_flag]);
300sub Pack {
301 my $self = shift;
302 my ($packing, $items);
303 ($packing, $items, $self->{buffer_recipients},
304 undef, $self->{buffer_ptrs}) = $self->getPack();
305
306 if(DEBUG){
307 DEBUG "(PM)Struct::Pack: $self->{__typedef__}(buffer) = pack($packing, @$items)\n";
308 }
309
310 if($_[0]){ #Pack() on a new struct, without slice set, will cause lots of uninit
311 #warnings, sometimes its intentional to set up buffer recipients for a
312 #future UnPack()
31320s20s
# spent 0s within Win32::API::Struct::BEGIN@313 which was called: # once (0s+0s) by Win32::API::BEGIN@63 at line 313
no warnings 'uninitialized';
# spent 0s making 1 call to Win32::API::Struct::BEGIN@313 # spent 0s making 1 call to warnings::unimport
314 $self->{buffer} = pack($packing, @$items);
315 }
316 else{
317 $self->{buffer} = pack($packing, @$items);
318 }
319 if (DEBUG) {
320 for my $i (0 .. $self->sizeof - 1) {
321 printf "#pack# %3d: 0x%02x\n", $i, ord(substr($self->{buffer}, $i, 1));
322 }
323 }
324}
325
326sub getUnpack {
327 my $self = shift;
328 my $packing = "";
329 my $packed_size = 0;
330 my ($type, $name, $type_size, $type_align, $orig_type);
331 my (@items, @types, @type_names);
332 my $align = $self->align();
333 foreach my $member (@{$self->{typedef}}) {
334 my ($name, $type, $orig) = @$member;
335 if ($type eq '>') {
336 my ($subpacking, $subpacksize, $subitems, $subtypes, $subtype_names) = $self->{$name}->getUnpack();
337 DEBUG "(PM)Struct::getUnpack($self->{__typedef__}) ++ $subpacking\n";
338 $packing .= $subpacking;
339 $packed_size += $subpacksize;
340 push(@items, @$subitems);
341 push(@types, @$subtypes);
342 push(@type_names, @$subtype_names);
343 }
344 else {
345 if($type eq 'T') {
346 $orig_type = $type;
347 $type = Win32::API::Type::pointer_pack_type();
348 }
349 my $repeat = 1;
350 if ($type =~ /\w\*(\d+)/) {
351 $repeat = $1;
352 $type = "Z$repeat";
353 }
354 DEBUG "(PM)Struct::getUnpack($self->{__typedef__}) ++ $type\n";
355 $type_size = Win32::API::Type::sizeof($orig);
356 $type_align = (($packed_size + $type_size) % $type_size);
357 $packing .= "x" x $type_align . $type;
358 $packed_size += ( $type_size * $repeat ) + $type_align;
359 push(@items, $name);
360 if($orig_type){
361 push(@types, $orig_type);
362 undef($orig_type);
363 }
364 else{
365 push(@types, $type);
366 }
367 push(@type_names, $orig);
368 }
369 }
370 DEBUG "(PM)Struct::getUnpack($self->{__typedef__}): unpack($packing, @items)\n";
371 return ($packing, $packed_size, \@items, \@types, \@type_names);
372}
373
374sub Unpack {
375 my $self = shift;
376 my ($packing, undef, $items, $types, $type_names) = $self->getUnpack();
377 my @itemvalue = unpack($packing, $self->{buffer});
378 DEBUG "(PM)Struct::Unpack: unpack($packing, buffer) = @itemvalue\n";
379 foreach my $i (0 .. $#$items) {
380 my $recipient = $self->{buffer_recipients}->[$i];
381 my $item = $$items[$i];
382 DEBUG "(PM)Struct::Unpack: %s(%s) = '%s' (0x%08x)\n",
383 $recipient->{__typedef__},
384 $item,
385 $itemvalue[$i],
386 $itemvalue[$i],
387 ;
388 if($$types[$i] eq 'T'){
389my $oldstructptr = pop(@{$self->{buffer_ptrs}});
390my $newstructptr = $itemvalue[$i];
391my $SVMemberRef = \$recipient->{$item};
392
393if(!$newstructptr){ #new ptr is null
394 if($oldstructptr != $newstructptr){ #old ptr was true
395 carp "Win32::API::Struct::Unpack struct pointer".
396 " member \"".$item."\" was changed by C function,".
397 " possible resource leak";
398 }
399 $$SVMemberRef = undef;
400}
401else{ #new ptr is true
402 if($oldstructptr != $newstructptr){#old ptr was true, or null, but has changed, leak warning
403 carp "Win32::API::Struct::Unpack struct pointer".
404 " member \"".$item."\" was changed by C function,".
405 " possible resource leak";
406 }#create a ::Struct if the slice is undef, user had the slice set to undef
407
408 if (!ref($$SVMemberRef)){
409 $$SVMemberRef = Win32::API::Struct->new(to_base_struct($type_names->[$i]));
410 $$SVMemberRef->Pack(1); #buffer_recipients must be generated, no uninit warnings
411 }
412#must fix {buffer} with contents of the new struct, $structptr might be
413#null or might be a SVPV from a ::Struct that was ignored, in any case,
414#a foreign memory allocator is at work here
415 $$SVMemberRef->{buffer} = Win32::API::ReadMemory($newstructptr, $$SVMemberRef->sizeof)
416 if($oldstructptr != $newstructptr);
417#always must be called, if new ptr is not null, at this point, C func, did
418#one of 2 things, filled the old ::Struct's {buffer} PV, or gave a new struct *
419#from its own allocator, there is no way to tell if the struct contents changed
420#so Unpack() must be called
421 $$SVMemberRef->Unpack();
422}
423}
424 else{ #not a struct ptr
425 $recipient->{$item} = $itemvalue[$i];
426
427 # DEBUG "(PM)Struct::Unpack: self.items[$i] = $self->{$$items[$i]}\n";
428 }
429 }
430}
431
432sub FromMemory {
433 my ($self, $addr) = @_;
434 DEBUG "(PM)Struct::FromMemory: doing Pack\n";
435 $self->Pack();
436 DEBUG "(PM)Struct::FromMemory: doing GetMemory( 0x%08x, %d )\n", $addr, $self->sizeof;
437 $self->{buffer} = Win32::API::ReadMemory($addr, $self->sizeof);
438 $self->Unpack();
439 DEBUG "(PM)Struct::FromMemory: doing Unpack\n";
440 DEBUG "(PM)Struct::FromMemory: structure is now:\n";
441 $self->Dump() if DEBUG;
442 DEBUG "\n";
443}
444
445sub Dump {
446 my $self = shift;
447 my $prefix = shift;
448 foreach my $member (@{$self->{typedef}}) {
449 my ($name, $packing, $type) = @$member;
450 if (ref($self->{$name})) {
451 $self->{$name}->Dump($name);
452 }
453 else {
454 printf "%-20s %-20s %-20s\n", $prefix, $name, $self->{$name};
455 }
456 }
457}
458
459#the LP logic should be moved to parse_prototype, since only
460#::API::Call() ever understood the implied LP prefix, Struct::new never did
461#is_known then can be inlined away and sub deleted, it is not public API
462sub is_known {
463 my $name = shift;
464 if (exists $Known{$name}) {
465 return 1;
466 }
467 else {
468 my $nametest = $name;
469 if ($nametest =~ s/^LP//) {
470 return exists $Known{$nametest};
471 }
472 $nametest = $name;
473 if($nametest =~ s/\*$//){
474 return exists $Known{$nametest};
475 }
476 return 0;
477 }
478}
479
480sub TIEHASH {
481 return Win32::API::Struct::new(@_);
482}
483
484sub EXISTS {
485
486}
487
488sub FETCH {
489 my $self = shift;
490 my $key = shift;
491
492 if ($key eq 'sizeof') {
493 return $self->sizeof;
494 }
495 my @members = map { $_->[0] } @{$self->{typedef}};
496 if (grep(/^\Q$key\E$/, @members)) {
497 return $self->{$key};
498 }
499 else {
500 warn "'$key' is not a member of Win32::API::Struct $self->{__typedef__}";
501 }
502}
503
504sub STORE {
505 my $self = shift;
506 my ($key, $val) = @_;
507 my @members = map { $_->[0] } @{$self->{typedef}};
508 if (grep(/^\Q$key\E$/, @members)) {
509 $self->{$key} = $val;
510 }
511 else {
512 warn "'$key' is not a member of Win32::API::Struct $self->{__typedef__}";
513 }
514}
515
516sub FIRSTKEY {
517 my $self = shift;
518 my @members = map { $_->[0] } @{$self->{typedef}};
519 return $members[0];
520}
521
522sub NEXTKEY {
523 my $self = shift;
524 my $key = shift;
525 my @members = map { $_->[0] } @{$self->{typedef}};
526 for my $i (0 .. $#members - 1) {
527 return $members[$i + 1] if $members[$i] eq $key;
528 }
529 return undef;
530}
531
53210s1;
533
534#######################################################################
535# DOCUMENTATION
536#
537
538=head1 NAME
539
540Win32::API::Struct - C struct support package for Win32::API
541
542=head1 SYNOPSIS
543
544 use Win32::API;
545
546 Win32::API::Struct->typedef( 'POINT', qw(
547 LONG x;
548 LONG y;
549 ));
550
551 my $Point = Win32::API::Struct->new( 'POINT' );
552 $Point->{x} = 1024;
553 $Point->{y} = 768;
554
555 #### alternatively
556
557 tie %Point, 'Win32::API::Struct', 'POINT';
558 $Point{x} = 1024;
559 $Point{y} = 768;
560
561
562=head1 ABSTRACT
563
564This module enables you to define C structs for use with
565Win32::API.
566
567See L<Win32::API/USING STRUCTURES> for more info about its usage.
568
569=head1 DESCRIPTION
570
571This module is automatically imported by Win32::API, so you don't
572need to 'use' it explicitly. The main methods are C<typedef> and
573C<new>, which are documented below.
574
575=over 4
576
577=item C<typedef NAME, TYPE, MEMBER, TYPE, MEMBER, ...>
578
579This method defines a structure named C<NAME>. The definition consists
580of types and member names, just like in C. In fact, most of the
581times you can cut the C definition for a structure and paste it
582verbatim to your script, enclosing it in a C<qw()> block. The
583function takes care of removing the semicolon after the member
584name. Win32::API::Struct does B<NOT> support Enums, Unions, or Bitfields.
585C<NAME> must not end in C<*>, typedef creates structs, not struct pointers.
586See L<Win32::API::Type/"typedef">
587on how to create a struct pointer type. Returns true on success, and undef on error.
588On error it L<warns|perlfunc/warn> with the specific reason.
589
590The synopsis example could be written like this:
591
592 Win32::API::Struct->typedef('POINT', 'LONG', 'x', 'LONG', 'y');
593
594But it could also be written like this (note the indirect object
595syntax), which is pretty cool:
596
597 typedef Win32::API::Struct POINT => qw{
598 LONG x;
599 LONG y;
600 };
601
602L<Win32::API/Call> automatically knows that an 'LPNAME' type, refers
603to a 'NAME' type struct. Also see L<Win32::API::Type/"typedef"> on how to declare
604pointers to struct types.
605
606Unlike in Win32::API, a single non-array char or CHAR struct member in a
607struct is numeric, NOT the first character of a string. UTF16 strings pointers
608will be garbage on read back (passing in works, returning doesn't) since
609the NULL character will often be the 2nd byte of the UTF16 string.
610
611=item C<new NAME>
612
613This creates a structure (a Win32::API::Struct object) of the
614type C<NAME> (it must have been defined with C<typedef>). In Perl,
615when you create a structure, all the members are undefined. But
616when you use that structure in C (eg. a Win32::API call), you
617can safely assume that they will be treated as zero (or NULL).
618
619=item C<sizeof>
620
621This returns the size, in bytes, of the structure. Acts just like
622the C function of the same name. It is particularly useful for
623structures that need a member to be initialized to the structure's
624own size.
625
626=item C<align [SIZE]>
627
628Sets or returns the structure alignment (eg. how the structure is
629stored in memory). This is a very advanced option, and you normally
630don't need to mess with it.
631All structures in the Win32 Platform SDK should work without it.
632But if you define your own structure, you may need to give it an
633explicit alignment. In most cases, passing a C<SIZE> of 'auto'
634should keep the world happy.
635
636=back
637
638=head2 THE C<tie> INTERFACE
639
640Instead of creating an object with the C<new> method, you can
641tie a hash, which will hold the desired structure, using the
642C<tie> builtin function:
643
644 tie %structure, Win32::API::Struct => 'NAME';
645
646The differences between the tied and non-tied approaches are:
647
648=over 4
649
650=item *
651with tied structures, you can access members directly as
652hash lookups, eg.
653
654 # tied # non-tied
655 $Point{x} vs. $Point->{x}
656
657=item *
658with tied structures, when you try to fetch or store a
659member that is not part of the structure, it will result
660in a warning, eg.
661
662 print $Point{z};
663 # this will warn: 'z' is not a member of Win32::API::Struct POINT
664
665=item *
666when you pass a tied structure as a Win32::API parameter,
667remember to backslash it, eg.
668
669 # tied # non-tied
670 GetCursorPos( \%Point ) vs. GetCursorPos( $Point )
671
672=back
673
674=head2 FOREIGN MEMORY ALLOCATORS
675
676Using Win32::API::Struct is not recommended in situations where a C function
677will return results to you by putting a pointer to a string or a pointer to
678another struct into your supplied struct. Win32::API::Struct will do its best
679to detect that a new pointer appeared and to read it contents into Perl, but
680that pointer will be tossed away after being read. If this pointer is
681something you must explicitly free, you have leaked it by using
682Win32::API::Struct to decode it. If this pointer is something you must pass back to
683the C API you are using, you lost/leaked it. If you pass NULL, or a ::Struct
684pointer in a ::Struct to C API, after the C API call, ::Struct will detect the
685pointer changed, it will read the new struct from the new pointer into
686Perl, and a new child ::Struct will appear in the hash slice
687of the parent ::Struct, if you pass this new child ::Struct into the C API
688it will be a B<COPY> of the struct the C API from Perl's allocation placed
689in the parent ::Struct. For C++-like APIs, this will be unacceptable and lead to
690crashes as the C Functions tries to free a memory block that didn't come from the
691allocator of the C Function. Windows has many memory allocators, each CRT
692(VS 2, 3, 4, 5, NT/6, 7.0, 7.1, 8, 9, 10) malloc, LocalAlloc, GlobalAlloc,
693HeapAlloc, (each version of C++ Runtime Library) "new", CoGetMalloc, CoTaskMemAlloc,
694NetApiBufferAllocate, VirtualAlloc, CryptMemAlloc, AllocADsMem, SHAlloc,
695SnmpUtilMemAlloc. None of these allocators' pointers are compatible with Perl's
696allocator. Some C APIs give you static global buffers which never are freed or freed
697automatically in the next call to a function from to that DLL.
698
699With foreign allocators, its best to treat to write a pointer class, bless the
700ref to scalar integer (holding the pointer) into that class to ensure that the
701DESTROY method will free the pointer and you never leak it, and your write
702method accessors using L<perlfunc/pack>, L<Win32::API/ReadMemory> and
703L<Win32::API/WriteMemory> around the pointer.
704
705
706=head1 AUTHOR
707
708Aldo Calpini ( I<dada@perl.it> ).
709
710=head1 MAINTAINER
711
712Cosimo Streppone ( I<cosimo@cpan.org> ).
713
714=cut
Report produced by the NYTProf 5.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.