Syntax error
[perl-ctypes:perl-ctypes.git] / lib / Ctypes / Function.pm
1 package Ctypes::Function;
2
3 use strict;
4 use warnings;
5 use Ctypes;
6 use overload '&{}' => \&_call_overload;
7
8 # Public functions are defined in POD order
9 sub new;
10 sub update;
11 sub abi_default;
12 sub validate_abi;
13 sub validate_types;
14
15 =head1 NAME
16
17 Ctypes::Function - Object-oriented access to C function calls
18
19 =head1 VERSION
20
21 Version 0.002
22
23 =head1 SYNOPSIS
24
25     use Ctypes::Function;
26
27     $toupper = Ctypes::Function->new( "-lc", "toupper", "cii" );
28     $result = $func->(ord("y"));
29
30     # or
31     $toupper = Ctypes::Function->new({ lib    => 'c',
32                                        name   => 'toupper',
33                                        atypes => 'i',
34                                        rtype  => 'i' } );
35     $result = chr($toupper->(ord("y")));
36
37 =head1 DESCRIPTION
38
39 Ctypes::Function abstracts the raw Ctypes::call() API
40
41 =cut
42
43 # TODO:
44 # - namespace install feature from P5NCI
45
46 ################################
47 #   PRIVATE FUNCTIONS & DATA   #
48 ################################
49
50 # For which members will AUTOLOAD provide mutators?
51 my $_setable = { name => 1, sig => 1, abi => 1, rtype => 1, lib => 1 };
52 # For abi_default():
53 my $_default_abi = ($^O eq 'MSWin32' ? 's' : 'c' );
54
55 sub _get_args (\@\@;$) {
56   my $args = shift;
57   my $want = shift;
58   my $ret = {};
59
60   if (ref($args->[0]) eq 'HASH') {
61     # Using named parameters.
62     for(@{$want}) {
63       $ret->{$_} = $args->[0]->{$_} }
64   } else {
65     # Using positional parameters.
66     for(my $i=0; $i <= $#{$args}; $i++ ) {
67       $ret->{$want->[$i]} = $args->[$i] }
68   }
69   return $ret;
70 }
71
72 sub _call_overload {
73   my $self = shift;
74   return sub { _call($self, @_) };
75 }
76
77 sub _call {
78   my $self = shift;
79   my @args = @_;
80   my $retval;
81   die "Function needs a signature (even '' must be defined)"
82     unless defined $self->sig;
83   #print Dumper( $self );
84   # Constructing / validating full sig to pass to Ctypes::call
85   validate_types($self->sig);
86   my $whole_sig;
87   if ($self->abi) {
88     validate_abi($self->abi); # chops to 1 char & checks letters
89     if ($self->rtype) {
90       # validate_types also used for sig so must chop here
91       $self->rtype = substr($self->rtype, 0, 1);
92       validate_types($self->rtype);
93       $whole_sig = $self->abi . $self->rtype . $self->sig;
94     } else {
95       $whole_sig = $self->abi . $self->sig;
96     }
97   } elsif( $self->rtype ) {
98     warn("Got rtype but no abi; using system default");
99     $self->abi = abi_default();
100     $whole_sig = $self->abi . $self->rtype . $self->sig;
101   } 
102   if (!defined $self->abi and !defined $self->rtype) { # for clarity
103     $whole_sig = $self->sig; 
104   }
105   $retval = Ctypes::call( $self->func, $whole_sig, @args );
106   return $retval;
107 }
108
109 sub AUTOLOAD {
110   our $AUTOLOAD;
111   if( $AUTOLOAD =~  /.*::(.*)/ ) {
112     return if $1 eq 'DESTROY';
113     my $mem = $1; # member
114     no strict 'refs';
115     *$AUTOLOAD = sub { 
116       my $self = shift;
117       if($_setable->{$mem}) {
118         if(@_) {
119           return $self->{$mem} = $_[0];
120         }
121         if( defined $self->{$mem} ) {
122           return $self->{$mem};
123         } else { return undef; }
124       } else {
125         if(@_) {
126           warn("$mem not setable"); }
127         if( defined $self->{$mem} ) {
128           return $self->{$mem}; 
129         } else { return undef; }
130       }
131     };
132     goto &$AUTOLOAD;
133   }
134 }
135
136 ################################
137 #       PUBLIC FUNCTIONS       #
138 ################################
139
140 =head1 PUBLIC SUBROUTINES/METHODS
141
142 Ctypes::Function's methods are designed for flexibility.
143
144 =head2 new ( lib, name, [ sig, [ abi, [ rtype, [ func ]]]] )
145
146 or hash-style: new ( { param => value, ... } )
147
148 Ctypes is happy to leave as much as possible until later, where it makes
149 sense. The only thing on which a Function object insists is knowing
150 where to find the C function it represents. This means that upon
151 instantiation, you must supply B<either> both the library and the name
152 of the function, B<or> a reference to the function itself. Further, to
153 avoid confusion, the C<func> reference is immutible after instantiation:
154 if you want a new function, make a new Function object.
155
156 Most of a Function's attributes can be accessed with a getter like this:
157 C<$obj->attr>, and set with a setter like this C<$obj->attr('value')> 
158 (apart from C<func>, which only has the getter). Each attribute's precise
159 meanings are explained below.
160
161 =over
162
163 =item lib
164
165 Describes the library in which the target function resides. It can
166 be one of three things:
167
168 =over
169
170 =item A linker argument style string, e.g. '-lc' for libc. Bear in mind
171 that on Win32 library name resolution may be a bit sketchy, so you might
172 want to use another option.
173
174 =item A path to a library file (B<unimplemented> as of v0.002).
175
176 =item An opaque library reference as returned by DynaLoader.
177
178 =back
179
180 B<N.B.> Although the L<DynaLoader> docs explicitly say that the references
181 it returns are to be considered 'opaque', we sneak a little regex on them
182 to make sure they look like a string of numbers - what a DL reference
183 normally looks like. This means that yes, you could do yourself a mischief
184 by passing any string of numbers as a library reference, even though that
185 would be a Silly Thing To Do.
186
187 =item name
188
189 The name of the function your object represents. On initialising,
190 it's used internally by L<DynaLoader> as the function symbol to look for
191 in the library given by C<lib>. It can also be useful for remembering
192 what an object does if you've assigned it to a non-intuitively named
193 reference. In theory though it's never looked at after initialization
194 (and not even then if you supply a C<func> reference) so you could
195 store any information you want in there.
196
197 =item sig
198
199 A string of letters representing the function signature, in the
200 same format as L<Ctypes::call>. In a Function object, it can represent the
201 full signature (like Ctypes::call), or just the return value + arguments,
202 or just the arguments, depending on whether C<abi> and/or C<rtype> have
203 been defined. See the note L</"abi, rtype and sig"> below.
204
205 =item abi
206
207 This is a single character representing the desired Application Binary
208 Interface for the call, here used to mean the calling convention. It can
209 be 'c' for C<cdecl> or 's' for C<stdcall>. Other values will fail.
210 'f' for C<fastcall> is for now used implicitly with 'c' on WIN64 
211 and UNIX64 architectures, not yet on 64bit libraries. 
212 See note L</"abi, rtype and sig"> below.
213
214 =item rtype
215
216 A single character representing the return type of the function, using
217 the same notation as Ctypes::call. See note L</"abi, rtype and sig">
218 below.
219
220 =item func
221
222 An opaque reference to the function which the object represents. Can be
223 accessed after initialisation, but cannot be changed.
224
225 =back
226
227 =head3 C<abi>, C<rtype> and C<sig>
228
229 For the short of time:
230
231 =over
232
233 =item If neither C<abi> nor C<rtype> are defined (as is the usual case),
234 C<sig> will be taken to include everything: the ABI, the return type, and
235 the parameter list, in that order.
236
237 =item If only C<abi> is set, C<sig> will be taken to include the other
238 two attributes, return type and parameter list, in that order.
239
240 =item If only C<rtype> is set, C<abi> will be defined I<for you>, to the
241 system default. C<sig> will be taken to include just the parameter
242 list, just like if you had defined both C<rtype> and C<abi> yourself. It
243 is B<not> possible for C<sig> to represent only the ABI and parameter
244 list.
245
246 =back
247
248 The simplest way to use a Function is to specify the ABI, return type
249 and parameters all in one string stored in C<$obj->sig>. However, there
250 may be times when you want to change the set ABI or return type
251 of your object after its creation. For these occasions, you can set
252 those attributes separately with their eponymous mutator methods. The
253 important thing to consider is that I<the definedness of> C<$obj->abi>
254 I<and> C<$obj->rtype> I<change the way> C<$obj->sig> I<will be
255 interpreted>.
256
257 This is pretty much common sense: if you have taken the time to specify
258 C<abi> and C<rtype> separately, then C<sig> must only represent the
259 parameter list. Where there may be uncertainty however is when only
260 one of C<abi> and C<rtype> is provided. The rules above describe the
261 logic used in those instances.
262
263 =cut
264
265 sub new {
266   my ($class, @args) = @_;
267   # default positional args are library, function name, function signature
268   # will never make sense to pass func address or lib address positionally
269   my @attrs = qw(lib name sig abi rtype func);
270   our $ret  =  _get_args(@args, @attrs);
271
272   # Just so we don't have to continually dereference $ret
273   my ($lib, $name, $sig, $abi, $rtype, $func)
274       = (map { \$ret->{$_}; } @attrs );
275
276   if (!$$func && !$$name) { die( "Need function ref or name" ); }
277
278   if (!$$func) {
279     if (!$$lib) {
280       die( "Can't find function without a library!" );
281     } else {
282       do {
283         $$lib = Ctypes::load_library( $$lib );
284       } unless ($$lib =~ /^[0-9]$/); # looks like dl_load_file libref
285     }
286     $$func = Ctypes::find_function( $$lib, $$name );
287   }
288   return bless $ret, $class;
289 }
290
291 =head2 update(name, sig, abi, args)
292
293 Also hash-style: update({ param => value, [...] })
294
295 C<update> provides a quick way of changing many attributes of a function
296 all at once. Only the function's C<lib> and C<func> references cannot
297 be updated (because that wouldn't make any sense).
298
299 =cut
300
301 sub update {
302   my $self = shift;
303   my @args = @_;
304   my @want = qw(name sig abi rtype);
305   my $update_self = _get_args(@args, @want);
306   for(@want) {
307     if(defined $update_self->{$_}) {
308       $self->{$_} = $update_self->{$_};
309     }
310   }
311   return $self;
312 }
313
314 =head2 abi_default( [ 'c' | $^O ] );
315
316 Also hash-style: abi_default( [ { abi => <char> | os => $^O } ] )
317
318 This class method is used to return the default ABI (calling convention)
319 for the current system. It can also be used to change the 'default' for
320 your script, either through passing a specific ABI code ( 'c' for C<cdecl>
321 or 's' for C<stdcall> ) or by specifying an operating system type. The OS
322 must be specified using a string returned by $^O on the target system.
323
324 =cut
325
326 sub abi_default {
327   my $arg = shift;
328   if( !defined $arg ) {
329     return $_default_abi;
330   }
331   # What kind of argument did we get?
332   if(ref($arg) eq 'SCALAR') {
333     if( ($arg eq 's') or ($arg eq 'MSWin32') ) { 
334       $_default_abi = 's'; return 1; }
335     if( ($arg eq 'c') or ($arg eq 'linux') or ($arg eq 'cygwin') ) { 
336       $_default_abi = 'c'; return 1; }
337     die("abi_default: unrecognised ABI code or OS identifier");
338   } elsif(ref($arg) eq 'HASH') {
339     if( (defined $arg->{abi} and $arg->{abi} eq 's') or 
340         (defined $arg->{os} and $arg->{os} eq 'MSWin32') ) {
341       $_default_abi = 's'; return 1;
342     }
343     if( (defined $arg->{abi} and $arg->{abi} eq 'c') or
344         (defined $arg->{os} and $arg->{os} eq 'linux') or 
345         (defined $arg->{os} and $arg->{os} eq 'cygwin') ) {
346       $_default_abi = 'c'; return 1;
347     }
348   }
349   die("abi_default: unrecognised ABI code or OS identifier");
350 }
351
352 =head2 validate_abi
353
354 TODO
355
356 =head2 validate_types
357
358 TODO
359
360 =cut
361
362 1;