More docs
[perl-ctypes:shlomifs-perl-ctypes.git] / lib / Ctypes / Type / Struct.pm
1 package Ctypes::Type::Struct;
2 use strict;
3 use warnings;
4 use Scalar::Util qw|blessed looks_like_number|;
5 use Ctypes;
6 use Ctypes::Type::Field;
7 use Carp;
8 use Data::Dumper;
9 use overload
10   '${}'    => \&_scalar_overload,
11   '%{}'    => \&_hash_overload,
12   '@{}'    => \&_array_overload,
13   fallback => 'TRUE';
14
15 our @ISA = qw|Ctypes::Type|;
16 my $Debug = 0;
17
18 =head1 NAME
19
20 Ctypes::Type::Struct - C Structures
21
22 =head1 SYNOPSIS
23
24   use Ctypes;
25
26   my
27
28 =head1 ABSTRACT
29
30 =cut
31
32 sub _process_fields {
33   my $self = shift;
34   my $fields = shift;
35   if( ref($fields) ne 'ARRAY' ) {
36     croak( 'Usage: $struct->_process_fields( ARRAYREF )' );
37   }
38   if( scalar @$fields % 2 ) {
39     croak( "Fields must be given as key => value pairs!" );
40   }
41   my( $key, $val );
42   for( 0 .. (( $#$fields - 1 ) / 2) ) {
43     $key = shift @{$fields};
44     $val = shift @{$fields};
45     if( not exists $self->{_fields}->{_hash}->{$key} ) {
46       $self->{_fields}->_add_field($key, $val);
47     } else {
48       $self->{_fields}->{_hash}->{$key}->{_contents} = $val;
49     }
50   }
51 }
52
53 sub _array_overload {
54   return \@{ $_[0]->{_values}->{_array} };
55 }
56
57 sub _hash_overload {
58   if( caller =~ /^Ctypes::Type/ ) {
59     return $_[0];
60   }
61   print "Structs's HASH ovld\n" if $Debug;
62   my( $self, $key ) = ( shift, shift );
63   my $class = ref($self);
64   bless $self => 'overload::dummy';
65   my $ret = $self->{_values}->{_hash};
66   bless $self => $class;
67   return $ret;
68 }
69
70 sub _scalar_overload {
71   return \$_[0]->{_values};
72 }
73
74 ############################################
75 # TYPE::STRUCT : PUBLIC FUNCTIONS & VALUES #
76 ############################################
77
78 =head1 METHODS
79
80 Structs expose the following methods in addition to those provided
81 by Ctypes::Type.
82
83 =over
84
85 =item new ARRAYREF
86
87 =item new HASHREF
88
89 Creates and returns a new Struct object. Structs must be initialised
90 using either an array reference or hash reference (since methods to add
91 and remove fields after initialisation are currently NYI).
92
93 The arrayref syntax is the simpler of the two, suitable for simple
94 initialisations where the default alignment and endianness is acceptable.
95
96     my $s = Struct([
97                      field1 => c_int(10),
98                      field2 => c_char('B'),
99                      field3 => c_double(999999999999999999),
100                    ]);
101
102 You might wonder why the hashref form doesn't look like this. The reason
103 is that we need the hashref form for specifying specific attributes of
104 the Struct, like C<align> and C<endianness (NYI)>, which would of course
105 cause problems if you wanted to make a Struct with a field called 'align'.
106 So with the arrayref syntax, we make use of the fact that Perl's C<=E<gt>>
107 operator is mostly just a synonym for the comma operator to pass a simple
108 list of arguments which looks like named key-value pairs to the human
109 reader.
110
111 The hashref syntax currently supports only two named attributes:
112
113 =over
114
115 =item C<fields>, an arrayref of fieldname-value pairs like the arrayref
116 syntax above.
117
118 =item C<align>, a number indicating the alignment of the struct. Valid
119 alignments are 0, 1, 2, 4, 8, 16, 32 or 64. The default alignment is 1
120 (trading processor cycles for saved space). An alignment of 0 is the same
121 as 1. Note that defining alignment for individual members or sections of
122 Structs is not yet implemented.
123
124 =back
125
126 =cut
127
128 sub new {
129   my $class = ref($_[0]) || $_[0];  shift;
130   print "In Struct::new constructor...\n" if $Debug;
131   print "    args:\n" if $Debug;
132   # Try to determine if ::new was called by a class that inherits
133   # from Struct, and get the name of that class
134   # XXX Later, the [non-]existence of $progeny is used to make an
135   # educated guess at whether Struct was instantiated directly, or
136   # via a subclass.
137   # Q: What are some of the ways the following logic fails?
138   my( $progeny, $extra_fields ) = undef;
139   my $caller = caller;
140   print "    caller is ", $caller, "\n" if $caller and $Debug;
141   if( $caller->isa('Ctypes::Type::Struct') ) {
142     no strict 'refs';
143     $progeny = $caller;
144     if( defined ${"${caller}::_fields_"} ) {
145       my $_fields_ = ${"${caller}::_fields_"};
146       for( 0..$#$_fields_ ) {
147       # Can't just set = as shift() extra_fields later affects every instance
148         if( blessed( $_fields_->[$_] )
149             and $_fields_->[$_]->isa('Ctypes::Type') ) {
150           $extra_fields->[$_] = $_fields_->[$_]->copy;
151         } else {
152           $extra_fields->[$_] = $_fields_->[$_];
153         }
154       }
155       print "    Got these extra fields:\n" if $Debug;
156       print Dumper( $extra_fields ) if $Debug;
157       if( scalar @$extra_fields % 2 ) {
158         croak( "_fields_ must be key => value pairs!" );
159       }
160     }
161   }
162
163   # Get fields, populate with named/unnamed args
164   my $self = {
165                _fields     => undef,
166                _values     => undef,
167                _typecode_  => 'p',
168                _subclass   => $progeny,
169                _alignment  => 0,
170                _data       => '', };
171   $self->{_fields} = new Ctypes::Type::Struct::_Fields($self);
172   $self->{_values} = new Ctypes::Type::Struct::_Values($self);
173   bless $self => $class;
174   my $base = $class->SUPER::_new;
175   for( keys(%$base) ) {
176     $self->{$_} = $base->{$_};
177   }
178   $self->{_name} = $progeny ? $progeny . '_Struct' : 'Struct';
179   $self->{_name} =~ s/.*:://;
180
181   if( $extra_fields ) {
182     my( $key, $val );
183     for( 0 .. (( $#$extra_fields - 1 ) / 2) ) {
184       $key = shift @{$extra_fields};
185       $val = shift @{$extra_fields};
186       print "    Adding extra field '$key'...\n" if $Debug;
187       $self->{_fields}->_add_field( $key, $val );
188     }
189   }
190
191   my $in = undef;
192   if( ref($_[0]) eq 'HASH' ) {
193     $in = shift;
194     if( exists $in->{align} ) {
195       if( $in->{align} !~ /^2$|^4$|^8$|^16$|^32$|^64$/ ) {
196         croak( '\'align\' parameter must be 2, 4, 8, 16, 32 or 64' );
197       }
198       $self->{_alignment} = $in->{align};
199       print "    My alignment is now ", $self->{_alignment}, "\n" if $Debug;
200       delete $in->{align};
201     }
202     if( exists $in->{fields} ) {
203       $self->_process_fields($in->{fields});
204       delete $in->{fields};
205     }
206   } elsif( ref($_[0]) eq 'ARRAY' ) {
207     $in = shift;
208     $self->_process_fields($in);
209   } else {
210     if( ( !$progeny
211           or scalar @{$self->{_fields}} == 0 )
212         and defined $_[0] ) {
213       croak( "Don't know what to do with args without fields" );
214     }
215     for( 0 .. $#{$self->{_fields}->{_array}} ) {
216       my $arg = shift;
217       print "  Assigning $arg to ", $_, "\n" if $Debug;
218       $self->{_values}->[$_] = $arg;
219     }
220   }
221
222   print "    Struct constructor returning\n" if $Debug;
223   return $self;
224 }
225
226 sub _as_param_ { return $_[0]->data(@_) }
227
228 =item copy
229
230 Return a copy of the Struct object.
231
232 =cut
233
234 sub copy {
235   my $self = shift;
236 }
237
238 sub data {
239   my $self = shift;
240   print "In ", $self->{_name}, "'s _DATA(), from ", join(", ",(caller(1))[0..3]), "\n" if $Debug;
241   my @data;
242   if( defined $self->{_data}
243       and $self->{_datasafe} == 1 ) {
244     print "    _data already defined and safe\n" if $Debug;
245     print "    returning ", unpack('b*',$self->{_data}), "\n" if $Debug;
246     return \$self->{_data};
247   }
248 # TODO This is where a check for an endianness property would come in.
249 #  if( $self->{_endianness} ne 'b' ) {
250     for(@{$self->{_fields}->{_rawarray}}) {
251       push @data, $_->{_data};
252     }
253     $self->{_data} = join('',@data);
254     print "    returning ", unpack('b*',$self->{_data}), "\n" if $Debug;
255     print "  ", $self->{_name}, "'s _data returning ok...\n" if $Debug;
256     $self->_datasafe(0);
257     return \$self->{_data};
258 #  } else {
259   # <insert code for other / swapped endianness here>
260 #  }
261 }
262
263 sub _update_ {
264   my($self, $arg, $index) = @_;
265   print "In ", $self->{_name}, "'s _UPDATE_, from ", join(", ",(caller(0))[0..3]), "\n" if $Debug;
266   print "  self is: ", $self, "\n" if $Debug;
267   print "  current data looks like:\n", unpack('b*',$self->{_data}), "\n" if $Debug;
268   print "  arg is: $arg" if $arg and $Debug;
269   print $arg ? (",  which is\n", unpack('b*',$arg), "\n  to you and me\n") : ('') if $Debug;
270   print "  and index is: $index\n" if defined $index and $Debug;
271   if( not defined $arg ) {
272     print "    Arg wasn't defined!\n" if $Debug;
273     if( $self->{_owner} ) {
274     print "      Getting data from owner...\n" if $Debug;
275     $self->{_data} = substr( ${$self->{_owner}->data},
276                              $self->{_index},
277                              $self->{_size} );
278     }
279   } else {
280     if( defined $index ) {
281       print "     Got an index...\n" if $Debug;
282       my $pad = $index + length($arg) - length($self->{_data});
283       if( $pad > 0 ) {
284         print "    pad was $pad\n" if $Debug;
285         $self->{_data} .= "\0" x $pad;
286       }
287       print "    Setting chunk of self->data\n" if $Debug;
288       substr( $self->{_data},
289               $index,
290               length($arg)
291             ) = $arg;
292     } else {
293       $self->{_data} = $arg; # if data given with no index, replaces all
294     }
295   }
296
297   # Have to send all data upstream even if only 1 member updated
298   # ... or do we? Send our _index, plus #bytes updated member starts at?
299   # Could C::B::C help with this???
300   if( defined $arg and $self->{_owner} ) {
301     print "    Need to update my owner...\n" if $Debug;
302     my $success = undef;
303     print "  Sending data back upstream:\n" if $arg and $Debug;
304     print "    Index is ", $self->{_index}, "\n" if $arg and $Debug;
305     $success =
306       $self->{_owner}->_update_(
307         $self->{_data},
308         $self->{_index}
309       );
310     if(!$success) {
311       croak($self->{_name},
312             ": Error updating member in owner object ",
313               $self->{_owner}->{_name});
314     }
315   }
316   $self->{_datasafe} = 1;
317   if( defined $arg or $self->{_owner} ) { # otherwise nothing's changed
318     $self->_set_owned_unsafe;
319   }
320   print "  data NOW looks like:\n", unpack('b*',$self->{_data}), "\n" if $Debug;
321   print "    updating size...\n" if $Debug;
322   $self->{_size} = length($self->{_data});
323   print "    ", $self->{_name}, "'s _Update_ returning ok\n" if $Debug;
324   return 1;
325 }
326
327 sub _valid_align {
328
329 }
330
331 # XXX partial alignment NYI
332
333 =item align
334
335 Returns or sets the alignment for the Struct. Valid alignments are
336 2, 4, 8, 16, 32 or 64. Setting alignment for individual members /
337 areas of the struct is not yet implemented.
338
339 =item fields
340
341 Returns an object used to access information B<about> fields of
342 the struct. You access individual fields as hash keys of this object.
343
344 Take the following hash as an example:
345
346   my $struct = Struct([
347     f1 => c_char('P'),
348     f2 => c_int(10),
349     f3 => c_long(90000),
350   ]);
351
352 Simply asking C<fields> for a field name returns a short description
353 of the field.
354
355   print $struct->fields->{f2}; # <Field type=c_int, ofs=1, size=4>
356
357 You can access any property of the field's internal Ctypes object through
358 this hash key as well.
359
360   print $struct->fields->{f2}->name;     # c_int
361   print $struct->fields->{f2}->typecode; # i
362   print $struct->fields->{f2}->owner;    # Ctypes::Type::Struct=HASH(0x...)
363
364 For simple types you could access the field's value by calling the C<value>
365 method through the hash key, but a much more convenient way to access values
366 is to use the C<values> method of the Struct object, detailed below.
367
368 =item name
369
370 Returns the name of the Struct object. If the object is a plain Struct
371 object, the name will be simply 'Struct'. If the object is a Struct
372 subclass, the name will be the last part of the package name, followed
373 by an underscore, followed by Struct, e.g. 'POINT_Struct'.
374
375 =item size
376
377 Returns the size of the Struct. Using the default alignment of 1, this
378 will be the sum of the sizes of all the members of the Struct. With
379 other alignments the C<size> might greater, depending on the contents of
380 the Struct.
381
382 For example, with the alignment set to 4, members I<after>
383 members which are smaller than 4 bytes (like C<c_char>s and C<c_short>s)
384 will be aligned to the next multple-of-four'th byte, making the small
385 member effectively 'take up' 4 bytes of memory in the Struct despite not
386 using them. But then of course, if the Struct only contains members which
387 are multiples of 4 bytes long, the 4-byte alignment will make no
388 difference.
389
390 =item typecode
391
392 Returns 'P', the typecode of all Structs.
393
394 =item values
395
396 Returns an object used to access the values of fields. This is what the
397 scalar dereferencing of Struct objects actually accesses for you, so the
398 following two lines are equivalent:
399
400   print $struct->values->{field1};
401   print $$struct->{field1};
402
403 =cut
404
405 #
406 # Accessor generation
407 #
408 my %access = (
409   typecode      => ['_typecode_'],
410   align         => [
411     '_alignment',
412     sub {if($_[0] =~ /^2$|^4$|^8$|^16$|^32$|^64$/){return 1}else{return 0}},
413     1,
414                    ],
415   name          => ['_name'],
416   size          => ['_size'],
417   fields        => ['_fields'],
418   values        => ['_values'],
419              );
420 for my $func (keys(%access)) {
421   no strict 'refs';
422   my $key = $access{$func}[0];
423   *$func = sub {
424     my $self = shift;
425     my $arg = shift;
426     croak("The $key method only takes one argument") if @_;
427     if(defined $access{$func}[1] and defined($arg)){
428       print "Validating...\n" if $Debug;
429       my $res;
430       eval{ $res = $access{$func}[1]->($arg); };
431       print "res: $res\n" if $Debug;
432       if( $@ or $res == 0 ) {
433         croak("Invalid argument for $key method: $arg");
434       }
435     }
436     if($access{$func}[2] and defined($arg)) {
437       $self->{$key} = $arg;
438     }
439     return $self->{$key};
440   }
441 }
442
443 sub _datasafe {
444   my( $self, $arg ) = @_;
445   if( defined $arg and $arg != 1 and $arg != 0 ) {
446     croak("Usage: ->_datasafe(1 or 0)")
447   }
448   if( defined $arg and $arg == 0 ) {
449     $self->_set_owned_unsafe;
450   }
451   $self->{_datasafe} = $arg if defined $arg;
452   return $self->{_datasafe};
453 }
454
455 sub _set_owned_unsafe {
456   my $self = shift;
457   print "Setting _owned_unsafe\n" if $Debug;
458   for( @{$self->{_fields}->{_rawarray}} ) {
459     $_->_datasafe(0);
460     print "    He now knows his data's ", $_->_datasafe, "00% safe\n" if $Debug;
461   }
462   return 1;
463 }
464
465 =back
466
467 =head1 SEE ALSO
468
469 L<Ctypes::Union>
470 L<Ctypes::Type>
471
472 =cut
473
474 package Ctypes::Type::Struct::_Fields;
475 use warnings;
476 use strict;
477 use Carp;
478 use Data::Dumper;
479 use Scalar::Util qw|blessed looks_like_number|;
480 use overload
481   '@{}'    => \&_array_overload,
482   '%{}'    => \&_hash_overload,
483   fallback => 'TRUE';
484 use Ctypes;
485 use Ctypes::Type::Field;
486
487 sub _array_overload {
488   return $_[0]->{_array};
489 }
490
491 sub _hash_overload {
492   my $caller = caller;
493   if( $caller =~ /^Ctypes::Type::Struct/ ) {
494     return $_[0];
495   }
496   my( $self, $key ) = ( shift, shift );
497   my $class = ref($self);
498   bless $self => 'overload::dummy';
499 #  print "_Fields' HashOverload\n" if $Debug;
500   my $ret = $self->{_hash};
501   bless $self => $class;
502   return $ret;
503 }
504
505 sub new {
506   my $class = ref($_[0]) || $_[0];  shift;
507   my $obj = shift;
508   my $self = {
509                _obj         => $obj,
510                _hash        => {},
511                _array       => [],
512                _size        => 0,
513                _allowchange => 1,
514              };
515   bless $self => $class;
516   return $self;
517 }
518
519 sub _add_field {
520   my( $self, $key, $val ) = ( shift, shift, shift );
521   print "In ", $self->{_obj}->{_name}, "'s _add_field(), from ", join(", ",(caller(1))[0..3]), "\n" if $Debug;
522   print "    key is $key\n" if $Debug;
523   print "    value is $val\n" if $Debug;
524   if( exists $self->{_hash}->{$key} ) {
525     croak( "Trying to add already extant key!" );
526   }
527
528   my $offset = 0;
529   my $newfieldindex = 0;
530   $newfieldindex = scalar @{$self->{_array}};
531   my $align = $self->{_obj}->{_alignment};
532   $align = 1 if $align == 0;
533
534   if( $newfieldindex > 0 ) {
535     print "    Already stuff in array\n" if $Debug;
536     my $lastindex = $#{$self->{_array}};
537     print "    lastindex is $lastindex\n" if $Debug;
538     print "    lastindex index: ", $self->{_array}->[$lastindex]->index, "\n" if $Debug;
539     print "    lastindex size: ", $self->{_array}->[$lastindex]->size, "\n" if $Debug;
540     $offset = $self->{_array}->[$lastindex]->index
541               + $self->{_array}->[$lastindex]->size;
542     print "    alignment is $align\n" if $Debug;
543     my $offoff = abs( $offset - $align ) % $align;
544     if( $offoff ) { # how much the 'off'set is 'off' by.
545       print "  offoff was $offoff off!\n" if $Debug;
546       $offset += $offoff;
547     }
548   }
549   print "    offset will be ", $offset, "\n" if $Debug;
550   print "  Creating Field...\n" if $Debug;
551   my $field = new Ctypes::Type::Field( $key, $val, $offset, $self->{_obj} );
552   print "    setting array...\n" if $Debug;
553   $self->{_array}->[$newfieldindex] = $field;
554   print "    setting hash...\n" if $Debug;
555   $self->{_hash}->{$key} = $field;
556
557   print "    _ADD_FIELD returning!\n" if $Debug;
558   return $self->{_hash}->{$key};
559 }
560
561 package Ctypes::Type::Struct::_Values;
562 use warnings;
563 use strict;
564 use Carp;
565 use Data::Dumper;
566 use Scalar::Util qw|blessed looks_like_number|;
567 use overload
568   '@{}'    => \&_array_overload,
569   '%{}'    => \&_hash_overload,
570   fallback => 'TRUE';
571
572 sub _array_overload {
573   print "_Values's ARRAY ovld\n" if $Debug;
574   print "    ", ref( $_[0]->{_array} ), "\n" if $Debug;
575   my $self = shift;
576   return $self->{_array};
577 }
578
579 sub _hash_overload {
580   my $caller = caller;
581   if( $caller =~ /^Ctypes::Type::Struct/ ) {
582     return $_[0];
583   }
584   print "_Values's HASH ovld\n" if $Debug;
585   my( $self, $key ) = ( shift, shift );
586   my $class = ref($self);
587   bless $self => 'overload::dummy';
588   my $ret = $self->{_hash};
589   bless $self => $class;
590   return $ret;
591 }
592
593 sub new {
594   print "In _Values constructor!\n" if $Debug;
595   my $class = ref($_[0]) || $_[0];  shift;
596   my $obj = shift;
597   my $self = {
598                 _obj         => $obj,
599                 _hash        => {},
600                 _rawhash     => undef,
601                 _array       => [],
602                 _rawarray    => undef,
603                 _fields      => $obj->{_fields},
604               };
605   $self->{_rawhash} = tie %{$self->{_hash}},
606                   'Ctypes::Type::Struct::_Fields::_hash', $self->{_fields};
607   $self->{_rawarray} = tie @{$self->{_array}},
608                   'Ctypes::Type::Struct::_Fields::_array', $self->{_fields};
609   bless $self => $class;
610   print "    _VALUES constructor returning ok\n" if $Debug;
611   return $self;
612 }
613
614 package Ctypes::Type::Struct::_Fields::_array;
615 use warnings;
616 use strict;
617 use Carp;
618 use Scalar::Util qw|blessed|;
619 use Ctypes;
620 use Data::Dumper;
621
622 sub TIEARRAY {
623   my $class = ref($_[0]) || $_[0];  shift;
624   my $fields = shift;
625   my $self = {
626                 _fields   => $fields,
627                 _array     => [],
628               };
629   bless $self => $class;
630   return $self;
631 }
632
633 sub STORE {
634   my $self = shift;
635   my $index = shift;
636   my $val = shift;
637   print "In _Fields::_array::STORE\n" if $Debug;
638   print "    index is $index\n" if $Debug;
639   print "    val is $val\n" if $Debug;
640   $self->{_fields}->{_array}->[$index]->{_contents} = $val;
641   return $self->{_fields}->{_array}->[$index]->{_contents};
642 }
643
644 sub FETCH {
645   my( $self, $index ) = (shift, shift);
646   print "In _array::FETCH, index $index, from ", join(", ",(caller(1))[0..3]), "\n" if $Debug;
647   return $self->{_fields}->{_array}->[$index]->{_contents};
648 }
649
650 sub FETCHSIZE { return scalar @{ $_[0]->{_fields}->{_array} } }
651 sub EXISTS { exists $_[0]->{_fields}->{_array}->[$_[1]] }
652
653 package Ctypes::Type::Struct::_Fields::_hash;
654 use warnings;
655 use strict;
656 use Scalar::Util qw|blessed|;
657 use Ctypes;
658 use Carp;
659 use Data::Dumper;
660
661 sub TIEHASH {
662   my $class = ref($_[0]) || $_[0];  shift;
663   my $fields = shift;
664   my $self = {
665                 _fields   => $fields,
666                 _hash     => {},
667               };
668   bless $self => $class;
669   return $self;
670 }
671
672 sub STORE {
673   my $self = shift;
674   my $key = shift;
675   my $val = shift;
676   print "In _Fields::_hash::STORE\n" if $Debug;
677   print "    key is $key\n" if $Debug;
678   print "    val is $val\n" if $Debug;
679   $self->{_fields}->{_hash}->{$key}->{_contents} = $val;
680   return $self->{_fields}->{$key};
681 }
682
683 sub FETCH {
684   my( $self, $key ) = (shift, shift);
685   print "In _hash::FETCH, key $key, from ", join(", ",(caller(1))[0..3]), "\n" if $Debug;
686   print "    ", ref($self->{_fields}->{_hash}->{$key}), "\n" if $Debug;
687   return $self->{_fields}->{_hash}->{$key}->{_contents};
688 }
689
690 sub FIRSTKEY {
691   my $a = scalar keys %{$_[0]->{_fields}->{_hash}};
692   each %{$_[0]->{_fields}->{_hash}}
693 }
694
695 sub NEXTKEY { each %{$_[0]->{_fields}->{_hash}} }
696 sub EXISTS { exists $_[0]->{_fields}->{_hash}->{$_[1]} }
697 sub DELETE { croak( "XXX Cannot delete Struct fields" ) }
698 sub CLEAR { croak( "XXX Cannot clear Struct fields" ) }
699 sub SCALAR { scalar %{$_[0]->{_fields}->{_hash}} }
700
701 #  package Ctypes::Type::Struct::_Fields::_Finder;
702 #  use warnings;
703 #  use strict;
704 #  use Ctypes;
705 #  use Carp;
706 #  use Data::Dumper;
707 #
708 #  #
709 #  # This was designed to allow method-style access to Struct members
710 #  # Removed and not yet re-integrated
711 #  #
712 #
713 #  sub new {
714 #    if( caller ne 'Ctypes::Type::Struct::_Fields' ) {
715 #      our $AUTOLOAD = '_Finder::new';
716 #      shift->AUTOLOAD;
717 #    }
718 #    my $class = shift;
719 #    my $fields = shift;
720 #    return bless [ $fields ] => $class;
721 #  }
722 #
723 #  sub AUTOLOAD {
724 #    our $AUTOLOAD;
725 #    print "In _Finder::AUTOLOAD\n" if $Debug;
726 #    print "    AUTOLOAD is $AUTOLOAD\n" if $Debug;
727 #    if ( $AUTOLOAD =~ /.*::(.*)/ ) {
728 #      return if $1 eq 'DESTROY';
729 #      my $wantfield = $1;
730 #      print "     Trying to AUTOLOAD for $wantfield\n" if $Debug;
731 #      my $self = $_[0];
732 #      my $instance = $self->[0]->{_obj};
733 #      if( defined $instance->{_subclass}
734 #          and $instance->can($wantfield) ) {
735 #        no strict 'refs';
736 #        goto &{$self->[0]->{_obj}->can($wantfield)};
737 #      }
738 #      my $found = 0;
739 #      if( exists $self->[0]->{_hash}->{$wantfield} ) {
740 #        $found = 1;
741 #        print "    Found it!\n" if $Debug;
742 #        my $object = $self->[0]->{_obj};
743 #        my $func = sub {
744 #          my $caller = shift;
745 #          my $arg = shift;
746 #          print "In $wantfield accessor\n" if $Debug;
747 #          croak("Too many arguments") if @_;
748 #          if( not defined $arg ) {
749 #            if(ref($caller)) {
750 #              print "    Returning value...\n" if $Debug;
751 #              my $ret = $self->[0]->{_hash}->{$wantfield};
752 #              if( ref($ret) eq 'Ctypes::Type::Simple' ) {
753 #                return ${$ret};
754 #              } elsif( ref($ret) eq 'Ctypes::Type::Array') {
755 #                return ${$ret};
756 #              } else {
757 #                return $ret;
758 #              }
759 #            } else {
760 #              # class method?
761 #              # or should that be done in Type::Struct?
762 #            }
763 #          } else {
764 #          }
765 #        };
766 #        if( defined( my $subclass = $self->[0]->{_obj}->{_subclass} ) ) {
767 #          no strict 'refs';
768 #          *{"${subclass}::$wantfield"} = $func;
769 #          goto &{"${subclass}::$wantfield"};
770 #        }
771 #      } else { # didn't find field
772 #        print "    Didn't find it\n" if $Debug;
773 #        print "    Here's what we had:\n" if $Debug;
774 #        print Dumper( $self->[0]->{_hash} ) if $Debug;
775 #        print Dumper( $self->[0]->{_array} ) if $Debug;
776 #        croak( "Couldn't find field '$wantfield' in ",
777 #          $self->[0]->{_obj}->name );
778 #      }
779 #    }  # if ( $AUTOLOAD =~ /.*::(.*)/ )
780 #  }
781
782 1;