File Coverage

blib/lib/FFI/Platypus/Lang/Win32.pm
Criterion Covered Total %
statement 40 48 83.3
branch 10 14 71.4
condition 1 3 33.3
subroutine 7 7 100.0
pod 3 3 100.0
total 61 75 81.3


line stmt bran cond sub pod time code
1             package FFI::Platypus::Lang::Win32;
2              
3 1     1   217698 use strict;
  1         8  
  1         27  
4 1     1   5 use warnings;
  1         2  
  1         22  
5 1     1   26 use 5.008004;
  1         3  
6 1     1   5 use Config;
  1         2  
  1         604  
7              
8             # ABSTRACT: Documentation and tools for using Platypus with the Windows API
9             our $VERSION = '2.06_01'; # TRIAL VERSION
10              
11              
12             sub abi
13             {
14 1 50 33 1 1 27 $^O =~ /^(cygwin|MSWin32|msys)$/ && $Config{ptrsize} == 4
15             ? 'stdcall'
16             : 'default_abi';
17             }
18              
19              
20             my %map;
21              
22             sub native_type_map
23             {
24 2 100   2 1 6775 unless(%map)
25             {
26 1         6 require FFI::Platypus::ShareConfig;
27 1         3 %map = %{ FFI::Platypus::ShareConfig->get('type_map') };
  1         5  
28              
29 1         65 my %win32_map = qw(
30             BOOL int
31             BOOLEAN BYTE
32             BYTE uchar
33             CCHAR char
34             CHAR char
35             COLORREF DWORD
36             DWORD uint
37             DWORDLONG uint64
38             DWORD_PTR ULONG_PTR
39             DWORD32 uint32
40             DWORD64 uint64
41             FLOAT float
42             HACCEL HANDLE
43             HANDLE PVOID
44             HBITMAP HANDLE
45             HBRUSH HANDLE
46             HCOLORSPACE HANDLE
47             HCONV HANDLE
48             HCONVLIST HANDLE
49             HCURSOR HICON
50             HDC HANDLE
51             HDDEDATA HANDLE
52             HDESK HANDLE
53             HDROP HANDLE
54             HDWP HANDLE
55             HENHMETAFILE HANDLE
56             HFILE int
57             HFONT HANDLE
58             HGDIOBJ HANDLE
59             HGLOBAL HANDLE
60             HHOOK HANDLE
61             HICON HANDLE
62             HINSTANCE HANDLE
63             HKEY HANDLE
64             HKL HANDLE
65             HLOCAL HANDLE
66             HMENU HANDLE
67             HMETAFILE HANDLE
68             HMODULE HINSTANCE
69             HMONITOR HANDLE
70             HPALETTE HANDLE
71             HPEN HANDLE
72             HRESULT LONG
73             HRGN HANDLE
74             HRSRC HANDLE
75             HSZ HANDLE
76             HWINSTA HANDLE
77             HWND HANDLE
78             INT int
79             INT8 sint8
80             INT16 sint16
81             INT32 sint32
82             INT64 sint64
83             LANGID WORD
84             LCID DWORD
85             LCTYPE DWORD
86             LGRPID DWORD
87             LONG sint32
88             LONGLONG sint64
89             LONG32 sint32
90             LONG64 sint64
91             LPCSTR string
92             LPCVOID opaque
93             LPVOID opaque
94             LRESULT LONG_PTR
95             PSTR string
96             PVOID opaque
97             QWORD uint64
98             SC_HANDLE HANDLE
99             SC_LOCK LPVOID
100             SERVICE_STATUS_HANDLE HANDLE
101             SHORT sint16
102             SIZE_T ULONG_PTR
103             SSIZE_T LONG_PTR
104             UCHAR uint8
105             UINT uint
106             UINT8 uint8
107             UINT16 uint16
108             UINT32 uint32
109             UINT64 uint64
110             ULONG uint32
111             ULONGLONG uint64
112             ULONG32 uint32
113             ULONG64 uint64
114             USHORT uint16
115             USN LONGLONG
116             VOID void
117             WORD uint16
118             WPARAM UINT_PTR
119              
120             );
121              
122 1 50       84 if($Config{ptrsize} == 4)
    50          
123             {
124 0         0 $win32_map{HALF_PTR} = 'sint16';
125 0         0 $win32_map{INT_PTR} = 'sint32';
126 0         0 $win32_map{LONG_PTR} = 'sint16';
127 0         0 $win32_map{UHALF_PTR} = 'uint16';
128 0         0 $win32_map{UINT_PTR} = 'uint32';
129 0         0 $win32_map{ULONG_PTR} = 'uint16';
130             }
131             elsif($Config{ptrsize} == 8)
132             {
133 1         4 $win32_map{HALF_PTR} = 'sint16';
134 1         3 $win32_map{INT_PTR} = 'sint32';
135 1         2 $win32_map{LONG_PTR} = 'sint16';
136 1         2 $win32_map{UHALF_PTR} = 'uint16';
137 1         3 $win32_map{UINT_PTR} = 'uint32';
138 1         2 $win32_map{ULONG_PTR} = 'uint16';
139             }
140             else
141             {
142 0         0 die "interesting word size you have";
143             }
144              
145 1         13 foreach my $alias (keys %win32_map)
146             {
147 95         122 my $type = $alias;
148 95         110 while(1)
149             {
150 212 100       429 if($type =~ /^(opaque|[us]int(8|16|32|64)|float|double|string|void)$/)
151             {
152 49         74 $map{$alias} = $type;
153 49         72 last;
154             }
155 163 100       275 if(defined $map{$type})
156             {
157 46         75 $map{$alias} = $map{$type};
158 46         75 last;
159             }
160 117 50       183 if(defined $win32_map{$type})
161             {
162 117         153 $type = $win32_map{$type};
163 117         145 next;
164             }
165 0         0 die "unable to resolve $alias => ... => $type";
166             }
167             }
168              
169             # stuff we are not yet dealing with
170             # LPCTSTR is unicode string, not currently supported
171             # LPWSTR 16 bit unicode string
172             # TBYTE TCHAR UNICODE_STRING WCHAR
173             # Not supported: POINTER_32 POINTER_64 POINTER_SIGNED POINTER_UNSIGNED
174             }
175 2         8 \%map;
176             }
177              
178              
179             sub load_custom_types
180             {
181 1     1 1 4 my(undef, $ffi) = @_;
182 1         6 $ffi->load_custom_type('::WideString' => 'LPCWSTR', access => 'read' );
183 1         3 $ffi->load_custom_type('::WideString' => 'LPWSTR', access => 'write' );
184             }
185              
186             1;
187              
188             __END__