package Win32::API::Type; # See the bottom of this file for the POD documentation. Search for the # string '=head'. ####################################################################### # # Win32::API::Type - Perl Win32 API type definitions # # Author: Aldo Calpini # Maintainer: Cosimo Streppone # # $Id: Type.pm,v 1.0 2001/10/30 13:57:31 dada Exp $ ####################################################################### $VERSION = '0.47'; use Carp; require Exporter; # to export the constants to the main:: space require DynaLoader; # to dynuhlode the module. @ISA = qw( Exporter DynaLoader ); use vars qw( %Known %PackSize %Modifier %Pointer ); sub DEBUG { if ($Win32::API::DEBUG) { printf @_ if @_ or return 1; } else { return 0; } } %Known = (); %PackSize = (); %Modifier = (); %Pointer = (); # Initialize data structures at startup. # Aldo wants to keep the approach. # my $section = 'nothing'; foreach () { next if /^\s*#/ or /^\s*$/; chomp; if( /\[(.+)\]/) { $section = $1; next; } if($section eq 'TYPE') { my($name, $packing) = split(/\s+/); # DEBUG "(PM)Type::INIT: Known('$name') => '$packing'\n"; $Known{$name} = $packing; } elsif($section eq 'PACKSIZE') { my($packing, $size) = split(/\s+/); # DEBUG "(PM)Type::INIT: PackSize('$packing') => '$size'\n"; $PackSize{$packing} = $size; } elsif($section eq 'MODIFIER') { my($modifier, $mapto) = split(/\s+/, $_, 2); my %maps = (); foreach my $item (split(/\s+/, $mapto)) { my($k, $v) = split(/=/, $item); $maps{$k} = $v; } # DEBUG "(PM)Type::INIT: Modifier('$modifier') => '%maps'\n"; $Modifier{$modifier} = { %maps }; } elsif($section eq 'POINTER') { my($pointer, $pointto) = split(/\s+/); # DEBUG "(PM)Type::INIT: Pointer('$pointer') => '$pointto'\n"; $Pointer{$pointer} = $pointto; } } close(DATA); sub new { my $class = shift; my($type) = @_; my $packing = packing($type); my $size = sizeof($type); my $self = { type => $type, packing => $packing, size => $size, }; return bless $self; } sub typedef { my $class = shift; my($name, $type) = @_; my $packing = packing($type, $name); DEBUG "(PM)Type::typedef: packing='$packing'\n"; my $size = sizeof($type); $Known{$name} = $packing; return 1; } sub is_known { my $self = shift; my $type = shift; $type = $self unless defined $type; if(ref($type) =~ /Win32::API::Type/) { return 1; } else { return defined packing($type); } } sub sizeof { my $self = shift; my $type = shift; $type = $self unless defined $type; if(ref($type) =~ /Win32::API::Type/) { return $self->{size}; } else { my $packing = packing($type); if($packing =~ /(\w)\*(\d+)/) { return $PackSize{ $1 } * $2; } else { return $PackSize{ $packing }; } } } sub packing { # DEBUG "(PM)Type::packing: called by ". join("::", (caller(1))[0,3]). "\n"; my $self = shift; my $is_pointer = 0; if(ref($self) =~ /Win32::API::Type/) { # DEBUG "(PM)Type::packing: got an object\n"; return $self->{packing}; } my $type = ($self eq 'Win32::API::Type') ? shift : $self; my $name = shift; # DEBUG "(PM)Type::packing: got '$type', '$name'\n"; my($modifier, $size, $packing); if(exists $Pointer{$type}) { # DEBUG "(PM)Type::packing: got '$type', is really '$Pointer{$type}'\n"; $type = $Pointer{$type}; $is_pointer = 1; } elsif($type =~ /(\w+)\s+(\w+)/) { $modifier = $1; $type = $2; # DEBUG "(PM)packing: got modifier '$modifier', type '$type'\n"; } $type =~ s/\*$//; if(exists $Known{$type}) { if(defined $name and $name =~ s/\[(.*)\]$//) { $size = $1; $packing = $Known{$type}[0]."*".$size; # DEBUG "(PM)Type::packing: composite packing: '$packing' '$size'\n"; } else { $packing = $Known{$type}; if($is_pointer and $packing eq 'c') { $packing = "p"; } # DEBUG "(PM)Type::packing: simple packing: '$packing'\n"; } if(defined $modifier and exists $Modifier{$modifier}->{$type}) { # DEBUG "(PM)Type::packing: applying modifier '$modifier' -> '$Modifier{$modifier}->{$type}'\n"; $packing = $Modifier{$modifier}->{$type}; } return $packing; } else { # DEBUG "(PM)Type::packing: NOT FOUND\n"; return undef; } } sub is_pointer { my $self = shift; my $type = shift; $type = $self unless defined $type; if(ref($type) =~ /Win32::API::Type/) { return 1; } else { if($type =~ /\*$/) { return 1; } else { return exists $Pointer{$type}; } } } sub Pack { my $type = $_[0]; if(packing($type) eq 'c' and is_pointer($type)) { $_[1] = pack("Z*", $_[1]); return $_[1]; } $_[1] = pack( packing($type), $_[1]); return $_[1]; } sub Unpack { my $type = $_[0]; if(packing($type) eq 'c' and is_pointer($type)) { DEBUG "(PM)Type::Unpack: got packing 'c', is a pointer, unpacking 'Z*' '$_[1]'\n"; $_[1] = unpack("Z*", $_[1]); DEBUG "(PM)Type::Unpack: returning '$_[1]'\n"; return $_[1]; } DEBUG "(PM)Type::Unpack: unpacking '".packing($type)."' '$_[1]'\n"; $_[1] = unpack( packing($type), $_[1]); DEBUG "(PM)Type::Unpack: returning '$_[1]'\n"; return $_[1]; } 1; ####################################################################### # DOCUMENTATION # =head1 NAME Win32::API::Type - C type support package for Win32::API =head1 SYNOPSIS use Win32::API; Win32::API::Type->typedef( 'my_number', 'LONG' ); =head1 ABSTRACT This module is a support package for Win32::API that implements C types for the import with prototype functionality. See L for more info about its usage. =head1 DESCRIPTION This module is automatically imported by Win32::API, so you don't need to 'use' it explicitly. These are the methods of this package: =over 4 =item C This method defines a new type named C. This actually just creates an alias for the already-defined type C, which you can use as a parameter in a Win32::API call. =item C This returns the size, in bytes, of C. Acts just like the C function of the same name. =item C Returns true if C is known by Win32::API::Type, false otherwise. =back =head2 SUPPORTED TYPES This module should recognize all the types defined in the Win32 Platform SDK header files. Please see the source for this module, in the C<__DATA__> section, for the full list. =head1 AUTHOR Aldo Calpini ( I ). =head1 MAINTAINER Cosimo Streppone ( I ). =cut __DATA__ [TYPE] ATOM s BOOL L BOOLEAN c BYTE C CHAR c COLORREF L DWORD L DWORD32 L DWORD64 Q FLOAT f HACCEL L HANDLE L HBITMAP L HBRUSH L HCOLORSPACE L HCONV L HCONVLIST L HCURSOR L HDC L HDDEDATA L HDESK L HDROP L HDWP L HENHMETAFILE L HFILE L HFONT L HGDIOBJ L HGLOBAL L HHOOK L HICON L HIMC L HINSTANCE L HKEY L HKL L HLOCAL L HMENU L HMETAFILE L HMODULE L HPALETTE L HPEN L HRGN L HRSRC L HSZ L HWINSTA L HWND L INT i INT32 i INT64 q LANGID s LCID L LCSCSTYPE L LCSGAMUTMATCH L LCTYPE L LONG l LONG32 l LONG64 q LONGLONG q LPARAM L LRESULT L REGSAM L SC_HANDLE L SC_LOCK L SERVICE_STATUS_HANDLE L SHORT s SIZE_T L SSIZE_T L TBYTE c TCHAR C UCHAR C UINT I UINT_PTR L UINT32 I UINT64 Q ULONG L ULONG32 L ULONG64 Q ULONGLONG Q USHORT S WCHAR S WORD S WPARAM L VOID c int i long l float f double d char c #CRITICAL_SECTION 24 -- a structure #LUID ? 8 -- a structure #VOID 0 #CONST 4 #FILE_SEGMENT_ELEMENT 8 -- a structure [PACKSIZE] c 1 C 1 d 8 f 4 i 4 I 4 l 4 L 4 q 8 Q 8 s 2 S 2 p 4 [MODIFIER] unsigned int=I long=L short=S char=C [POINTER] INT_PTR INT LPBOOL BOOL LPBYTE BYTE LPCOLORREF COLORREF LPCSTR CHAR #LPCTSTR CHAR or WCHAR LPCTSTR CHAR LPCVOID any LPCWSTR WCHAR LPDWORD DWORD LPHANDLE HANDLE LPINT INT LPLONG LONG LPSTR CHAR #LPTSTR CHAR or WCHAR LPTSTR CHAR LPVOID VOID LPWORD WORD LPWSTR WCHAR PBOOL BOOL PBOOLEAN BOOL PBYTE BYTE PCHAR CHAR PCSTR CSTR PCWCH CWCH PCWSTR CWSTR PDWORD DWORD PFLOAT FLOAT PHANDLE HANDLE PHKEY HKEY PINT INT PLCID LCID PLONG LONG PSHORT SHORT PSTR CHAR #PTBYTE TBYTE -- #PTCHAR TCHAR -- #PTSTR CHAR or WCHAR PTSTR CHAR PUCHAR UCHAR PUINT UINT PULONG ULONG PUSHORT USHORT PVOID VOID PWCHAR WCHAR PWORD WORD PWSTR WCHAR