Many changes
[perl-ctypes:perl-ctypes.git] / lib / Ctypes.pm
1 package Ctypes;
2 use strict;
3 use warnings;
4 my $Debug = 0;
5
6 =head1 NAME
7
8 Ctypes - Call and wrap C libraries and functions from Perl, using Perl
9
10 =head1 VERSION
11
12 Version 0.002
13
14 =cut
15
16 our $VERSION = '0.002';
17
18 use AutoLoader;
19 use Carp;
20 use Config;
21 use Ctypes::Type;
22 use Ctypes::Type::Struct;
23 use DynaLoader;
24 use File::Spec;
25 use Scalar::Util qw|blessed looks_like_number|;
26
27 require Exporter;
28 our @ISA = qw(Exporter);
29 our @EXPORT = ( qw|CDLL WinDLL OleDLL PerlDLL 
30                    WINFUNCTYPE CFUNCTYPE PERLFUNCTYPE
31                    POINTER WinError byref is_ctypes_compat
32                    Array Pointer Struct Union
33                   |, @Ctypes::Type::_allnames );
34 our @EXPORT_OK = qw|_make_arrayref _check_invalid_types
35                     _check_type_needed _valid_for_type
36                     _cast|;
37
38 require XSLoader;
39 XSLoader::load('Ctypes', $VERSION);
40
41 =head1 SYNOPSIS
42
43     use Ctypes;
44
45     # Look Ma, no XS!
46     my $lib  = CDLL->LoadLibrary("-lm");
47     my $func = $lib->sqrt;
48     my $ret = $lib->sqrt(16.0); # on Windows only
49     # non-windows
50     my $ret = $lib->sqrt({sig=>"cdd"},16.0);
51
52     # bare
53     my $ret  = Ctypes::call( $func, 'cdd', 16.0  );
54     print $ret; # 4! Eureka!
55
56     # which is the same as:
57     use DynaLoader;
58     my $lib =  DynaLoader::dl_load_file( DynaLoader::dl_findfile( "-lm" ));
59     my $func = Dynaloader::dl_find_symbol( $lib, 'sqrt' );
60     my $ret  = Ctypes::call( $func, 'cdd', 16.0  );
61
62 =head1 ABSTRACT
63
64 Ctypes is the Perl equivalent to the Python ctypes FFI library, using
65 libffi. It provides C compatible data types, and allows one to call
66 functions in dlls/shared libraries.
67
68 =head1 DESCRIPTION
69
70 Ctypes is designed to let module authors wrap native C libraries in
71 a pure Perly way. Authors can benefit by not having to deal with any
72 XS or C code. Users benefit from not having to have a compiler properly
73 installed and configured - they simply download the necessary binaries
74 and run the Ctypes-based Perl modules written against them.
75
76 The module should also be as useful for the admin, scientist or general
77 datamangler who wants to quickly script together a couple of functions
78 from different native libraries as for the Perl module author who wants
79 to expose the full functionality of a large C/C++ project.
80
81 =cut
82
83
84 =head1 SUBROUTINES
85
86 =over
87
88 =item call SIG, ADDR, [ ARGS ... ]
89
90 Lets you call the external function at the address specified by ADDR,
91 with the signature specified by SIG, and return a value.
92
93 C<Ctypes::call> is modelled after the C<call> function found in
94 L<FFI.pm|FFI>: it's the low-level, bare bones access to Ctypes'
95 capabilities. Most of the time you'll probably prefer the
96 abstractions provided by L<Ctypes::Function>.
97
98 I<SIG> is the signature string. The first character specifies the
99 calling-convention: s for stdcall, c for cdecl (or 64-bit fastcall). 
100 The second character specifies the typecode for the return type
101 of the function, and the subsequent characters specify the argument types.
102
103 'Typecodes' are single character designations for various C data types.
104 They're similar in concept to the codes used by Perl's
105 L<pack|perlfunc/pack> and L<unpack|perlfunc/unpack> functions, but they
106 are B<not> the same codes!
107  
108 I<ADDR> is the function address, the return value of L<find_function> or
109 L<DynaLoader::dl_find_symbol>.
110
111 I<ARGS> are the optional arguments for the external function. The types
112 are converted as specified by sig[2..].
113
114 Here are the urrently supported signature typecode characters. As you can
115 see, there is some overlap with Perl's L<pack|perlfunc/pack> notation,
116 they're not identical (v), and furthermore B<WILL CHANGE> to offer a wider
117 range of types:
118
119   'v': void
120   'c': signed char
121   'C': unsigned char
122   's': signed short
123   'S': unsigned short
124   'i': signed int
125   'I': unsigned int
126   'l': signed long
127   'L': unsigned long
128   'f': float
129   'd': double
130   'D': long double
131   'p': pointer
132
133 =cut
134
135 sub call {
136   my $func = shift;
137   my $sig = shift;
138   my @args = @_;
139   my @argtypes = ();
140   @argtypes = split( //, substr( $sig, 2 ) ) if length $sig > 2;
141   for(my $i=0 ; $i<=$#args ; $i++) {
142     if( $argtypes[$i] =~ /[dDfFiIjJlLnNqQsSvV]/ and 
143         not looks_like_number($args[$i]) ) {
144       die "$i-th argument $args[$i] is no number";
145     }
146   }
147   return _call( $func, $sig, @args );
148 }
149
150 =item Array I<LIST>
151
152 =item Array I<TYPE>, I<ARRAYREF>
153
154 Create a L<Ctypes::Type::Array> object. LIST and ARRAYREF can contain
155 Ctypes objects, or a Perl natives.
156
157 If the latter, Ctypes will try to choose the smallest appropriate C
158 type and create Ctypes objects out of the Perl natives for you. You
159 can find out which type it chose afterwards by calling the C<member_type>
160 accessor method on the Array object.
161
162 If you want to specify the data type of the array, you can do so by
163 passing a Ctypes type as the first parameter, and the contents in an
164 array reference as the second. Naturally, your data must be compatible
165 with the type specified, otherwise you'll get an error from the a
166 C<Ctypes::Type::Simple> constructor.
167
168 And of course, in C(types), all your array input has to be of the same
169 type.
170
171 See L<Ctypes::Type::Array> for more detailed documentation.
172
173 =cut
174
175 sub Array {
176   return Ctypes::Type::Array->new(@_);
177 }
178
179 =item Pointer OBJECT
180
181 =item Pointer TYPE, OBJECT
182
183 Create a L<Ctypes::Type::Pointer> object. OBJECT must be a Ctypes object.
184 See the relevant documentation for more information.
185
186 =cut
187
188 sub Pointer {
189   return Ctypes::Type::Pointer->new(@_);
190 }
191
192 =item Struct HASHREF
193
194 Create a L<Ctypes::Type::Struct> object. Basing new classes on Struct
195 may also often be more useful than subclassing other Types. See the
196 relevant documentation for more information.
197
198 =cut
199
200 sub Struct {
201   return Ctypes::Type::Struct->new(@_);
202 }
203
204 =item Union HASHREF
205
206 Create a L<Ctypes::Type::Union> object. See the module docs for more
207 information.
208
209 =cut
210
211 sub Union {
212   return Ctypes::Type::Union->new(@_);
213 }
214
215 =item load_library (lib, [mode])
216
217 Searches the dll/so loadpath for the given library, architecture dependently.
218
219 The lib argument is either part of a filename (e.g. "kernel32") with 
220 platform specific path and extension defaults,
221 a full pathname to the shared library
222 or the same as for L<DynaLoader::dl_findfile>:
223 "-llib" or "-Lpath -llib", with -L for the optional path.
224
225 Returns a libraryhandle, to be used for find_function.
226 Uses L<Ctypes::Util::find_library> to find the path.
227 See also the L<LoadLibrary> method for a DLL object, 
228 which also returns a handle.
229
230 With C<mode> optional dynaloader args can be specified:
231
232 =over
233
234 =item RTLD_GLOBAL 
235
236 Flag to use as mode parameter. On platforms where this flag is not
237 available, it is defined as the integer zero.
238
239 =item RTLD_LOCAL
240
241 Flag to use as mode parameter. On platforms where this is not
242 available, it is the same as RTLD_GLOBAL.
243
244 =item DEFAULT_MODE 
245
246 The default mode which is used to load shared libraries. On OSX 10.3,
247  this is RTLD_GLOBAL, otherwise it is the same as RTLD_LOCAL.
248
249 =back
250
251 =cut
252
253 sub load_library($;@) {
254   my $path = Ctypes::Util::find_library( shift, @_ );
255   # This might trigger a Windows MessageBox
256   return DynaLoader::dl_load_file($path, @_) if $path;
257 }
258
259
260 =item CDLL (library, [mode])
261
262 Searches the library search path for the given name, and 
263 returns a library object which defaults to the C<cdecl> ABI, with 
264 default restype C<i>.
265
266 For B<mode> see L<load_library>.
267
268 =cut
269
270 sub CDLL {
271   return Ctypes::CDLL->new( @_ );
272 }
273
274 =item WinDLL (library, [mode])
275
276 Windows only: Searches the library search path for the given name, and 
277 returns a library object which defaults to the C<stdcall> ABI, 
278 with default restype C<i>.
279
280 For B<mode> see L<load_library>.
281
282 =cut
283
284 sub WinDLL {
285   return Ctypes::WinDLL->new( @_ );
286 }
287
288 =item OleDLL (library, [mode])
289
290 Windows only: Objects representing loaded shared libraries, functions
291 in these libraries use the C<stdcall> calling convention, and are assumed
292 to return the windows specific C<HRESULT> code. HRESULT values contain
293 information specifying whether the function call failed or succeeded,
294 together with additional error code. If the return value signals a
295 failure, a L<WindowsError> is automatically raised.
296
297 For B<mode> see L<load_library>.
298
299 =cut
300
301 sub OleDLL {
302   return Ctypes::OleDLL->new( @_ );
303 }
304
305 =item PerlDLL (library)
306
307 Instances of this class behave like CDLL instances, except that the
308 Perl XS library is not released during the function call, and after
309 the function execution the Perl error flag is checked. If the error
310 flag is set, a Perl exception is raised.  Thus, this is only useful
311 to call Perl XS api functions directly.
312
313 =cut
314
315 sub PerlDLL() {
316   return Ctypes::PerlDLL->new( @_ );
317 }
318
319 =item CFUNCTYPE (restype, argtypes...)
320
321 The returned L<C function prototype|Ctypes::FuncProto::C> creates a
322 function that use the standard C calling convention. The function will
323 release the library during the call.
324
325 restype and argtypes are L<Ctype::Type> objects, such as c_int, 
326 c_void_p, c_char_p etc..
327
328 =item WINFUNCTYPE (restype, argtypes...)
329
330 Windows only: The returned L<Windows function prototype|Ctypes::FuncProto::Win> 
331 creates a function that use the C<stdcall> calling convention. 
332 The function will release the library during the call.
333
334 B<SYNOPSIS>
335
336   my $prototype  = WINFUNCTYPE(c_int, HWND, LPCSTR, LPCSTR, UINT);
337   my $paramflags = [[1, "hwnd", 0], [1, "text", "Hi"], 
338                    [1, "caption", undef], [1, "flags", 0]];
339   my $MessageBox = $prototype->(("MessageBoxA", WinDLL->user32), $paramflags);
340   $MessageBox->({text=>"Spam, spam, spam")});
341
342 =item PERLFUNCTYPE (restype, argtypes...)
343
344 The returned function prototype creates functions that use the Perl XS
345 calling convention. The function will not release the library during
346 the call.
347
348 =cut
349
350 sub WINFUNCTYPE {
351   use Ctypes::FuncProto;
352   return Ctypes::FuncProto::Win->new( @_ );
353 }
354 sub CFUNCTYPE {
355   use Ctypes::FuncProto;
356   return Ctypes::FuncProto::C->new( @_ );
357 }
358 sub PERLFUNCTYPE {
359   use Ctypes::FuncProto;
360   return Ctypes::FuncProto::Perl->new( @_ );
361 }
362
363 =item callback (<perlfunc>, <restype>, <argtypes>)
364
365 Creates a callable, an external function which calls back into perl,
366 specified by the signature and a reference to a perl sub.
367
368 B<perlfunc> is a named (or anonymous?) subroutine reference. B<restype>
369 is a single character string representing the return type, and
370 B<argtypes> is a multi-character string representing the argument
371 types the function will receive from C. All types are represented
372 in typecode format.
373
374 B<Note> that the interface for Callback->new() will be updated
375 to be more consistent with Function->new().
376
377 =cut
378
379 sub callback($$$) {
380   return Ctypes::Callback->new( @_ );
381 }
382
383 =back
384
385 =head1 Ctypes::DLL
386
387 Define objects for shared libraries and its abi.
388
389 Subclasses are CDLL, WinDLL, OleDLL and PerlDLL, returning objects
390 defining the path, handle, restype and abi of the found shared library.
391
392 Submethods are LoadLibrary and the functions and variables inside the library. 
393
394 Properties are _name, _path, _abi, _handle.
395
396   $lib = CDLL->msvcrt;
397
398 is the same as CDLL->new("msvcrt"),
399 but CDLL->libc should be used for cross-platform compat.
400
401   $func = CDLL->c->toupper;
402
403 returns the function for the libc function toupper, 
404 on Windows and Posix.
405
406 Functions within libraries can be declared.
407 or called directly.
408
409   $ret = CDLL->libc->toupper({sig => "cii"})->ord("y");
410
411 =cut
412
413 package Ctypes::DLL;
414 use strict;
415 use warnings;
416 use Ctypes;
417 use Ctypes::Function;
418 use Carp;
419
420 # This AUTOLOAD is used to define the dll/soname for the library,
421 # or access a function in the library.
422 # $lib = CDLL->msvcrt; $func = CDLL->msvcrt->toupper; 
423 # Indexed with CDLL->msvcrt[0] (tied array?) on windows only
424 # or named with WinDLL->kernel32->GetModuleHandle({sig=>"sll"})->(32)
425 sub AUTOLOAD {
426   my $name;
427   our $AUTOLOAD;
428   ($name = $AUTOLOAD) =~ s/.*:://;
429   return if $name eq 'DESTROY';
430   # property
431   if ($name =~ /^_(abi|handle|path|name)$/) {
432     *$AUTOLOAD = sub { 
433       my $self = shift;
434       # only _abi is setable
435       if ($name eq 'abi') {
436         if (@_) {
437           return $self->{$name} = $_[0];
438         }
439         if (defined $self->{$name} ) {
440           return $self->{$name};
441         } else { return undef; }
442       } else {
443         warn("$name not setable") if @_;
444         if (defined $self->{$name} ) {
445           return $self->{$name};
446         } else { return undef; }
447       }
448       goto &$AUTOLOAD;
449     }
450   }
451   if (@_) {
452     # ->library
453     my $lib = shift;
454     # library not yet loaded?
455     if (ref($lib) =~ /^Ctypes::(|C|Win|Ole|Perl)DLL$/ and !$lib->{_handle}) {
456       $lib->LoadLibrary($name)
457         or croak "LoadLibrary($name) failed";
458       return $lib;
459     } else { # name is a ->function
460       my $props = { lib => $lib->{_handle},
461                     abi => $lib->{_abi}, 
462                     restype => $lib->{_restype}, 
463                     name => $name };
464       if (@_ and ref $_[0] eq 'HASH') { # declare the sig or restype via HASHREF
465         my $arg = shift;
466         $props->{sig} = $arg->{sig} if $arg->{sig};
467         $props->{restype} = $arg->{restype} if $arg->{restype};
468         $props->{argtypes} = $arg->{argtypes} if $arg->{argtypes};
469       }
470       return Ctypes::Function->new($props, @_);
471     }
472   } else {
473     my $lib = Ctypes::load_library($name)
474       or croak "Ctypes::load_library($name) failed";
475     return $lib; # scalar handle only?
476   }
477 }
478
479 =head1 LoadLibrary (name [mode])
480
481 A DLL method which loads the given shared library, 
482 and on success sets the new object properties path and handle, 
483 and returns the library handle.
484
485 =cut
486
487 sub LoadLibrary($;@) {
488   my $self = shift;
489   my $path = $self->{_path};
490   $self->{_name} = shift;
491   $self->{_abi} = ref $self eq 'Ctypes::CDLL' ? 'c' : 's';
492   $path = Ctypes::Util::find_library( $self->{_name} ) unless $path;
493   $self->{_handle} = DynaLoader::dl_load_file($path, @_) if $path;
494   $self->{_path} = $path if $self->{_handle};
495   return $self->{_handle};
496 }
497
498 =head1 CDLL
499
500   $lib = CDLL->msvcrt;
501
502 is a fancy name for Ctypes::CDLL->new("msvcrt"). 
503 Note that you should really use the platform compatible 
504 CDLL->c for the current libc, which can be any msvcrtxx.dll
505
506   $func = CDLL->msvcrt->toupper;
507
508 returns the function for the Windows libc function toupper,
509 but this function cannot be called, since the sig is missing.
510 It only checks if the symbol is define inside the library.
511 You can add the sig later, as in
512
513   $func->{sig} = 'cii';
514
515 or call the function like
516
517   $ret = CDLL->msvcrt->toupper({sig=>"cii"})->(ord("y"));
518
519 On windows you can also define and call functions by their 
520 ordinal in the library.
521
522 Define:
523
524   $func = CDLL->kernel32[1];
525
526 Call:
527
528   $ret = CDLL->kernel32[1]->();
529
530 =head1 WinDLL
531
532   $lib = WinDLL->kernel32;
533
534 Windows only: Returns a library object for the Windows kernel32.dll.
535
536 =head1 OleDLL
537
538   $lib = OleDLL->mshtml;
539
540 Windows only.
541
542 =cut
543
544 package Ctypes::CDLL;
545 use strict;
546 use warnings;
547 use Ctypes;
548 our @ISA = qw(Ctypes::DLL);
549 use Carp;
550
551 sub new {
552   my $class = shift;
553   my $props = { _abi => 'c', _restype => 'i' };
554   if (@_) {
555     $props->{_path} = Ctypes::Util::find_library(shift);
556     $props->{_handle} = Ctypes::load_library($props->{_path});
557   }
558   return bless $props, $class;
559 }
560
561 #our ($libc, $libm);
562 #sub libc {
563 #  return $libc if $libc;
564 #  $libc = load_library("c");
565 #}
566 #sub libm {
567 #  return $libm if $libm;
568 #  $libm = load_library("m");
569 #}
570
571 package Ctypes::WinDLL;
572 use strict;
573 use warnings;
574 our @ISA = qw(Ctypes::DLL);
575
576 sub new {
577   my $class = shift;
578   my $props = { _abi => 's', _restype => 'i' };
579   if (@_) {
580     $props->{_path} = Ctypes::Util::find_library(shift);
581     $props->{_handle} = Ctypes::load_library($props->{_path});
582   }
583   return bless $props, $class;
584 }
585
586 package Ctypes::OleDLL;
587 use strict;
588 use warnings;
589 use Ctypes;
590 our @ISA = qw(Ctypes::DLL);
591
592 sub new {
593   my $class = shift;
594   my $props = { abi => 's', _restype => 'p', _oledll => 1 };
595   if (@_) {
596     $props->{_path} = Ctypes::Util::find_library(shift);
597     $props->{_handle} = Ctypes::load_library($props->{_path});
598   }
599   return bless $props, $class;
600 }
601
602 package Ctypes::PerlDLL;
603 use strict;
604 use warnings;
605 our @ISA = qw(Ctypes::DLL);
606
607 sub new {
608   my $class = shift;
609   my $name = shift;
610   # TODO: name may be split into subpackages: PerlDLL->new("C::DynaLib")
611   my $props = { _abi => 'c', _restype => 'i', _name => $name, _perldll => 1 };
612   die "TODO perl xs library search";
613   $name =~ s/::/\//g;
614   #$props->{_path} = $Config{...}.$name.$Config{soext};
615   my $self = bless $props, $class;
616   $self->LoadLibrary($props->{_path});
617 }
618
619 package Ctypes::Util;
620 use strict;
621 use warnings;
622
623 =head1 Utility Functions
624
625 =over
626
627 =item Ctypes::Util::find_library (lib, [dynaloader args])
628
629 Searches the dll/so loadpath for the given library, architecture dependently.
630
631 The lib argument is either part of a filename (e.g. "kernel32"),
632 a full pathname to the shared library
633 or the same as for L<DynaLoader::dl_findfile>:
634 "-llib" or "-Lpath -llib", with -L for the optional path.
635
636 Returns the path of the found library or undef.
637
638   find_library "-lm"
639     => "/usr/lib/libm.so"
640      | "/usr/bin/cygwin1.dll"
641      | "C:\\WINDOWS\\\\System32\\MSVCRT.DLL
642
643   find_library "-L/usr/local/kde/lib -lkde"
644     => "/usr/local/kde/lib/libkde.so.2.0"
645
646   find_library "kernel32"
647     => "C:\\WINDOWS\\\\System32\\KERNEL32.dll"
648
649 On cygwin or mingw C<find_library> might try to run the external program C<dllimport>
650 to resolve the version specific dll from the found unversioned import library.
651
652 With C<mode> optional dynaloader args can or even must be specified as with
653 L<load_library>, because C<find_library> also tries to load every found
654 library, and only returns libraries which could successfully be dynaloaded.
655
656 =cut
657
658 sub find_library($;@) {# from C::DynaLib::new
659   my $libname = $_ = shift;
660   my $so = $libname;
661   -e $so or $so = DynaLoader::dl_findfile($libname) || $libname;
662   my $lib;
663   $lib = DynaLoader::dl_load_file($so, @_) unless $so =~ /\.a$/;
664   return $so if $lib;
665
666   # Duplicate most of the DynaLoader code, since DynaLoader is
667   # not ready to find MSWin32 dll's.
668   if ($^O =~ /MSWin32|cygwin/) { # activeperl, mingw (strawberry) or cygwin
669     my ($found, @dirs, @names, @dl_library_path);
670     my $lib = $libname;
671     $lib =~ s/^-l//;
672     if ($^O eq 'cygwin' and $lib =~ m{^(c|m|pthread|/usr/lib/libc\.a)$}) {
673       return "/bin/cygwin1.dll";
674     }
675     if ($^O eq 'MSWin32' and $lib =~ /^(c|m|msvcrt|msvcrt\.lib)$/) {
676       $so = $ENV{SYSTEMROOT}."\\System32\\MSVCRT.DLL";
677       if ($lib = DynaLoader::dl_load_file($so, @_)) {
678               return $so;
679       }
680       # python has a different logic: The version+subversion is taken from 
681       # msvcrt dll used in the python.exe
682       # We search in the systempath for the first found.
683       push(@names, "MSVCRT.DLL","MSVCRT90","MSVCRT80","MSVCRT71","MSVCRT70",
684            "MSVCRT60","MSVCRT40","MSVCRT20");
685     }
686     # Either a dll if there exists a unversioned dll,
687     # or the import lib points to the versioned dll.
688     push(@dirs, "/lib", "/usr/lib", "/usr/bin/", "/usr/local/bin")
689       unless $^O eq 'MSWin32'; # i.e. cygwin
690     push(@dirs, $ENV{SYSTEMROOT}."\\System32", $ENV{SYSTEMROOT}, ".")
691       if $^O eq 'MSWin32';
692     push(@names, "cyg$_.dll", "lib$_.dll.a") if $^O eq 'cygwin';
693     push(@names, "$_.dll", "lib$_.a") if $^O eq 'MSWin32';
694     push(@names, "lib$_.so", "lib$_.a");
695     my $pthsep = $Config::Config{path_sep};
696     push(@dl_library_path, split(/$pthsep/, $ENV{LD_LIBRARY_PATH} || ""))
697       unless $^O eq 'MSWin32';
698     push(@dirs, split(/$pthsep/, $ENV{PATH}));
699   LOOP:
700     for my $name (@names) {
701       for my $dir (@dirs, @dl_library_path) {
702               next unless -d $dir;
703               my $file = File::Spec->catfile($dir,$name);
704               if (-f $file) {
705                 $found = $file;
706                 last LOOP;
707               }
708       }
709     }
710     if ($found) {
711       # resolve the .a or .dll.a to the dll. 
712       # dllimport from binutils must be in the path
713       $found = system("dllimport -I $found") if $found =~ /\.a$/;
714       return $found if $found;
715     }
716   } else {
717     if (-e $so) {
718       # resolve possible ld script
719       # GROUP ( /lib/libc.so.6 /usr/lib/libc_nonshared.a  AS_NEEDED ( /lib/ld-linux-x86-64.so.2 ) )
720       local $/;
721       my $fh;
722       open($fh, "<", $so);
723       my $slurp = <$fh>;
724       # for now the first in the GROUP. We should use ld 
725       # or /sbin/ldconfig -p or objdump
726       if ($slurp =~ /^\s*GROUP\s*\(\s*(\S+)\s+/m) {
727         return $1;
728       }
729     }
730   }
731 }
732
733 package Ctypes;
734
735 =item find_function (libraryhandle, functionname)
736
737 Returns the function address of the exported function within the shared library.
738 libraryhandle is the return value of find_library or DynaLoader::dl_load_file.
739
740 =cut
741
742 sub find_function($$) {
743   return DynaLoader::dl_find_symbol( shift, shift );
744 }
745
746 =item load_error ()
747
748 Returns the error description of the last L<load_library> call, 
749 via L<DynaLoader::dl_error>.
750
751 =cut
752
753 sub load_error() {
754   return DynaLoader::dl_error();
755 }
756
757 =item addressof (obj)
758
759 Returns the address of the memory buffer as integer. obj must be an
760 instance of a ctypes type.
761
762 =cut
763
764 sub addressof($) {
765   my $obj = shift;
766   $obj->isa("Ctypes::Type")
767     or die "addressof(".ref $obj.") not a Ctypes::Type";
768   return $obj->{address};
769 }
770
771 =item alignment(obj_or_type)
772
773 Returns the alignment requirements of a Ctypes type. 
774 obj_or_type must be a Ctypes type or instance.
775
776 =cut
777
778 sub alignment($) {
779   my $obj = shift;
780   $obj->isa("Ctypes::Type")
781     or die "alignment(".ref $obj.") not a Ctypes::Type or instance";
782   return $obj->{alignment};
783 }
784
785 =item byref(obj)
786
787 Returns a light-weight pointer to obj, which must be an instance of a
788 ctypes type. The returned object can only be used as a foreign
789 function call parameter. It behaves similar to pointer(obj), but the
790 construction is a lot faster.
791
792 =cut
793
794 sub byref {
795   return \$_[0];  
796 }
797
798 =item is_ctypes_compat($obj)
799
800 Returns 1 if object is Ctypes compatible - that is, it has a
801 _as_param_, _update_ and _typecode_ methods, and the value returned
802 by _typecode_ is valid. Returns undef otherwise.
803
804 =cut
805
806 sub is_ctypes_compat (\$) {
807   if( blessed($_[0]),
808       and $_[0]->can('_as_param_')
809       and $_[0]->can('_update_')
810       and $_[0]->can('typecode')
811     ) {
812     $@ = undef;
813     eval{ sizeof($_[0]->typecode) };
814     if( !$@ ) {
815       return 1;
816     }
817   }
818   return undef;
819 }
820
821 =item cast(obj, type)
822
823 This function is similar to the cast operator in C. It returns a new
824 instance of type which points to the same memory block as obj. type
825 must be a pointer type, and obj must be an object that can be
826 interpreted as a pointer.
827
828 =item create_string_buffer(init_or_size[, size])
829
830 This function creates a mutable character buffer. The returned object
831 is a ctypes array of c_char.
832
833 init_or_size must be an integer which specifies the size of the array,
834 or a string which will be used to initialize the array items.
835
836 If a string is specified as first argument, the buffer is made one
837 item larger than the length of the string so that the last element in
838 the array is a NUL termination character. An integer can be passed as
839 second argument which allows to specify the size of the array if the
840 length of the string should not be used.
841
842 If the first parameter is a unicode string, it is converted into an
843 8-bit string according to ctypes conversion rules.
844
845 =item create_unicode_buffer(init_or_size[, size])
846
847 This function creates a mutable unicode character buffer. The returned
848 object is a ctypes array of C<c_wchar>.
849
850 init_or_size must be an integer which specifies the size of the array,
851 or a unicode string which will be used to initialize the array items.
852
853 If a unicode string is specified as first argument, the buffer is made
854 one item larger than the length of the string so that the last element
855 in the array is a NUL termination character. An integer can be passed
856 as second argument which allows to specify the size of the array if
857 the length of the string should not be used.
858
859 If the first parameter is a 8-bit string, it is converted into an
860 unicode string according to ctypes conversion rules.
861
862 =item DllCanUnloadNow()
863
864 Windows only: This function is a hook which allows to implement
865 inprocess COM servers with ctypes. It is called from the
866 DllCanUnloadNow function that the Ctypes XS extension dll exports.
867
868 =item DllGetClassObject()
869
870 Windows only: This function is a hook which allows to implement
871 inprocess COM servers with ctypes. It is called from the
872 DllGetClassObject function that the Ctypes XS extension dll exports.
873
874 =item FormatError([code])
875
876 Windows only: Returns a textual description of the error code. If no
877 error code is specified, the last error code is used by calling the
878 Windows API function C<GetLastError>.
879
880 =item GetLastError()
881
882 Windows only: Returns the last error code set by Windows in the calling thread.
883
884 =item memmove(dst, src, count)
885
886 Same as the standard C memmove library function: copies count bytes
887 from src to dst. dst and src must be integers or ctypes instances that
888 can be converted to pointers.
889
890 =item memset(dst, c, count)
891
892 Same as the standard C memset library function: fills the memory block
893 at address dst with count bytes of value c. dst must be an integer
894 specifying an address, or a ctypes instance.
895
896 =item POINTER(type)
897
898 This factory function creates and returns a new ctypes pointer
899 type. Pointer types are cached an reused internally, so calling this
900 function repeatedly is cheap. type must be a ctypes type.
901
902 =item pointer(obj)
903
904 This function creates a new pointer instance, pointing to obj. The
905 returned object is of the type POINTER(type(obj)).
906
907 Note: If you just want to pass a pointer to an object to a foreign
908 function call, you should use byref(obj) which is much faster.
909
910 =item resize(obj, size)
911
912 This function resizes the internal memory buffer of obj, which must be
913 an instance of a ctypes type. It is not possible to make the buffer
914 smaller than the native size of the objects type, as given by
915 sizeof(type(obj)), but it is possible to enlarge the buffer.
916
917 =item set_conversion_mode(encoding, errors)
918
919 This function sets the rules that ctypes objects use when converting
920 between 8-bit strings and unicode strings. encoding must be a string
921 specifying an encoding, like 'utf-8' or 'mbcs', errors must be a
922 string specifying the error handling on encoding/decoding
923 errors. Examples of possible values are "strict", "replace", or
924 "ignore".
925
926 set_conversion_mode returns a 2-tuple containing the previous
927 conversion rules. On windows, the initial conversion rules are
928 ('mbcs', 'ignore'), on other systems ('ascii', 'strict').
929
930 =item sizeof(obj_or_type)
931
932 Returns the size in bytes of a ctypes type or instance memory
933 buffer. Does the same as the C sizeof() function.
934
935 =item string_at(address[, size])
936
937 This function returns the string starting at memory address
938 address. If size is specified, it is used as size, otherwise the
939 string is assumed to be zero-terminated.
940
941 =item WinError( { code=>undef, descr=>undef } )
942
943 Windows only: this function is probably the worst-named thing in
944 Ctypes. It creates an instance of WindowsError. 
945
946 If B<code> is not specified, GetLastError is called to determine the
947 error code. If B<descr> is not spcified, FormatError is called to get
948 a textual description of the error.
949
950 =item wstring_at(address)
951
952 This function returns the wide character string starting at memory
953 address address as unicode string. If size is specified, it is used as
954 the number of characters of the string, otherwise the string is
955 assumed to be zero-terminated.
956
957 =back
958
959 =head1 AUTHOR
960
961 Ryan Jendoubi C<< <ryan.jendoubi at gmail.com> >>
962
963 Reini Urban C<< <rurban at x-ray.at> >>
964
965 =head1 BUGS
966
967 Please report any bugs or feature requests to C<bug-ctypes at
968 rt.cpan.org>, or through the web interface at
969 L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Ctypes>.  I will be
970 notified, and then you'll automatically be notified of progress on
971 your bug as I make changes.
972
973 =head1 SUPPORT
974
975 You can see the proposed API and keep up to date with development at
976 L<http://blogs.perl.org/users/doubi> or by following <at>doubious_code
977 on Twitter (if anyone knows a microblogging client that lets me manage
978 my Twitter, Facebook and Iden.ti.ca from the one interface, please let
979 me know :-)
980
981 You can find documentation for this module with the perldoc command.
982
983     perldoc Ctypes
984
985 You can also look for information at:
986
987 =over 4
988
989 =item * RT: CPAN's request tracker
990
991 L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Ctypes>
992
993 =item * AnnoCPAN: Annotated CPAN documentation
994
995 L<http://annocpan.org/dist/Ctypes>
996
997 =item * CPAN Ratings
998
999 L<http://cpanratings.perl.org/d/Ctypes>
1000
1001 =item * Search CPAN
1002
1003 L<http://search.cpan.org/dist/Ctypes/>
1004
1005 =back
1006
1007 =head1 SEE ALSO
1008
1009 There are 4 other Perl ffi libraries:
1010 L<Win32::API>, L<C::DynaLib>, L<FFI> and L<P5NCI>.
1011
1012 You'll need the headers and/or description of the foreign library.
1013
1014 =head1 ACKNOWLEDGEMENTS
1015
1016 This module was created under the auspices of Google through their
1017 Summer of Code 2010. My deep thanks to Jonathan Leto, Reini Urban
1018 and Shlomi Fish for giving me the opportunity to work on the project.
1019
1020 =head1 LICENSE AND COPYRIGHT
1021
1022 Copyright 2010 Ryan Jendoubi.
1023
1024 This program is free software; you can redistribute it and/or modify it
1025 under the terms of the Artistic License 2.0.
1026
1027 See http://dev.perl.org/licenses/ for more information.
1028
1029 =cut
1030
1031
1032 ################################
1033 #   PRIVATE FUNCTIONS & DATA   #
1034 ################################
1035
1036 # Take input of:
1037 #   ARRAY ref
1038 #   or list
1039 #   or typecode string
1040 # ... and interpret into an array ref
1041 sub _make_arrayref {
1042   my @inputs = @_;
1043   my $output = [];
1044   # Turn single arg or LIST into arrayref...
1045   if( ref($inputs[0]) ne 'ARRAY' ) {
1046     if( $#inputs > 0 ) {      # there is a list of inputs 
1047       for(@inputs) {
1048         push @{$output}, $_;
1049       }    
1050     } else {   # there is only one input 
1051       if( !ref($inputs[0]) ) {
1052       # We can make list of argtypes from string of type codes...
1053         $output = [ split(//,$inputs[0]) ];
1054       } else {
1055         push @{$output}, $inputs[0];
1056       }
1057     }
1058   } else {  # first arg is an ARRAY ref, must be the only arg
1059     croak( "Can't take more args after ARRAY ref" ) if $#inputs > 0;
1060     $output = $inputs[0];
1061   }
1062   return $output;
1063 }
1064
1065 # Take an arrayref (see _make_arrayref) and makes sure all contents are
1066 #   valid typecodes
1067 #   Type objects
1068 #   Objects implementing _as_param_ attribute or method
1069 # Returns UNDEF on SUCCESS
1070 # Returns the index of the failing thingy on failure
1071 sub _check_invalid_types ($) {
1072   my $typesref = shift;
1073   # Now check supplied args are valid...
1074   my $typecode = undef;
1075   for( my $i=0; $i<=$#{$typesref}; $i++ ) {
1076     $_ = $typesref->[$i];
1077     # Check objects fulfil all the requirements...
1078     if( ref($_) ) {
1079       if( !blessed($_) ) {
1080         carp("No unblessed references as types");
1081         return $i;
1082       } else {
1083         if( !$_->can("_as_param_")
1084             and not defined($_->{_as_param_}) ) {
1085           carp("types must have _as_param_ method or attribute");
1086           return $i;
1087         }
1088         # try for attribute first
1089         $typecode = $_->{_typecode_};
1090         if( not defined($typecode) ) {
1091           if( $_->can("typecode") ) {
1092             $typecode = $_->typecode;
1093           } else {
1094             carp("types must have typecode method");
1095             return $i;
1096           }
1097         }
1098         eval{ Ctypes::sizeof($typecode) };
1099         if( $@ ) { 
1100           carp( @_ );
1101           return $i;
1102         }
1103       } 
1104     } else {
1105     # Not a ref; make sure it's a valid 1-char typecode...
1106       if( length($_) > 1 ) {
1107 carp("types must be valid objects or 1-char typecodes (perldoc Ctypes)");
1108         return $i;
1109       }
1110       eval{ Ctypes::sizeof($_); };
1111       if( $@ ) { 
1112         carp( @_ );
1113         return $i;
1114       }
1115     }
1116   }
1117   return undef;
1118 }
1119
1120 # Take an list of Perl natives, return the typecode of
1121 # the smallest C type needed to hold all the data - the
1122 # lowest common demoninator, if you will (will you?)
1123 sub _check_type_needed (@) {
1124   # XXX This needs changed when we support more typecodes
1125   print "In _check_type_needed\n" if $Debug == 1;
1126   my @numtypes = qw|s i l d|; #  1.short 2.int 3.long 4.double
1127   my $low = 0;
1128   my $char = 0;
1129   my $string = 0;
1130   for(my $i = 0; defined( local $_ = $_[$i]); $i++ ) {
1131   print "    Now looking at: $_\n" if $Debug == 1; 
1132    if( $char == 1 or !looks_like_number($_) ) {
1133       $char = 1;
1134       $string = 1 if length( $_ ) > 1;
1135       last if $string == 1;
1136       next;
1137     } else {
1138       next if $low == 3;
1139       $low = 1 if $_ > Ctypes::constant('PERL_SHORT_MAX') and $low < 1;
1140       $low = 2 if $_ > Ctypes::constant('PERL_INT_MAX') and $low < 2;
1141       $low = 3 if $_ > Ctypes::constant('PERL_LONG_MAX') and $low < 3;
1142     }
1143   }
1144   my $ret;
1145   if( $string == 1 ) {
1146     $ret = 'p';
1147   } elsif( $char == 1 ) {
1148     $ret = 'C';
1149   } else {
1150     $ret = $numtypes[$low];
1151   }
1152   print "  Returning: $ret\n" if $Debug == 1; 
1153   return $ret;
1154 }
1155
1156
1157 1;
1158 __END__